cartesian

csp/csp.rkt

@@ -7,6 +7,13 @@
 (define (make-csp) ($csp null null))
 (define debug (make-parameter #false))
 
+(define (in-cartesian xss)
+  (in-generator (let loop ([xss xss][args empty])
+                  (if (null? xss)
+                      (yield (reverse args))
+                      (for ([x (in-list (car xss))])
+                        (loop (cdr xss) (cons x args)))))))
+
 (struct $var (name vals) #:transparent)
 (define $var-name? symbol?)
 (struct $constraint (names proc) #:transparent
@@ -14,14 +21,9 @@
   (λ (constraint csp)
     (unless ($csp? csp)
       (raise-argument-error '$constraint-proc "$csp" csp))
-    (match-define ($constraint names proc) constraint)
-    (cond
-      [(empty? names) (proc)]
-      [else
-       (match-define (cons name other-names) names)
-       (for/and ([val (in-list ($csp-vals csp name))])
-         ;; todo: reconsider efficiency of currying every value
-         (($constraint other-names (curry proc val)) csp))])))
+    ;; apply proc in many-to-many style
+    (for/and ([args (in-cartesian (map (λ (cname) ($csp-vals csp cname)) ($constraint-names constraint)))])
+      (apply ($constraint-proc constraint) args))))
 
 (define/contract (check-name-in-csp! caller csp name)
   (symbol? $csp? $var-name? . -> . void?)
@@ -77,8 +79,7 @@
 
 (define/contract (no-solutions? csp)
   ($csp? . -> . boolean?)
-  (for/or ([var (in-list ($csp-vars csp))])
-    (zero? (remaining-values var))))
+  (zero? (state-count csp)))
 
 (struct inconsistency-signal () #:transparent)
 

csp/test.rkt

@@ -150,19 +150,20 @@ A collection of 33 coins, consisting of nickels, dimes, and quarters, has a valu
 
 ;; queens problem
 ;; place queens on chessboard so they do not intersect
-(define queens-problem (make-csp))
-(define queens '(q0 q1 q2 q3 q4 q5 q6 q7))
-(define rows (range 8))
-(add-vars! queens-problem queens rows)
-(for* ([(qa qa-col) (in-indexed queens)]
-       [(qb qb-col) (in-indexed queens)]
-       #:when (< qa-col qb-col))
-      (add-constraint! queens-problem
+(define queens (make-csp))
+(define qs (for/list ([q 8]) (string->symbol (format "q~a" q))))
+(define rows (range (length qs)))
+(add-vars! queens qs rows)
+(define (q-col q) (string->number (string-trim (symbol->string q) "q")))
+(for* ([qs (in-combinations qs 2)])
+  (match-define (list qa qb) qs)
+  (match-define (list qa-col qb-col) (map q-col qs))
+  (add-constraint! queens
                    (λ (qa-row qb-row)
                      (and 
                       (not (= (abs (- qa-row qb-row)) (abs (- qa-col qb-col)))) ; same diagonal?
                       (not (= qa-row qb-row)))) ; same row?
                    (list qa qb)))
 
-(check-equal? 92 (length (time (solve* queens-problem))))
+(check-equal? 92 (length (time (solve* queens))))