threaded

csp/hacs-test-workbench.rkt

@@ -9,23 +9,23 @@
 ;; queens problem
 ;; place queens on chessboard so they do not intersect
 
-(define board-size 8)
+(define board-size 12)
 
-  (define queens (make-csp))
+(define queens (make-csp))
-  (define qs (for/list ([q board-size]) (string->symbol (format "q~a" q))))
+(define qs (for/list ([q board-size]) (string->symbol (format "q~a" q))))
-  (define rows (range (length qs)))
+(define rows (range (length qs)))
-  (add-vars! queens qs rows)
+(add-vars! queens qs rows)
-  (define (q-col q) (string->number (string-trim (symbol->string q) "q")))
+(define (q-col q) (string->number (string-trim (symbol->string q) "q")))
-  (for* ([qs (in-combinations qs 2)])
+(for* ([qs (in-combinations qs 2)])
-    (match-define (list qa qb) qs)
+  (match-define (list qa qb) qs)
-    (match-define (list qa-col qb-col) (map q-col qs))
+  (match-define (list qa-col qb-col) (map q-col qs))
-    (add-constraint! queens
+  (add-constraint! queens
-                     (λ (qa-row qb-row)
+                   (λ (qa-row qb-row)
-                       (nor
+                     (nor
-                        (= (abs (- qa-row qb-row)) (abs (- qa-col qb-col))) ; same diagonal?
+                      (= (abs (- qa-row qb-row)) (abs (- qa-col qb-col))) ; same diagonal?
-                        (= qa-row qb-row))) ; same row?
+                      (= qa-row qb-row))) ; same row?
-                     (list qa qb)))
+                   (list qa qb)))
 
-(time-avg 10 (solve queens))
+#;(time-avg 10 (solve queens))
 (parameterize ([current-solver min-conflicts])
   (time-named (solve queens)))

csp/hacs.rkt

@@ -415,26 +415,34 @@
 (define (random-pick xs)
   (list-ref xs (random (length xs))))
 
+(define (assign-random-vals csp)
+  (for/fold ([new-csp csp])
+            ([name (in-var-names csp)])
+    (assign-val new-csp name (random-pick ($csp-vals csp name)))))
+
+(define (make-min-conflcts-thread csp0 max-steps [main-thread (current-thread)])
+  (thread
+   (λ ()
+     ;; Generate a complete assignment for all variables (probably with conflicts)
+     (for/fold ([csp (assign-random-vals csp0)])
+               ([nth-step (in-range max-steps)])
+       ;; Now repeatedly choose a random conflicted variable and change it
+       (match (conflicted-var-names csp)
+         [(? empty?) (thread-send main-thread csp) csp]
+         [names
+          (define name (random-pick names))
+          (define val (min-conflicts-value csp name ($csp-vals csp0 name)))
+          (assign-val csp name val)])))))
+
 (define/contract (min-conflicts csp [max-steps 100])
   (($csp?) (integer?) . ->* . generator?)
-  ;; Solve a CSP by stochastic hillclimbing on the number of conflicts.
+  ;; Solve a CSP by stochastic hillclimbing on the number of conflicts.  
   (generator ()
-             (let loop ([csp0 csp])
+             (for ([thread-count 4]) ; todo: what is ideal thread quantity?
-               ;; Generate a complete assignment for all variables (probably with conflicts)
+               (make-min-conflcts-thread csp max-steps))
-               (define starting-assignment
+             (let loop ()
-                 (for/fold ([csp csp0])
+               (yield (thread-receive))
-                                 ([var (in-vars csp0)])
+               (loop))))
-                         (define name (var-name var))
-                         (assign-val csp name (random-pick ($csp-vals csp0 name)))))
-               ;; Now repeatedly choose a random conflicted variable and change it
-               (for/fold ([csp starting-assignment])
-                         ([i (in-range max-steps)])
-                 (match (conflicted-var-names csp)
-                   [(? empty?) (yield csp) (loop csp0)]
-                   [names
-                    (define name (random-pick names))
-                    (define val (min-conflicts-value csp name ($csp-vals csp0 name)))
-                    (assign-val csp name val)])))))
 
 (define/contract (conflicted-var-names csp)
   ($csp? . -> . (listof name?))