nitwittery

csp/hacs-test-workbench.rkt

@@ -21,11 +21,10 @@
   (match-define (list qa-col qb-col) (map q-col qs))
   (add-constraint! queens
                    (λ (qa-row qb-row)
-                     (nor
-                      (= (abs (- qa-row qb-row)) (abs (- qa-col qb-col))) ; same diagonal?
-                      (= qa-row qb-row))) ; same row?
-                   (list qa qb)))
+                     (not (= (abs (- qa-row qb-row)) (abs (- (q-col qa) (q-col qb)))))) ; same diag?
+                   (list qa qb))
+  (add-constraint! queens (negate =) (list qa qb)))
 
 (time-avg 10 (solve queens))
-(parameterize ([current-solver min-conflicts])
+(parameterize ([current-solver min-conflicts-solver])
   (time-named (solve queens)))

csp/hacs.rkt

@@ -250,9 +250,13 @@
        [(list winning-uvar) winning-uvar] 
        [(list mrv-uvars ...)
         ;; use degree as tiebreaker for mrv
-        (define max-degree-arg (argmax (λ (var) (var-degree csp var)) mrv-uvars))
+        (define degrees (map (λ (var) (var-degree csp var)) mrv-uvars))
+        (define max-degree (apply max degrees))
         ;; use random tiebreaker for degree
-        (random-pick (filter (λ (var) (= (var-degree csp max-degree-arg) (var-degree csp var))) mrv-uvars))])]))
+        (random-pick (for/list ([var (in-list mrv-uvars)]
+                                [degree (in-list degrees)]
+                                #:when (= max-degree degree))
+                       var))])]))
   
 (define first-domain-value values)
 
@@ -422,26 +426,27 @@
             ([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)])
+(define (make-min-conflcts-thread csp0 thread-count 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])
+     (let loop ()
+       ;; 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) (loop)]
+           [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-solver csp [max-steps 100])
   (($csp?) (integer?) . ->* . generator?)
   ;; Solve a CSP by stochastic hillclimbing on the number of conflicts.  
   (generator ()
-             (for ([thread-count 4]) ; todo: what is ideal thread quantity?
-               (make-min-conflcts-thread csp max-steps))
+             (for ([thread-count 4]) ; todo: what is ideal thread count?
+               (make-min-conflcts-thread csp thread-count max-steps))
              (for ([i (in-naturals)])
                (yield (thread-receive)))))
 
@@ -480,7 +485,8 @@
                          #:finish-proc [finish-proc csp->assocs]
                          #:solver [solver (or (current-solver) backtracking-solver)]
                          #:limit [max-solutions +inf.0])
-  ((csp?) (#:finish-proc procedure? #:solver procedure? #:limit integer?) . ->* . (listof any/c))
+  ((csp?) (#:finish-proc procedure? #:solver procedure? #:limit exact-nonnegative-integer?)
+          . ->* . (listof any/c))
   (when-debug
    (reset-assns!)
    (reset-nfcs!)
@@ -491,10 +497,13 @@
 
 (define/contract (solve csp
                         #:finish-proc [finish-proc csp->assocs]
-                        #:solver [solver (or (current-solver) backtracking-solver)])
-  ((csp?) (#:finish-proc procedure? #:solver procedure?) . ->* . (or/c #false any/c))
-  (match (solve* csp #:finish-proc finish-proc #:solver solver #:limit 1)
+                        #:solver [solver (or (current-solver) backtracking-solver)]
+                        #:limit [max-solutions 1])
+  ((csp?) (#:finish-proc procedure? #:solver procedure? #:limit exact-nonnegative-integer?)
+          . ->* . (or/c #false any/c))
+  (match (solve* csp #:finish-proc finish-proc #:solver solver #:limit max-solutions)
     [(list solution) solution]
+    [(list solutions ...) solutions]
     [else #false]))
 
 (define (<> a b) (not (= a b)))