diff --git a/csp/hacs-map.rkt b/csp/hacs-map.rkt index f0c77ef0..34450098 100644 --- a/csp/hacs-map.rkt +++ b/csp/hacs-map.rkt @@ -1,7 +1,8 @@ #lang debug racket -(require "hacs.rkt") +(require "hacs.rkt" sugar/debug) (module+ test (require rackunit)) + (define (map-coloring-csp colors neighbors) (define variables (remove-duplicates (flatten neighbors) eq?)) (define vds (for/list ([var (in-list variables)]) @@ -55,5 +56,4 @@ (module+ test (check-true (pair? (solve fr)))) -(module+ main - (solve aus)) \ No newline at end of file +(module+ main) \ No newline at end of file diff --git a/csp/hacs.rkt b/csp/hacs.rkt index d5ba1d6c..26f92106 100644 --- a/csp/hacs.rkt +++ b/csp/hacs.rkt @@ -118,6 +118,7 @@ (define current-inference (make-parameter #f)) (define current-solver (make-parameter #f)) (define current-random (make-parameter #t)) +(define current-decompose (make-parameter #t)) (define/contract (check-name-in-csp! caller csp name) (symbol? csp? name? . -> . void?) @@ -490,12 +491,19 @@ (define/contract (make-cartesian-generator solgens) ((listof generator?) . -> . generator?) (generator () - (let loop ([solgens solgens][sols empty]) - (cond - [(empty? solgens) (yield (combine-csps (reverse sols)))] - [else (match-define (cons solgen others) solgens) - (for ([sol (in-producer solgen (void))]) - (loop others (cons sol sols)))])))) + (define solcache (make-hasheqv)) + (let loop ([solgens solgens][idx 0][sols empty]) + (match solgens + [(? empty?) (yield (combine-csps (reverse sols)))] + [(cons solgen rest) + (cond + [(eq? (generator-state solgen) 'done) + (for ([sol (in-list (reverse (hash-ref solcache idx)))]) + (loop rest (add1 idx) (cons sol sols)))] + [else + (for ([sol (in-producer solgen (void))]) + (hash-update! solcache idx (λ (vals) (cons sol vals)) null) + (loop rest (add1 idx) (cons sol sols)))])])))) (define/contract (extract-subcsp csp names) ($csp? (listof name?) . -> . $csp?) @@ -516,10 +524,13 @@ . ->* . (listof any/c)) (when-debug (reset-assns!) (reset-nfcs!) (reset-nchecks!)) - (define subproblems (for/list ([nodeset (in-list (cc (csp->graph csp)))]) - (extract-subcsp csp nodeset))) + (define subcsps ; decompose into independent csps. `cc` determines "connected components" + (if (current-decompose) + (for/list ([nodeset (in-list (cc (csp->graph csp)))]) + (extract-subcsp csp nodeset)) + (list csp))) - (for/list ([solution (in-producer (make-cartesian-generator (map solver subproblems)) (void))] + (for/list ([solution (in-producer (make-cartesian-generator (map solver subcsps)) (void))] [idx (in-range max-solutions)]) (finish-proc solution)))