Revert "well"

This reverts commit 778677e967.

csp/aima.rkt

@@ -8,11 +8,6 @@
 (define variable? symbol?)
 (define removal? (cons/c variable? any/c))
 
-(define (update-assignment assignment var val)
-  (define h (hash-copy assignment))
-  (hash-set! h var val)
-  h)
-
 (struct $constraint (names proc) #:transparent)
 (struct $vd (name vals) #:transparent)
 
@@ -53,15 +48,13 @@
 (define nassigns $csp-nassigns)
 (define nchecks $csp-nchecks)
 
-(define/contract (check-constraint csp varval-hash [limit #f])
+(define/contract (check-constraint csp . varvals)
-  (($csp? hash?) ((or/c #f variable?)) . ->* . any/c)
+  (($csp?) #:rest (listof any/c) . ->* . any/c)
+  (define varval-hash (apply hasheq varvals))
   (define relevant-constraints
     (for/list ([constraint (in-list ($csp-constraints csp))]
-               #:when (let ([cnames ($constraint-names constraint)])
+               #:when (for/and ([cname (in-list ($constraint-names constraint))])
-                        (and
+                        (memq cname (hash-keys varval-hash))))
-                         (if limit (memq limit cnames) #true)
-                         (for/and ([cname (in-list cnames)])
-                           (memq cname (hash-keys varval-hash))))))
       constraint))
   (begin0
     (for/and ([constraint (in-list relevant-constraints)])
@@ -92,17 +85,18 @@
   ($csp? assignment? . -> . boolean?)
   (= (length (hash-keys assignment)) (length ($csp-variables csp))))
 
-(define asses (make-parameter #f))
+
 (define/contract (nconflicts csp var val assignment)
   ($csp? variable? any/c assignment? . -> . number?)
   ;; Return the number of conflicts var=val has with other variables."""
   ;; Subclasses may implement this more efficiently
-  (define ass (update-assignment assignment var val))
   (for/sum ([v (in-list (neighbors csp var))]
             #:when (assignment . assigns? . v))
-    (if (check-constraint csp (if asses
+    #;(define this (apply check-constraint csp (append (list var val) (flatten (for/list ([(k v) (in-hash assignment)]
-                                  ass
+                                                                               #:unless (eq? var k))
-                                  (hasheq var val v (hash-ref assignment v))))
+                                                                      (list k v))))))
+    (define that (check-constraint csp var val v (hash-ref assignment v)))
+    (if that
         0
         1)))
 
@@ -248,7 +242,7 @@
     (cond
       [(not
         (for/or ([y (in-list (curr_domain csp Xj))])
-          (check-constraint csp (hasheq Xi x Xj y))))
+          (check-constraint csp Xi x Xj y)))
        (prune csp Xi x removals)
        #true]
       [else revised])))
@@ -311,11 +305,10 @@
   ($csp? variable? any/c assignment? (box/c (listof removal?)) . -> . boolean?)
   ;; Prune neighbor values inconsistent with var=value.
   (support_pruning csp) ;; necessary to set up curr_domains
-  (define ass (update-assignment assignment var value))
   (for/and ([B (in-list (neighbors csp var))]
             #:unless (assignment . assigns? . B))
     (for ([b (in-list (curr_domain csp B))]
-          #:unless (check-constraint csp (if asses ass (hasheq var value B b))))
+          #:unless (check-constraint csp var value B b))
       (prune csp B b removals))
     (not (empty? (curr_domain csp B)))))
 
@@ -401,44 +394,23 @@
     [else #false]))
 
 (require rackunit)
-(define vs '(wa nsw t q nt v sa))
+
-(define vds (for/list ([k vs])
+(begin
-              ($vd k '(red green blue))))
+    (define vs '(wa nsw t q nt v sa))
-(define (neq? a b) (not (eq? a b)))
+    (define vds (for/list ([k vs])
-(define cs (list
+                  ($vd k '(red green blue))))
-            ($constraint '(wa nt) neq?)
+    (define (neq? a b) (not (eq? a b)))
-            ($constraint '(wa sa) neq?)
+    (define cs (list
-            ($constraint '(nt sa) neq?)
+                ($constraint '(wa nt) neq?)
-            ($constraint '(nt q) neq?)
+                ($constraint '(wa sa) neq?)
-            ($constraint '(q sa) neq?)
+                ($constraint '(nt sa) neq?)
-            ($constraint '(q nsw) neq?)
+                ($constraint '(nt q) neq?)
-            ($constraint '(nsw sa) neq?)
+                ($constraint '(q sa) neq?)
-            ($constraint '(nsw v) neq?)
+                ($constraint '(q nsw) neq?)
-            ($constraint '(v sa) neq?)))
+                ($constraint '(nsw sa) neq?)
-(define csp (make-csp vds cs))
+                ($constraint '(nsw v) neq?)
-
+                ($constraint '(v sa) neq?)))
-(define (one)
+    (define csp (make-csp vds cs))
-  (parameterize ([current-select-variable mrv]
-                 [current-order-values lcv]
-                 [current-inference mac]
-                 [current-reset #f]
-                 [current-shuffle #f])
-    (set-$csp-curr_domains! csp #f)
-    (check-equal? (solve csp)
-                  (make-hasheq
-                   '((nsw . green)
-                     (nt . green)
-                     (q . red)
-                     (sa . blue)
-                     (t . red)
-                     (v . red)
-                     (wa . red))))
-
-    (check-equal? (begin0 (list ($csp-nassigns csp) ($csp-nchecks csp)) (reset-counters! csp)) '(7 97))))
-
-(define (test)
-  (begin
-    (set-$csp-curr_domains! csp #f)
     (check-true ($csp? csp))
     (define a (make-hasheq))
     (assign csp 'key 42 a)
@@ -532,7 +504,7 @@
       (check-equal?
        (solve csp)
        (make-hasheq '((nsw . red) (nt . red) (q . green) (sa . blue) (t . red) (v . green) (wa . green))))
-      (check-equal? (begin0 (list ($csp-nassigns csp) ($csp-nchecks csp)) (reset-counters! csp)) '(9 220)))))
+      (check-equal? (begin0 (list ($csp-nassigns csp) ($csp-nchecks csp)) (reset-counters! csp)) '(9 220))))
 
 (solve (make-csp (list ($vd 'a '(1 2 3))
                        ($vd 'b '(4 5 6))