diff --git a/csp/csp.rkt b/csp/csp.rkt index ff9d25cc..807ac685 100644 --- a/csp/csp.rkt +++ b/csp/csp.rkt @@ -3,7 +3,7 @@ (struct $csp ([vars #:mutable] [constraints #:mutable]) #:transparent) -(define (new-csp) ($csp null null)) +(define (make-csp) ($csp null null)) (struct $var (name vals) #:transparent) (define $var-name? symbol?) @@ -41,15 +41,21 @@ (define/contract (add-var! csp name [vals empty]) (($csp? $var-name?) ((listof any/c)) . ->* . void?) - (when (memq name (map $var-name ($csp-vars csp))) + (add-vars! csp (list name) vals)) + +(define/contract (add-vars! csp names [vals empty]) + (($csp? (listof $var-name?)) ((listof any/c)) . ->* . void?) + (for ([name (in-list names)] + #:when (memq name (map $var-name ($csp-vars csp)))) (raise-argument-error 'add-var! "var that doesn't exist" name)) - (set-$csp-vars! csp (cons ($var name vals) ($csp-vars csp)))) + (for ([name (in-list names)]) + (set-$csp-vars! csp (cons ($var name vals) ($csp-vars csp))))) (define (unique-varnames? xs) (and (andmap $var-name? xs) (not (check-duplicates xs eq?)))) -(define/contract (add-constraint! csp proc . var-names) - (($csp? procedure?) #:rest (listof $var-name?) . ->* . void?) +(define/contract (add-constraint! csp proc var-names) + ($csp? procedure? (listof $var-name?) . -> . void?) (for ([name (in-list var-names)]) (check-name-in-csp! 'add-constraint! csp name)) (set-$csp-constraints! csp (cons ($constraint var-names proc) ($csp-constraints csp)))) @@ -213,4 +219,4 @@ (define/contract (alldiff . xs) (() #:rest (listof any/c) . ->* . boolean?) (for/and ([comb (in-combinations xs 2)]) - (not (apply equal? comb)))) + (not (apply equal? comb)))) diff --git a/csp/test.rkt b/csp/test.rkt index af5d9171..5d9a1fc1 100644 --- a/csp/test.rkt +++ b/csp/test.rkt @@ -1,57 +1,34 @@ #lang at-exp racket (require "csp.rkt" rackunit) -(let ([demo (new-csp)]) - (define digits (range 7)) - (add-var! demo 't digits) - (add-var! demo 'w digits) - (add-var! demo 'o '(2 6 7)) +(define demo (make-csp)) +(add-vars! demo '(t w) (range 7)) +(add-var! demo 'o '(2 6 7)) - (define (sum-three t w o) (= 3 (+ t w o))) - (add-constraint! demo sum-three 't 'w 'o) +(define (sum-three t w o) (= 3 (+ t w o))) +(add-constraint! demo sum-three '(t w o)) +(add-constraint! demo alldiff '(t w o)) +(add-constraint! demo < '(t w o)) - (define diff (compose1 not =)) - (add-constraint! demo diff 't 'w) - (add-constraint! demo diff 'w 'o) - (add-constraint! demo diff 't 'o) - - (add-constraint! demo < 't 'w) - - (define three-or-less (curryr <= 3)) - (add-constraint! demo three-or-less 't) - (add-constraint! demo three-or-less 'w) - (add-constraint! demo three-or-less 'o) - (check-equal? (solve demo) ($csp (list ($var 'o '(2)) ($var 'w '(1)) ($var 't '(0))) '()))) +(check-equal? (solve demo) ($csp (list ($var 'o '(2)) ($var 'w '(1)) ($var 't '(0))) '())) ;; TWO + TWO = FOUR -(define ttf (new-csp)) -(define digs (range 10)) -(add-var! ttf 't digs) -(add-var! ttf 'w digs) -(add-var! ttf 'o digs) -(add-var! ttf 'f digs) -(add-var! ttf 'u digs) -(add-var! ttf 'r digs) - -(add-var! ttf 'c10 digs) -(add-var! ttf 'c100 digs) -(add-var! ttf 'c1000 digs) - -(add-constraint! ttf alldiff 't 'w 'o 'f 'u 'r) -(define (adder arg1 arg2 ones-digit tens-digit) (= (+ arg1 arg2) (+ (* 10 tens-digit) ones-digit))) -(add-constraint! ttf adder 'o 'o 'r 'c10) -(add-constraint! ttf adder 'w 'w 'u 'c100) -(add-constraint! ttf adder 't 't 'o 'c1000) -(add-constraint! ttf positive? 'f) -(add-constraint! ttf = 'f 'c1000) +(define ttf (make-csp)) +(add-vars! ttf '(t w o f u r c10 c100) (range 10)) +(add-constraint! ttf alldiff '(t w o f u r)) +(define (adder arg1 arg2 ones-digit tens-digit) + (= (+ arg1 arg2) (+ (* 10 tens-digit) ones-digit))) +(add-constraint! ttf adder '(o o r c10)) +(add-constraint! ttf adder '(w w u c100)) +(add-constraint! ttf adder '(t t o f)) +(add-constraint! ttf positive? '(f)) (define ttf-solution (solve ttf)) (check-equal? ttf-solution ($csp (list - ($var 'c1000 '(1)) ($var 'c100 '(0)) ($var 'c10 '(0)) ($var 'r '(8)) @@ -66,3 +43,20 @@ (format "~a~a~a + ~a~a~a = ~a~a~a~a" ($csp-ref csp 't) ($csp-ref csp 'w) ($csp-ref csp 'o) ($csp-ref csp 't) ($csp-ref csp 'w) ($csp-ref csp 'o) ($csp-ref csp 'f) ($csp-ref csp 'o) ($csp-ref csp 'u) ($csp-ref csp 'r))) (check-equal? (solve ttf-solution ttf-print) "734 + 734 = 1468") + + +;; ABC problem: +;; what is the minimum value of +;; ABC +;; ------- +;; A+B+C + +(define abc (make-csp)) +(add-vars! abc '(a b c) (range 1 10)) +(define (test-solution s) (let ([a (car ($csp-vals abc 'a))] + [b (car ($csp-vals abc 'b))] + [c (car ($csp-vals abc 'c))]) + (/ (+ (* 100 a) (* 10 b) c) (+ a b c)))) + +;; todo: gather all solutins in generator +(test-solution (solve abc)) \ No newline at end of file