|
|
|
|
@ -4,8 +4,7 @@
|
|
|
|
|
(current-inference forward-check)
|
|
|
|
|
(current-select-variable mrv-degree-hybrid)
|
|
|
|
|
(current-order-values shuffle)
|
|
|
|
|
(current-random #true)
|
|
|
|
|
(current-node-consistency #f)
|
|
|
|
|
(current-node-consistency #t)
|
|
|
|
|
(current-arity-reduction #t)
|
|
|
|
|
|
|
|
|
|
(check-equal? (first-unassigned-variable (csp (list (var 'a (range 3)) (var 'b (range 3))) null))
|
|
|
|
|
@ -23,21 +22,36 @@
|
|
|
|
|
(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 (set 2) '((b . 0) (a . 1)))))
|
|
|
|
|
(list (avar 'a '(1)) (avar 'b '(0)) (cvar 'c (seteq 2) '((b . 0) (a . 1)))))
|
|
|
|
|
|
|
|
|
|
(check-equal?
|
|
|
|
|
;; no inconsistency: b≠c not checked when fc is relative to a
|
|
|
|
|
;; no inconsistency: b≠c not checked when fc is relative to a, so assignment succeeds
|
|
|
|
|
(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 (set 0) '((a . 1))) (var 'c '(0))))
|
|
|
|
|
(list (avar 'a '(1)) (cvar 'b (seteq 0) '((a . 1))) (var 'c '(0))))
|
|
|
|
|
|
|
|
|
|
;; inconsistency: b≠c is checked by AC-3, thus assignment fails
|
|
|
|
|
(check-exn backtrack?
|
|
|
|
|
(λ ()
|
|
|
|
|
(csp-vars (ac-3 (csp (list (avar 'a '(1)) (var 'b (range 2)) (var 'c '(0)))
|
|
|
|
|
(list (constraint '(a b) (negate =))
|
|
|
|
|
(constraint '(b c) (negate =)))) 'a))))
|
|
|
|
|
|
|
|
|
|
(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 (set 0) '((b . 1)))))
|
|
|
|
|
(list (avar 'a '(1)) (avar 'b '(1)) (cvar 'c (seteq 0) '((b . 1)))))
|
|
|
|
|
|
|
|
|
|
(check-equal?
|
|
|
|
|
;; no inconsistency: a≠b is not checked by AC-3, because it's already assigned
|
|
|
|
|
;; todo: is this the right result?
|
|
|
|
|
(csp-vars (ac-3 (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)) (var 'c (seteq 0))))
|
|
|
|
|
|
|
|
|
|
(check-exn backtrack?
|
|
|
|
|
(λ () (csp-vars (forward-check (csp (list (avar 'a '(1))
|
|
|
|
|
@ -48,7 +62,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 (set 1 2) '((a . 0)))))
|
|
|
|
|
(list (var 'a '(0)) (cvar 'b (seteq 1 2) '((a . 0)))))
|
|
|
|
|
|
|
|
|
|
(check-equal?
|
|
|
|
|
(parameterize ([current-inference forward-check])
|
|
|
|
|
@ -281,8 +295,7 @@
|
|
|
|
|
(define (finish x)
|
|
|
|
|
(apply map list (slice-at x 5)))
|
|
|
|
|
|
|
|
|
|
(check-equal? (parameterize ([current-select-variable mrv]
|
|
|
|
|
[current-random #f])
|
|
|
|
|
(check-equal? (parameterize ([current-select-variable mrv])
|
|
|
|
|
(finish (time-named (solve zebra))))
|
|
|
|
|
'(((nationality-0 . norwegian) (color-0 . yellow) (drink-0 . water) (smoke-0 . kools) (pet-0 . foxes))
|
|
|
|
|
((nationality-1 . ukrainian) (color-1 . blue) (drink-1 . tea) (smoke-1 . chesterfields) (pet-1 . horses))
|
|
|
|
|
@ -299,4 +312,3 @@
|
|
|
|
|
(time-avg n (void (solve smm)))
|
|
|
|
|
(time-avg n (void (solve* queens)))
|
|
|
|
|
(time-avg n (void (solve zebra)))))
|
|
|
|
|
|
