diff --git a/csp/aima.rkt b/csp/aima.rkt index 9c262675..8e515cf2 100644 --- a/csp/aima.rkt +++ b/csp/aima.rkt @@ -10,6 +10,18 @@ ((listof variable?) hash? hash? procedure? . -> . $csp?) ($csp variables domains neighbors constraints null #f 0)) +(define/contract (curr_domain csp var) + ($csp? variable? . -> . (listof any/c)) + (hash-ref ($csp-curr_domains csp) var)) + +(define/contract (neighbors csp var) + ($csp? variable? . -> . (listof variable?)) + (hash-ref ($csp-neighbors csp) var)) + +(define/contract (assigns? assignment var) + (assignment? variable? . -> . boolean?) + (hash-has-key? assignment var)) + (define/contract (reset-nassigns! csp) ($csp? . -> . void?) (set-$csp-nassigns! csp 0)) @@ -31,8 +43,8 @@ ($csp? variable? any/c assignment? . -> . number?) ;; Return the number of conflicts var=val has with other variables.""" ;; Subclasses may implement this more efficiently - (for/sum ([v (in-list (hash-ref ($csp-neighbors csp) var))] - #:when (hash-has-key? assignment v)) + (for/sum ([v (in-list (neighbors csp var))] + #:when (assignment . assigns? . v)) (if (($csp-constraints csp) var val v (hash-ref assignment v)) 0 1))) (define (display csp assignment) @@ -67,9 +79,9 @@ ;; Start accumulating inferences from assuming var=value (support_pruning csp) (begin0 - (box (for/list ([a (hash-ref ($csp-curr_domains csp) var)] - #:when (not (equal? a value))) - (cons var a))) + (box (for/list ([val (in-list (curr_domain csp var))] + #:when (not (equal? val value))) + (cons var val))) (hash-set! ($csp-curr_domains csp) var (list value)))) ;; todo: update uses of `prune` to be functional on removals @@ -92,7 +104,7 @@ (support_pruning csp) (define assignment (make-hasheq)) (for ([v (in-list ($csp-variables csp))]) - (match (hash-ref ($csp-curr_domains csp) v) + (match (curr_domain csp v) [(list one-value) (hash-set! assignment v one-value)] [else #f])) assignment) @@ -115,7 +127,7 @@ (assignment? $csp? . -> . (or/c #false variable?)) ;; The default variable order. (for/first ([var (in-list ($csp-variables csp))] - #:unless (hash-has-key? assignment var)) + #:unless (assignment . assigns? . var)) var)) (define current-shuffle (make-parameter #t)) @@ -126,7 +138,7 @@ ;; with random tiebreaker. (define (num_legal_values var) (if ($csp-curr_domains csp) - (length (hash-ref ($csp-curr_domains csp) var)) + (length (curr_domain csp var)) ;; todo: is this the same as python `count`? (for/sum ([val (in-list (hash-ref ($csp-domains csp) var))] #:when (zero? (nconflicts csp var val assignment))) @@ -134,7 +146,7 @@ (struct $mrv-rec (var num) #:transparent) (define recs (sort (for/list ([var (in-list ($csp-variables csp))] - #:unless (hash-has-key? assignment var)) + #:unless (assignment . assigns? . var)) ($mrv-rec var (num_legal_values var))) < #:key $mrv-rec-num)) (first ((if (current-shuffle) shuffle values) (map $mrv-rec-var (takef recs (λ (rec) (= ($mrv-rec-num (first recs)) @@ -162,12 +174,12 @@ ($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 - (for/and ([B (in-list (hash-ref ($csp-neighbors csp) var))] - #:unless (hash-has-key? assignment B)) - (for ([b (in-list (hash-ref ($csp-curr_domains csp) B))] + (for/and ([B (in-list (neighbors csp var))] + #:unless (assignment . assigns? . B)) + (for ([b (in-list (curr_domain csp B))] #:unless (($csp-constraints csp) var value B b)) (prune csp B b removals)) - (not (empty? (hash-ref ($csp-curr_domains csp) B))))) + (not (empty? (curr_domain csp B))))) (define current-select-variable (make-parameter first_unassigned_variable)) (define current-order-values (make-parameter unordered_domain_values)) @@ -240,8 +252,7 @@ (check-true (hash? ($csp-curr_domains csp))) (check-equal? (suppose csp 'wa 'red) '#&((wa . green) (wa . blue))) -(check-equal? - (hash-ref ($csp-curr_domains csp) 'wa) '(red)) +(check-equal? (curr_domain csp 'wa) '(red)) (check-equal? (prune csp 'v 'red (box empty)) '#&((v . red))) @@ -297,7 +308,6 @@ (set-$csp-curr_domains! csp #f) (parameterize ([current-inference forward_checking] [current-reset #f]) - (support_pruning csp) (check-equal? (solve csp) (make-hasheq '((nsw . green) (nt . green) (q . red) (sa . blue) (t . blue) (v . red) (wa . red))))