diff --git a/csp/aima.rkt b/csp/aima.rkt index 64547c5f..cace3e26 100644 --- a/csp/aima.rkt +++ b/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) - ((listof variable?) (listof $vd?) (listof $constraint?) . -> . $csp?) - (define g (constraint-graph variables constraints)) - (define ns (for/hasheq ([v (in-list variables)]) - (values v (get-neighbors g v)))) +(define/contract (make-csp vds constraints) + ((listof $vd?) (listof $constraint?) . -> . $csp?) + (define variables (map $vd-name vds)) (define domains (for/hasheq ([vd (in-list vds)]) (match vd [($vd name vals) (values name vals)]))) - - ($csp variables domains ns constraints null #f 0 0 #f)) + (define g (constraint-graph variables constraints)) + (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]) - ($vd k '(red green blue)))) +(define vds (for/list ([k vs]) + ($vd k '(red green blue)))) (define (neq? a b) (not (eq? a b))) (define cs (list - ($constraint '(wa nt) neq?) - ($constraint '(wa sa) neq?) - ($constraint '(nt sa) neq?) - ($constraint '(nt q) neq?) - ($constraint '(q sa) neq?) - ($constraint '(q nsw) neq?) - ($constraint '(nsw sa) neq?) - ($constraint '(nsw v) neq?) - ($constraint '(v sa) neq?))) -(define csp (make-csp vs ds cs)) + ($constraint '(wa nt) neq?) + ($constraint '(wa sa) neq?) + ($constraint '(nt sa) neq?) + ($constraint '(nt q) neq?) + ($constraint '(q sa) neq?) + ($constraint '(q nsw) neq?) + ($constraint '(nsw sa) neq?) + ($constraint '(nsw v) neq?) + ($constraint '(v sa) neq?))) +(define csp (make-csp vds cs)) (check-true ($csp? csp)) (define a (make-hasheq)) (assign csp 'key 42 a)