diff --git a/csp/solver.rkt b/csp/solver.rkt index 6173d4fd..54dc3bd3 100644 --- a/csp/solver.rkt +++ b/csp/solver.rkt @@ -28,19 +28,14 @@ (field [_forwardcheck forwardcheck]) (define/override (get-solution-iter domains constraints vconstraints) - - (define forwardcheck _forwardcheck) (define assignments (make-hash)) (define queue null) + (define variable #f) (define values null) (define pushdomains null) - (define variable #f) - (define work-list null) - (define want-to-return #f) - (define return-k #f) - (let/ec break-loop1 - (set! return-k break-loop1) - (let loop1 () + (define work-list #f) + (let/ec return-k + (let main-loop () ;; Mix the Degree and Minimum Remaing Values (MRV) heuristics (set! work-list (sort (for/list ([variable (in-hash-keys domains)]) (list (* -1 (length (hash-ref vconstraints variable))) @@ -53,7 +48,7 @@ (set! variable last-item) (set! values ((hash-ref domains variable))) (set! pushdomains - (if forwardcheck + (if _forwardcheck (for/list ([x (in-hash-keys domains)] #:when (and (not (hash-has-key? assignments x)) (not (equal? variable x)))) @@ -69,8 +64,7 @@ [(not (null? queue)) (set!-values (variable values pushdomains) (pop-vvp-values! queue)) (for-each-send pop-state pushdomains)] - [else - (set! want-to-return #t) (return-k)])) + [else (return-k)])) (let constraint-checking-loop () ;; We have a variable. Do we have any values left? @@ -78,7 +72,7 @@ ;; No. Go back to last variable, if there is one, otherwise solver is done. (for/or ([i (in-naturals)]) (hash-remove! assignments variable) - (when (null? queue) (set! want-to-return #t) (return-k)) + (when (null? queue) (return-k)) (set!-values (variable values pushdomains) (pop-vvp-values! queue)) (for-each-send pop-state pushdomains) (not (null? values)))) @@ -88,18 +82,18 @@ (for-each-send push-state pushdomains) (when (for/or ([cvpair (in-list (hash-ref vconstraints variable))]) (match-define (list constraint variables) cvpair) - (not (send constraint is-true? variables domains assignments pushdomains))) + (not (send constraint broken? variables domains assignments pushdomains))) ;; constraint failed, so try again (for-each-send pop-state pushdomains) (constraint-checking-loop))) ;; Push state before looking for next variable. (set! queue (cons (vvp variable values pushdomains) queue)) - (loop1))) + (main-loop)) + + (error 'get-solution-iter "Should never get here")) - (if want-to-return - (void) - (error 'get-solution-iter "Whoops, broken solver"))) + (void)) (define (call-solution-generator domains constraints vconstraints #:first-only [first-only #f])