simpler

csp/aima.rkt

@@ -2,7 +2,7 @@
 (require racket/generator sugar graph)
 (provide (all-defined-out))
 
-(struct $csp (variables domains neighbors constraints initial curr_domains nassigns nchecks current) #:transparent #:mutable)
+(struct $csp (variables domains neighbors constraints initial curr_domains nassigns nchecks current graph) #:transparent #:mutable)
 ;; `current` = current assignment
 (define assignment? hash?)
 (define variable? symbol?)
@@ -18,16 +18,16 @@
     (apply add-edge! g edge)
     g))
 
-(define/contract (make-csp variables vds constraints)
+(define/contract (make-csp vds constraints)
-  ((listof variable?) (listof $vd?) (listof $constraint?) . -> . $csp?)
+  ((listof $vd?) (listof $constraint?) . -> . $csp?)
-  (define g (constraint-graph variables constraints))
+  (define variables (map $vd-name vds))
-  (define ns (for/hasheq ([v (in-list variables)])
-               (values v (get-neighbors g v))))
   (define domains (for/hasheq ([vd (in-list vds)])
                     (match vd
                       [($vd name vals) (values name vals)])))
-      
+  (define g (constraint-graph variables constraints))
-  ($csp variables domains ns constraints null #f 0 0 #f))
+  (define neighbors (for/hasheq ([v (in-list variables)])
+                      (values v (get-neighbors g v))))
+  ($csp variables domains neighbors constraints null #f 0 0 #f g))
 
 (define/contract (domain csp var)
   ($csp? variable? . -> . (listof any/c))
@@ -384,21 +384,22 @@
     [else #false]))
 
 (require rackunit)
+
 (define vs '(wa nsw t q nt v sa))
-(define ds (for/list ([k vs])
+(define vds (for/list ([k vs])
-             ($vd k '(red green blue))))
+              ($vd k '(red green blue))))
 (define (neq? a b) (not (eq? a b)))
 (define cs (list
-             ($constraint '(wa nt) neq?)
+            ($constraint '(wa nt) neq?)
-             ($constraint '(wa sa) neq?)
+            ($constraint '(wa sa) neq?)
-             ($constraint '(nt sa) neq?)
+            ($constraint '(nt sa) neq?)
-             ($constraint '(nt q) neq?)
+            ($constraint '(nt q) neq?)
-             ($constraint '(q sa) neq?)
+            ($constraint '(q sa) neq?)
-             ($constraint '(q nsw) neq?)
+            ($constraint '(q nsw) neq?)
-             ($constraint '(nsw sa) neq?)
+            ($constraint '(nsw sa) neq?)
-             ($constraint '(nsw v) neq?)
+            ($constraint '(nsw v) neq?)
-             ($constraint '(v sa) neq?)))
+            ($constraint '(v sa) neq?)))
-(define csp (make-csp vs ds cs))
+(define csp (make-csp vds cs))
 (check-true ($csp? csp))
 (define a (make-hasheq))
 (assign csp 'key 42 a)