├── README.md ├── project.clj ├── src └── clocop │ ├── constraints.clj │ ├── core.clj │ └── solver.clj └── test └── clocop ├── all_interval_series_test.clj ├── binpack_test.clj ├── magic_series_test.clj ├── minimize_test.clj ├── sudoku_test.clj └── twentysix_puzzle_test.clj /README.md: -------------------------------------------------------------------------------- 1 | CloCoP 2 | ====== 3 | 4 | CloCoP is a Clojure wrapper for JaCoP, which is a Java constraint programming engine. JaCoP stands for JAva COnstraint Programming. Can you guess what CloCoP stands for? 5 | 6 | Constraint Programming (or CP) falls into the category of problems that can be checked easily, but not necessarily easy to come up with. 7 | This is a common theme behind a lot of problems such as SAT and the Graph Coloring problem. 8 | 9 | Here's an example of a Constraint Programming problem (not implemented in any specific CP language): 10 | 11 | var X ϵ {1, 2} 12 | var Y ϵ {3, 4} 13 | 14 | X + Y = 6 15 | 16 | => X = 2, Y = 4 17 | 18 | A CP library will provide a set of constraints you can specify for some integer variables, and try to solve the variables as quickly 19 | as possible. In JaCoP's case, the search is essentially a depth-first search with 20 | intelligent deduction tactics. (More information on that later.) 21 | 22 | ###Usage 23 | 24 | Add the following to your dependencies: 25 | 26 | [clocop "0.2.0"] 27 | 28 | ###Sample code 29 | 30 | If you're curious, here's some sample code based on the API I have so far. 31 | 32 | (use 'clocop.core 33 | 'clocop.constraints) 34 | 35 | ; Variable X is between 1 and 2. Variable Y is between 3 and 4. 36 | ; We know that X + Y = 6. What are X and Y? 37 | (with-store (store) ; initialize the variable store 38 | (let [x (int-var "x" 1 2) 39 | y (int-var "y" 3 4)] ; initialize the variables 40 | (constrain! ($= ($+ x y) 6)) ; specify x + y = 6 41 | (solve!))) ; searches for a solution and returns it as a map 42 | 43 | => {"x" 2, "y" 4} 44 | 45 | ###More sample code 46 | 47 | If you'd like to see more sample code, check out the test cases in clocop/test/clocop. 48 | 49 | ###But what about core.logic? 50 | 51 | I'm aware of core.logic, but there are a few ways in which, in my opinion, JaCoP is better than MiniKanren: 52 | 53 | + JaCoP is more "plug-in-able," with an extensive set of customizations to the way that the search operates. There are interfaces for different components of the search, and each have several implementations. 54 | + I found that with core.logic, I was somewhat limited by the set of available constraints. JaCoP has many different global and FD constraints that seem to more suit my needs for solving challenging problems. 55 | + [As the core.logic people say,](https://github.com/clojure/core.logic/wiki/External-solvers) JaCoP is anywhere from 10X-100X faster than core.logic at solving Finite Domain problems. 56 | 57 | Constraint Programming 58 | ====== 59 | 60 | Here is a very brief guide to the key components in CP, as well as the implementation of each component in CloCoP. 61 | 62 | ###The Store 63 | 64 | The store has one job and one job only: keep track of all the variables. 65 | Constraints, searches, and variables themselves do the hard work of actually solving the problems. 66 | 67 | One way to think about it is that it's a box for all the variables, with several constraints attached to that box. 68 | 69 | In CloCoP, a store is created with (store). To create variables and constrain constraints, you must wrap those function calls in the following macro: 70 | 71 | (with-store 72 | (...)) 73 | 74 | so that the variables and constraints know which store you're talking about. 75 | ###Variables 76 | 77 | Variables can only have integer values. Every variable is assigned a "domain," i.e. a finite set of integers it could possibly be. 78 | In JaCoP, initial domains must be assigned to variables at the time of creation. 79 | 80 | In CloCoP, a variable is created with (int-var "name" min max). 81 | 82 | ###Constraints 83 | 84 | A constraint can conceptually be as simple as "X = 3", or as complex as "X, Y, and Z are all different". 85 | 86 | It has two jobs: 87 | - check if it is still feasible (e.g. in the X = 3 example, it will check if 3 is in the domain of X) 88 | - "prune" the domains of the variables in question (e.g. in the X = 3 example, it will remove any values in the domain of X that is not 3). 89 | 90 | In CloCoP, all of the constraints are in the clocop.constraints namespace. By convention, all constraints start with a "$", i.e. $= for "=". This is because there would be a lot of overlap between the constraint names and the clojure.core function names. 91 | 92 | You can find a complete guide to clocop.constraints at the [bottom](https://github.com/aengelberg/clocop#arithmetic) of the page. 93 | 94 | If you want to apply a constraint to the store, use (constrain! ...). 95 | 96 | ###The Search 97 | 98 | The three steps to CP search: 99 | Step 1: repeatedly ask the constraints to prune the domains until no further pruning can be done. 100 | Step 2: pick a variable V (and a possible value X for V), and branch into two new child searches: 101 | - one of which with X assigned to V (i.e. V has a domain with one item), 102 | - and the other with X removed from the domain of V. 103 | Step 3: repeat this process on the two child nodes (the assignment node first). 104 | 105 | To solve your store, i.e. find a satisfying assignment for all of the variables, simply call (solve!). 106 | 107 | Here is a complete list of the optional keyword arguments to solve!: 108 | 109 | :solutions will either return one (:one) or all (:all) of the solutions. 110 | 111 | :log?, when set to true, will have the search print out a log to the Console about the search. 112 | 113 | :minimize takes a variable that the search will attempt to minimize the value of. JaCoP will use a "Branch and Bound" search strategy. It starts by running the search on the provided constraints. 114 | Then it will see what the cost variable was assigned to, and then add a constraint saying that the cost variable must be less than that. 115 | It'll keep going until adding that extra constraint makes the search infeasible, in which case it will return the last feasible solution. 116 | 117 | Note that if you use :minimize as well as specifying :solutions :all, it will return a reversed list 118 | of solutions it found along the way, with the final minimized one at the head of the list. (good for debugging) 119 | 120 | :timeout takes a number of seconds after which the search will stop (if it hasn't finished already). 121 | This option is typically used with a minimization (it returns the best solution so far), but it can also be used for a single solution (it returns nil after the timeout) or multiple solutions (it returns all of the solutions it had found before the timeout). 122 | 123 | :pick-var will pick a variable (as described in Step 2). Possible choices: 124 | - :smallest-domain (default): var with smallest domain 125 | - :most-constrained-static: var with most constraints assigned to it 126 | - :most-constrained-dynamic: var with most pending constraints assigned to it 127 | - :smallest-min: var with smallest value in its domain 128 | - :largest-domain: var with largest domain size 129 | - :largest-min: var with largest minimum in its domain 130 | - :smallest-max: var with smallest maximum in its domain 131 | - :max-regret: var with biggest difference between min and max 132 | - (list var var ...): will choose those variables in order (skipping over already-assigned vars). 133 | Note that this final option will induce a side effect: only the given variables will appear in the solution assignment(s). 134 | 135 | :pick-val will pick a value (as described in Step 2) for the chosen variable. Possible choices: 136 | - :min (default): minimum value 137 | - :max: maximum value 138 | - :middle: selects middle value (and later chooses the left and right values). 139 | - :random: random 140 | - [:random N]: random with seed 141 | - :simple-random: faster than :random but lower quality randomness 142 | 143 | CloCoP Constraints 144 | ====== 145 | 146 | ###A note about "arithmetic piping" 147 | 148 | Suppose you want to add a constraint "X + Y = Z." In JaCoP, you'd write this: 149 | 150 | Constraint c = new XplusYeqZ(X, Y, Z); 151 | store.impose(c); 152 | 153 | That's fine if you're using very small-scale constraints, but it gets complicated when you want to constrain something like "A + (B * C) = D." 154 | 155 | IntVar BtimesC = new IntVar(...); 156 | Constraint c1 = new XmulYeqZ(B, C, BtimesC); 157 | store.impose(c1); 158 | Constraint c2 = new XplusYeqZ(A, BtimesC, D); 159 | return c2; 160 | 161 | It becomes tiring to have to work from the bottom up when designing the vars and constraints. Here's how you would write the same constraint in CloCoP: 162 | 163 | ($= ($+ A ($* B C)) D)) 164 | 165 | which basically expands to the following: 166 | 167 | (do (constrain! (XmulYeqZ. B C tempVar1)) 168 | (constrain! (XplusYeqZ. A tempVar1 tempVar2)) 169 | (XeqY. tempVar2 D)) 170 | 171 | Note that, although the tempVars now exist in the constraint store, they only exist behind the scenes and 172 | they will not be included in the final solution map. This is because each tempVar serves merely as a "middle man" 173 | to help constrain the relationship between A, B, C, and D. 174 | 175 | I call this concept "piping," which lets you create your constraints top-down without the need to create your own temporary variables. 176 | 177 | Now, on to the actual constraints... 178 | 179 | ### Arithmetic 180 | 181 | Note that these aren't actual "constraints" but just piping functions, which take variables as inputs and return a new variable. 182 | 183 | - ($+ x y ...) - sum 184 | - ($- x ...) - negation or subtraction 185 | - ($* x y) - multiplication 186 | - ($pow x y) - exponent 187 | - ($min ...) - min 188 | - ($max ...) - max 189 | - ($abs x) - absolute value 190 | - ($weighted-sum [x y z ...] [a b c ...]) - given some vars and some constant ints, returns ax + by + cz + ... 191 | 192 | NOTE: sometimes you might want to mix constant numbers into your arithmetic statements (like X + 3). 193 | However, these piping functions require that you only input variables, but there is one exception: 194 | - When using $+ on two or three arguments, CloCoP will use the streamlined addition constraints provided in JaCoP, which are suited for small numbers of variables. 195 | In this case, you can replace up to one argument with a constant integer. (e.g. ($+ x 1), or ($+ 4 x y)) 196 | 197 | ### Equality 198 | 199 | Takes variables and returns a constraint. 200 | 201 | - ($= x y) - equals 202 | - ($< x y) - less than 203 | - ($<= x y) - less than or equal 204 | - ($> x y) - greater than 205 | - ($>= x y) - greater than or equal 206 | - ($!= x y) - not equal 207 | 208 | ### Logic 209 | 210 | Takes constraints and returns another constraint. 211 | Note: logic constraints can only take equality constraints, or other logic constraints. i.e. NOT global constraints. 212 | 213 | - ($and & clauses) - "and" statement; all of the given statements are true 214 | - ($or & clauses) - "or" statement; at least one of the given statements are true 215 | - ($not P) - "not / ~P" statement; P is not true. 216 | - ($if P Q R) - "if/then/else" statement; if P is true, Q is true, otherwise R is true (R is optional) 217 | - ($cond ...) - behaves like "cond" but made out of $if statements; not a macro 218 | - ($iff P Q) - "iff/<=>" statement; P is true if and only if Q is true 219 | 220 | ### Global 221 | 222 | JaCoP provides quite a few global constraints, which are expressive constraints that implement clever algorithms 223 | to prune domains efficiently. I ported a few of them to CloCoP, and when the opportunity presented itself, I made 224 | some of them into piping functions. 225 | 226 | Constraints: 227 | - ($all-different & vars) - "all different" statement; none of the vars are equal to any other var. 228 | - ($binpacking :bin-sizes [...] :item-sizes [...] :item-locations [...]) - 229 | packs items into bins. :bin-sizes is a seq of bin sizes (seq of constant integers). :item-sizes is a seq of item sizes (seq of variables). 230 | :item-locations is a seq of bin indices corresponding to the items (seq of variables). 231 | 232 | Piping functions: 233 | - ($reify c) - given a constraint, returns a variable that will be 1 if the constraint is true and 0 if the constraint is false. It can only be passed logic or equality constraints. 234 | - ($nth L i) - given a list of vars (or a list of constants) and a var i, returns another var that will equal L[i]. 235 | - ($occurrences L i) - given a list of vars, and a constant i, returns another var that will equal the amount of times i appears in L. 236 | 237 | Conclusion 238 | ----- 239 | 240 | There are many more JaCoP constraints I haven't ported to CloCoP yet. I plan to add more in the future, but let me know (e.g. in the Issues forum) if you're eager to get a specific constraint on board. 241 | 242 | Special thanks to Radoslaw Szymanek (a creator of JaCoP) for permission to put JaCoP on Clojars and create a Clojure spin-off of JaCoP. 243 | 244 | This project is under the Eclipse Public License. Contributions welcome! -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (defproject clocop "0.2.0" 2 | :description "A Clojure wrapper for JaCoP." 3 | :url "http://github.com/aengelberg/clocop" 4 | :license {:name "Eclipse Public License" 5 | :url "http://www.eclipse.org/legal/epl-v10.html"} 6 | :dependencies [[org.clojure/clojure "1.5.1"] 7 | [org.jacop/jacop "3.2"]]) -------------------------------------------------------------------------------- /src/clocop/constraints.clj: -------------------------------------------------------------------------------- 1 | (ns clocop.constraints 2 | "A namespace for the various constraints you can use." 3 | (:require [clocop.core :as core]) 4 | (:import 5 | (JaCoP.core Var IntVar IntervalDomain) 6 | (JaCoP.constraints PrimitiveConstraint 7 | 8 | XeqY 9 | XeqC 10 | XltY 11 | XltC 12 | XlteqY 13 | XlteqC 14 | XgtY 15 | XgtC 16 | XgteqY 17 | XgteqC 18 | XneqY 19 | XneqC 20 | 21 | XplusCeqZ 22 | XplusClteqZ 23 | XplusYeqC 24 | XplusYeqZ 25 | XplusYgtC 26 | XplusYlteqZ 27 | XplusYplusCeqZ 28 | XplusYplusQeqZ 29 | XplusYplusQgtC 30 | Sum 31 | SumWeight 32 | 33 | AbsXeqY 34 | 35 | XmulYeqZ 36 | XmulCeqZ 37 | XmodYeqZ 38 | XdivYeqZ 39 | XexpYeqZ 40 | 41 | Min 42 | Max 43 | 44 | And 45 | Or 46 | Not 47 | IfThen 48 | IfThenElse 49 | Eq 50 | 51 | Alldifferent 52 | Element 53 | Count 54 | Among 55 | Reified 56 | ) 57 | JaCoP.constraints.binpacking.Binpacking)) 58 | 59 | ; Sample code: (+% x y := 3) 60 | 61 | (defn- cartesian-product 62 | [lists] 63 | (cond 64 | (empty? lists) '(()) 65 | :else (let [next-cart (cartesian-product (rest lists))] 66 | (apply concat (for [i (first lists)] 67 | (map (partial cons i) next-cart)))))) 68 | (defn- domain-min [x] 69 | (if (instance? IntVar x) 70 | (.min (.dom x)) 71 | x)) 72 | (defn- domain-max [x] 73 | (if (instance? IntVar x) 74 | (.max (.dom x)) 75 | x)) 76 | 77 | (defn- pipe-helper 78 | [real-op args] 79 | (let [mins (map domain-min args) 80 | maxes (map domain-max args) 81 | key-points (for [comb (cartesian-product (map vector mins maxes))] 82 | (apply real-op comb)) 83 | [final-min final-max] [(apply min key-points) (apply max key-points)]] 84 | (core/int-var final-min final-max))) 85 | 86 | (defn- typeify 87 | [args] 88 | (vec 89 | (for [x args] 90 | (cond 91 | (keyword? x) x 92 | (instance? Var x) :var 93 | (instance? Number x) :num)))) 94 | 95 | ;;;;;; Arithmetic 96 | 97 | (defn $+ 98 | "Given two or more variables, returns a new variable that is constrained to equal the sum of those variables. 99 | 100 | If you use two or three variables, one of them may be a constant number. 101 | (i.e. ($+ x 1))" 102 | ([x y] 103 | (core/get-current-store) 104 | (let [accepted #{[:var :var] [:var :num]} 105 | piped (when (accepted (typeify [x y])) 106 | (pipe-helper + [x y]))] 107 | (case (typeify [x y]) 108 | [:var :var] (do (core/constrain! (XplusYeqZ. x y piped)) piped) 109 | [:var :num] (do (core/constrain! (XplusCeqZ. x y piped)) piped) 110 | [:num :var] (recur y x)))) 111 | ([x y z] 112 | (core/get-current-store) 113 | (let [accepted #{[:var :var :var] [:var :var :num]} 114 | piped (when (accepted (typeify [x y z])) 115 | (pipe-helper + [x y z]))] 116 | (case (typeify [x y z]) 117 | [:var :var :var] (do (core/constrain! (XplusYplusQeqZ. x y z piped)) piped) 118 | [:var :var :num] (do (core/constrain! (XplusYplusCeqZ. x y z piped)) piped) 119 | [:var :num :var] (recur x z y) 120 | [:num :var :var] (recur y z x)))) 121 | ([a b c d & more] 122 | (core/get-current-store) 123 | (let [args (list* a b c d more) 124 | total-min (apply + (map domain-min args)) 125 | total-max (apply + (map domain-max args)) 126 | z (core/int-var total-min total-max)] 127 | (core/constrain! (Sum. (into-array IntVar args) 128 | z)) 129 | z))) 130 | 131 | (defn $- 132 | "Given one or more variables X, Y, Z, ... returns a new variable that is constrained to equal X - Y - Z - ... (or -X if only one argument)" 133 | ([x] 134 | (let [final-min (- (domain-max x)) 135 | final-max (- (domain-min x)) 136 | piped (core/int-var final-min final-max)] 137 | (core/constrain! (XplusYeqC. x piped 0)) 138 | piped)) 139 | ([x & more] 140 | (apply $+ x (map $- more)))) 141 | 142 | (defn $min 143 | "Returns a variable that is constrained to equal the minimum of the given variables." 144 | [& vars] 145 | (let [final-min (apply min (map domain-min vars)) 146 | final-max (apply min (map domain-max vars)) 147 | piped (core/int-var final-min final-max)] 148 | (core/constrain! (Min. (into-array IntVar vars) piped)) 149 | piped)) 150 | 151 | (defn $max 152 | "Returns a variable that is constrained to equal the maximum of the given variables." 153 | [& vars] 154 | (let [final-min (apply max (map domain-min vars)) 155 | final-max (apply max (map domain-max vars)) 156 | piped (core/int-var final-min final-max)] 157 | (core/constrain! (Max. (into-array IntVar vars) piped)) 158 | piped)) 159 | 160 | (defn $abs 161 | "Given a variable X, returns another variable Y such that |X| = Y." 162 | [x] 163 | (let [xmin (domain-min x) 164 | xmax (domain-max x) 165 | [ymin ymax] (cond 166 | (< xmax 0) [(- xmax) (- xmin)] 167 | (< xmin 0) [0 (max (- xmin) xmax)] 168 | :else [xmin xmax]) 169 | y (core/int-var ymin ymax)] 170 | (core/constrain! (AbsXeqY. x y)) 171 | y)) 172 | 173 | (defn $weighted-sum 174 | "Given vars x, y, z..., and integers a, b, c..., returns a var that equals ax + by + cz + ..." 175 | [vars weights] 176 | (let [minmaxes (map sort (map vector 177 | (map * (map domain-min vars) weights) 178 | (map * (map domain-max vars) weights))) 179 | final-min (apply + (map first minmaxes)) 180 | final-max (apply + (map second minmaxes)) 181 | piped (core/int-var final-min final-max)] 182 | (core/constrain! (SumWeight. (into-array IntVar vars) 183 | (int-array weights) 184 | piped)) 185 | piped)) 186 | 187 | (defn $* 188 | "Given two variables (or a variable and a number), returns a new variable that is constrained to be equal to the product of the two arguments." 189 | [x y] 190 | (core/get-current-store) 191 | (let [accepted #{[:var :var] [:var :num]} 192 | piped (when (accepted (typeify [x y])) 193 | (pipe-helper * [x y]))] 194 | (case (typeify [x y]) 195 | [:var :var] (do (core/constrain! (XmulYeqZ. x y piped)) piped) 196 | [:var :num] (do (core/constrain! (XmulCeqZ. x y piped)) piped) 197 | [:num :var] (recur y x)))) 198 | 199 | (defn $pow 200 | "Given two variables X and Y, returns a new variable constrained to equal X^Y." 201 | [x y] 202 | (let [piped (pipe-helper #(int (Math/pow %1 %2)) [x y])] 203 | (core/constrain! (XexpYeqZ. x y piped)) 204 | piped)) 205 | 206 | (declare $and $= $!= $< $> $<= $>=) 207 | (defn $= 208 | ([x y] 209 | (case (typeify [x y]) 210 | [:var :var] (XeqY. x y) 211 | [:var :num] (XeqC. x y) 212 | [:num :var] (recur y x))) 213 | ([x y & more] 214 | (let [args (list* x y more)] 215 | (apply $and (map (partial apply $=) (partition 2 1 args)))))) 216 | (defn $!= 217 | [x y] 218 | (case (typeify [x y]) 219 | [:var :var] (XneqY. x y) 220 | [:var :num] (XneqC. x y) 221 | [:num :var] (recur y x))) 222 | (defn $< 223 | [x y] 224 | (case (typeify [x y]) 225 | [:var :var] (XltY. x y) 226 | [:var :num] (XltC. x y) 227 | [:num :var] ($> y x))) 228 | (defn $> 229 | [x y] 230 | (case (typeify [x y]) 231 | [:var :var] (XgtY. x y) 232 | [:var :num] (XgtC. x y) 233 | [:num :var] ($< y x))) 234 | (defn $<= 235 | [x y] 236 | (case (typeify [x y]) 237 | [:var :var] (XlteqY. x y) 238 | [:var :num] (XlteqC. x y) 239 | [:num :var] ($>= y x))) 240 | (defn $>= 241 | [x y] 242 | (case (typeify [x y]) 243 | [:var :var] (XgteqY. x y) 244 | [:var :num] (XgteqC. x y) 245 | [:num :var] ($<= y x))) 246 | 247 | ;;;;;;;; Logic 248 | 249 | (defn $and 250 | "Specifies that all of the given constraints must be true. 251 | 252 | Note: the given constraints can only be number comparisons or logic statements." 253 | [& constraints] 254 | (And. (into-array PrimitiveConstraint constraints))) 255 | 256 | (defn $or 257 | "Specifies that one or more of the given constraints must be true. 258 | 259 | Note: the given constraints can only be number comparisons or logic statements." 260 | [& constraints] 261 | (Or. (into-array PrimitiveConstraint constraints))) 262 | 263 | (defn $not 264 | "Specifies that the given constraint is NOT true. 265 | 266 | Note: the given constraints can only be number comparisons or logic statements." 267 | [constraint] 268 | (Not. constraint)) 269 | 270 | (defn $if 271 | "Specifies that if one constraint is true, the other constraint must be true as well. An \"else\" statement can be specified as well." 272 | ([if-this then-this] 273 | (IfThen. if-this then-this)) 274 | ([if-this then-this else-this] 275 | (IfThenElse. if-this then-this else-this))) 276 | 277 | (defn- $cond-helper 278 | [clauses] 279 | (let [c (cond 280 | (empty? clauses) 0 281 | (empty? (rest clauses)) 1 282 | (empty? (drop 2 clauses)) 2 283 | :else :more)] 284 | (case c 285 | 0 ($and) 286 | 1 (first clauses) 287 | 2 (apply $if clauses) 288 | ($if (first clauses) (second clauses) ($cond-helper (drop 2 clauses)))))) 289 | 290 | (defn $cond 291 | "Takes inputs in a similar form as \"cond\". The final \"else\" statement can be specified with :else (like in cond) or as the odd argument (like in case)" 292 | [& clauses] 293 | ($cond-helper (remove #(= % :else) clauses))) 294 | 295 | (defn $iff 296 | "Constrains a \"bicond\" constraint P <=> Q, a.k.a. P iff Q." 297 | [P Q] 298 | (Eq. P Q)) 299 | 300 | ;;;;;;;; Global constraints 301 | 302 | (defn $all-different 303 | [& vars] 304 | (Alldifferent. (into-array IntVar vars))) 305 | 306 | (defn $reify 307 | "Sometimes it's nice to be able to manipulate the true/false value of a constraint. $reify takes a constraint, and returns a variable that will be constrained to equal the 0/1 boolean value of whether that constraint is true. 308 | 309 | i.e. ($= ($reify X) 1) would be saying that X is true. 310 | Note: calling constrain! on the given constraint as well as reifying it isn't entirely useful, because calling constrain! will force it to be true anyway." 311 | [constraint] 312 | (let [piped (core/int-var 0 1)] 313 | (core/constrain! (Reified. constraint piped)) 314 | piped)) 315 | 316 | (defn $nth 317 | "Given a list of vars (or numbers) L, and a variable index i, returns a var x such that L[i] = x. 318 | 319 | Example: 320 | (def L [1 2 3 4 5 6]) 321 | (def i (int-var \"i\" 0 5)) 322 | (constrain! ($= ($nth L i) 3))" 323 | [L i] 324 | (let [L (if (number? (first L)) 325 | (int-array L) 326 | (into-array IntVar L)) 327 | final-min (apply min (map domain-min L)) 328 | final-max (apply max (map domain-max L)) 329 | piped (core/int-var final-min final-max)] 330 | (core/constrain! (Element. i L piped 1)) 331 | piped)) 332 | 333 | (defn $occurrences 334 | "Given a list of variables and a number, returns a variable X such that X = the number of occurrences of the number in the list. 335 | 336 | Note: you can also pass in a domain instead of a number, in which case it will count how many numbers are in that domain." 337 | [list-of-vars item] 338 | (let [list-of-vars (into-array IntVar list-of-vars) 339 | piped (core/int-var 0 (count list-of-vars))] 340 | (if (instance? IntervalDomain item) 341 | (core/constrain! (Among. list-of-vars item piped)) 342 | (core/constrain! (Count. list-of-vars piped item))) 343 | piped)) 344 | 345 | (defn $binpacking 346 | "Keyword arguments: 347 | :bin-sizes - list of constant numbers, which represent the capacities of the bins. 348 | :item-sizes - list of IntVars, which represent the sizes of the items. 349 | :item-locations - list of IntVars, which dictate which bins said items will go into. 350 | Example: (constrain! ($binpack :bins [3 3 3], :items [x y z], :locations [x-loc y-loc z-loc]))" 351 | [& {:as args}] 352 | (let [bins (:bin-sizes args) 353 | weights (:item-sizes args) 354 | item-locs (:item-locations args)] 355 | (Binpacking. (into-array IntVar item-locs) 356 | (into-array IntVar weights) 357 | (int-array bins)))) -------------------------------------------------------------------------------- /src/clocop/core.clj: -------------------------------------------------------------------------------- 1 | (ns clocop.core 2 | (:import (JaCoP.core Store 3 | IntVar 4 | IntDomain 5 | IntervalDomain 6 | BoundDomain) 7 | (JaCoP.search DepthFirstSearch 8 | InputOrderSelect 9 | IndomainMin 10 | )) 11 | (:use clocop.solver)) 12 | 13 | (def ^:dynamic *current-store* 14 | "A (private) dynamic variable used in conjunction with the with-store function." 15 | nil) 16 | 17 | (defn get-current-store 18 | "Private function for working with with-store." 19 | [] 20 | (if *current-store* 21 | *current-store* 22 | (throw (Exception. "Could not find *current-store* binding. Try using with-store")))) 23 | 24 | (defmacro with-store 25 | "Binds a store to a dynamic variable that the internal CloCoP functions share. with-store is more or less required to do most CloCoP operations." 26 | [store & body] 27 | `(binding [*current-store* ~store] 28 | ~@body)) 29 | 30 | (defn ^Store store 31 | "Makes a JaCoP \"Store\" object, which is the key concept in constraint programming. 32 | No options and configurations are required for the Store itself, but you will connect all the variables, constraints, and searchers to it eventually." 33 | [] 34 | (Store.)) 35 | 36 | (defn ^IntDomain domain 37 | "Takes an arbitrary number of [min max] pairs. This function is more capable than simply entering a min and max value in the int-var function." 38 | [& min-max-pairs] 39 | (let [domains (for [[min max] min-max-pairs] 40 | (IntervalDomain. min max)) 41 | [the-domain & other-domains] domains] 42 | (doseq [other-domain other-domains] 43 | (.addDom the-domain other-domain)) 44 | the-domain)) 45 | 46 | (defn ^IntVar int-var 47 | "Creates a JaCoP \"IntVar\" object, which can have constraints on it. Must be connected to a Store object at the time of creation. 48 | 49 | Allowed argument lists: 50 | - (int-var min max) 51 | - (int-var name min max) 52 | 53 | - (int-var number) 54 | - (int-var name number) 55 | 56 | - (int-var domain) 57 | - (int-var name domain) 58 | 59 | Note that the optional \"name\" field (which is an input-order-select by default) is only used for the outputted logs, and not at all necessary to function internally." 60 | [& args] 61 | (let [store (get-current-store)] 62 | (case (count args) 63 | 1 (if (instance? IntDomain (first args)) 64 | (IntVar. store (first args)) 65 | (IntVar. store (first args) (first args))) 66 | 2 (case [(string? (first args)) (number? (second args))] 67 | [true true] (IntVar. store (first args) (second args) (second args)) 68 | [true false] (IntVar. store (first args) (second args)) 69 | [false true] (IntVar. store (first args) (second args))) 70 | 3 (IntVar. store (first args) (second args) (nth args 2))))) 71 | 72 | (defn constrain! 73 | "Given a constraint (created with clocop.constraints, or implements JaCoP.constraints.Constraint), imposes the constraint on your store. 74 | The constraint doesn't take effect on the variables until you run the \"solve!\" function." 75 | [constraint] 76 | (.impose ^Store (get-current-store) ^Constraint constraint)) 77 | 78 | (defn- disclosed-variables 79 | [store] 80 | (filter #(and (identity %) 81 | (not= (first (.id %)) \_)) 82 | (.vars store))) 83 | 84 | (defn solve! 85 | "Finds one (or every) solution in your store. Solutions are returned in the form of a map, from the var names to their values. Variables whose names start with an underscore will not be included in the final map. 86 | The var names included in the map are all of them by default, but if you use a custom Selector, it will only return the variables you gave to the selector. 87 | 88 | Optional keyword arguments: 89 | :timeout - number of seconds for the search to run before returning best solution 90 | :solutions - :one or :all (default :one) 91 | :minimize - an int-var that the search will minimize as much as possible. 92 | :log? - if true, the searcher will print a log about its search to the Console. (default false) 93 | :pick-var - if there are no more deductions to make, which variable should we branch the search on? 94 | Options: keywords like :smallest-domain (see readme for all choices), or a list of variables that the solver will branch on in order (skipping over variables already solved) 95 | Default: :smallest-domain 96 | :pick-val - after picking a variable, what value should we pick first? 97 | Options: keywords like :min, see readme for all choices. 98 | Default: :min 99 | 100 | NOTE: Weird behavior occurs when reusing stores and constraints. 101 | Although this function returns something, the function name is marked with an exclamation point to remind you that this function shouldn't be reused on the same store. 102 | " 103 | [& args] 104 | (let [store (get-current-store) 105 | args (apply hash-map args) 106 | vars (disclosed-variables store) 107 | num-solutions (or (:solutions args) :one) 108 | 109 | pick-var-arg (or (:pick-var args) 110 | :smallest-domain) 111 | pick-val-arg (or (:pick-val args) 112 | :min) 113 | the-pick-val (pick-val pick-val-arg) 114 | the-selector (if (sequential? pick-var-arg) 115 | (input-order-selector store pick-var-arg the-pick-val) 116 | (selector vars 117 | :pick-var (pick-var pick-var-arg) 118 | :pick-val the-pick-val)) 119 | 120 | minimize (:minimize args) 121 | timeout (:timeout args) 122 | log? (:log? args) 123 | search (DepthFirstSearch.) 124 | listener (.getSolutionListener search) 125 | _ (.setPrintInfo search (boolean log?)) 126 | _ (when (= num-solutions :all) 127 | (.searchAll listener true)) 128 | _ (when timeout 129 | (.setTimeOut search timeout)) 130 | _ (.recordSolutions listener true) 131 | labeling? (if minimize 132 | (.labeling search store the-selector minimize) 133 | (.labeling search store the-selector)) 134 | ] 135 | (cond 136 | (not labeling?) nil 137 | :else (let [solutions (for [i (if minimize 138 | (range (.solutionsNo listener) 0 -1) ; last solutions first 139 | (range 1 (inc (.solutionsNo listener))) ; first solutions first 140 | ) 141 | :let [domain-array (.getSolution listener i)]] 142 | (let [vars (.getVariables listener) 143 | varnames (map #(.id %) vars) 144 | domain-vals (for [domain domain-array] 145 | (.getElementAt domain 0)) 146 | result (into {} 147 | (for [[var val] (map vector varnames domain-vals) 148 | :when (not= (first var) \_)] 149 | [var val]))] 150 | result))] 151 | 152 | (if (= num-solutions :one) 153 | (first solutions) 154 | solutions))))) 155 | 156 | ;(def s (store)) 157 | ;(def vars [(int-var s "a" 1 2) 158 | ; (int-var s "b" 3 4)]) 159 | ;(def constraints [(clocop.constraints/=% (vars 0) 1) 160 | ; (clocop.constraints/=% (vars 1) 4)]) -------------------------------------------------------------------------------- /src/clocop/solver.clj: -------------------------------------------------------------------------------- 1 | (ns clocop.solver 2 | "A namespace with functions for customizing the way the solver works." 3 | (:import (JaCoP.core Var) 4 | (JaCoP.search SimpleSelect 5 | InputOrderSelect 6 | 7 | ComparatorVariable 8 | 9 | LargestDomain 10 | LargestMax 11 | LargestMin 12 | MaxRegret 13 | MinDomainOverDegree 14 | MostConstrainedDynamic 15 | MostConstrainedStatic 16 | SmallestDomain 17 | SmallestMax 18 | SmallestMin 19 | WeightedDegree 20 | 21 | Indomain 22 | 23 | IndomainMin 24 | IndomainMax 25 | IndomainMiddle 26 | IndomainList 27 | IndomainRandom 28 | IndomainSimpleRandom 29 | ))) 30 | 31 | (defn ^SimpleSelect selector 32 | [variables & {:as args}] 33 | (let [{pick-var :pick-var 34 | pick-val :pick-val} args] 35 | (SimpleSelect. (into-array Var variables) 36 | pick-var 37 | pick-val))) 38 | 39 | (defn ^InputOrderSelect input-order-selector 40 | [store list-of-vars pick-val] 41 | (InputOrderSelect. store (into-array Var list-of-vars) pick-val)) 42 | 43 | (defn ^ComparatorVariable pick-var 44 | [pick-var-type] 45 | (case pick-var-type 46 | :largest-domain (LargestDomain.), :largest-max (LargestMax.), :largest-min (LargestMin.), 47 | :max-regret (MaxRegret.), 48 | :min-domain-over-degree (MinDomainOverDegree.), 49 | :most-constrained-dynamic (MostConstrainedDynamic.) 50 | :most-constrained-static (MostConstrainedStatic.) 51 | :smallest-domain (SmallestDomain.), :smallest-max (SmallestMax.), :smallest-min (SmallestMin.), 52 | :weighted-degree (WeightedDegree.))) 53 | 54 | (defn ^Indomain pick-val 55 | [indomain-type] 56 | (case indomain-type 57 | :min (IndomainMin.) 58 | :max (IndomainMax.) 59 | :middle (IndomainMiddle.) 60 | :random (IndomainRandom.) 61 | :simple-random (IndomainSimpleRandom.) 62 | (let [[indomain-type & args] indomain-type] 63 | (case indomain-type 64 | :random (IndomainRandom. (first args)))))) -------------------------------------------------------------------------------- /test/clocop/all_interval_series_test.clj: -------------------------------------------------------------------------------- 1 | (ns clocop.all-interval-series-test 2 | (:use clojure.test 3 | clocop.core 4 | clocop.constraints)) 5 | 6 | ; An "all interval series" of length N is a permutation of array [0 1 .... N-1], such that differences between adjacent 7 | ; elements are all different 8 | 9 | ; Here's an example of an all interval series of length 5: 10 | 11 | ; [1 0 4 2 3] 12 | ; 1 -4 2 -1 (differences) 13 | 14 | (defn all-interval-series 15 | [N] 16 | (with-store (store) 17 | (let [L (vec (for [i (range N)] 18 | (int-var (str i) 0 N))) ; variables for elements 19 | D (vec (for [i (range (dec N))] 20 | (int-var (str "d" i) (- N) N)))] ; variables for differences 21 | (doseq [i (range (dec N))] 22 | (constrain! ($= (D i) ($- (L i) (L (inc i)))))) ; difference relation 23 | (constrain! (apply $all-different L)) ; L is a permutation of [0 1 ... N -1] 24 | (constrain! (apply $all-different D)) ; all intervals are different 25 | ; These are symmetry breaking constraints. They reduce search space by removing feasible solutions, that can be 26 | ; obtained by trivial transformation of other feasible solutions: 27 | ; - breaks symmetry against transformation: (L_1, L_2, ... L_n-1) -> (N - L_1, N - L_2, ... N - L_n-1) 28 | (constrain! ($> (L 0) (L 1))) 29 | ; - breaks symmetry against transformation: (L_1, L_2, ... L_n-1) -> (L_n-1, ... L_2, L_1) 30 | (constrain! ($> (D 0) (D (- N 2)))) 31 | 32 | (let [solved (solve!)] 33 | (map solved (map str (range 0 N))))))) 34 | 35 | (deftest all-interval-series-correct? 36 | (doseq [N '(5 10 20 30) 37 | :let [series (all-interval-series N)]] 38 | (is (every? #(= 1 %) 39 | (vals (frequencies 40 | (for [i (range (dec N))] 41 | (- (nth series i) (nth series (inc i)))))))))) 42 | -------------------------------------------------------------------------------- /test/clocop/binpack_test.clj: -------------------------------------------------------------------------------- 1 | (ns clocop.binpack-test 2 | (:use clocop.core 3 | clocop.constraints 4 | clojure.test)) 5 | 6 | (deftest binpacktest1 7 | (with-store (store) 8 | (let [x (int-var "xloc" 0 2) ; which bin, from 0 to 2, is x in 9 | y (int-var "yloc" 0 2) 10 | z (int-var "zloc" 0 2) 11 | bins [1 2 3] ; the constant bin capacities 12 | xweight (int-var 1) ; x's weight 13 | yweight (int-var 3) 14 | zweight (int-var 2)] 15 | (constrain! ($binpacking :bin-sizes bins 16 | :item-sizes [xweight yweight zweight] 17 | :item-locations [x y z])) 18 | (is (= (solve!) 19 | {"xloc" 0 20 | "yloc" 2 21 | "zloc" 1}))))) -------------------------------------------------------------------------------- /test/clocop/magic_series_test.clj: -------------------------------------------------------------------------------- 1 | (ns clocop.magic-series-test 2 | (:use clojure.test 3 | clocop.core 4 | clocop.constraints)) 5 | 6 | ; A "magic series" of length N is an array L, such that for all i in [0..N), L[i] = the number of occurrences of i in L. 7 | 8 | ; Here's an example of a magic series of length 5: 9 | 10 | ; [2 1 2 0 0] 11 | 12 | (defn magic-series 13 | [N] 14 | (with-store (store) 15 | (let [L (vec (for [i (range N)] 16 | (int-var (str i) 0 N)))] ; initialize L to be a vector of vars 17 | (doseq [i (range N)] 18 | (constrain! ($= ($occurrences L i) 19 | (nth L i)))) ; L[i] = # of times i occurs in L 20 | 21 | ; This is a redundant constraint, i.e. a constraint that doesn't change the feasibility of the problem 22 | ; but makes the solving faster: summation(i=0..N | i * L[i]) = N. (Think about it!) 23 | (constrain! ($= ($weighted-sum L (range N)) N)) 24 | 25 | (let [solved (solve!)] 26 | (map solved (map str (range 0 N))))))) 27 | 28 | (deftest magic-series-correct? 29 | (doseq [N '(5 10 20 30) 30 | :let [series (magic-series N)]] 31 | (is (every? identity 32 | (for [i (range N)] 33 | (= (nth series i) (count (filter #(= % i) series)))))))) -------------------------------------------------------------------------------- /test/clocop/minimize_test.clj: -------------------------------------------------------------------------------- 1 | (ns clocop.minimize-test 2 | (:use clocop.core 3 | clocop.constraints 4 | clojure.test)) 5 | 6 | (deftest minimize-test1 7 | (-> (with-store (store) 8 | (let [x (int-var "x" 1 5)] 9 | (get (solve! :minimize x) 10 | "x"))) 11 | (= 1) 12 | is)) 13 | 14 | (deftest minimize-test2 15 | (-> (with-store (store) 16 | (let [x (int-var "x" 1 5) 17 | y (int-var "y" 1 5)] 18 | (constrain! ($= x ($+ y 1))) 19 | ((solve! :minimize x) "x"))) 20 | (= 2) 21 | is)) 22 | 23 | (deftest minimize-test3 24 | (-> (with-store (store) 25 | (let [x (int-var "x" 1 5) 26 | y (int-var "y" 1 5)] 27 | (constrain! ($!= x y)) ; still should work 28 | ((solve! :minimize x) "x"))) 29 | (= 1) 30 | is)) 31 | 32 | (deftest maximize-test 33 | (-> (with-store (store) 34 | (let [x (int-var "x" 1 5)] 35 | ((solve! :minimize ($- x)) "x"))) 36 | (= 5) 37 | is)) -------------------------------------------------------------------------------- /test/clocop/sudoku_test.clj: -------------------------------------------------------------------------------- 1 | (ns clocop.sudoku-test 2 | "A sudoku solver using CloCoP." 3 | (:use clojure.test) 4 | (:use clocop.core 5 | clocop.constraints)) 6 | 7 | (defn solve-sudoku 8 | "Takes and returns a vector of vectors of numbers (with 0 as a blank space)." 9 | [board] 10 | (with-store (store) 11 | (let [var-grid (vec (map vec (for [i (range 9)] 12 | (for [j (range 9)] 13 | (let [n (get-in board [i j])] 14 | (int-var (str i j) (if (not= n 0) 15 | (domain [n n]) 16 | (domain [1 9])))))))) 17 | rows var-grid 18 | cols (apply map vector var-grid) 19 | squares (for [a (range 3) 20 | b (range 3)] 21 | (for [i (range (* a 3) (* (inc a) 3)) 22 | j (range (* b 3) (* (inc b) 3))] 23 | (get-in var-grid [i j])))] 24 | 25 | (doseq [cell-group (concat rows cols squares)] 26 | (constrain! (apply $all-different cell-group))) 27 | ; in each row, column, and 3x3 square, all of the numbers must be different. 28 | 29 | (let [solved (solve!)] 30 | (when solved 31 | (vec (map vec (for [i (range 9)] 32 | (for [j (range 9)] 33 | (solved (str i j))))))))))) 34 | 35 | (defn solve-sudoku-pretty 36 | [board] 37 | (doseq [line (solve-sudoku board)] 38 | (println line))) 39 | 40 | (def board1 41 | "One of the hardest sudoku puzzles of all time" 42 | [[8 0 0 0 0 0 0 0 0] 43 | [0 0 3 6 0 0 0 0 0] 44 | [0 7 0 0 9 0 2 0 0] 45 | 46 | [0 5 0 0 0 7 0 0 0] 47 | [0 0 0 0 4 5 7 0 0] 48 | [0 0 0 1 0 0 0 3 0] 49 | 50 | [0 0 1 0 0 0 0 6 8] 51 | [0 0 8 5 0 0 0 1 0] 52 | [0 9 0 0 0 0 4 0 0]]) 53 | 54 | (def board1answer 55 | [[8 1 2 7 5 3 6 4 9] 56 | [9 4 3 6 8 2 1 7 5] 57 | [6 7 5 4 9 1 2 8 3] 58 | 59 | [1 5 4 2 3 7 8 9 6] 60 | [3 6 9 8 4 5 7 2 1] 61 | [2 8 7 1 6 9 5 3 4] 62 | 63 | [5 2 1 9 7 4 3 6 8] 64 | [4 3 8 5 2 6 9 1 7] 65 | [7 9 6 3 1 8 4 5 2]]) 66 | 67 | (deftest board1test 68 | (is (= (solve-sudoku board1) 69 | board1answer))) -------------------------------------------------------------------------------- /test/clocop/twentysix_puzzle_test.clj: -------------------------------------------------------------------------------- 1 | (ns clocop.twentysix-puzzle-test 2 | (:use clojure.test 3 | clocop.core 4 | clocop.constraints)) 5 | 6 | ; In the 26 puzzle, there are 12 different numbers (from 1-12) arranged in a 6-point-star fashion, like so: 7 | ; A 8 | ; B C D E 9 | ; F G 10 | ; H I J K 11 | ; L 12 | 13 | ; There are seven different sets of numbers that have to add up to 26. These include: 14 | ; - The set of six corners 15 | ; - The six "sides", e.g. B C D E, or H F C A 16 | 17 | ; I represent A by "o-n", because it's on the outside ("o") and it's to the north ("n") 18 | ; Similarly, J is represented by "i-se". 19 | 20 | (defn twentysix-puzzle 21 | [] 22 | (with-store (store) 23 | (let [o-n (int-var "o-n" 1 12) 24 | o-nw (int-var "o-nw" 1 12) 25 | o-sw (int-var "o-sw" 1 12) 26 | o-s (int-var "o-s" 1 12) 27 | o-se (int-var "o-se" 1 12) 28 | o-ne (int-var "o-ne" 1 12) 29 | 30 | i-nw (int-var "i-nw" 1 12) 31 | i-w (int-var "i-w" 1 12) 32 | i-sw (int-var "i-sw" 1 12) 33 | i-se (int-var "i-se" 1 12) 34 | i-e (int-var "i-e" 1 12) 35 | i-ne (int-var "i-ne" 1 12)] 36 | (constrain! ($all-different o-n o-nw o-sw o-s o-se o-ne 37 | i-nw i-w i-sw i-se i-e i-ne)) 38 | 39 | (constrain! ($= ($+ o-n o-nw o-sw o-s o-se o-ne) 26)) 40 | 41 | (constrain! ($= ($+ o-nw i-nw i-ne o-ne) 26)) 42 | (constrain! ($= ($+ o-sw i-w i-nw o-n) 26)) 43 | (constrain! ($= ($+ o-s i-sw i-w o-nw) 26)) 44 | (constrain! ($= ($+ o-se i-se i-sw o-sw) 26)) 45 | (constrain! ($= ($+ o-ne i-e i-se o-s) 26)) 46 | (constrain! ($= ($+ o-n i-ne i-e o-se) 26)) 47 | 48 | (let [solved (solve!)] 49 | (when solved 50 | (println " " (solved "o-n")) 51 | (println (solved "o-nw") (solved "i-nw") (solved "i-ne") (solved "o-ne")) 52 | (println "" (solved "i-w") " " (solved "i-e")) 53 | (println (solved "o-sw") (solved "i-sw") (solved "i-se") (solved "o-se")) 54 | (println " " (solved "o-s"))))))) 55 | ; => 56 | ; 1 57 | ; 2 12 9 3 58 | ; 6 11 59 | ; 7 10 4 5 60 | ; 8 61 | 62 | (deftest twentysix-puzzle-test 63 | (is (or (= " 1\r\n2 12 9 3\r\n 6 11\r\n7 10 4 5\r\n 8\r\n" (with-out-str (twentysix-puzzle))) 64 | (= " 1\n2 12 9 3\n 6 11\n7 10 4 5\n 8\n" (with-out-str (twentysix-puzzle)))))) --------------------------------------------------------------------------------