diff --git a/csp/constraint.rkt b/csp/constraint.rkt index 31fd282c..3423c16c 100644 --- a/csp/constraint.rkt +++ b/csp/constraint.rkt @@ -66,23 +66,14 @@ (field [_func func][_assigned assigned]) (inherit forward-check) + (define/override (call variables domains assignments [forward-check? #f] [_unassigned Unassigned]) - ;(report assignments assignments-before) - (define parms (for/list ([x (in-list variables)]) - (if (hash-has-key? assignments x) (hash-ref assignments x) _unassigned))) - ;(report assignments assignments-after) - (define missing (length (filter (λ(v) (equal? v _unassigned)) parms))) + (define parms (map (λ(v) (hash-ref assignments v _unassigned)) variables)) + (define missing (length (filter (λ(p) (equal? p _unassigned)) parms))) (if (> missing 0) - (begin - ;(report missing) - ;(report _assigned) - ;(report parms) - ;(report (apply _func parms)) - ;(report forwardcheck) - ;(report assignments assignments-to-fc) - (and (or _assigned (apply _func parms)) - (or (not forward-check?) (not (= missing 1)) - (forward-check variables domains assignments)))) + (and (or _assigned (apply _func parms)) + (or (not forward-check?) (not (= missing 1)) + (forward-check variables domains assignments))) (apply _func parms))) )) @@ -96,27 +87,25 @@ (define/override (call variables domains assignments [forward-check? #f] [_unassigned Unassigned]) (define seen (make-hash)) - (define value #f) - (define domain #f) (define return-value (void)) + (let/ec return-k - (for ([variable (in-list variables)]) - (set! value (if (hash-has-key? assignments variable) - (hash-ref assignments variable) - _unassigned)) - (when (not (equal? value _unassigned)) - (when (value . in? . seen) - (set! return-value #f) - (return-k)) - (hash-set! seen value #t))) + (define values (map (λ(v) (hash-ref assignments v _unassigned)) variables)) + (for ([value (in-list values)] + #:when (not (equal? value _unassigned))) + (when (hash-has-key? (report seen) value) + (set! return-value #f) + (return-k)) + (hash-set! seen value #t)) + (when forward-check? (for ([variable (in-list variables)]) - (when (not (variable . in? . assignments)) - (set! domain (hash-ref domains variable)) - (for ([value (in-hash-keys seen)]) - (when (value . in? . (get-field _list (hash-ref domains variable))) + (when (not (hash-has-key? assignments variable)) + (let ([domain (hash-ref domains variable)]) + (for ([value (in-hash-keys seen)] + #:when (member value (send domain get-values))) (send domain hide-value value) - (when (null? (get-field _list (hash-ref domains variable))) + (when (send domain values-empty?) (set! return-value #f) (return-k))))))) (set! return-value #t)