change to racket naming conventions

csp/constraint.rkt

@@ -3,7 +3,7 @@
 (provide (all-defined-out))
 
 
-(define Constraint
+(define constraint%
   (class object% 
     (super-new)
     
@@ -67,10 +67,10 @@
       return-result)
     ))
 
-(define Constraint? (is-a?/c Constraint))
+(define constraint%? (is-a?/c constraint%))
 
-(define FunctionConstraint
-  (class Constraint 
+(define function-constraint%
+  (class constraint% 
     (super-new)
     (init-field func [assigned #t])
     (field [_func func][_assigned assigned])
@@ -96,12 +96,12 @@
           (apply _func parms)))
     
     ))
-(define FunctionConstraint? (is-a?/c FunctionConstraint))
+(define function-constraint%? (is-a?/c function-constraint%))
 
-(define AllDifferentConstraint
+(define all-different-constraint%
   ;; Constraint enforcing that values of all given variables are different
   
-  (class Constraint 
+  (class constraint% 
     (super-new)
     
     (define/override (call variables domains assignments [forwardcheck #f] [_unassigned Unassigned])
@@ -133,13 +133,13 @@
         (return-k))
       return-value)))
 
-(define AllDifferentConstraint? (is-a?/c AllDifferentConstraint))
+(define all-different-constraint%? (is-a?/c all-different-constraint%))
 
 
-(define AllEqualConstraint
+(define all-equal-constraint%
   ;; Constraint enforcing that values of all given variables are different
   
-  (class Constraint 
+  (class constraint% 
     (super-new)
     
     (define/override (call variables domains assignments [forwardcheck #f] [_unassigned Unassigned])
@@ -171,4 +171,4 @@
         (return-k))
       return-value)))
 
-(define AllEqualConstraint? (is-a?/c AllEqualConstraint))
+(define all-equal-constraint%? (is-a?/c all-equal-constraint%))

csp/domain.rkt

@@ -2,7 +2,7 @@
 (require racket/class racket/list "helper.rkt")
 (provide (all-defined-out))
 
-(define Domain
+(define domain%
   ;; Class used to control possible values for variables
   ;; When list or tuples are used as domains, they are automatically
   ;; converted to an instance of that class.
@@ -53,12 +53,12 @@
       (py-pop! _list))
     
     (define/public (copy)
-      (define copied-domain (new Domain [set _list]))
+      (define copied-domain (new domain% [set _list]))
       (set-field! _hidden copied-domain _hidden)
       (set-field! _states copied-domain _states)
       copied-domain)
     
     
     ))
-(define Domain? (is-a?/c Domain))
+(define domain%? (is-a?/c domain%))
 

csp/main.rkt

@@ -2,10 +2,12 @@
 (require 
   "problem.rkt"
   "constraint.rkt"
+  "solver.rkt"
   "helper.rkt")
 
 (provide (all-from-out
   "problem.rkt"
   "constraint.rkt"
+  "solver.rkt"
   "helper.rkt"))
 

csp/problem.rkt

@@ -1,26 +1,33 @@
 #lang racket/base
-(require racket/class sugar/container racket/contract racket/match "domain.rkt" "helper.rkt" "constraint.rkt" "solver.rkt")
+(require racket/class sugar/container sugar/debug racket/contract racket/match)
+(require "domain.rkt" "helper.rkt" "constraint.rkt" "solver.rkt")
 (provide (all-defined-out))
 
-(define/contract Problem
+(define/contract problem%
   ;; Class used to define a problem and retrieve solutions
   
   (class/c [reset (->m void?)]
-           [setSolver (Solver? . ->m . void?)] 
-           [getSolver (->m Solver?)]
+           [set-solver (solver%? . ->m . void?)] 
+           [get-solver (->m solver%?)]
            ;; todo: tighten `object?` contract
-           [addVariable (any/c (or/c list? Domain?) . ->m . void?)]
-           [getSolutions (->m list?)])
+           [add-variable (any/c (or/c list? domain%?) . ->m . void?)]
+           [add-variables ((listof any/c) (or/c list? domain%?) . ->m . void?)]
+           [add-constraint (((or/c constraint%? procedure?)) ((listof any/c)) . ->*m . void?)]
+           [get-solution (->m any/c)]
+           [get-solutions (->m list?)]
+           [_get-args (->m (values (listof domain%?) (listof constraint%?) (listof hash?)))])
+  
   (class* object% (printable<%>)
     (super-new)
     
     (init-field [solver #f])
-    (field [_solver (or solver (new BacktrackingSolver))]
-           [_constraints null]
-           [_variables (make-hash)])
+    (field [_solver (or solver (new backtracking-solver%))]
+           [_constraints #f]
+           [_variables #f])
     
+    (reset)
     
-    (define (repr) (format "<Problem ~a>" (hash-keys _variables)))
+    (define (repr) (format "<problem% ~a>" (hash-keys _variables)))
     (define/public (custom-print out quoting-depth) (print (repr) out))
     (define/public (custom-display out) (displayln (repr) out))
     (define/public (custom-write out) (write (repr) out))
@@ -28,61 +35,64 @@
     (define/public (reset)
       ;; Reset the current problem definition
       (set! _constraints null)
-      (hash-clear! _variables))
+      (set! _variables (make-hash)))
     
-    (define/public (setSolver solver)
+    (define/public (set-solver solver)
       ;; Change the problem solver currently in use
       (set! _solver solver))
     
-    (define/public (getSolver)
+    (define/public (get-solver)
       ;; Obtain the problem solver currently in use
       _solver)
     
-    (define/public (addVariable variable domain)
+    (define/public (add-variable variable domain-or-values)
       ;; Add a variable to the problem
-      (when (variable . in? . _variables)
-        (error 'addVariable (format "Tried to insert duplicated variable ~a" variable)))
-      (cond 
-        [(list? domain) (set! domain (new Domain [set domain]))]
-        [(Domain? domain) (set! domain (send domain copy))]
-        [else (error 'addVariable "Domains must be instances of subclasses of Domain")])
-      (when (not (object? domain)) (error 'fudge))
-      (when (not domain) ; todo: check this test
-        (error 'addVariable "Domain is empty"))
+      ;; Contract insures input is Domain object or list of values.
+      (when (hash-has-key? _variables variable)
+        (error 'add-variable (format "Tried to insert duplicated variable ~a" variable)))      
+      (define domain (if (domain%? domain-or-values)
+                         (send domain-or-values copy)
+                         (new domain% [set domain-or-values])))
+      (when (not (object? domain)) (error 'add-variable "not a Domain object"))
+      (when (null? (get-field _list domain)) (error 'add-variable "domain value is null"))
       (hash-set! _variables variable domain))
     
-    (define/public (addVariables variables domain)
+    (define/public (add-variables variables domain)
       ;; Add one or more variables to the problem
       (define listified-variables
         (cond 
           [(string? variables) (map (λ(c) (format "~a" c)) (string->list variables))]
           [else variables]))
-      (for-each (λ(var) (addVariable var domain)) listified-variables))
+      (for-each (λ(var) (add-variable var domain)) listified-variables))
     
-    (define/public (addConstraint constraint [variables null])
+    (define/public (add-constraint constraint [variables null])
       ;; Add a constraint to the problem
       
-      (when (not (Constraint? constraint))
+      (when (not (constraint%? constraint))
         (if (procedure? constraint)
-            (set! constraint (new FunctionConstraint [func constraint]))
-            (error 'addConstraint "Constraints must be instances of class Constraint")))
+            (set! constraint (new function-constraint% [func constraint]))
+            (error 'add-constraint "Constraints must be instances of class Constraint")))
       (py-append! _constraints (list constraint variables)))
     
-    (define/public (getSolution)
+    (define/public (get-solution)
       ;; Find and return a solution to the problem
-      (define-values (domains constraints vconstraints) (_getArgs))
+      (define-values (domains constraints vconstraints) (_get-args))
       (if (not domains)
           null
-          (send _solver getSolution domains constraints vconstraints)))
+          (send _solver get-solution domains constraints vconstraints)))
     
-    (define/public (getSolutions)
+    (define/public (get-solutions)
       ;; Find and return all solutions to the problem
-      (define-values (domains constraints vconstraints) (_getArgs))
+      (define-values (domains constraints vconstraints) (_get-args))
       (if (not domains)
           null
-          (send _solver getSolutions domains constraints vconstraints)))
+          (send _solver get-solutions domains constraints vconstraints)))
+    
+    (define/public (get-solution-iter)
+      ; Return an iterator to the solutions of the problem
+      (void))
     
-    (define/public (_getArgs)
+    (define/public (_get-args)
       (define domains (hash-copy _variables))
       (define allvariables (hash-keys domains))
       (define constraints null)

csp/solver.rkt

@@ -2,26 +2,24 @@
 (require racket/class sugar/container racket/list racket/generator racket/match "helper.rkt")
 (provide (all-defined-out))
 
-(define Solver
+(define solver%
   ;; Abstract base class for solvers
   (class object%
     (super-new)
-    (abstract getSolution)
-    (abstract getSolutions)
-    (abstract getSolutionIter)))
+    (abstract get-solution)
+    (abstract get-solutions)
+    (abstract get-solution-iter)))
 
-(define Solver? (is-a?/c Solver))
+(define solver%? (is-a?/c solver%))
 
-(define BacktrackingSolver
+(define backtracking-solver%
   ;; Problem solver with backtracking capabilities
-  (class Solver
+  (class solver%
     (super-new)
     (init-field [forwardcheck #t])
     (field [_forwardcheck forwardcheck]) 
     
-    (define/override (getSolutionIter domains constraints vconstraints)
-      
-      
+    (define/override (get-solution-iter domains constraints vconstraints)
       
       (define forwardcheck _forwardcheck)
       (define assignments (make-hash))
@@ -139,17 +137,17 @@
       
       (if want-to-return
           (void)
-          (error 'getSolutionIter "Whoops, broken solver")))
+          (error 'get-solution-iter "Whoops, broken solver")))
     
     
     (define (call-solution-generator domains constraints vconstraints #:first-only [first-only #f])
-      (for/list ([solution (in-generator (getSolutionIter domains constraints vconstraints))] #:final first-only) 
+      (for/list ([solution (in-generator (get-solution-iter domains constraints vconstraints))] #:final first-only) 
         solution))
     
-    (define/override (getSolution . args)
+    (define/override (get-solution . args)
       (car (apply call-solution-generator #:first-only #t args)))
     
-    (define/override (getSolutions . args)
-      (apply call-solution-generator args))
-    
-    ))
+    (define/override (get-solutions . args)
+      (apply call-solution-generator args))))
+
+(define backtracking-solver%? (is-a?/c backtracking-solver%))

csp/test-classes.rkt

@@ -1,45 +1,71 @@
 #lang racket
 (require rackunit "main.rkt")
 
-(check-equal? (get-field _solver (new Problem [solver 'solver-in])) 'solver-in)
-(check-equal? (get-field _constraints (new Problem)) null)
-(check-equal? (get-field _variables (new Problem)) (make-hash))
 
-(define problem (new Problem)) ;; test from line 125
-(send problem addVariable "a" '(1))
-(check-equal? (get-field _list (hash-ref (get-field _variables problem) "a")) '(1)) 
+;; Problem: fields
+(check-equal? (get-field _solver (new problem% [solver 'solver-in])) 'solver-in)
+(check-equal? (get-field _constraints (new problem%)) null)
+(check-equal? (get-field _variables (new problem%)) (make-hash))
 
+(define problem null)
+
+;; Problem: reset
+(set! problem (new problem%))
+(define early-solutions (send problem get-solutions))
+(send problem add-variable "a" (range 3))
+(check-not-equal? (send problem get-solutions) early-solutions)
 (send problem reset)
-(check-equal? (get-field _variables problem) (make-hash))
-(send problem addVariables '("a" "b") '(1 2 3))
-(check-equal? (get-field _list (hash-ref (get-field _variables problem) "a")) '(1 2 3))
-(check-equal? (get-field _list (hash-ref (get-field _variables problem) "b")) '(1 2 3))
+(check-equal? (send problem get-solutions) early-solutions)
+
+;; Problem: setSolver & get-solver
+(define solver (new backtracking-solver%))
+(set! problem (new problem% [solver solver]))
+(check-true (solver%? (send problem get-solver)))
+
+;; Problem: add-variable
+(set! problem (new problem%))
+(send problem add-variable "a" '(1 2))
+(check-true (or (= (hash-ref (send problem get-solution) "a") 1)
+                (= (hash-ref (send problem get-solution) "a") 2)))
+(check-exn exn:fail? (λ () (send problem add-variable "b" null))) ;; empty domain
+
+
+;; Problem: add-variables
+(set! problem (new problem%))
+(send problem add-variables '("a" "b") '(1 2 3))
+(check-equal? (length (send problem get-solutions)) 9)
+
+;; Problem: add-constraint
+(set! problem (new problem%))
+(send problem add-variables '("a" "b") '(1 2 3))
+(send problem add-constraint (λ(a b) (= a (add1 b))))
+(check-equal? (length (send problem get-solutions)) 2)
 
 
 ;; FunctionConstraint, two ways: implicit and explicit
 (send problem reset)
-(send problem addVariables '(a b) '(1 2))
-(send problem addConstraint >) ; implicit
-(check-hash-items (send problem getSolution) #hash((a . 1) (b . 2)))
+(send problem add-variables '(a b) '(1 2))
+(send problem add-constraint >) ; implicit
+(check-hash-items (send problem get-solution) #hash((a . 1) (b . 2)))
 (send problem reset)
-(send problem addVariables '(a b) '(1 2))
-(send problem addConstraint (new FunctionConstraint [func >])) ; explicit
-(check-hash-items (send problem getSolution) #hash((a . 1) (b . 2)))
+(send problem add-variables '(a b) '(1 2))
+(send problem add-constraint (new function-constraint% [func >])) ; explicit
+(check-hash-items (send problem get-solution) #hash((a . 1) (b . 2)))
 
 ;; AllDifferentConstraint
 (send problem reset)
-(send problem addVariables '(a b) '(1 2))
-(send problem addConstraint (new AllDifferentConstraint))
-(let ([solutions (send problem getSolutions)])
+(send problem add-variables '(a b) '(1 2))
+(send problem add-constraint (new all-different-constraint%))
+(let ([solutions (send problem get-solutions)])
   (check-equal? (hash-ref (first solutions) 'a) (hash-ref (second solutions) 'b))
   (check-equal? (hash-ref (second solutions) 'a) (hash-ref (first solutions) 'b)))
 
 
 ;; AllEqualConstraint
 (send problem reset)
-(send problem addVariables '(a b) '(1 2))
-(send problem addConstraint (new AllEqualConstraint))
-(let ([solutions (send problem getSolutions)])
+(send problem add-variables '(a b) '(1 2))
+(send problem add-constraint (new all-equal-constraint%))
+(let ([solutions (send problem get-solutions)])
   (check-equal? (hash-ref (first solutions) 'a) (hash-ref (first solutions) 'b))
   (check-equal? (hash-ref (second solutions) 'a) (hash-ref (second solutions) 'b)))
 

csp/test-problems.rkt

@@ -11,14 +11,14 @@
 ;;      A+B+C
 
 
-(define abc-problem (new Problem))
-(send abc-problem addVariables '("a" "b" "c") (range 1 10))
+(define abc-problem (new problem%))
+(send abc-problem add-variables '("a" "b" "c") (range 1 10))
 (define (test-solution s) (let ([a (hash-ref s "a")]
                                 [b (hash-ref s "b")]
                                 [c (hash-ref s "c")])
                             (/ (+ (* 100 a) (* 10 b) c) (+ a b c))))
 
-(check-hash-items (argmin test-solution (send abc-problem getSolutions)) 
+(check-hash-items (argmin test-solution (send abc-problem get-solutions)) 
                   #hash(("c" . 9) ("b" . 9) ("a" . 1)))
 
 
@@ -26,24 +26,24 @@
 ;; 26 coins, dollars and quarters
 ;; that add up to $17.
 
-(define quarter-problem (new Problem))
-(send quarter-problem addVariables '("dollars" "quarters") (range 1 27))
-(send quarter-problem addConstraint (λ(d q) (= 17 (+ d (* 0.25 q)))) '("dollars" "quarters"))
-(send quarter-problem addConstraint (λ(d q) (= 26 (+ d q))) '("dollars" "quarters"))
-(check-hash-items (send quarter-problem getSolution) '#hash(("dollars" . 14) ("quarters" . 12)))
+(define quarter-problem (new problem%))
+(send quarter-problem add-variables '("dollars" "quarters") (range 1 27))
+(send quarter-problem add-constraint (λ(d q) (= 17 (+ d (* 0.25 q)))) '("dollars" "quarters"))
+(send quarter-problem add-constraint (λ(d q) (= 26 (+ d q))) '("dollars" "quarters"))
+(check-hash-items (send quarter-problem get-solution) '#hash(("dollars" . 14) ("quarters" . 12)))
 
 ;; coin problem 2
 #|
 A collection of 33 coins, consisting of nickels, dimes, and quarters, has a value of $3.30. If there are three times as many nickels as quarters, and one-half as many dimes as nickels, how many coins of each kind are there?
 |#
 
-(define nickel-problem (new Problem))
-(send nickel-problem addVariables '(nickels dimes quarters) (range 1 34))
-(send nickel-problem addConstraint (λ(n d q) (= 33 (+ n d q))) '(nickels dimes quarters))
-(send nickel-problem addConstraint (λ(n d q) (= 3.30 (+ (* 0.05 n) (* 0.1 d) (* 0.25 q)))) '(nickels dimes quarters))
-(send nickel-problem addConstraint (λ(n q) (= n (* 3 q))) '(nickels quarters))
-(send nickel-problem addConstraint (λ(d n) (= n (* 2 d))) '(dimes nickels))
-(check-hash-items (send nickel-problem getSolution) #hash((nickels . 18) (quarters . 6) (dimes . 9)))
+(define nickel-problem (new problem%))
+(send nickel-problem add-variables '(nickels dimes quarters) (range 1 34))
+(send nickel-problem add-constraint (λ(n d q) (= 33 (+ n d q))) '(nickels dimes quarters))
+(send nickel-problem add-constraint (λ(n d q) (= 3.30 (+ (* 0.05 n) (* 0.1 d) (* 0.25 q)))) '(nickels dimes quarters))
+(send nickel-problem add-constraint (λ(n q) (= n (* 3 q))) '(nickels quarters))
+(send nickel-problem add-constraint (λ(d n) (= n (* 2 d))) '(dimes nickels))
+(check-hash-items (send nickel-problem get-solution) #hash((nickels . 18) (quarters . 6) (dimes . 9)))
 
 ;; word math
 #|
@@ -57,19 +57,19 @@ A collection of 33 coins, consisting of nickels, dimes, and quarters, has a valu
 |#
 
 
-(define two-four-problem (new Problem))
-(send two-four-problem addVariables '(t w o f u r) (range 10))
-(send two-four-problem addConstraint (new AllDifferentConstraint))
-(send two-four-problem addConstraint (λ(t w o) (> (word-value t w o) 99)) '(t w o))
-(send two-four-problem addConstraint (λ(f o u r) (> (word-value f o u r) 999)) '(f o u r))
-(send two-four-problem addConstraint 
+(define two-four-problem (new problem%))
+(send two-four-problem add-variables '(t w o f u r) (range 10))
+(send two-four-problem add-constraint (new all-different-constraint%))
+(send two-four-problem add-constraint (λ(t w o) (> (word-value t w o) 99)) '(t w o))
+(send two-four-problem add-constraint (λ(f o u r) (> (word-value f o u r) 999)) '(f o u r))
+(send two-four-problem add-constraint 
       (λ (t w o f u r)
         (let ([two (word-value t w o)]
               [four (word-value f o u r)])
           ((two . + . two) . = . four))) '(t w o f u r))
-(check-equal? (length (send two-four-problem getSolutions)) 7)
-(send two-four-problem addConstraint (λ(r) (= r 0)) '(r))
-(check-hash-items (send two-four-problem getSolution) #hash((o . 5) (w . 6) (u . 3) (f . 1) (r . 0) (t . 7)))
+(check-equal? (length (send two-four-problem get-solutions)) 7)
+(send two-four-problem add-constraint (λ(r) (= r 0)) '(r))
+(check-hash-items (send two-four-problem get-solution) #hash((o . 5) (w . 6) (u . 3) (f . 1) (r . 0) (t . 7)))
 
 
 ;; xsum
@@ -85,16 +85,16 @@ A collection of 33 coins, consisting of nickels, dimes, and quarters, has a valu
 #
 |#
 
-(define xsum-problem (new Problem))
-(send xsum-problem addVariables '(l1 l2 l3 l4 r1 r2 r3 r4 x) (range 10))
-(send xsum-problem addConstraint (λ (l1 l2 l3 l4 x) 
+(define xsum-problem (new problem%))
+(send xsum-problem add-variables '(l1 l2 l3 l4 r1 r2 r3 r4 x) (range 10))
+(send xsum-problem add-constraint (λ (l1 l2 l3 l4 x) 
                                    (and (< l1 l2 l3 l4)
                                         (= 27 (+ l1 l2 l3 l4 x)))) '(l1 l2 l3 l4 x))
-(send xsum-problem addConstraint (λ (r1 r2 r3 r4 x) 
+(send xsum-problem add-constraint (λ (r1 r2 r3 r4 x) 
                                    (and (< r1 r2 r3 r4)
                                         (= 27 (+ r1 r2 r3 r4 x)))) '(r1 r2 r3 r4 x))
-(send xsum-problem addConstraint (new AllDifferentConstraint))
-(check-equal? (length (send xsum-problem getSolutions)) 8)
+(send xsum-problem add-constraint (new all-different-constraint%))
+(check-equal? (length (send xsum-problem get-solutions)) 8)
 
 
 
@@ -109,37 +109,37 @@ A collection of 33 coins, consisting of nickels, dimes, and quarters, has a valu
 #   MONEY
 |#
 
-(define sm-problem (new Problem))
-(send sm-problem addVariables '(s e n d m o r y) (range 10))
-(send sm-problem addConstraint (λ(x) (> x 0)) '(s))
-(send sm-problem addConstraint (λ(x) (> x 0)) '(m))
-(send sm-problem addConstraint (λ(d e y) (= (modulo (+ d e) 10) y)) '(d e y))
-(send sm-problem addConstraint (λ(n d r e y)
+(define sm-problem (new problem%))
+(send sm-problem add-variables '(s e n d m o r y) (range 10))
+(send sm-problem add-constraint (λ(x) (> x 0)) '(s))
+(send sm-problem add-constraint (λ(x) (> x 0)) '(m))
+(send sm-problem add-constraint (λ(d e y) (= (modulo (+ d e) 10) y)) '(d e y))
+(send sm-problem add-constraint (λ(n d r e y)
                                  (= (modulo (+ (word-value n d) (word-value r e)) 100)
                                     (word-value e y))) '(n d r e y))
-(send sm-problem addConstraint (λ(e n d o r y)
+(send sm-problem add-constraint (λ(e n d o r y)
                                  (= (modulo (+ (word-value e n d) (word-value o r e)) 1000) (word-value n e y))) '(e n d o r y))
-(send sm-problem addConstraint (λ(s e n d m o r y) (=
+(send sm-problem add-constraint (λ(s e n d m o r y) (=
                                                     (+ (word-value s e n d)
                                                        (word-value m o r e))
                                                     (word-value m o n e y))) '(s e n d m o r y))
-(send sm-problem addConstraint (new AllDifferentConstraint))
+(send sm-problem add-constraint (new all-different-constraint%))
 
-(check-hash-items (send sm-problem getSolution) '#hash((m . 1) (e . 5) (r . 8) (n . 6) (y . 2) (o . 0) (d . 7) (s . 9)))
+(check-hash-items (send sm-problem get-solution) '#hash((m . 1) (e . 5) (r . 8) (n . 6) (y . 2) (o . 0) (d . 7) (s . 9)))
 
 
 ;; queens problem
 ;; place queens on chessboard so they do not intersect
 
-(define qp (new Problem))
+(define qp (new problem%))
 (define cols (range 8))
 (define rows (range 8))
-(send qp addVariables cols rows)
+(send qp add-variables cols rows)
 (for* ([col1 (in-list cols)] [col2 (in-list cols)] #:when (< col1 col2))
-  (send qp addConstraint (λ(row1 row2 [col1 col1][col2 col2])
+  (send qp add-constraint (λ(row1 row2 [col1 col1][col2 col2])
                            (and 
                             ;; test if two cells are on a diagonal
                             (not (= (abs (- row1 row2)) (abs (- col1 col2))))
                             ;; test if two cells are in same row
                             (not (= row1 row2)))) (list col1 col2))) 
-(check-equal? (length (send qp getSolutions)) 92)
+(check-equal? (length (send qp get-solutions)) 92)