|
|
|
@ -45,7 +45,7 @@
|
|
|
|
($csp
|
|
|
|
($csp
|
|
|
|
(for/list ([var ($csp-vars csp)])
|
|
|
|
(for/list ([var ($csp-vars csp)])
|
|
|
|
(if (eq? name ($var-name var))
|
|
|
|
(if (eq? name ($var-name var))
|
|
|
|
(+$avar name (list val))
|
|
|
|
(+$avar name (list val) ($var-past var) ($var-conflicts var))
|
|
|
|
var))
|
|
|
|
var))
|
|
|
|
($csp-constraints csp)))
|
|
|
|
($csp-constraints csp)))
|
|
|
|
|
|
|
|
|
|
|
|
@ -85,7 +85,6 @@
|
|
|
|
|
|
|
|
|
|
|
|
(define/contract (forward-check csp aname)
|
|
|
|
(define/contract (forward-check csp aname)
|
|
|
|
($csp? $var-name? . -> . $csp?)
|
|
|
|
($csp? $var-name? . -> . $csp?)
|
|
|
|
#R csp
|
|
|
|
|
|
|
|
(define aval (first ($csp-vals csp aname)))
|
|
|
|
(define aval (first ($csp-vals csp aname)))
|
|
|
|
(define (filter-vals var)
|
|
|
|
(define (filter-vals var)
|
|
|
|
(match-define ($var name vals past conflicts) var)
|
|
|
|
(match-define ($var name vals past conflicts) var)
|
|
|
|
@ -164,7 +163,6 @@
|
|
|
|
(for/fold ([conflicts null]
|
|
|
|
(for/fold ([conflicts null]
|
|
|
|
#:result (void))
|
|
|
|
#:result (void))
|
|
|
|
([val (in-list (order-domain-values vals))])
|
|
|
|
([val (in-list (order-domain-values vals))])
|
|
|
|
#R conflicts
|
|
|
|
|
|
|
|
(with-handlers ([inconsistency-signal?
|
|
|
|
(with-handlers ([inconsistency-signal?
|
|
|
|
(λ (sig)
|
|
|
|
(λ (sig)
|
|
|
|
(match sig
|
|
|
|
(match sig
|
|
|
|
@ -195,26 +193,27 @@
|
|
|
|
(define (<> a b) (not (= a b)))
|
|
|
|
(define (<> a b) (not (= a b)))
|
|
|
|
(define (neq? a b) (not (eq? a b)))
|
|
|
|
(define (neq? a b) (not (eq? a b)))
|
|
|
|
|
|
|
|
|
|
|
|
(parameterize ([current-inference forward-check])
|
|
|
|
(check-equal?
|
|
|
|
(time (solve* ($csp (list (+$var 'a '(1))
|
|
|
|
(parameterize ([current-inference forward-check])
|
|
|
|
(+$var 'b '(1))
|
|
|
|
(length (solve* ($csp (list (+$var 'x (range 3))
|
|
|
|
(+$var 'c '(1)))
|
|
|
|
(+$var 'y (range 3))
|
|
|
|
(list ($constraint '(a b) <>)
|
|
|
|
(+$var 'z (range 3)))
|
|
|
|
($constraint '(a c) <>)
|
|
|
|
(list ($constraint '(x y) <>)
|
|
|
|
($constraint '(b c) <>))))))
|
|
|
|
($constraint '(x z) <>)
|
|
|
|
|
|
|
|
($constraint '(y z) <>)))))) 6)
|
|
|
|
(parameterize ([current-inference forward-check])
|
|
|
|
|
|
|
|
(define vds (for/list ([k '(wa nsw t q nt v sa)])
|
|
|
|
#;(parameterize ([current-inference forward-check])
|
|
|
|
(+$var k '(red green blue))))
|
|
|
|
(define vds (for/list ([k '(wa nsw t q nt v sa)])
|
|
|
|
(define cs (list
|
|
|
|
(+$var k '(red green blue))))
|
|
|
|
($constraint '(wa nt) neq?)
|
|
|
|
(define cs (list
|
|
|
|
($constraint '(wa sa) neq?)
|
|
|
|
($constraint '(wa nt) neq?)
|
|
|
|
($constraint '(nt sa) neq?)
|
|
|
|
($constraint '(wa sa) neq?)
|
|
|
|
($constraint '(nt q) neq?)
|
|
|
|
($constraint '(nt sa) neq?)
|
|
|
|
($constraint '(q sa) neq?)
|
|
|
|
($constraint '(nt q) neq?)
|
|
|
|
($constraint '(q nsw) neq?)
|
|
|
|
($constraint '(q sa) neq?)
|
|
|
|
($constraint '(nsw sa) neq?)
|
|
|
|
($constraint '(q nsw) neq?)
|
|
|
|
($constraint '(nsw v) neq?)
|
|
|
|
($constraint '(nsw sa) neq?)
|
|
|
|
($constraint '(v sa) neq?)))
|
|
|
|
($constraint '(nsw v) neq?)
|
|
|
|
(define csp ($csp vds cs))
|
|
|
|
($constraint '(v sa) neq?)))
|
|
|
|
(check-equal? (time (length (solve* csp))) 18))
|
|
|
|
(define csp ($csp vds cs))
|
|
|
|
|
|
|
|
(check-equal? (time (length (solve* csp))) 18))
|
