mbutterick
/
typesetting
2
1
Fork 0
Code Issues 13 Pull Requests Projects Releases Wiki Activity

tweaks

Browse Source
main
Matthew Butterick 10 years ago
parent 1d91bd3b1b
commit 634c32a2cb
1 changed files with 19 additions and 23 deletions
Show Stats Download Patch File Download Diff File

42
csp/solver.rkt
Unescape Escape View File

@ -27,7 +27,7 @@
(define values null) (define values null)
(define pushdomains null) (define pushdomains null)
(define variable #f) (define variable #f)
(define lst null) (define work-list null)
(define want-to-return #f) (define want-to-return #f)
(define return-k #f) (define return-k #f)
(let/ec break-loop1 (let/ec break-loop1
@ -37,30 +37,29 @@
;; Mix the Degree and Minimum Remaing Values (MRV) heuristics ;; Mix the Degree and Minimum Remaing Values (MRV) heuristics
(set! lst (sort (for/list ([variable (in-hash-keys domains)]) (set! work-list (sort (for/list ([variable (in-hash-keys domains)])
(list (* -1 (length (hash-ref vconstraints variable))) (list (* -1 (length (hash-ref vconstraints variable)))
(length ((hash-ref domains variable))) (length ((hash-ref domains variable)))
variable)) list-comparator)) variable)) list-comparator))
;(report lst) ;(report lst)
(let/ec break-for-loop (let/ec break-for-loop
(for ([item (in-list lst)]) (for ([last-item (in-list (map last work-list))]
(when (not ((last item) . in? . assignments)) #:when (not (hash-has-key? assignments last-item)))
; Found unassigned variable
; Found unassigned variable (set! variable last-item)
(set! variable (last item)) ;(report variable unassigned-variable)
;(report variable unassigned-variable) (set! values ((hash-ref domains variable)))
(set! values ((hash-ref domains variable))) (set! pushdomains
(set! pushdomains (if forwardcheck
(if forwardcheck (for/list ([x (in-hash-keys domains)]
(for/list ([x (in-hash-keys domains)] #:when (and (not (hash-has-key? assignments x))
#:when (and (not (x . in? . assignments)) (not (equal? variable x))))
(not (x . equal? . variable)))) (hash-ref domains x))
(hash-ref domains x)) null))
null)) (break-for-loop))
(break-for-loop)))
;; if it makes it through the loop without breaking, then there are ;; if it makes it through the loop without breaking, then there are
;; No unassigned variables. We've got a solution. Go back ;; no unassigned variables. We've got a solution. Go back
;; to last variable, if there's one. ;; to last variable, if there's one.
(yield (hash-copy assignments)) (yield (hash-copy assignments))
(when (null? queue) (begin (when (null? queue) (begin
@ -70,8 +69,7 @@
(set! variable (first variable-values-pushdomains)) (set! variable (first variable-values-pushdomains))
(set! values (second variable-values-pushdomains)) (set! values (second variable-values-pushdomains))
(set! pushdomains (third variable-values-pushdomains)) (set! pushdomains (third variable-values-pushdomains))
(for ([domain (in-list pushdomains)]) (for-each (λ(pd) (send pd pop-state)) pushdomains))
(send domain pop-state)))
;(report variable variable-preloop-2) ;(report variable variable-preloop-2)
;(report assignments assignments-preloop-2) ;(report assignments assignments-preloop-2)
@ -94,9 +92,7 @@
(set! variable (first variable-values-pushdomains)) (set! variable (first variable-values-pushdomains))
(set! values (second variable-values-pushdomains)) (set! values (second variable-values-pushdomains))
(set! pushdomains (third variable-values-pushdomains)) (set! pushdomains (third variable-values-pushdomains))
(when (not (null? pushdomains)) (for-each (λ(pd) (send pd pop-state)) pushdomains)
(for ([domain (in-list pushdomains)])
(send domain pop-state)))
(when (not (null? values)) (break-loop3)) (when (not (null? values)) (break-loop3))
(hash-remove! assignments variable) (hash-remove! assignments variable)
(loop3)) (loop3))

Write Preview
Loading…
Cancel
Save