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

set tweaks

Browse Source
main
Matthew Butterick 6 years ago
parent 9750ec411e
commit 69f87fe1a2
2 changed files with 6 additions and 7 deletions
Show Stats Download Patch File Download Diff File

8
csp/csp/hacs-test.rkt
Unescape Escape View File

@ -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])

5
csp/csp/hacs.rkt
Unescape Escape View File

@ -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))

Write Preview
Loading…
Cancel
Save