in-solutions

csp/csp/hacs.rkt

@@ -1,6 +1,6 @@
 #lang debug racket
 (require racket/generator graph)
-(provide (all-defined-out))
+(provide (except-out (all-defined-out) define/contract))
 
 (define-syntax-rule (define/contract EXPR CONTRACT . BODY)
   (define EXPR . BODY))
@@ -627,39 +627,45 @@
                               (memq cname names)))
              const)))
 
-(define/contract (solve* prob
+(define (decompose-prob prob)
-                         #:finish-proc [finish-proc (λ (p) (csp->assocs p (map var-name (vars prob))))]
+  ; decompose into independent csps. `cc` determines "connected components"
-                         #:solver [solver (or (current-solver) backtracking-solver)]
-                         #:count [max-solutions +inf.0])
-  ((csp?) (#:finish-proc procedure? #:solver procedure? #:count natural?)
-          . ->* . (listof any/c))
-  (when-debug (reset-nassns!) (reset-nfchecks!) (reset-nchecks!))          
-
-  (define subcsps ; decompose into independent csps. `cc` determines "connected components"
   (if (current-decompose)
       (for/list ([nodeset (in-list (cc (csp->graph prob)))])
                 (extract-subcsp prob nodeset))
       (list prob)))
 
-  (define solgens (map solver subcsps))
+(define (make-solution-generator prob)
+  (generator ()
+             (define subprobs (decompose-prob prob))
+             (define solgens (map (current-solver) subprobs))
              (define solstreams (for/list ([solgen (in-list solgens)])
                                           (for/stream ([sol (in-producer solgen (void))]) 
                                                       sol)))
+             (for ([solution-pieces (in-cartesian solstreams)])
+                  (yield (combine-csps solution-pieces)))))
+
+(define-syntax-rule (in-solutions PROB)
+  (in-producer (make-solution-generator PROB) (void)))
+
+(define/contract (solve* prob [max-solutions +inf.0]
+                         #:finish-proc [finish-proc (λ (p) (csp->assocs p (map var-name (vars prob))))]
+                         #:solver [solver #f])
+  ((csp?) (natural? #:finish-proc procedure? #:solver procedure?) . ->* . (listof any/c))
+  (when-debug (reset-nassns!) (reset-nfchecks!) (reset-nchecks!))          
 
-  (for/list ([solution-pieces (in-cartesian solstreams)]
+  (parameterize ([current-solver (or solver (current-solver) backtracking-solver)])
+    (for/list ([sol (in-solutions prob)]
                [idx (in-range max-solutions)])
-    (finish-proc (combine-csps solution-pieces))))
+              (finish-proc sol))))
 
 (define/contract (solve prob
                         #:finish-proc [finish-proc (λ (p) (csp->assocs p (map var-name (vars prob))))]
-                        #:solver [solver (or (current-solver) backtracking-solver)]
+                        #:solver [solver #f])
-                        #:count [max-solutions 1])
+  ((csp?) (#:finish-proc procedure? #:solver procedure?)
-  ((csp?) (#:finish-proc procedure? #:solver procedure? #:count natural?)
           . ->* . (or/c #false any/c))
-  (match (solve* prob #:finish-proc finish-proc #:solver solver #:count max-solutions)
+  (match (solve* prob 1 #:finish-proc finish-proc #:solver solver)
     [(list solution) solution]
-    [(list) #false]
+    [_ #false]))
-    [(list solutions ...) solutions]))
 
 (define (<> a b) (not (= a b)))
 (define (neq? a b) (not (eq? a b)))

csp/csp/scribblings/csp.scrbl

@@ -8,7 +8,7 @@
 @(define-syntax-rule (my-examples ARG ...)
 (examples #:label #f #:eval my-eval ARG ...))
 
-@title{Constraint-satisfaction problems}
+@title{Constraint-satisfaction problems (and how to solve them)}
 
 @author[(author+email "Matthew Butterick" "mb@mbtype.com")]
 
@@ -120,11 +120,11 @@ We should use @racket[solve*] with care. It can't finish until the CSP solver e
 (state-count triples)
 ]
 
-It's easy for a CSP to have a state count in the zillions. For this reason we can supply @racket[solve*] with an optional @racket[#:count] argument that will only generate a certain number of solutions: 
+It's easy for a CSP to have a state count in the zillions. For this reason we can supply @racket[solve*] with an optional argument that will only generate a certain number of solutions: 
 
 @examples[#:label #f #:eval my-eval
 (time (solve* triples))
-(time (solve* triples #:count 2))
+(time (solve* triples 2))
 ]
 
 Here, the answers are the same. But the second call to @racket[solve*] finishes sooner, because it quits as soon as it's found two solutions.
@@ -159,7 +159,7 @@ The whole example in one block:
 
 (add-constraint! triples <= '(a b))
 
-(solve* triples #:count 2)
+(solve* triples 2)
 ]
 
 @section{Interlude}
@@ -282,19 +282,21 @@ TK
 }
 
 @defproc[(solve 
-[prob csp?] 
+[prob csp?] )
-[#:count count natural? 1])
 (or/c #false any/c (listof any/c))]{
 TK
 }
 
 @defproc[(solve* 
 [prob csp?] 
-[#:count count natural? +inf.0])
+[count natural? +inf.0])
 (listof any/c)]{
 TK
 }
 
+@defform[(in-solutions prob)]{
+TK
+}
 
 
 @section{Sideshows}