Revert "param style"

This reverts commit a631ee4547.
main
Matthew Butterick 6 years ago
parent a631ee4547
commit 0f8cca3cec

@ -5,7 +5,6 @@
(define assignment? hash?)
(define variable? symbol?)
(define removal? (cons/c variable? any/c))
(define current-removals (make-parameter empty))
(define/contract (make-csp variables domains neighbors constraints)
((listof variable?) hash? hash? procedure? . -> . $csp?)
@ -71,11 +70,11 @@
removals)
;; todo: update uses of `prune` to be functional on removals
(define/contract (prune csp var value)
($csp? variable? any/c . -> . void?)
(define/contract (prune csp var value removals)
($csp? variable? any/c (or/c #f (listof removal?)) . -> . (listof removal?))
;; Rule out var=value
(hash-update! ($csp-curr_domains csp) var (λ (vals) (remove value vals)))
(current-removals (append (current-removals) (list (cons var value)))))
(and removals (append removals (list (cons var value)))))
(define/contract (choices csp var)
($csp? variable? . -> . (listof any/c))
@ -93,10 +92,10 @@
[else #f]))
assignment)
(define/contract (restore csp)
($csp? . -> . void?)
(define/contract (restore csp removals)
($csp? (listof removal?) . -> . void?)
;; Undo a supposition and all inferences from it.
(for ([removal (in-list (current-removals))])
(for ([removal (in-list removals)])
(match removal
[(cons B b) (hash-update! ($csp-curr_domains csp) B
(λ (vals) (append vals (list b))))])))
@ -150,22 +149,23 @@
;; Inference
(define/contract (no_inference csp var value assignment)
($csp? variable? any/c assignment? . -> . boolean?)
(define/contract (no_inference csp var value assignment removals)
($csp? variable? any/c assignment? (listof removal?) . -> . boolean?)
#true)
(define/contract (forward_checking csp var value assignment)
($csp? variable? any/c assignment? . -> . boolean?)
(define/contract (forward_checking csp var value assignment removals)
($csp? variable? any/c assignment? (listof removal?) . -> . boolean?)
;; Prune neighbor values inconsistent with var=value.
(support_pruning csp) ;; necessary to set up curr_domains
#R var #R value
(for/and ([B (in-list (hash-ref ($csp-neighbors csp) var))]
#:unless (hash-has-key? assignment B))
(report B 'pruning-var)
(for ([b (in-list (hash-ref ($csp-curr_domains csp) B))]
#:unless (($csp-constraints csp) var value B b))
(for/fold ([removals removals])
([b (in-list (hash-ref ($csp-curr_domains csp) B))]
#:unless (($csp-constraints csp) var value B b))
(report b 'pruning-val)
(prune csp B b))
(prune csp B b removals))
(not (empty? #R (hash-ref ($csp-curr_domains csp) B)))))
(define current-select-variable (make-parameter first_unassigned_variable))
@ -188,10 +188,10 @@
(for ([val (in-list (order_domain_values var assignment csp))]
#:when (zero? (nconflicts csp var val assignment)))
(assign csp var val assignment)
(parameterize ([current-removals (suppose csp var val)])
(when (inference csp var val assignment)
(backtrack assignment))
(restore csp)))
(define removals (suppose csp var val))
(when (inference csp var val assignment removals)
(backtrack assignment))
(restore csp removals))
(unassign csp var assignment)]))))
(define current-reset (make-parameter #t))
@ -206,7 +206,7 @@
[(? pair? solutions) solutions]
[else #false])
(when (current-reset)
(set-$csp-curr_domains! csp #f))))
(set-$csp-curr_domains! csp #f))))
(define/contract (solve csp [solver backtracking_search] [finish-proc values])
(($csp?) (procedure? procedure?) . ->* . any/c)
@ -242,24 +242,23 @@
(check-equal?
(hash-ref ($csp-curr_domains csp) 'wa) '(red))
#;(check-equal? (prune csp 'v 'red) '((v . red)))
(check-equal? (prune csp 'v 'red empty) '((v . red)))
#;(check-equal? (choices csp 'v) '(green blue))
(check-equal? (choices csp 'v) '(green blue))
(check-equal? (choices csp 'wa) '(red))
(check-equal? (infer_assignment csp)
(make-hasheq '((wa . red))))
#;(check-equal? (suppose csp 'v 'blue) '((v . green)))
#;(check-equal? (infer_assignment csp)
(check-equal? (suppose csp 'v 'blue) '((v . green)))
(check-equal? (infer_assignment csp)
(make-hasheq '((v . blue) (wa . red))))
#|
(restore csp '((wa . green)))
(check-equal? (infer_assignment csp)
(make-hasheq '((v . blue))))
(restore csp '((v . blue)))
(check-equal? (infer_assignment csp) (make-hasheq))
|#
(check-equal? (first_unassigned_variable (hash) csp) 'wa)
#;(check-equal? (unordered_domain_values 'wa (hash) csp) '(red green))
(check-equal? (unordered_domain_values 'wa (hash) csp) '(red green))
(set-$csp-curr_domains! csp #f) ; reset current domains
(check-equal? (solve csp)

Loading…
Cancel
Save