From 69f87fe1a286ed71f6c850887725ceb183abdaa9 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sat, 1 Dec 2018 11:31:19 -0800 Subject: [PATCH] set tweaks --- csp/csp/hacs-test.rkt | 8 ++++---- csp/csp/hacs.rkt | 5 ++--- 2 files changed, 6 insertions(+), 7 deletions(-) diff --git a/csp/csp/hacs-test.rkt b/csp/csp/hacs-test.rkt index b51435c2..24c335f2 100644 --- a/csp/csp/hacs-test.rkt +++ b/csp/csp/hacs-test.rkt @@ -23,21 +23,21 @@ (csp-vars (forward-check (forward-check (csp (list (avar 'a '(1)) (avar 'b '(0)) (var 'c '(0 1 2))) (list (constraint '(a c) (negate =)) (constraint '(b c) (negate =)))) 'a) 'b)) - (list (avar 'a '(1)) (avar 'b '(0)) (cvar 'c '(2) '((b . 0) (a . 1))))) + (list (avar 'a '(1)) (avar 'b '(0)) (cvar 'c (set 2) '((b . 0) (a . 1))))) (check-equal? ;; no inconsistency: b≠c not checked when fc is relative to a (csp-vars (forward-check (csp (list (avar 'a '(1)) (var 'b (range 2)) (var 'c '(0))) (list (constraint '(a b) (negate =)) (constraint '(b c) (negate =)))) 'a)) - (list (avar 'a '(1)) (cvar 'b '(0) '((a . 1))) (var 'c '(0)))) + (list (avar 'a '(1)) (cvar 'b (set 0) '((a . 1))) (var 'c '(0)))) (check-equal? ;; no inconsistency: a≠b not checked when fc ignores a, which is already assigned (csp-vars (forward-check (csp (list (avar 'a '(1)) (avar 'b '(1)) (var 'c (range 2))) (list (constraint '(a b) (negate =)) (constraint '(b c) (negate =)))) 'b)) - (list (avar 'a '(1)) (avar 'b '(1)) (cvar 'c '(0) '((b . 1))))) + (list (avar 'a '(1)) (avar 'b '(1)) (cvar 'c (set 0) '((b . 1))))) (check-exn backtrack? (λ () (csp-vars (forward-check (csp (list (avar 'a '(1)) @@ -48,7 +48,7 @@ (check-equal? (csp-vars (forward-check (csp (list (var 'a '(0)) (var 'b (range 3))) (list (constraint '(a b) <))) 'a)) - (list (var 'a '(0)) (cvar 'b '(1 2) '((a . 0))))) + (list (var 'a '(0)) (cvar 'b (set 1 2) '((a . 0))))) (check-equal? (parameterize ([current-inference forward-check]) diff --git a/csp/csp/hacs.rkt b/csp/csp/hacs.rkt index 34318605..c0e8bbe1 100644 --- a/csp/csp/hacs.rkt +++ b/csp/csp/hacs.rkt @@ -477,7 +477,7 @@ (for/list ([vr (in-vars prob)]) (match-define (var name vals) vr) (define name-constraints (filter (λ (const) (constraint-relates? const name)) unary-constraints)) - (make-var name (for/list ([val (in-list vals)] + (make-var name (for/set ([val (in-set vals)] #:when (for/and ([const (in-list name-constraints)]) ((constraint-proc const) val))) val))) @@ -511,8 +511,7 @@ (eq? name (car rec)))))))) (for/fold ([conflicts null] #:result (void)) - ([val #;(in-list (order-domain-values domain)) - (in-set domain)]) + ([val (in-list (order-domain-values (set->list domain)))]) (with-handlers ([wants-backtrack? (λ (bt) (define bths (backtrack-histories bt))