From dd0aa8a6555f83415f9bfbeb2f48959f117e290d Mon Sep 17 00:00:00 2001
From: Matthew Butterick <mb@mbtype.com>
Date: Wed, 10 Oct 2018 21:15:54 -0700
Subject: [PATCH] gen

---
 csp/csp.rkt  | 18 ++++++++-----
 csp/test.rkt | 74 ++++++++++++++++++++++++----------------------------
 2 files changed, 46 insertions(+), 46 deletions(-)

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