diff --git a/csp/constraint.rkt b/csp/constraint.rkt index c0d54a09..e1c763f6 100644 --- a/csp/constraint.rkt +++ b/csp/constraint.rkt @@ -53,7 +53,7 @@ (unless (is-true? variables domains assignments) (send unassigned-variable-domain hide-value value))) (hash-remove! assignments unassigned-variable) - (not (null? unassigned-variable-domain))] ; if domain had no remaining values, the constraint will be impossible to meet, so return #f + (not (empty? unassigned-variable-domain))] ; if domain had no remaining values, the constraint will be impossible to meet, so return #f [else #t])) )) @@ -96,7 +96,7 @@ [assigned-value (in-list assigned-values)] #:when (member assigned-value (unassigned-var-domain))) (send unassigned-var-domain hide-value assigned-value) - (null? unassigned-var-domain))) #f] ; if domain had no remaining values, the constraint will be impossible to meet, so return #f + (empty? unassigned-var-domain))) #f] ; if domain had no remaining values, the constraint will be impossible to meet, so return #f [else #t])))) (define all-different-constraint%? (is-a?/c all-different-constraint%)) diff --git a/csp/helper.rkt b/csp/helper.rkt index fbe1ecdd..c607c9ea 100644 --- a/csp/helper.rkt +++ b/csp/helper.rkt @@ -7,7 +7,7 @@ (for ([i (in-naturals)]) expr ...)) -(define-syntax-rule (forever/or expr ...) +(define-syntax-rule (forever/until expr ...) (for/or ([i (in-naturals)]) expr ...)) diff --git a/csp/solver.rkt b/csp/solver.rkt index 301adb31..491f9104 100644 --- a/csp/solver.rkt +++ b/csp/solver.rkt @@ -15,7 +15,7 @@ (struct vvp (variable values pushdomains)) (define-syntax-rule (pop-vvp-values! vvps) - (if (null? vvps) + (if (empty? vvps) (error 'pop-vvp-values! (format "~a is null" vvps)) (let ([vvp (car vvps)]) (set! vvps (cdr vvps)) @@ -29,11 +29,11 @@ (field [_forwardcheck forwardcheck]) (define/override (get-solution-iter domains constraints vconstraints) - (define sorted-variables - (map third (sort (map (λ(var) - (list (- (length (hash-ref vconstraints var))) ; first two elements used for sorting - (length ((hash-ref domains var))) - var)) (hash-keys domains)) list-comparator))) + (define sorted-variables (sort (hash-keys domains) list-comparator + #:key (λ(var) + (list (- (length (hash-ref vconstraints var))) + (length ((hash-ref domains var))) + var)))) ;; state-retention variables (define possible-solution (make-hash)) (define variable-queue null) @@ -64,17 +64,17 @@ (forever (unless (get-next-unassigned-variable) (yield (hash-copy possible-solution)) ; if there are no unassigned variables, solution is complete. - (if (null? variable-queue) ; then, if queue is empty ... + (if (empty? variable-queue) (exit-k) ; all done, no other solutions possible. - (set!-previous-variable))) ; or queue is not empty, so return to previous variable + (set!-previous-variable))) ; otherwise return to previous variable (let value-checking-loop () ; we have a variable. Do we have any values left? - (when (null? values) ; no, so try going back to last variable and getting some values - (forever/or - (when (null? variable-queue) (exit-k)) ; no variables left, so solver is done + (when (empty? values) ; no, so try going back to last variable and getting some values + (forever/until + (when (empty? variable-queue) (exit-k)) ; no variables left, so solver is done (hash-remove! possible-solution variable) (set!-previous-variable) - (not (null? values)))) + (not (empty? values)))) ;; Got a value. Check it. (hash-set! possible-solution variable (car-pop! values))