reality

csp/csp/hacs-map.rkt

@@ -4,13 +4,13 @@
 
 
 (define (map-coloring-csp colors neighbors)
-  (define variables (remove-duplicates (flatten neighbors) eq?))
-  (define vds (for/list ([var (in-list variables)])
-                ($var var colors)))
+  (define names (remove-duplicates (flatten neighbors) eq?))
+  (define vds (for/list ([name (in-list names)])
+                (var name colors)))
   (define cs (for*/list ([neighbor neighbors]
                          [target (cdr neighbor)])
-               ($constraint (list (car neighbor) target) neq?)))
-  ($csp vds cs))
+               (constraint (list (car neighbor) target) neq?)))
+  (csp vds cs))
 
 (define (parse-colors str) (map string->symbol (map string-downcase (regexp-match* "." str))))
 (define(parse-neighbors str)

csp/csp/hacs-test-queens.rkt

@@ -0,0 +1,31 @@
+#lang debug racket
+(require sugar/debug "hacs.rkt")
+
+(current-inference forward-check)
+(current-select-variable mrv)
+(current-order-values shuffle)
+(current-random #true)
+
+;; queens problem
+;; place queens on chessboard so they do not intersect
+
+(define board-size 8)
+
+(define queens (make-csp))
+(define qs (for/list ([q board-size]) (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)
+                     (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)))
+
+(current-thread-count 4)
+(time-avg 10 (solve queens))
+(parameterize ([current-solver min-conflicts-solver])
+  (time-avg 10 (solve queens)))

csp/csp/hacs-test.rkt

@@ -6,60 +6,60 @@
 (current-order-values shuffle)
 (current-random #true)
 
-(check-equal? (first-unassigned-variable (csp (list (variable 'a (range 3)) (variable 'b (range 3))) null))
-              (variable 'a (range 3)))
-(check-equal? (first-unassigned-variable (csp (list (avar 'a (range 3)) (variable 'b (range 3))) null))
-              (variable 'b (range 3)))
+(check-equal? (first-unassigned-variable (csp (list (var 'a (range 3)) (var 'b (range 3))) null))
+              (var 'a (range 3)))
+(check-equal? (first-unassigned-variable (csp (list (avar 'a (range 3)) (var 'b (range 3))) null))
+              (var 'b (range 3)))
 (check-false (first-unassigned-variable (csp (list (avar 'a (range 3)) (avar 'b (range 3))) null)))
 
 (check-equal?
  ;; no forward checking when no constraints
- (csp-vars (forward-check (csp (list (avar 'a '(1)) (variable 'b (range 2))) null) 'a))
- (list (avar 'a '(1)) (variable 'b '(0 1))))
+ (csp-vars (forward-check (csp (list (avar 'a '(1)) (var 'b (range 2))) null) 'a))
+ (list (avar 'a '(1)) (var 'b '(0 1))))
 
 (check-equal?
- (csp-vars (forward-check (forward-check (csp (list (avar 'a '(1))  (avar 'b '(0)) (variable 'c '(0 1 2)))
+ (csp-vars (forward-check (forward-check (csp (list (avar 'a '(1))  (avar 'b '(0)) (var 'c '(0 1 2)))
                                                 (list (constraint '(a c) (negate =))
                                                       (constraint '(b c) (negate =)))) 'a) 'b))
  (list (avar 'a '(1)) (avar 'b '(0)) (cvar 'c '(2) '(b a))))
 
 (check-equal?
  ;; no inconsistency: b≠c not checked when fc is relative to a
- (csp-vars (forward-check (csp (list (avar 'a '(1))  (variable 'b (range 2)) (variable 'c '(0)))
+ (csp-vars (forward-check (csp (list (avar 'a '(1))  (var 'b (range 2)) (var 'c '(0)))
                                  (list (constraint '(a b) (negate =))
                                        (constraint '(b c) (negate =)))) 'a))
- (list (avar 'a '(1)) (cvar 'b '(0) '(a)) (variable 'c '(0))))
+ (list (avar 'a '(1)) (cvar 'b '(0) '(a)) (var 'c '(0))))
 
 (check-equal?
  ;; no inconsistency: a≠b not checked when fc ignores a, which is already assigned
- (csp-vars (forward-check (csp (list (avar 'a '(1))  (avar 'b '(1)) (variable 'c (range 2)))
+ (csp-vars (forward-check (csp (list (avar 'a '(1))  (avar 'b '(1)) (var 'c (range 2)))
                                  (list (constraint '(a b) (negate =))
                                        (constraint '(b c) (negate =)))) 'b))
  (list (avar 'a '(1)) (avar 'b '(1)) (cvar 'c '(0) '(b))))
 
-(check-exn $backtrack?
+(check-exn backtrack?
            (λ () (csp-vars (forward-check (csp (list (avar 'a '(1))
-                                                       (variable 'b '(1)))
+                                                       (var 'b '(1)))
                                                  (list (constraint '(a b) (negate =)))) 'a))))
 
 
-(check-equal? (csp-vars (forward-check (csp (list (variable 'a '(0))
-                                                    (variable 'b (range 3)))
+(check-equal? (csp-vars (forward-check (csp (list (var 'a '(0))
+                                                    (var 'b (range 3)))
                                               (list (constraint '(a b) <))) 'a))
-              (list (variable 'a '(0)) (cvar 'b '(1 2) '(a))))
+              (list (var 'a '(0)) (cvar 'b '(1 2) '(a))))
 
 (check-equal?
  (parameterize ([current-inference forward-check])
-   (length (solve* (csp (list (variable 'x (range 3))
-                               (variable 'y (range 3))
-                               (variable 'z (range 3)))
+   (length (solve* (csp (list (var 'x (range 3))
+                               (var 'y (range 3))
+                               (var 'z (range 3)))
                          (list (constraint '(x y) <>)
                                (constraint '(x z) <>)
                                (constraint '(y z) <>)))))) 6)
 
 (parameterize ([current-inference forward-check])
   (define vds (for/list ([k '(wa nt nsw q t v sa)])
-                        (variable k '(red green blue))))
+                        (var k '(red green blue))))
   (define cs (list
               (constraint '(wa nt) neq?)
               (constraint '(wa sa) neq?)

csp/csp/hacs.rkt

@@ -18,87 +18,85 @@
                         (for ([arg (in-list (car argss))])
                              (loop (cdr argss) (cons arg acc))))))))
 
-(struct csp (vars 
-              constraints
-              [assignments #:auto]
-              [checks #:auto]) #:mutable #:transparent
-  #:auto-value 0)
-(define vars csp-vars)
+(struct csp (vars constraints [assignments #:auto] [checks #:auto])
+  #:mutable #:transparent #:auto-value 0)
 (define constraints csp-constraints)
+(define vars csp-vars)
 (define-syntax-rule (in-constraints csp) (in-list (csp-constraints csp)))
-(define-syntax-rule (in-vars csp) (in-list (csp-vars csp)))
-(define-syntax-rule (in-variable-names csp) (in-list (map variable-name (csp-vars csp))))
+(define-syntax-rule (in-vars csp) (in-list (vars csp)))
+(define-syntax-rule (in-variable-names csp) (in-list (map var-name (vars csp))))
 
 (struct constraint (names proc) #:transparent
   #:property prop:procedure
   (λ (const prob)
     (unless (csp? prob)
-      (raise-argument-error '$constraint-proc "$csp" prob))
+      (raise-argument-error 'constraint-proc "csp" prob))
     ;; apply proc in many-to-many style
-    (for/and ([args (in-cartesian (map (λ (name) (csp-domain prob name)) (constraint-names const)))])
+    (for/and ([args (in-cartesian (map (λ (name) (find-domain prob name)) (constraint-names const)))])
              (apply (constraint-proc const) args))))
 
-(define (make-constraint [names null] [proc values])
-  (constraint names proc))
+(define name? symbol?)
 
+(define/contract (make-constraint [names null] [proc values])
+  (() ((listof name?) procedure?) . ->* . constraint?)
+  (constraint names proc))
 
-(define (csp->graphviz prob)
+(define/contract (csp->graphviz prob)
+  (csp? . -> . string?)
   (define g (csp->graph prob))
   (graphviz g #:colors (coloring/brelaz g)))
 
-(define (csp->graph prob)
-  (for*/fold ([gr (unweighted-graph/undirected (map variable-name (vars prob)))])
+(define/contract (csp->graph prob)
+  (csp? . -> . graph?)
+  (for*/fold ([gr (unweighted-graph/undirected (map var-name (vars prob)))])
              ([constraint (in-constraints prob)]
               [edge (in-combinations (constraint-names constraint) 2)])
     (apply add-edge! gr edge)
     gr))
 
-(struct variable (name domain) #:transparent)
-(define name? symbol?)
+(struct var (name domain) #:transparent)
+(define domain var-domain)
 
-(struct checked-var variable (past) #:transparent)
-(define cvar checked-var)
-(define cvar? checked-var?)
+(struct checked-variable var (history) #:transparent)
+(define history checked-variable-history)
+(define cvar checked-variable)
+(define cvar? checked-variable?)
 
-(struct assigned-var variable () #:transparent)
+(struct assigned-var var () #:transparent)
 (define avar assigned-var)
 (define avar? assigned-var?)
 
 (define/contract (make-csp [vars null] [consts null])
-  (() ((listof variable?) (listof constraint?)) . ->* . csp?)
+  (() ((listof var?) (listof constraint?)) . ->* . csp?)
   (csp vars consts))
 
-(define/contract (add-variables! prob names-or-procedure [vals-or-procedure empty])
+(define/contract (add-vars! prob names-or-procedure [vals-or-procedure empty])
   ((csp? (or/c (listof name?) procedure?)) ((or/c (listof any/c) procedure?)) . ->* . void?)
-  (for/fold ([vars (csp-vars prob)]
-             #:result (set-csp-vars! prob vars))
+  (for/fold ([vrs (vars prob)]
+             #:result (set-csp-vars! prob vrs))
             ([name (in-list (if (procedure? names-or-procedure)
                                 (names-or-procedure)
                                 names-or-procedure))])
-    (when (memq name (map variable-name vars))
+    (when (memq name (map var-name vrs))
       (raise-argument-error 'add-vars! "var that doesn't already exist" name))
-    (append vars (list (variable name
-                             (if (procedure? vals-or-procedure)
-                                 (vals-or-procedure)
-                                 vals-or-procedure))))))
+    (append vrs (list (var name
+                            (if (procedure? vals-or-procedure)
+                                (vals-or-procedure)
+                                vals-or-procedure))))))
 
-(define add-vars! add-variables!)
-
-(define/contract (add-variable! prob name [vals-or-procedure empty])
+(define/contract (add-var! prob name [vals-or-procedure empty])
   ((csp? name?) ((or/c (listof any/c) procedure?)) . ->* . void?)
   (add-vars! prob (list name) vals-or-procedure))
 
-(define add-var! add-variable!)
-
 (define/contract (add-constraints! prob proc namess [proc-name #false])
   ((csp? procedure? (listof (listof name?))) ((or/c #false name?)) . ->* . void?)
   (set-csp-constraints! prob (append (constraints prob) 
-                                      (for/list ([names (in-list namess)])
-                                                (for ([name (in-list names)])
-                                                     (check-name-in-csp! 'add-constraints! prob name))
-                                                (make-constraint names (if proc-name
-                                                                           (procedure-rename proc proc-name)
-                                                                           proc))))))
+                                     (for/list ([names (in-list namess)])
+                                               (for ([name (in-list names)])
+                                                    (check-name-in-csp! 'add-constraints! prob name))
+                                               (make-constraint names (if proc-name
+                                                                          (procedure-rename proc proc-name)
+                                                                          proc))))))
 
 (define/contract (add-pairwise-constraint! prob proc var-names [proc-name #false])
   ((csp? procedure? (listof name?)) (name?) . ->* . void?)
@@ -112,8 +110,8 @@
   (any/c any/c . -> . boolean?)
   (not (= x y)))
 
-(struct $backtrack (names) #:transparent)
-(define (backtrack! [names null]) (raise ($backtrack names)))
+(struct backtrack (names) #:transparent)
+(define (backtrack! [names null]) (raise (backtrack names)))
 
 (define current-select-variable (make-parameter #f))
 (define current-order-values (make-parameter #f))
@@ -121,32 +119,33 @@
 (define current-solver (make-parameter #f))
 (define current-random (make-parameter #t))
 (define current-decompose (make-parameter #t))
+(define current-thread-count (make-parameter 4))
 
 (define/contract (check-name-in-csp! caller prob name)
   (symbol? csp? name? . -> . void?)
-  (define names (map variable-name (vars prob)))
+  (define names (map var-name (vars prob)))
   (unless (memq name names)
     (raise-argument-error caller (format "one of these existing csp var names: ~v" names) name)))
 
-(define/contract (csp-var prob name)
-  (csp? name? . -> . variable?)
-  (check-name-in-csp! 'csp-var prob name)
-  (for/first ([var (in-vars prob)]
-              #:when (eq? name (variable-name var)))
-             var))
+(define/contract (find-var prob name)
+  (csp? name? . -> . var?)
+  (check-name-in-csp! 'find-var prob name)
+  (for/first ([vr (in-vars prob)]
+              #:when (eq? name (var-name vr)))
+             vr))
 
-(define/contract (csp-domain prob name)
+(define/contract (find-domain prob name)
   (csp? name? . -> . (listof any/c))
-  (check-name-in-csp! 'csp-vals prob name)
-  (variable-domain (csp-var prob name)))
+  (check-name-in-csp! 'find-domain prob name)
+  (domain (find-var prob name)))
 
 (define order-domain-values values)
 
 (define/contract (assigned-name? prob name)
   (csp? name? . -> . any/c)
-  (for/or ([var (in-vars prob)]
-           #:when (assigned-var? var))
-          (eq? name (variable-name var))))
+  (for/or ([vr (in-vars prob)]
+           #:when (assigned-var? vr))
+          (eq? name (var-name vr))))
 
 (define/contract (reduce-function-arity proc pattern)
   (procedure? (listof any/c) . -> . procedure?)
@@ -172,97 +171,91 @@
    reduced-arity-name))
 
 (define/contract (reduce-constraint-arity prob [minimum-arity 3])
-  ((csp?) ((or/c #false exact-nonnegative-integer?)) . ->* . csp?)
-  (let ([assigned-name? (curry assigned-name? prob)])
-    (define (partially-assigned? constraint)
-      (ormap assigned-name? (constraint-names constraint)))
-    (make-csp (vars prob)
-              (for/list ([const (in-constraints prob)])
-                        (cond
-                          [(and (or (not minimum-arity) (<= minimum-arity (constraint-arity const)))
-                                (partially-assigned? const))
-                           (match-define (constraint cnames proc) const)
-                           (constraint (filter-not assigned-name? cnames)
-                                        ;; pattern is mix of values and boxed symbols (indicating variables to persist)
-                                        ;; use boxes here as cheap way to distinguish id symbols from value symbols
-                                        (let ([reduce-arity-pattern (for/list ([cname (in-list cnames)])
-                                                                              (if (assigned-name? cname)
-                                                                                  (first (csp-domain prob cname))
-                                                                                  (box cname)))])
-                                          (reduce-function-arity proc reduce-arity-pattern)))]
-                          [else const])))))
+  ((csp?) ((or/c #false natural?)) . ->* . csp?)
+  (define assigned? (curry assigned-name? prob))
+  (define (partially-assigned? constraint)
+    (ormap assigned? (constraint-names constraint)))
+  (make-csp (vars prob)
+            (for/list ([const (in-constraints prob)])
+                      (cond
+                        ;; no point reducing 2-arity functions because they will be consumed by forward checking
+                        [(and (or (not minimum-arity) (<= minimum-arity (constraint-arity const)))
+                              (partially-assigned? const))
+                         (match-define (constraint cnames proc) const)
+                         ;; pattern is mix of values and boxed symbols (indicating variables to persist)
+                         ;; use boxes here as cheap way to distinguish id symbols from value symbols
+                         (define reduce-arity-pattern (for/list ([cname (in-list cnames)])
+                                                                (if (assigned? cname)
+                                                                    (first (find-domain prob cname))
+                                                                    (box cname))))
+                         (constraint (filter-not assigned? cnames)
+                                     (reduce-function-arity proc reduce-arity-pattern))]
+                        [else const]))))
 
 (define nassns 0)
 
 (define (reset-assns!) (set! nassns 0))
 
+(define nfchecks 0)
+
+(define (reset-nfcs!) (set! nfchecks 0))
+
 (define/contract (assign-val prob name val)
   (csp? name? any/c . -> . csp?)
   (when-debug (set! nassns (add1 nassns)))
   (make-csp
-   (for/list ([var (vars prob)])
-             (if (eq? name (variable-name var))
+   (for/list ([vr (vars prob)])
+             (if (eq? name (var-name vr))
                  (assigned-var name (list val))
-                 var))
+                 vr))
    (constraints prob)))
 
 (define/contract (unassigned-vars prob)
-  (csp? . -> . (listof (and/c variable? (not/c assigned-var?))))
+  (csp? . -> . (listof (and/c var? (not/c assigned-var?))))
   (filter-not assigned-var? (vars prob)))
 
 (define/contract (first-unassigned-variable csp)
-  (csp? . -> . (or/c #false (and/c variable? (not/c assigned-var?))))
+  (csp? . -> . (or/c #false (and/c var? (not/c assigned-var?))))
   (match (unassigned-vars csp)
     [(? empty?) #false]
-    [(cons x _) x]))
+    [xs (first xs)]))
 
 (define/contract (minimum-remaining-values prob)
-  (csp? . -> . (or/c #false (and/c variable? (not/c assigned-var?))))
+  (csp? . -> . (or/c #false (and/c var? (not/c assigned-var?))))
   (match (unassigned-vars prob)
     [(? empty?) #false]
-    [xs (argmin (λ (var) (length (variable-domain var))) xs)]))
+    [xs (argmin (λ (var) (length (domain var))) xs)]))
 
 (define mrv minimum-remaining-values)
 
 (define/contract (var-degree prob var)
-  (csp? variable? . -> . exact-nonnegative-integer?)
+  (csp? var? . -> . natural?)
   (for/sum ([const (in-constraints prob)]
-            #:when (memq (variable-name var) (constraint-names const)))
+            #:when (memq (var-name var) (constraint-names const)))
            1))
 
-(define/contract (blended-variable-selector prob)
-  (csp? . -> . (or/c #false (and/c variable? (not/c assigned-var?))))
-  (define uvars (unassigned-vars prob))
-  (cond
-    [(empty? uvars) #false]
-    [(findf singleton-var? uvars)]
-    [else (first (let* ([uvars-by-mrv (sort uvars < #:key (λ (var) (length (variable-domain var))))]
-                        [uvars-by-degree (sort uvars-by-mrv > #:key (λ (var) (var-degree prob var)))])
-                   uvars-by-degree))]))
-
-(define/contract (remaining-values var)
-  (variable? . -> . exact-nonnegative-integer?)
-  (length (variable-domain var)))
+(define/contract (domain-length var)
+  (var? . -> . natural?)
+  (length (domain var)))
 
 (define/contract (mrv-degree-hybrid prob)
-  (csp? . -> . (or/c #f variable?))
-  (define uvars (unassigned-vars prob))
-  (cond
-    [(empty? uvars) #false]
-    [else
+  (csp? . -> . (or/c #f var?))
+  (match (unassigned-vars prob)
+    [(? empty?) #false]
+    [uvars
      ;; minimum remaining values (MRV) rule
-     (define mrv-arg (argmin remaining-values uvars))
-     (match (filter (λ (var) (= (remaining-values mrv-arg) (remaining-values var))) uvars)
+     (define mrv-arg (argmin domain-length uvars))
+     (match (filter (λ (var) (= (domain-length mrv-arg) (domain-length var))) uvars)
        [(list winning-uvar) winning-uvar] 
        [(list mrv-uvars ...)
         ;; use degree as tiebreaker for mrv
         (define degrees (map (λ (var) (var-degree prob var)) mrv-uvars))
         (define max-degree (apply max degrees))
         ;; use random tiebreaker for degree
-        (random-pick (for/list ([var (in-list mrv-uvars)]
+        (random-pick (for/list ([uv (in-list mrv-uvars)]
                                 [degree (in-list degrees)]
                                 #:when (= max-degree degree))
-                               var))])]))
+                               uv))])]))
   
 (define first-domain-value values)
 
@@ -277,44 +270,40 @@
                                    (memq name cnames))))
              const))
 
-(define (binary-constraint? const)
-  (= 2 (constraint-arity const)))
+(define (two-arity? const) (= 2 (constraint-arity const)))
 
 (define (constraint-relates? const name)
   (memq name (constraint-names const)))
 
-(define nfchecks 0)
-(define (reset-nfcs!) (set! nfchecks 0))
-
 (define/contract (forward-check prob ref-name)
   (csp? name? . -> . csp?)
-  (define aval (first (csp-domain prob ref-name)))
-  (define (check-var var)
-    (match var
+  (define aval (first (find-domain prob ref-name)))
+  (define (check-var v)
+    (match v
       ;; don't check against assigned vars, or the reference var
       ;; (which is probably assigned but maybe not)
-      [(? (λ (x) (or (assigned-var? x) (eq? (variable-name x) ref-name)))) var]
-      [(variable name vals)
+      [(? (λ (x) (or (assigned-var? x) (eq? (var-name x) ref-name)))) v]
+      [(var name vals)
        (match ((constraints prob) . relating-only . (list ref-name name))
-         [(? empty?) var]
+         [(? empty?) v]
          [constraints
           (define new-vals
             (for/list ([val (in-list vals)]
-                       #:when (for/and ([constraint (in-list constraints)])
-                                       (let ([proc (constraint-proc constraint)])
-                                         (if (eq? name (first (constraint-names constraint)))
+                       #:when (for/and ([const (in-list constraints)])
+                                       (let ([proc (constraint-proc const)])
+                                         (if (eq? name (first (constraint-names const)))
                                              (proc val aval)
                                              (proc aval val)))))
                       val))
-          (checked-var name new-vals (cons ref-name (if (checked-var? var)
-                                               (checked-var-past var)
-                                               null)))])]))
+          (checked-variable name new-vals (cons ref-name (match v
+                                                           [(checked-variable _ _ history) history]
+                                                           [else null])))])]))
   (define checked-vars (map check-var (vars prob)))
   (when-debug (set! nfchecks (+ (length checked-vars) nchecks)))
-  ;; conflict-set will be empty if there are no empty domains
-  (define conflict-set (for*/list ([var (in-list checked-vars)]
-                                   #:when (empty? (variable-domain var))
-                                   [name (in-list (checked-var-past var))])
+  ;; conflict-set will be empty if there are no empty domains (as we would hope)
+  (define conflict-set (for*/list ([cv (in-list checked-vars)]
+                                   #:when (empty? (domain cv))
+                                   [name (in-list (history cv))])
                                   name))
   ;; for conflict-directed backjumping it's essential to forward-check ALL vars
   ;; (even after an empty domain is generated) and combine their conflicts
@@ -327,43 +316,42 @@
   ;; (they have no further use)
   (define nonsingleton-constraints
     (for/list ([const (in-constraints prob)]
-               #:unless (and
-                         (binary-constraint? const)
-                         (constraint-relates? const ref-name)
-                         (let ([other-name (first (remq ref-name (constraint-names const)))])
-                           (singleton-var? (csp-var prob other-name)))))
+               #:unless (and (two-arity? const)
+                             (constraint-relates? const ref-name)
+                             (let ([other-name (first (remq ref-name (constraint-names const)))])
+                               (singleton-var? (find-var prob other-name)))))
               const))
   (make-csp checked-vars nonsingleton-constraints))
 
-(define/contract (constraint-checkable? c names)
+(define/contract (constraint-checkable? const names)
   (constraint? (listof name?) . -> . any/c)
   ;; constraint is checkable if all constraint names
   ;; are in target list of names.
-  (for/and ([cname (in-list (constraint-names c))])
+  (for/and ([cname (in-list (constraint-names const))])
            (memq cname names)))
 
 (define/contract (constraint-arity const)
-  (constraint? . -> . exact-nonnegative-integer?)
+  (constraint? . -> . natural?)
   (length (constraint-names const)))
 
 (define (singleton-var? var)
-  (= 1 (length (variable-domain var))))
+  (= 1 (domain-length var)))
 
 (define nchecks 0)
 (define (reset-nchecks!) (set! nchecks 0))
 (define/contract (check-constraints prob [mandatory-names #f] #:conflicts [conflict-count? #f])
-  ((csp?) ((listof name?) #:conflicts boolean?) . ->* . (or/c csp? exact-nonnegative-integer?))
+  ((csp?) ((listof name?) #:conflicts boolean?) . ->* . (or/c csp? natural?))
   ;; this time, we're not limited to assigned variables
   ;; (that is, vars that have been deliberately assigned in the backtrack process thus far)
   ;; we also want to use "singleton" vars (that is, vars that have been reduced to a single domain value by forward checking)
-  (define singleton-varnames (for/list ([var (in-vars prob)]
-                                        #:when (singleton-var? var))
-                                       (variable-name var)))
+  (define singleton-varnames (for/list ([vr (in-vars prob)]
+                                        #:when (singleton-var? vr))
+                                       (var-name vr)))
   (define-values (checkable-consts other-consts)
-    (partition (λ (c) (and (constraint-checkable? c singleton-varnames)
-                           (or (not mandatory-names)
-                               (for/and ([name (in-list mandatory-names)])
-                                        (constraint-relates? c name)))))
+    (partition (λ (const) (and (constraint-checkable? const singleton-varnames)
+                               (or (not mandatory-names)
+                                   (for/and ([name (in-list mandatory-names)])
+                                            (constraint-relates? const name)))))
                (constraints prob)))
   (cond
     [conflict-count?
@@ -374,7 +362,7 @@
      (when-debug (set! nchecks (+ conflict-count nchecks)))
      conflict-count]
     [else
-     (for ([(constraint idx) (in-indexed (sort checkable-consts < #:key constraint-arity))]
+     (for ([(constraint idx) (in-indexed checkable-consts)]
            #:unless (constraint prob))
           (when-debug (set! nchecks (+ (add1 idx) nchecks)))
           (backtrack!))
@@ -385,16 +373,16 @@
   (csp? . -> . csp?)
   ;; todo: why does this function slow down searches?
   (make-csp
-   (for/list ([var (in-vars prob)])
-             (match-define (variable name vals) var)
+   (for/list ([vr (in-vars prob)])
+             (match-define (var name vals) vr)
              (define procs (for*/list ([const (in-constraints prob)]
                                        [cnames (in-value (constraint-names const))]
                                        #:when (and (= 1 (length cnames)) (eq? name (car cnames))))
                                       (constraint-proc const)))
-             (variable name
-                   (for*/fold ([vals vals])
-                              ([proc (in-list procs)])
-                     (filter proc vals))))
+             (var name
+                  (for*/fold ([vals vals])
+                             ([proc (in-list procs)])
+                    (filter proc vals))))
    (constraints prob)))
 
 (define/contract (backtracking-solver
@@ -408,15 +396,15 @@
              (let loop ([prob prob])
                (match (select-unassigned-variable prob)
                  [#false (yield prob)]
-                 [(variable name domain)
+                 [(var name domain)
                   (define (wants-backtrack? exn)
-                    (and ($backtrack? exn) (or (let ([btns ($backtrack-names exn)])
-                                                 (or (empty? btns) (memq name btns))))))
+                    (and (backtrack? exn) (or (let ([btns (backtrack-names exn)])
+                                                (or (empty? btns) (memq name btns))))))
                   (for/fold ([conflicts null]
                              #:result (void))
                             ([val (in-list (order-domain-values domain))])
                     (with-handlers ([wants-backtrack?
-                                     (λ (bt) (append conflicts (remq name ($backtrack-names bt))))])
+                                     (λ (bt) (append conflicts (remq name (backtrack-names bt))))])
                       (let* ([prob (assign-val prob name val)]
                              ;; reduce constraints before inference,
                              ;; to create more forward-checkable (binary) constraints
@@ -432,7 +420,7 @@
 (define (assign-random-vals prob)
   (for/fold ([new-csp prob])
             ([name (in-variable-names prob)])
-    (assign-val new-csp name (random-pick (csp-domain prob name)))))
+    (assign-val new-csp name (random-pick (find-domain prob name)))))
 
 (define (make-min-conflcts-thread prob-start thread-count max-steps [main-thread (current-thread)])
   (thread
@@ -446,13 +434,13 @@
            [(? empty?) (thread-send main-thread prob) (loop)]
            [names
             (define name (random-pick names))
-            (define val (min-conflicts-value prob name (csp-domain prob-start name)))
+            (define val (min-conflicts-value prob name (find-domain prob-start name)))
             (assign-val prob name val)]))))))
 
 (define/contract (min-conflicts-solver prob [max-steps 100])
   ((csp?) (integer?) . ->* . generator?)
   (generator ()
-             (for ([thread-count 4]) ; todo: what is ideal thread count?
+             (for ([thread-count (or (current-thread-count) 1)]) ; todo: what is ideal thread count?
                   (make-min-conflcts-thread prob thread-count max-steps))
              (for ([i (in-naturals)])
                   (yield (thread-receive)))))
@@ -461,9 +449,9 @@
   (procedure? (listof any/c) . -> . any/c)
   (define-values (sample candidates) (split-at xs (inexact->exact (floor (* .458 (length xs))))))
   (define threshold (argmin proc sample))
-  (or (for/first ([c (in-list candidates)]
-                  #:when (<= (proc c) threshold))
-                 c)
+  (or (for/first ([candidate (in-list candidates)]
+                  #:when (<= (proc candidate) threshold))
+                 candidate)
       (last candidates)))
 
 (define/contract (conflicted-variable-names prob)
@@ -479,13 +467,13 @@
   (define vals-by-conflict (sort vals < #:key (λ (val) (nconflicts prob name val))
                                  #:cache-keys? #true))
   (for/first ([val (in-list vals-by-conflict)]
-              #:unless (equal? val (first (csp-domain prob name)))) ;; but change the value
+              #:unless (equal? val (first (find-domain prob name)))) ;; but change the value
              val))
 
 (define no-value-sig (gensym))
 
 (define/contract (nconflicts prob name [val no-value-sig])
-  ((csp? name?) (any/c) . ->* . exact-nonnegative-integer?)
+  ((csp? name?) (any/c) . ->* . natural?)
   ;; How many conflicts var: val assignment has with other variables.
   (check-constraints (if (eq? val no-value-sig)
                          prob
@@ -493,14 +481,14 @@
 
 (define/contract (csp->assocs prob)
   (csp? . -> . (listof (cons/c name? any/c)))
-  (for/list ([var (in-vars prob)])
-            (match var
-              [(variable name (list val)) (cons name val)])))
+  (for/list ([vr (in-vars prob)])
+            (match vr
+              [(var name (list val)) (cons name val)])))
 
 (define/contract (combine-csps probs)
   ((listof csp?) . -> . csp?)
   (make-csp
-   (apply append (map csp-vars probs))
+   (apply append (map vars probs))
    (apply append (map csp-constraints probs))))
 
 (define/contract (make-cartesian-generator solgens)
@@ -518,9 +506,9 @@
 (define/contract (extract-subcsp prob names)
   (csp? (listof name?) . -> . csp?)
   (make-csp
-   (for/list ([var (in-vars prob)]
-              #:when (memq (variable-name var) names))
-             var)
+   (for/list ([vr (in-vars prob)]
+              #:when (memq (var-name vr) names))
+             vr)
    (for/list ([const (in-constraints prob)]
               #:when (for/and ([cname (in-list (constraint-names const))])
                               (memq cname names)))
@@ -530,7 +518,7 @@
                          #: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 exact-nonnegative-integer?)
+  ((csp?) (#:finish-proc procedure? #:solver procedure? #:limit natural?)
           . ->* . (listof any/c))
   (when-debug (reset-assns!) (reset-nfcs!) (reset-nchecks!))          
 
@@ -548,7 +536,7 @@
                         #:finish-proc [finish-proc csp->assocs]
                         #:solver [solver (or (current-solver) backtracking-solver)]
                         #:limit [max-solutions 1])
-  ((csp?) (#:finish-proc procedure? #:solver procedure? #:limit exact-nonnegative-integer?)
+  ((csp?) (#:finish-proc procedure? #:solver procedure? #:limit natural?)
           . ->* . (or/c #false any/c))
   (match (solve* prob #:finish-proc finish-proc #:solver solver #:limit max-solutions)
     [(list solution) solution]