├── .gitignore
├── CHANGES
├── LICENSE
├── README
├── combine.opam
├── dune-project
├── examples
    ├── cmb
    │   ├── .gitignore
    │   ├── arthur.cmb
    │   ├── cat_stax.cmb
    │   ├── chameau.cmb
    │   ├── dominos.cmb
    │   ├── euler.cmb
    │   ├── gagnetonpapa.cmb
    │   ├── hexa.cmb
    │   ├── hexaminos.cmb
    │   ├── modotri_8_8.cmb
    │   ├── non-regression.cmb
    │   ├── penta-5xn.cmb
    │   ├── penta.cmb
    │   ├── pentacubes.cmb
    │   ├── pentaminos.cmb
    │   ├── pyth-3-4-5.cmb
    │   ├── pyth-5-12-13.cmb
    │   ├── pyth-6-8-10.cmb
    │   ├── pyth.ml
    │   ├── sandbox.cmb
    │   ├── scott.cmb
    │   ├── stephane.cmb
    │   ├── test_sudoku.txt
    │   ├── tetro.cmb
    │   └── tetrominoes.cmb
    └── lib
    │   ├── backslide.ml
    │   ├── color.ml
    │   ├── dune
    │   ├── queens.ml
    │   └── sudoku.ml
├── misc
    ├── stats.txt
    └── test.txt
├── src
    ├── .gitignore
    ├── dune
    ├── lib
    │   ├── ast.mli
    │   ├── backtracking.ml
    │   ├── backtracking.mli
    │   ├── cube.ml
    │   ├── cube.mli
    │   ├── d4.ml
    │   ├── d4.mli
    │   ├── dlx.ml
    │   ├── dlx.mli
    │   ├── dlxa.ml
    │   ├── dlxa.mli
    │   ├── dune
    │   ├── emc.ml
    │   ├── emc.mli
    │   ├── interp.ml
    │   ├── interp.mli
    │   ├── lexer.mll
    │   ├── matrix.ml
    │   ├── matrix.mli
    │   ├── parser.mly
    │   ├── tiling.ml
    │   ├── tiling.mli
    │   ├── zdd.ml
    │   └── zdd.mli
    └── main.ml
├── tests
    ├── dune
    ├── test.ml
    └── test_sat.ml
└── www
    ├── images
        ├── bg.png
        └── exemple.svg
    ├── index.html
    └── style.css


/.gitignore:
--------------------------------------------------------------------------------
1 | _build/
2 | *.merlin
3 | *.install
4 | solutions/
5 | 


--------------------------------------------------------------------------------
/CHANGES:
--------------------------------------------------------------------------------
 1 | version 0.55, Apr 2014
 2 | ----------------------
 3 | 
 4 |  * Tiling.Problem.ToEMC now creates a sparse matrix
 5 |  o alternative implementation of DLX using arrays of integers (in Dlxa)
 6 |  * use oasis as build system
 7 | 
 8 | version 0.55, Apr 2014
 9 | ----------------------
10 | 
11 | 
12 | 


--------------------------------------------------------------------------------
/README:
--------------------------------------------------------------------------------
  1 | ##########################################################################
  2 | #                                                                        #
  3 | #  Combine - an OCaml library for combinatorics                          #
  4 | #                                                                        #
  5 | #  Copyright (C) 2012-2014                                               #
  6 | #    Remy El Sibaie                                                      #
  7 | #    Jean-Christophe Filliatre                                           #
  8 | #                                                                        #
  9 | #  This software is free software; you can redistribute it and/or        #
 10 | #  modify it under the terms of the GNU Library General Public           #
 11 | #  License version 2.1, with the special exception on linking            #
 12 | #  described in file LICENSE.                                            #
 13 | #                                                                        #
 14 | #  This software is distributed in the hope that it will be useful,      #
 15 | #  but WITHOUT ANY WARRANTY; without even the implied warranty of        #
 16 | #  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  #
 17 | #                                                                        #
 18 | ##########################################################################
 19 | 
 20 | 
 21 | * Library
 22 | 
 23 |   The Combine library contains four main modules:
 24 |   - Dlx: implements Knuth's dancing links
 25 |   - Zdd: implements Zero-suppressed binary decision diagrams
 26 |   - Emc: a common interface to modules Dlx and Zdd to solve EMC +
 27 |          reduction of EMC to SAT
 28 |   - Tiling: converts a 2D tiling problem into an EMC problem
 29 | 
 30 |   Usage: the Combine library is packed into a single module Combine, installed
 31 |   in the subdirectory combine/ of OCaml's standard library. Thus, it must be
 32 |   used as follows:
 33 | 
 34 |     ocamlc -I +combine combine.cma <other files>
 35 | 
 36 |   full documentation : https://usr.lmf.cnrs.fr/~jcf/combine/
 37 | 
 38 | 
 39 | * Examples
 40 | 
 41 |   The distribution contains several example programs:
 42 |   - queens.ml: solve the N-queens puzzle
 43 |   - sudoku.ml: well, you haved guessed already
 44 |   - color.ml: 4-color planar graphs using DLX and SAT (requires OCamlgraph
 45 |     and an explicit 'make color.opt')
 46 | 
 47 | 
 48 | * Tiling language and interpreter
 49 | 
 50 |   In addition to the library, Combine provides a language to describe 2D tiling
 51 |   problems and an interpreter (combine) for this language.
 52 | 
 53 |   Directory tests/ contains various examples of tiling problems (.cmb files).
 54 |   To execute such a test, just run "combine" on the file.
 55 | 
 56 |   The grammar of the tiling language is the following:
 57 | 
 58 | <file> ::=              | decl ... decl
 59 | 
 60 | <decl> ::=
 61 | 			| pattern <identifier> = <expr>
 62 | 			| tiles <identifier> = <tile_list>
 63 | 			| problem <identifier>  equal <expr> tl = tiles
 64 | 			| assert b = boolean_expr
 65 | 			| print <identifier>
 66 | 			| solve a = algo <identifier>  out = output
 67 | 			| count a = algo <identifier>
 68 |                         | dimacs <identifier> <string>
 69 | 			| debug st = state
 70 | 			| timing st = state
 71 | 			| exit
 72 | 			| include <string>
 73 | 
 74 | algo ::=
 75 | 			| dlx
 76 | 			| zdd
 77 |                         | sat <string>
 78 | 
 79 | state ::=
 80 | 			| on
 81 | 			| off
 82 | 
 83 | option ::=
 84 | 			| one
 85 | 			| maybe
 86 | 			| sym
 87 | 			| rot
 88 | 
 89 | tiles ::=
 90 | 			| <tile_list>
 91 | 			| <identifier>
 92 | 
 93 | tile_list ::=
 94 | 			| [ tile, ..., tile ]
 95 | 
 96 | output ::=
 97 | 			| svg_out <string>
 98 | 			| ascii_out
 99 | 
100 | isometry ::=
101 | 			| id
102 | 			| rot90
103 | 			| rot180
104 | 			| rot270
105 | 			| vertrefl
106 | 			| horizrefl
107 | 			| diag1refl
108 | 			| diag2refl
109 | 
110 | tile ::=
111 | 			| <expr> o = list(option)
112 | 
113 | expr ::=
114 | 			| lpar <expr> rpar
115 | 			| <identifier>
116 | 			| constant <dim> <bool>
117 | 			| union <expr> <expr>
118 | 			| inter <expr> <expr>
119 | 			| diff <expr> <expr>
120 | 			| xor <expr> <expr>
121 | 			| <expr> minus <expr>
122 | 			| <expr> ampamp <expr>
123 | 			| <expr> barbar <expr>
124 | 			| <expr> hat <expr>
125 | 			| set <expr> <dim> <bool>
126 | 			| crop <dim> <dim> <expr>
127 | 			| shift <expr> <dim>
128 | 			| resize <expr> <dim>
129 | 			| apply <isometry> <expr>
130 | 			| <ascii>
131 | 
132 | bool ::=
133 | 			| false
134 | 			| true
135 | 
136 | boolean_expr::=
137 | 			| <bool>
138 | 			| <expr> equal <expr>
139 | 
140 | 
141 | 
142 | 
143 | 
144 | 
145 | 
146 | 
147 | 


--------------------------------------------------------------------------------
/combine.opam:
--------------------------------------------------------------------------------
 1 | # This file is generated by dune, edit dune-project instead
 2 | opam-version: "2.0"
 3 | synopsis: "Combine is an OCaml library for combinatorics problem solving"
 4 | description: """
 5 | Combine is an OCaml library for combinatorics problem solving.
 6 | The Combine library contains four main modules:
 7 | - Dlx: implements Knuth's dancing links
 8 | - Zdd: implements Zero-suppressed binary decision diagrams
 9 | - Emc: a common interface to modules Dlx and Zdd to solve the Exact Matrix Cover problem
10 | - Tiling: converts a 2D tiling problem into an EMC problem"""
11 | maintainer: ["Jean-Christophe Filliâtre <jean-christophe.filliatre@cnrs.fr>"]
12 | authors: [
13 |   "Remy El Sibaie <remy.el-sibaie@lip6.fr>, Jean-Christophe Filliâtre <jean-christophe.filliatre@cnrs.fr>"
14 | ]
15 | license: "LGPL"
16 | homepage: "https://github.com/backtracking/combine"
17 | doc: "https://github.com/backtracking/combine"
18 | bug-reports: "https://github.com/backtracking/combine/issues"
19 | depends: [
20 |   "ocaml" {>= "4.07"}
21 |   "dune" {>= "2.4"}
22 |   "menhir" {>= "20200211"}
23 |   "zarith"
24 |   "str" {dev}
25 |   "graphics" {dev}
26 |   "ocamlgraph" {dev}
27 | ]
28 | build: [
29 |   ["dune" "subst"] {pinned}
30 |   [
31 |     "dune"
32 |     "build"
33 |     "-p"
34 |     name
35 |     "-j"
36 |     jobs
37 |     "@install"
38 |     "@runtest" {with-test}
39 |     "@doc" {with-doc}
40 |   ]
41 | ]
42 | dev-repo: "git://github.com/backtracking/combine.git"
43 | 


--------------------------------------------------------------------------------
/dune-project:
--------------------------------------------------------------------------------
1 | (lang dune 2.4)
2 | (name combine)
3 | (using menhir 2.1)
4 | 


--------------------------------------------------------------------------------
/examples/cmb/.gitignore:
--------------------------------------------------------------------------------
1 | solutions/
2 | 


--------------------------------------------------------------------------------
/examples/cmb/arthur.cmb:
--------------------------------------------------------------------------------
 1 | 
 2 | pattern3 Y = [{
 3 | ****
 4 | .*..
 5 | }]
 6 | 
 7 | 
 8 | ### sets of tiles ###########################################################
 9 | 
10 | tiles3 pieces =
11 | [ Y ~sym ]
12 | 
13 | ### problem #############################################################
14 | 
15 | debug on
16 | timing on
17 | 
18 | pattern3 one_cube = [{
19 | *****
20 | *****
21 | *****
22 | *****
23 | *****
24 | },{
25 | *****
26 | *****
27 | *****
28 | *****
29 | *****
30 | },{
31 | *****
32 | *****
33 | *****
34 | *****
35 | *****
36 | },{
37 | *****
38 | *****
39 | *****
40 | *****
41 | *****
42 | },{
43 | *****
44 | *****
45 | *****
46 | *****
47 | *****
48 | }]
49 | 
50 | problem3 one_cube = one_cube pieces
51 | 
52 | count3 zdd one_cube
53 | 
54 | 
55 | # Local Variables:
56 | # compile-command: "../../src/main.exe arthur.cmb"
57 | # End:
58 | 


--------------------------------------------------------------------------------
/examples/cmb/cat_stax.cmb:
--------------------------------------------------------------------------------
  1 | ### Cat Stax "The purrfect puzzle"
  2 | 
  3 | pattern yellow_cat = {
  4 | *..
  5 | ***
  6 | ***
  7 | }
  8 | pattern purple_cat = {
  9 | ***
 10 | ***
 11 | }
 12 | pattern white_cat = {
 13 | *..
 14 | ***
 15 | }
 16 | pattern black_cat = {
 17 | *.*
 18 | ***
 19 | ***
 20 | }
 21 | pattern blue_cat = {
 22 | **
 23 | }
 24 | pattern darkblue_cat = {
 25 | **
 26 | **
 27 | }
 28 | pattern green_cat = {
 29 | **..
 30 | *..*
 31 | ****
 32 | *..*
 33 | }
 34 | pattern pink_cat = {
 35 | ..*
 36 | ***
 37 | *.*
 38 | }
 39 | pattern red_cat = {
 40 | ...*
 41 | ****
 42 | *..*
 43 | }
 44 | pattern turqoise_cat = {
 45 | ...*
 46 | ****
 47 | ****
 48 | }
 49 | pattern sage_cat = {
 50 | .*.
 51 | .**
 52 | ***
 53 | }
 54 | pattern yale_cat = {
 55 | *.
 56 | **
 57 | }
 58 | 
 59 | pattern pattern_15 = {
 60 | ***.***
 61 | *******
 62 | *******
 63 | .*****.
 64 | *******
 65 | *******
 66 | ***.***
 67 | }
 68 | tiles tiles_15 = [
 69 |   yellow_cat ~one ~sym,
 70 |   purple_cat ~one ~sym,
 71 |   white_cat ~one ~sym,
 72 |   black_cat ~one ~sym,
 73 |   blue_cat ~one ~sym,
 74 |   turqoise_cat ~one ~sym,
 75 |   sage_cat ~one,
 76 |   yale_cat ~one ~sym
 77 | ]
 78 | problem problem_15 = pattern_15 tiles_15
 79 | 
 80 | solve dlx problem_15 svg "solutions/cat_stax_15.svg"
 81 | count dlx problem_15
 82 | 
 83 | pattern pattern_16 = {
 84 | *******
 85 | *******
 86 | *.***.*
 87 | *******
 88 | *******
 89 | *.***.*
 90 | *******
 91 | *******
 92 | }
 93 | tiles tiles_16 = [
 94 |   darkblue_cat ~one ~sym,
 95 |   red_cat ~one ~sym,
 96 |   black_cat ~one ~sym,
 97 |   blue_cat ~one ~sym,
 98 |   yale_cat ~one ~sym,
 99 |   yellow_cat ~one ~sym,
100 |   purple_cat ~one ~sym,
101 |   turqoise_cat ~one ~sym,
102 |   sage_cat ~one
103 | ]
104 | problem problem_16 = pattern_16 tiles_16
105 | 
106 | solve dlx problem_16 svg "solutions/cat_stax_16.svg"
107 | count dlx problem_16
108 | 
109 | 
110 | ## several layers
111 | 
112 | pattern3 yellow_cat = [{
113 | *..
114 | ***
115 | ***
116 | }]
117 | pattern3 purple_cat = [{
118 | ***
119 | ***
120 | }]
121 | pattern3 white_cat = [{
122 | *..
123 | ***
124 | }]
125 | pattern3 black_cat = [{
126 | *.*
127 | ***
128 | ***
129 | }]
130 | pattern3 blue_cat = [{
131 | **
132 | }]
133 | pattern3 darkblue_cat = [{
134 | **
135 | **
136 | }]
137 | pattern3 green_cat = [{
138 | **..
139 | *..*
140 | ****
141 | *..*
142 | }]
143 | pattern3 pink_cat = [{
144 | ..*
145 | ***
146 | *.*
147 | }]
148 | pattern3 red_cat = [{
149 | ...*
150 | ****
151 | *..*
152 | }]
153 | pattern3 turqoise_cat = [{
154 | ...*
155 | ****
156 | ****
157 | }]
158 | pattern3 sage_cat = [{
159 | .*.
160 | .**
161 | ***
162 | }]
163 | pattern3 yale_cat = [{
164 | *.
165 | **
166 | }]
167 | 
168 | tiles3 all_cats3 = [
169 |   yellow_cat ~one ~sym,
170 |   purple_cat ~one ~sym,
171 |   white_cat  ~one ~sym,
172 |   black_cat ~one ~sym,
173 |   blue_cat ~one ~sym,
174 |   darkblue_cat ~one ~sym,
175 |   green_cat ~one ~sym,
176 |   pink_cat ~one ~sym,
177 |   red_cat ~one ~sym,
178 |   turqoise_cat ~one ~sym,
179 |   sage_cat ~one ~sym,
180 |   yale_cat ~one ~sym
181 | ]
182 | pattern3 pattern_43 = [{
183 | ..*..
184 | *****
185 | *****
186 | *****
187 | *****
188 | *****
189 | *****
190 | *****
191 | },{
192 | ..*..
193 | *****
194 | *****
195 | *****
196 | *****
197 | *****
198 | *****
199 | *****
200 | }]
201 | problem3 problem_43 = pattern_43 all_cats3
202 | 
203 | solve3 dlx problem_43 ascii
204 | 
205 | # Local Variables:
206 | # compile-command: "../../src/main.exe cat_stax.cmb"
207 | # End:
208 | 
209 | 


--------------------------------------------------------------------------------
/examples/cmb/chameau.cmb:
--------------------------------------------------------------------------------
 1 | 
 2 | timing on
 3 | # debug on
 4 | 
 5 | pattern domino = {**}
 6 | 
 7 | pattern caml2 = {
 8 | ....****....................
 9 | ..******....................
10 | ********....****..****......
11 | ....****....**********......
12 | ....****..**************....
13 | ....**********************..
14 | ....************************
15 | ......********....******..**
16 | ........****........****....
17 | ........****........****....
18 | ........****........****....
19 | ........****........****....
20 | ........****........****....
21 | }
22 | 
23 | problem caml2 = caml2 [domino ~sym]
24 | print caml2
25 | 
26 | dimacs caml2 "chameau.dimacs"
27 | 
28 | 
29 | solve dlx caml2 ascii
30 | solve dlx caml2 svg "solutions/chameau.svg"
31 | 
32 | #solve sat "minisat2" caml2 svg "solutions/chameau2.svg"
33 | 
34 | count zdd caml2
35 | 
36 | 
37 | # Local Variables:
38 | # compile-command: "../../src/main.exe chameau.cmb"
39 | # End:
40 | 


--------------------------------------------------------------------------------
/examples/cmb/dominos.cmb:
--------------------------------------------------------------------------------
  1 | 
  2 | timing on
  3 | # debug on
  4 | 
  5 | pattern domino = {**}
  6 | 
  7 | pattern test = {
  8 | .........****.........
  9 | ......**********......
 10 | ....**************....
 11 | ...****************...
 12 | ..********..********..
 13 | ..*...***....***..**..
 14 | .**...***....***..***.
 15 | .********....********.
 16 | .********************.
 17 | *****...*....*...*****
 18 | ****....*....*....****
 19 | ****....*....*....****
 20 | *****...*....*...*****
 21 | .********....********.
 22 | .********....***.****.
 23 | .****.***....***.****.
 24 | ..***.***....***.***..
 25 | ..********..****.***..
 26 | ...****************...
 27 | ....**************....
 28 | ......**********......
 29 | .........****.........
 30 | }
 31 | 
 32 | problem test = test [domino ~sym]
 33 | print test
 34 | 
 35 | count zdd test
 36 | 
 37 | # Local Variables:
 38 | # compile-command: "../../main.native dominos.cmb"
 39 | # End:
 40 | 
 41 | # ********
 42 | # ********
 43 | # **....**
 44 | # **...***
 45 | # **...***
 46 | # ****..**
 47 | # ********
 48 | # ********
 49 | # test : (ZDD) 115662 solutions
 50 | # test solutions counted in 0.019951s
 51 | 
 52 | # ....****....
 53 | # ..********..
 54 | # ..********..
 55 | # ************
 56 | # ************
 57 | # ************
 58 | # ************
 59 | # ..********..
 60 | # ..********..
 61 | # ....****....
 62 | # test : (ZDD) 3637249604 solutions
 63 | # test solutions counted in 0.111029s
 64 | 
 65 | # .........****.........
 66 | # ......**********......
 67 | # ....**************....
 68 | # ...****************...
 69 | # ..********..********..
 70 | # ..*******....*******..
 71 | # .*******......*******.
 72 | # .******........******.
 73 | # .*****..........*****.
 74 | # *****............*****
 75 | # ****..............****
 76 | # ****..............****
 77 | # *****............*****
 78 | # .*****..........*****.
 79 | # .******........******.
 80 | # .*******......*******.
 81 | # ..*******....*******..
 82 | # ..********..********..
 83 | # ...****************...
 84 | # ....**************....
 85 | # ......**********......
 86 | # .........****.........
 87 | # test : (ZDD) 104857600000000 solutions
 88 | # test solutions counted in 0.526390s
 89 | 
 90 | # .........****.........
 91 | # ......**********......
 92 | # ....**************....
 93 | # ...****************...
 94 | # ..********..********..
 95 | # ..*******....*******..
 96 | # .********....********.
 97 | # .********....********.
 98 | # .********************.
 99 | # *****...*....*...*****
100 | # ****....*....*....****
101 | # ****....*....*....****
102 | # *****...*....*...*****
103 | # .********************.
104 | # .********....********.
105 | # .********....********.
106 | # ..*******....*******..
107 | # ..********..********..
108 | # ...****************...
109 | # ....**************....
110 | # ......**********......
111 | # .........****.........
112 | # test : (ZDD) 2255578550442504749056000000 solutions
113 | # test solutions counted in 4.759073s
114 | 
115 | # .........****.........
116 | # ......**********......
117 | # ....**************....
118 | # ...****************...
119 | # ..********..********..
120 | # ..*...***....***..**..
121 | # .**...***....***..***.
122 | # .********....********.
123 | # .********************.
124 | # *****...*....*...*****
125 | # ****....*....*....****
126 | # ****....*....*....****
127 | # *****...*....*...*****
128 | # .********....********.
129 | # .********....***.****.
130 | # .****.***....***.****.
131 | # ..***.***....***.***..
132 | # ..********..****.***..
133 | # ...****************...
134 | # ....**************....
135 | # ......**********......
136 | # .........****.........
137 | # test : (ZDD) 247319451357235281887232 solutions
138 | # test solutions counted in 1.844444s
139 | 


--------------------------------------------------------------------------------
/examples/cmb/euler.cmb:
--------------------------------------------------------------------------------
 1 | 
 2 | timing on
 3 | # debug on
 4 | 
 5 | pattern domino = {**}
 6 | 
 7 | pattern euler = {
 8 | ..........**********..........
 9 | ........**************........
10 | .......****************.......
11 | ......*******....*******......
12 | .....******........******.....
13 | ....******..........*****.....
14 | ....*****............*****....
15 | ....****.............*****....
16 | ...*****..............****....
17 | ...*****..............****....
18 | ...*****..............*****...
19 | ...************************...
20 | ...************************...
21 | ...************************...
22 | ...****.......................
23 | ...****.......................
24 | ...*****......................
25 | ...*****......................
26 | ....****..............*****...
27 | ....*****............*****....
28 | ....******...........*****....
29 | .....******.........*****.....
30 | ......*******.....*******.....
31 | .......*****************......
32 | ........**************........
33 | ..........***********.........
34 | .............*****............
35 | }
36 | 
37 | problem euler = euler [domino ~sym]
38 | print euler
39 | 
40 | solve dlx euler ascii
41 | solve dlx euler svg "solutions/euler.svg"
42 | 
43 | count zdd euler
44 | # 971166110121482088250709280 solutions
45 | # 127s 6Gb
46 | 
47 | # Local Variables:
48 | # compile-command: "../../main.native euler.cmb"
49 | # End:
50 | 


--------------------------------------------------------------------------------
/examples/cmb/gagnetonpapa.cmb:
--------------------------------------------------------------------------------
 1 | 
 2 | pattern p1 = {
 3 | **
 4 | }
 5 | pattern p2 = {
 6 | *..
 7 | *..
 8 | ***
 9 | }
10 | pattern p3 = {
11 | **.
12 | .*.
13 | .**
14 | }
15 | pattern p4 = {
16 | ***
17 | .*.
18 | }
19 | pattern p5 = {
20 | ***
21 | *..
22 | }
23 | pattern p6 = {
24 | ***.
25 | ..**
26 | }
27 | 
28 | tiles pieces =
29 | [ p1 ~one ~sym,
30 |   p2 ~one ~sym,
31 |   p3 ~one ~sym,
32 |   p4 ~one ~sym,
33 |   p5 ~one ~sym,
34 |   p6 ~one ~sym ]
35 | 
36 | problem p = {
37 | *****
38 | *****
39 | *****
40 | *****
41 | *****
42 | } pieces
43 | 
44 | solve dlx p svg "solutions/gagnetonpapa.svg"
45 | count dlx p
46 | count zdd p
47 | 


--------------------------------------------------------------------------------
/examples/cmb/hexa.cmb:
--------------------------------------------------------------------------------
  1 | 
  2 | include "hexaminos.cmb"
  3 | 
  4 | timing on
  5 | 
  6 | pattern cell = {
  7 | *
  8 | }
  9 | 
 10 | tiles some_complex_hexaminos = [
 11 |   cell ~one, cell ~one, cell ~one, cell ~one, cell ~one, cell ~one,
 12 |   h17 ~one ~sym,
 13 |   h20 ~one ~sym,
 14 |   h33 ~one ~sym,
 15 |   h10 ~one ~sym,
 16 |   h24 ~one ~sym,
 17 |   h18 ~one ~sym,
 18 |   h22 ~one ~sym,
 19 |   h25 ~one ~sym,
 20 |   h29 ~one ~sym,
 21 |   h35 ~one ~sym,
 22 |   h23 ~one ~sym,
 23 |   h11 ~one ~sym,
 24 |   h12 ~one ~sym,
 25 |   h13 ~one ~sym,
 26 |   h14 ~one ~sym,
 27 |   h16 ~one ~sym,
 28 |   h15 ~one ~sym
 29 | ]
 30 | 
 31 | tiles some_simple_hexaminos = [
 32 |   cell ~one, cell ~one, cell ~one, cell ~one, cell ~one, cell ~one,
 33 |   h5 ~one ~sym,
 34 |   h9 ~one ~sym,
 35 |   h6 ~one ~sym,
 36 |   h7 ~one ~sym,
 37 |   h21 ~one ~sym,
 38 |   h19 ~one ~sym,
 39 |   h2 ~one ~sym,
 40 |   h3 ~one ~sym,
 41 |   h4 ~one ~sym,
 42 |   h26 ~one ~sym,
 43 |   h32 ~one ~sym,
 44 |   h31 ~one ~sym,
 45 |   h30 ~one ~sym,
 46 |   h34 ~one ~sym,
 47 |   h28 ~one ~sym,
 48 |   h27 ~one ~sym,
 49 |   h8 ~one ~sym
 50 | ]
 51 | 
 52 | problem p9x12 = {
 53 | ************
 54 | ************
 55 | ************
 56 | ************
 57 | ************
 58 | ************
 59 | ************
 60 | ************
 61 | ************
 62 | } some_complex_hexaminos
 63 | 
 64 | problem p9x12simple = {
 65 | ************
 66 | ************
 67 | ************
 68 | ************
 69 | ************
 70 | ************
 71 | ************
 72 | ************
 73 | ************
 74 | } some_simple_hexaminos
 75 | 
 76 | solve dlx p9x12simple svg "solutions/hexa_9x12simple.svg"
 77 | solve dlx p9x12 svg "solutions/hexa_9x12.svg"
 78 | count dlx p9x12
 79 | exit
 80 | 
 81 | problem p18x15_5x3 = {
 82 | ***************
 83 | ***************
 84 | ***************
 85 | ***************
 86 | ***************
 87 | ***************
 88 | *****.....*****
 89 | *****.....*****
 90 | *****.....*****
 91 | ***************
 92 | ***************
 93 | ***************
 94 | ***************
 95 | ***************
 96 | ***************
 97 | } all_hexaminos_nosym
 98 | 
 99 | # solve dlx p18x15_5x3 svg "solutions/hexa_18x15-5x3.svg" # 0m1.920s
100 | # count dlx p18x15_5x3
101 | 
102 | tiles all_hexaminos_but_h11 = [
103 |   h1 ~one ~sym, h2 ~one ~sym, h3 ~one ~sym, h4 ~one ~sym,
104 |   h5 ~one ~sym, h6 ~one ~sym, h7 ~one ~sym, h8 ~one ~sym,
105 |   h9 ~one ~sym, h10 ~one ~sym, h12 ~one ~sym, h13 ~one ~sym,
106 |   h14 ~one ~sym, h15 ~one ~sym, h16 ~one ~sym, h17 ~one ~sym,
107 |   h18 ~one ~sym, h19 ~one ~sym, h20 ~one ~sym, h21 ~one ~sym,
108 |   h22 ~one ~sym, h23 ~one ~sym, h24 ~one ~sym, h25 ~one ~sym,
109 |   h26 ~one ~sym, h27 ~one ~sym, h28 ~one ~sym, h29 ~one ~sym,
110 |   h30 ~one ~sym, h31 ~one ~sym, h32 ~one ~sym, h33 ~one ~sym,
111 |   h34 ~one ~sym, h35 ~one ~sym ]
112 | 
113 | problem p1 = {
114 | ************
115 | ************
116 | ************
117 | ************
118 | ************
119 | ************
120 | ************
121 | ************
122 | ************
123 | ............
124 | ************
125 | ************
126 | ************
127 | ************
128 | ************
129 | ************
130 | ************
131 | ************
132 | } all_hexaminos_but_h11
133 | 
134 | print p1
135 | 
136 | # solve dlx p1 svg "solutions/hexa_p1.svg" # > 110m
137 | # count dlx p1
138 | 
139 | 
140 | problem p2 = {
141 | *****************
142 | *****************
143 | *****************
144 | *****************
145 | *****************
146 | *****************
147 | *****************
148 | *****************
149 | *****************
150 | *****************
151 | *****************
152 | *****************
153 | } all_hexaminos_but_h11
154 | 
155 | # solve dlx p2 svg "solutions/hexa_p2.svg"
156 | # count dlx p2
157 | 
158 | 


--------------------------------------------------------------------------------
/examples/cmb/hexaminos.cmb:
--------------------------------------------------------------------------------
  1 | 
  2 | # The 35 hexaminos
  3 | #
  4 | # See for instance http://fr.wikipedia.org/wiki/Hexamino
  5 | # Tiling problems involving the hexaminos can be found in hexa.cmb
  6 | 
  7 | pattern h1 = {
  8 | ******
  9 | }
 10 | pattern h2 = {
 11 | ....*
 12 | *****
 13 | }
 14 | pattern h3 = {
 15 | ...*.
 16 | *****
 17 | }
 18 | pattern h4 = {
 19 | ..*..
 20 | *****
 21 | }
 22 | pattern h5 = {
 23 | ..**
 24 | ****
 25 | }
 26 | pattern h6 = {
 27 | .*.*
 28 | ****
 29 | }
 30 | pattern h7 = {
 31 | *..*
 32 | ****
 33 | }
 34 | pattern h8 = {
 35 | ...*
 36 | ...*
 37 | ****
 38 | }
 39 | pattern h9 = {
 40 | .**.
 41 | ****
 42 | }
 43 | pattern h10 = {
 44 | ..*.
 45 | ..*.
 46 | ****
 47 | }
 48 | pattern h11 = {
 49 | ...*
 50 | ****
 51 | ...*
 52 | }
 53 | pattern h12 = {
 54 | ..*.
 55 | ****
 56 | ...*
 57 | }
 58 | pattern h13 = {
 59 | .*..
 60 | ****
 61 | ...*
 62 | }
 63 | pattern h14 = {
 64 | *...
 65 | ****
 66 | ...*
 67 | }
 68 | pattern h15 = {
 69 | .*..
 70 | ****
 71 | ..*.
 72 | }
 73 | pattern h16 = {
 74 | ..*.
 75 | ****
 76 | ..*.
 77 | }
 78 | pattern h17 = {
 79 | ...**
 80 | ****.
 81 | }
 82 | pattern h18 = {
 83 | .*..
 84 | **..
 85 | .***
 86 | }
 87 | pattern h19 = {
 88 | **.*
 89 | .***
 90 | }
 91 | pattern h20 = {
 92 | ***..
 93 | ..***
 94 | }
 95 | pattern h21 = {
 96 | ***.
 97 | .***
 98 | }
 99 | pattern h22 = {
100 | ..*.
101 | ***.
102 | ..**
103 | }
104 | pattern h23 = {
105 | .*..
106 | ***.
107 | ..**
108 | }
109 | pattern h24 = {
110 | **..
111 | .*..
112 | .***
113 | }
114 | pattern h25 = {
115 | *...
116 | **..
117 | .***
118 | }
119 | pattern h26 = {
120 | ***
121 | ***
122 | }
123 | pattern h27 = {
124 | ..*
125 | .**
126 | ***
127 | }
128 | pattern h28 = {
129 | .**
130 | ..*
131 | ***
132 | }
133 | pattern h29 = {
134 | **..
135 | .***
136 | ...*
137 | }
138 | pattern h30 = {
139 | ..*
140 | ***
141 | .**
142 | }
143 | pattern h31 = {
144 | .*.
145 | ***
146 | .**
147 | }
148 | pattern h32 = {
149 | **.
150 | .**
151 | .**
152 | }
153 | pattern h33 = {
154 | .*.
155 | ***
156 | *.*
157 | }
158 | pattern h34 = {
159 | ..*
160 | ***
161 | *.*
162 | }
163 | pattern h35 = {
164 | **..
165 | .**.
166 | ..**
167 | }
168 | 
169 | 
170 | tiles all_hexaminos = [
171 |   h1 ~one ~sym,
172 |   h2 ~one ~sym,
173 |   h3 ~one ~sym,
174 |   h4 ~one ~sym,
175 |   h5 ~one ~sym,
176 |   h6 ~one ~sym,
177 |   h7 ~one ~sym,
178 |   h8 ~one ~sym,
179 |   h9 ~one ~sym,
180 |   h10 ~one ~sym,
181 |   h11 ~one ~sym,
182 |   h12 ~one ~sym,
183 |   h13 ~one ~sym,
184 |   h14 ~one ~sym,
185 |   h15 ~one ~sym,
186 |   h16 ~one ~sym,
187 |   h17 ~one ~sym,
188 |   h18 ~one ~sym,
189 |   h19 ~one ~sym,
190 |   h20 ~one ~sym,
191 |   h21 ~one ~sym,
192 |   h22 ~one ~sym,
193 |   h23 ~one ~sym,
194 |   h24 ~one ~sym,
195 |   h25 ~one ~sym,
196 |   h26 ~one ~sym,
197 |   h27 ~one ~sym,
198 |   h28 ~one ~sym,
199 |   h29 ~one ~sym,
200 |   h30 ~one ~sym,
201 |   h31 ~one ~sym,
202 |   h32 ~one ~sym,
203 |   h33 ~one ~sym,
204 |   h34 ~one ~sym,
205 |   h35 ~one ~sym
206 | ]
207 | 
208 | tiles all_hexaminos_nosym = [
209 |   h1 ~one ~sym,
210 |   h2 ~one ~sym,
211 |   h3 ~one ~sym,
212 |   h4 ~one ~sym,
213 |   h5 ~one ~sym,
214 |   h6 ~one ~sym,
215 |   h7 ~one ~sym,
216 |   h8 ~one ~sym,
217 |   h9 ~one ~sym,
218 |   h10 ~one ~sym,
219 |   h11 ~one ~sym,
220 |   h12 ~one ~sym,
221 |   h13 ~one ~sym,
222 |   h14 ~one ~sym,
223 |   h15 ~one ~sym,
224 |   h16 ~one ~sym,
225 |   h17 ~one ~sym,
226 |   h18 ~one ~sym,
227 |   h19 ~one ~sym,
228 |   h20 ~one ~sym,
229 |   h21 ~one ~sym,
230 |   h22 ~one ~sym,
231 |   h23 ~one ~sym,
232 |   h24 ~one ~sym,
233 |   h25 ~one ~sym,
234 |   h26 ~one ~sym,
235 |   h27 ~one ~sym,
236 |   h28 ~one ~sym,
237 |   h29 ~one ~sym,
238 |   h30 ~one ~sym,
239 |   h31 ~one ~sym,
240 |   h32 ~one ~sym,
241 |   h33 ~one ~sym,
242 |   h34 ~one,
243 |   h35 ~one ~sym
244 | ]
245 | 
246 | tiles some_hexaminos = [
247 |   h1 ~maybe ~sym,
248 |   h2 ~maybe ~sym,
249 |   h3 ~maybe ~sym,
250 |   h4 ~maybe ~sym,
251 |   h5 ~maybe ~sym,
252 |   h6 ~maybe ~sym,
253 |   h7 ~maybe ~sym,
254 |   h8 ~maybe ~sym,
255 |   h9 ~maybe ~sym,
256 |   h10 ~maybe ~sym,
257 |   h11 ~maybe ~sym,
258 |   h12 ~maybe ~sym,
259 |   h13 ~maybe ~sym,
260 |   h14 ~maybe ~sym,
261 |   h15 ~maybe ~sym,
262 |   h16 ~maybe ~sym,
263 |   h17 ~maybe ~sym,
264 |   h18 ~maybe ~sym,
265 |   h19 ~maybe ~sym,
266 |   h20 ~maybe ~sym,
267 |   h21 ~maybe ~sym,
268 |   h22 ~maybe ~sym,
269 |   h23 ~maybe ~sym,
270 |   h24 ~maybe ~sym,
271 |   h25 ~maybe ~sym,
272 |   h26 ~maybe ~sym,
273 |   h27 ~maybe ~sym,
274 |   h28 ~maybe ~sym,
275 |   h29 ~maybe ~sym,
276 |   h30 ~maybe ~sym,
277 |   h31 ~maybe ~sym,
278 |   h32 ~maybe ~sym,
279 |   h33 ~maybe ~sym,
280 |   h34 ~maybe ~sym,
281 |   h35 ~maybe ~sym
282 | ]
283 | 
284 | 


--------------------------------------------------------------------------------
/examples/cmb/modotri_8_8.cmb:
--------------------------------------------------------------------------------
 1 | 
 2 | # Tiling a 8x8 chessboard with monominoes, domnioes and triominoes
 3 | # TAOCP vol 4A page 252
 4 | 
 5 | pattern chessboard = constant 8x8 true
 6 | 
 7 | pattern a = {**}
 8 | 
 9 | pattern b = {*}
10 | 
11 | pattern c = {**$*}
12 | pattern d = {***}
13 | 
14 | problem modotri = chessboard [a ~sym, b ~sym, c ~sym, d ~sym]
15 | 
16 | 
17 | 
18 | timing on
19 | count zdd modotri
20 | timing off
21 | 


--------------------------------------------------------------------------------
/examples/cmb/non-regression.cmb:
--------------------------------------------------------------------------------
1 | 
2 | pattern chessboard = constant 8x8 true
3 | 
4 | pattern a = {**}
5 | 
6 | problem domino_8_8 = chessboard [a ~sym]
7 | 
8 | 


--------------------------------------------------------------------------------
/examples/cmb/penta-5xn.cmb:
--------------------------------------------------------------------------------
 1 | 
 2 | # tiling a 5xn rectangle with a subset of the pentaminos
 3 | # this is https://oeis.org/A246902
 4 | 
 5 | include "pentaminos.cmb"
 6 | 
 7 | #   n | nb solutions
 8 | #   1 |     1
 9 | #   2 |     0
10 | #   3 |    28
11 | #   4 |   200
12 | #   5 |   856
13 | #   6 |  2164
14 | #   7 |  5584
15 | #   8 | 13632
16 | #   9 | 23608
17 | #  10 | 27804
18 | #  11 | 16412
19 | #  12 |  4040
20 | 
21 | # answers for n=1 and n=2 are obvious but we check anyway
22 | 
23 | problem penta_5_1 = constant 5x1 true some_pentaminos
24 | solve dlx penta_5_1 svg "solutions/penta_5_1.svg"
25 | count dlx penta_5_1
26 | 
27 | problem penta_5_2 = constant 5x2 true some_pentaminos
28 | solve dlx penta_5_2 svg "solutions/penta_5_2.svg"
29 | count dlx penta_5_2
30 | 
31 | problem penta_5_3 = constant 5x3 true some_pentaminos
32 | solve dlx penta_5_3 svg "solutions/penta_5_3.svg"
33 | count dlx penta_5_3
34 | 
35 | problem penta_5_4 = constant 5x4 true some_pentaminos
36 | solve dlx penta_5_4 svg "solutions/penta_5_4.svg"
37 | count dlx penta_5_4
38 | 
39 | problem penta_5_5 = constant 5x5 true some_pentaminos
40 | solve dlx penta_5_5 svg "solutions/penta_5_5.svg"
41 | count dlx penta_5_5
42 | 
43 | problem penta_5_6 = constant 5x6 true some_pentaminos
44 | solve dlx penta_5_6 svg "solutions/penta_5_6.svg"
45 | count dlx penta_5_6
46 | 
47 | problem penta_5_7 = constant 5x7 true some_pentaminos
48 | solve dlx penta_5_7 svg "solutions/penta_5_7.svg"
49 | count dlx penta_5_7
50 | 
51 | problem penta_5_8 = constant 5x8 true some_pentaminos
52 | solve dlx penta_5_8 svg "solutions/penta_5_8.svg"
53 | count dlx penta_5_8
54 | 
55 | problem penta_5_9 = constant 5x9 true some_pentaminos
56 | solve dlx penta_5_9 svg "solutions/penta_5_9.svg"
57 | count dlx penta_5_9
58 | 
59 | problem penta_5_10 = constant 5x10 true some_pentaminos
60 | solve dlx penta_5_10 svg "solutions/penta_5_10.svg"
61 | count dlx penta_5_10
62 | 
63 | problem penta_5_11 = constant 5x11 true some_pentaminos
64 | solve dlx penta_5_11 svg "solutions/penta_5_11.svg"
65 | count dlx penta_5_11
66 | 
67 | problem penta_5_12 = constant 5x12 true some_pentaminos
68 | solve dlx penta_5_12 svg "solutions/penta_5_12.svg"
69 | count dlx penta_5_12
70 | 


--------------------------------------------------------------------------------
/examples/cmb/penta.cmb:
--------------------------------------------------------------------------------
  1 | 
  2 | include "pentaminos.cmb"
  3 | 
  4 | ##############################################################################
  5 | # (see also scott.cmb)
  6 | problem p1 = {
  7 | ********
  8 | ********
  9 | ********
 10 | ***..***
 11 | ***..***
 12 | ********
 13 | ********
 14 | ********
 15 | } all_pentaminos_nosym
 16 | 
 17 | # count dlx p1  # => 65 x 8 = 520
 18 | 
 19 | ##############################################################################
 20 | problem p2 = {
 21 | ********
 22 | ********
 23 | ***..***
 24 | ***..***
 25 | ********
 26 | ********
 27 | ********
 28 | ********
 29 | } all_pentaminos
 30 | 
 31 | # count dlx p2  # => 768 x 2 = 1536
 32 | 
 33 | ##############################################################################
 34 | problem p3 = {
 35 | ********
 36 | ********
 37 | **..****
 38 | **..****
 39 | ********
 40 | ********
 41 | ********
 42 | ********
 43 | } all_pentaminos
 44 | 
 45 | # count dlx p3  # => 1164
 46 | 
 47 | ##############################################################################
 48 | problem p4 = {
 49 | ********
 50 | ***..***
 51 | ***..***
 52 | ********
 53 | ********
 54 | ********
 55 | ********
 56 | ********
 57 | } all_pentaminos
 58 | 
 59 | # count dlx p4  # => 1442
 60 | 
 61 | ##############################################################################
 62 | problem p5 = {
 63 | ********
 64 | **..****
 65 | **..****
 66 | ********
 67 | ********
 68 | ********
 69 | ********
 70 | ********
 71 | } all_pentaminos
 72 | 
 73 | # count dlx p5  # => 1662
 74 | 
 75 | ##############################################################################
 76 | problem p6 = {
 77 | ********
 78 | *..*****
 79 | *..*****
 80 | ********
 81 | ********
 82 | ********
 83 | ********
 84 | ********
 85 | } all_pentaminos
 86 | 
 87 | # count dlx p6  # => 987 x 2 = 1974
 88 | 
 89 | ##############################################################################
 90 | problem p7 = {
 91 | ***..***
 92 | ***..***
 93 | ********
 94 | ********
 95 | ********
 96 | ********
 97 | ********
 98 | ********
 99 | } all_pentaminos
100 | 
101 | # count dlx p7  # => 2576
102 | 
103 | ##############################################################################
104 | problem p8 = {
105 | **..****
106 | **..****
107 | ********
108 | ********
109 | ********
110 | ********
111 | ********
112 | ********
113 | } all_pentaminos
114 | 
115 | # count dlx p8  # => 1839
116 | 
117 | ##############################################################################
118 | problem p9 = {
119 | *..*****
120 | *..*****
121 | ********
122 | ********
123 | ********
124 | ********
125 | ********
126 | ********
127 | } all_pentaminos
128 | 
129 | # count dlx p9  # => 3207
130 | 
131 | ##############################################################################
132 | problem p10 = {
133 | ..******
134 | ..******
135 | ********
136 | ********
137 | ********
138 | ********
139 | ********
140 | ********
141 | } all_pentaminos
142 | 
143 | # count dlx p10  # => 10054
144 | 
145 | 
146 | ##############################################################################
147 | problem p11 = {
148 | ********
149 | *.****.*
150 | ********
151 | ********
152 | ********
153 | ********
154 | *.****.*
155 | ********
156 | } all_pentaminos
157 | 
158 | # count dlx p11  # => 188 x 8 = 1504
159 | 
160 | ##############################################################################
161 | problem p12 = {
162 | ********
163 | ********
164 | **.**.**
165 | ********
166 | ********
167 | **.**.**
168 | ********
169 | ********
170 | } all_pentaminos
171 | 
172 | # count dlx p12  # => 21 x 8 = 168
173 | 
174 | ##############################################################################
175 | problem p13 = {
176 | .******.
177 | ********
178 | ********
179 | ********
180 | ********
181 | ********
182 | ********
183 | .******.
184 | } all_pentaminos
185 | 
186 | # count dlx p13  # => 2170 x 8 = 17360
187 | 
188 | ##############################################################################
189 | problem p14 = {
190 | ********
191 | ********
192 | ***.****
193 | *****.**
194 | **.*****
195 | ****.***
196 | ********
197 | ********
198 | } all_pentaminos
199 | 
200 | # count dlx p14  # => 504
201 | 
202 | ##############################################################################
203 | problem p15 = {
204 | ********
205 | ********
206 | **.*****
207 | ***.****
208 | ****.***
209 | *****.**
210 | ********
211 | ********
212 | } all_pentaminos
213 | 
214 | # count dlx p15  # => 74 x 4 = 296
215 | 
216 | ##############################################################################
217 | problem penta_t = {
218 | *********
219 | *********
220 | *********
221 | ...***...
222 | ...***...
223 | ...***...
224 | ...***...
225 | ...***...
226 | ...***...
227 | } some_pentaminos
228 | 
229 | solve dlx penta_t svg "solutions/penta_t.svg"
230 | # count dlx penta_t  # => 764
231 | 
232 | ##############################################################################
233 | problem penta_12_5 = constant 12x5 true all_pentaminos
234 | solve dlx penta_12_5 svg "solutions/penta_12_5.svg"
235 | # count dlx penta_12_5  # => 4040
236 | 
237 | ##############################################################################
238 | problem penta_10_6 = constant 10x6 true all_pentaminos
239 | solve dlx penta_10_6 svg "solutions/penta_10_6.svg"
240 | # count dlx penta_10_6 # => 9356
241 | 
242 | ##############################################################################
243 | problem penta_15_4 = constant 15x4 true all_pentaminos
244 | solve dlx penta_15_4 svg "solutions/penta_15_4.svg"
245 | # count dlx penta_15_4 # => 1472
246 | 
247 | ##############################################################################
248 | problem penta_5_5 = constant 5x5 true some_pentaminos
249 | solve dlx penta_5_5 svg "solutions/penta_5_5.svg"
250 | # count zdd penta_5_5 # => 856
251 | 
252 | 
253 | 
254 | 
255 | 
256 | 


--------------------------------------------------------------------------------
/examples/cmb/pentacubes.cmb:
--------------------------------------------------------------------------------
  1 | 
  2 | # The 29 pentacubes
  3 | 
  4 | # first the 12 pentaminos
  5 | 
  6 | pattern3 I = [{
  7 | *****
  8 | }]
  9 | 
 10 | pattern3 V = [{
 11 | ***
 12 | *
 13 | *
 14 | }]
 15 | 
 16 | pattern3 Z = [{
 17 | .**
 18 | .*
 19 | **
 20 | }]
 21 | 
 22 | pattern3 P = [{
 23 | ***
 24 | **
 25 | }]
 26 | 
 27 | pattern3 N = [{
 28 | ***.
 29 | ..**
 30 | }]
 31 | 
 32 | pattern3 W = [{
 33 | .**
 34 | **
 35 | *
 36 | }]
 37 | 
 38 | pattern3 Y = [{
 39 | ****
 40 | .*
 41 | }]
 42 | 
 43 | pattern3 T = [{
 44 | ***
 45 | .*
 46 | .*
 47 | }]
 48 | 
 49 | pattern3 F = [{
 50 | .**
 51 | **
 52 | .*
 53 | }]
 54 | 
 55 | pattern3 U = [{
 56 | ***
 57 | *.*
 58 | }]
 59 | 
 60 | pattern3 L = [{
 61 | ****
 62 | *
 63 | }]
 64 | 
 65 | pattern3 X = [{
 66 | .*.
 67 | ***
 68 | .*.
 69 | }]
 70 | 
 71 | # then the 3D ones
 72 | 
 73 | pattern3 P1L = [{
 74 | .*
 75 | .*
 76 | **
 77 | },{
 78 | ..
 79 | ..
 80 | *.
 81 | }]
 82 | 
 83 | pattern3 P1R = [{
 84 | *.
 85 | *.
 86 | **
 87 | },{
 88 | ..
 89 | ..
 90 | .*
 91 | }]
 92 | 
 93 | pattern3 P2L = [{
 94 | .*
 95 | .*
 96 | **
 97 | },{
 98 | ..
 99 | .*
100 | ..
101 | }]
102 | 
103 | pattern3 P2R = [{
104 | *.
105 | *.
106 | **
107 | },{
108 | ..
109 | *.
110 | ..
111 | }]
112 | 
113 | pattern3 P3L = [{
114 | .*
115 | .*
116 | **
117 | },{
118 | .*
119 | ..
120 | ..
121 | }]
122 | 
123 | pattern3 P3R = [{
124 | *.
125 | *.
126 | **
127 | },{
128 | *.
129 | ..
130 | ..
131 | }]
132 | 
133 | pattern3 P4L = [{
134 | .*
135 | **
136 | *.
137 | },{
138 | .*
139 | ..
140 | ..
141 | }]
142 | 
143 | pattern3 P4R = [{
144 | *.
145 | **
146 | .*
147 | },{
148 | *.
149 | ..
150 | ..
151 | }]
152 | 
153 | pattern3 P5L = [{
154 | .*
155 | **
156 | *.
157 | },{
158 | ..
159 | *.
160 | ..
161 | }]
162 | 
163 | pattern3 P5R = [{
164 | *.
165 | **
166 | .*
167 | },{
168 | ..
169 | .*
170 | ..
171 | }]
172 | 
173 | pattern3 P6L = [{
174 | ..
175 | **
176 | *.
177 | },{
178 | .*
179 | .*
180 | ..
181 | }]
182 | 
183 | pattern3 P6R = [{
184 | ..
185 | **
186 | .*
187 | },{
188 | *.
189 | *.
190 | ..
191 | }]
192 | 
193 | pattern3 P7 = [{
194 | .*.
195 | ***
196 | },{
197 | .*.
198 | ...
199 | }]
200 | 
201 | pattern3 P8 = [{
202 | ***
203 | .*.
204 | },{
205 | .*.
206 | ...
207 | }]
208 | 
209 | pattern3 P9 = [{
210 | ***
211 | *..
212 | },{
213 | *..
214 | ...
215 | }]
216 | 
217 | pattern3 P10 = [{
218 | **
219 | **
220 | },{
221 | .*
222 | ..
223 | }]
224 | 
225 | pattern3 P11 = [{
226 | *.
227 | **
228 | },{
229 | *.
230 | .*
231 | }]
232 | 
233 | ### sets of tiles ###########################################################
234 | 
235 | tiles3 all_pentacubes =
236 | [ L   ~one ~sym, T   ~one ~sym, V ~one ~sym, N ~one ~sym,
237 |   Z   ~one ~sym, F   ~one ~sym, X ~one ~sym, W ~one ~sym,
238 |   P   ~one ~sym, I   ~one ~sym, Y ~one ~sym, U ~one ~sym,
239 |   P1L ~one ~sym, P1R ~one ~sym,
240 |   P2L ~one ~sym, P2R ~one ~sym,
241 |   P3L ~one ~sym, P3R ~one ~sym,
242 |   P4L ~one ~sym, P4R ~one ~sym,
243 |   P5L ~one ~sym, P5R ~one ~sym,
244 |   P6L ~one ~sym, P6R ~one ~sym,
245 |   P7  ~one ~sym,
246 |   P8  ~one ~sym,
247 |   P9  ~one ~sym,
248 |   P10 ~one ~sym,
249 |   P11 ~one ~sym
250 |  ]
251 | 
252 | tiles3 some_pentacubes =
253 | [ L   ~maybe ~sym, T   ~maybe ~sym, V ~maybe ~sym, N ~maybe ~sym,
254 |   Z   ~maybe ~sym, F   ~maybe ~sym, X ~maybe ~sym, W ~maybe ~sym,
255 |   P   ~maybe ~sym, I   ~maybe ~sym, Y ~maybe ~sym, U ~maybe ~sym,
256 |   P1L ~maybe ~sym, P1R ~maybe ~sym,
257 |   P2L ~maybe ~sym, P2R ~maybe ~sym,
258 |   P3L ~maybe ~sym, P3R ~maybe ~sym,
259 |   P4L ~maybe ~sym, P4R ~maybe ~sym,
260 |   P5L ~maybe ~sym, P5R ~maybe ~sym,
261 |   P6L ~maybe ~sym, P6R ~maybe ~sym,
262 |   P7  ~maybe ~sym,
263 |   P8  ~maybe ~sym,
264 |   P9  ~maybe ~sym,
265 |   P10 ~maybe ~sym,
266 |   P11 ~maybe ~sym
267 | ]
268 | 
269 | ### problems #############################################################
270 | 
271 | debug on
272 | timing on
273 | 
274 | pattern3 one_cube = [{
275 | ***
276 | ***
277 | ***
278 | },{
279 | ***
280 | *.*
281 | ***
282 | },{
283 | ***
284 | *.*
285 | ***
286 | }]
287 | 
288 | problem3 one_cube = one_cube some_pentacubes
289 | 
290 | all3 dlx one_cube
291 | 
292 | pattern3 two_cubes = [{
293 | ***.***
294 | ***.***
295 | ***.***
296 | },{
297 | ***.***
298 | *.*.*.*
299 | ***.***
300 | },{
301 | ***.***
302 | *.*.*.*
303 | ***.***
304 | }]
305 | 
306 | problem3 two_cubes = two_cubes some_pentacubes
307 | 
308 | # solve3 dlx two_cubes ascii
309 | 
310 | pattern3 three_cubes = [{
311 | ***.***.***
312 | ***.***.***
313 | ***.***.***
314 | },{
315 | ***.***.***
316 | *.*.*.*.*.*
317 | ***.***.***
318 | },{
319 | ***.***.***
320 | *.*.*.*.*.*
321 | ***.***.***
322 | }]
323 | 
324 | problem3 three_cubes = three_cubes some_pentacubes
325 | 
326 | # solve3 dlx three_cubes ascii
327 | 
328 | pattern3 four_cubes = [{
329 | ***.***.***.***
330 | ***.***.***.***
331 | ***.***.***.***
332 | },{
333 | ***.***.***.***
334 | *.*.*.*.*.*.*.*
335 | ***.***.***.***
336 | },{
337 | ***.***.***.***
338 | *.*.*.*.*.*.*.*
339 | ***.***.***.***
340 | }]
341 | 
342 | problem3 four_cubes = four_cubes some_pentacubes
343 | 
344 | # solve3 dlx four_cubes ascii
345 | 
346 | pattern3 five_cubes = [{
347 | ***.***.***.***.***
348 | ***.***.***.***.***
349 | ***.***.***.***.***
350 | },{
351 | ***.***.***.***.***
352 | *.*.*.*.*.*.*.*.*.*
353 | ***.***.***.***.***
354 | },{
355 | ***.***.***.***.***
356 | *.*.*.*.*.*.*.*.*.*
357 | ***.***.***.***.***
358 | }]
359 | 
360 | problem3 five_cubes = five_cubes some_pentacubes
361 | 
362 | # solve3 dlx five_cubes ascii
363 | 
364 | # Local Variables:
365 | # compile-command: "../../src/main.exe pentacubes.cmb"
366 | # End:
367 | 


--------------------------------------------------------------------------------
/examples/cmb/pentaminos.cmb:
--------------------------------------------------------------------------------
 1 | 
 2 | # The 12 pentaminos
 3 | #
 4 | # See for instance http://fr.wikipedia.org/wiki/Pentamino
 5 | # Tiling problems involving the pentaminos can be found in penta.cmb
 6 | 
 7 | 
 8 | pattern I = {
 9 | *****
10 | }
11 | 
12 | pattern V = {
13 | ***
14 | *
15 | *
16 | }
17 | 
18 | pattern Z = {
19 | .**
20 | .*
21 | **
22 | }
23 | 
24 | pattern P = {
25 | ***
26 | **
27 | }
28 | 
29 | pattern N = {
30 | ***.
31 | ..**
32 | }
33 | 
34 | pattern W = {
35 | .**
36 | **
37 | *
38 | }
39 | 
40 | pattern Y = {
41 | ****
42 | .*
43 | }
44 | 
45 | pattern T = {
46 | ***
47 | .*
48 | .*
49 | }
50 | 
51 | pattern F = {
52 | .**
53 | **
54 | .*
55 | }
56 | 
57 | pattern U = {
58 | ***
59 | *.*
60 | }
61 | 
62 | pattern L = {
63 | ****
64 | *
65 | }
66 | pattern X = {
67 | .*.
68 | ***
69 | .*.
70 | }
71 | 
72 | tiles all_pentaminos =
73 | [ L ~one ~sym, T ~one ~sym, V ~one ~sym, N ~one ~sym,
74 |   Z ~one ~sym, F ~one ~sym, X ~one ~sym, W ~one ~sym,
75 |   P ~one ~sym, I ~one ~sym, Y ~one ~sym, U ~one ~sym ]
76 | 
77 | tiles all_pentaminos_nosym =
78 | [ L ~one ~sym, T ~one ~sym, V ~one ~sym, N ~one ~sym,
79 |   Z ~one ~sym, F ~one     , X ~one ~sym, W ~one ~sym,
80 |   P ~one ~sym, I ~one ~sym, Y ~one ~sym, U ~one ~sym ]
81 | 
82 | tiles some_pentaminos =
83 | [ L ~maybe ~sym, T ~maybe ~sym, V ~maybe ~sym, N ~maybe ~sym,
84 |   Z ~maybe ~sym, F ~maybe ~sym, X ~maybe ~sym, W ~maybe ~sym,
85 |   P ~maybe ~sym, I ~maybe ~sym, Y ~maybe ~sym, U ~maybe ~sym ]
86 | 
87 | 


--------------------------------------------------------------------------------
/examples/cmb/pyth-3-4-5.cmb:
--------------------------------------------------------------------------------
 1 | debug on
 2 | 
 3 | timing on
 4 | 
 5 | pattern p_3_1 = {
 6 | *
 7 | }
 8 | 
 9 | pattern p_3_2 = {
10 | **
11 | *
12 | }
13 | 
14 | pattern p_3_3 = {
15 | ***
16 | *
17 | *
18 | }
19 | 
20 | pattern p_4_1 = {
21 | *
22 | }
23 | 
24 | pattern p_4_2 = {
25 | **
26 | *
27 | }
28 | 
29 | pattern p_4_3 = {
30 | ***
31 | *
32 | *
33 | }
34 | 
35 | pattern p_4_4 = {
36 | ****
37 | *
38 | *
39 | *
40 | }
41 | 
42 | tiles all_tiles =
43 | [ p_3_1 ~one ~sym, p_3_2 ~one ~sym, p_3_3 ~one ~sym, p_4_1 ~one ~sym,
44 | p_4_2 ~one ~sym, p_4_3 ~one ~sym, p_4_4 ~one ~sym]
45 | 
46 | problem pbm5 = {
47 | *****
48 | *****
49 | *****
50 | *****
51 | *****
52 | } all_tiles
53 | 
54 | solve dlx pbm5 svg "solutions/pyth-3-4-5.svg"
55 | # count dlx pbm5
56 | # pbm5 : (DLX) 640 solutions
57 | # pbm5 solutions counted in 0.003658s
58 | 
59 | 


--------------------------------------------------------------------------------
/examples/cmb/pyth-5-12-13.cmb:
--------------------------------------------------------------------------------
  1 | debug on
  2 | 
  3 | timing on
  4 | 
  5 | pattern p_5_1 = {
  6 | *
  7 | }
  8 | 
  9 | pattern p_5_2 = {
 10 | **
 11 | *
 12 | }
 13 | 
 14 | pattern p_5_3 = {
 15 | ***
 16 | *
 17 | *
 18 | }
 19 | 
 20 | pattern p_5_4 = {
 21 | ****
 22 | *
 23 | *
 24 | *
 25 | }
 26 | 
 27 | pattern p_5_5 = {
 28 | *****
 29 | *
 30 | *
 31 | *
 32 | *
 33 | }
 34 | 
 35 | pattern p_12_1 = {
 36 | *
 37 | }
 38 | 
 39 | pattern p_12_2 = {
 40 | **
 41 | *
 42 | }
 43 | 
 44 | pattern p_12_3 = {
 45 | ***
 46 | *
 47 | *
 48 | }
 49 | 
 50 | pattern p_12_4 = {
 51 | ****
 52 | *
 53 | *
 54 | *
 55 | }
 56 | 
 57 | pattern p_12_5 = {
 58 | *****
 59 | *
 60 | *
 61 | *
 62 | *
 63 | }
 64 | 
 65 | pattern p_12_6 = {
 66 | ******
 67 | *
 68 | *
 69 | *
 70 | *
 71 | *
 72 | }
 73 | 
 74 | pattern p_12_7 = {
 75 | *******
 76 | *
 77 | *
 78 | *
 79 | *
 80 | *
 81 | *
 82 | }
 83 | 
 84 | pattern p_12_8 = {
 85 | ********
 86 | *
 87 | *
 88 | *
 89 | *
 90 | *
 91 | *
 92 | *
 93 | }
 94 | 
 95 | pattern p_12_9 = {
 96 | *********
 97 | *
 98 | *
 99 | *
100 | *
101 | *
102 | *
103 | *
104 | *
105 | }
106 | 
107 | pattern p_12_10 = {
108 | **********
109 | *
110 | *
111 | *
112 | *
113 | *
114 | *
115 | *
116 | *
117 | *
118 | }
119 | 
120 | pattern p_12_11 = {
121 | ***********
122 | *
123 | *
124 | *
125 | *
126 | *
127 | *
128 | *
129 | *
130 | *
131 | *
132 | }
133 | 
134 | pattern p_12_12 = {
135 | ************
136 | *
137 | *
138 | *
139 | *
140 | *
141 | *
142 | *
143 | *
144 | *
145 | *
146 | *
147 | }
148 | 
149 | tiles all_tiles =
150 | [ p_5_1 ~one ~sym, p_5_2 ~one ~sym, p_5_3 ~one ~sym, p_5_4 ~one ~sym,
151 | p_5_5 ~one ~sym, p_12_1 ~one ~sym, p_12_2 ~one ~sym, p_12_3 ~one ~sym,
152 | p_12_4 ~one ~sym, p_12_5 ~one ~sym, p_12_6 ~one ~sym, p_12_7 ~one ~sym,
153 | p_12_8 ~one ~sym, p_12_9 ~one ~sym, p_12_10 ~one ~sym, p_12_11 ~one ~sym,
154 | p_12_12 ~one ~sym]
155 | 
156 | problem pbm13 = {
157 | *************
158 | *************
159 | *************
160 | *************
161 | *************
162 | *************
163 | *************
164 | *************
165 | *************
166 | *************
167 | *************
168 | *************
169 | *************
170 | } all_tiles
171 | 
172 | solve dlx pbm13 svg "solutions/pyth-5-12-13.svg"
173 | # count dlx pbm13
174 | # pbm13 : (DLX) 1276672 solutions
175 | # pbm13 solutions counted in 158.109695s
176 | 
177 | 


--------------------------------------------------------------------------------
/examples/cmb/pyth-6-8-10.cmb:
--------------------------------------------------------------------------------
  1 | debug on
  2 | 
  3 | timing on
  4 | 
  5 | pattern p_6_1 = {
  6 | *
  7 | }
  8 | 
  9 | pattern p_6_2 = {
 10 | **
 11 | *
 12 | }
 13 | 
 14 | pattern p_6_3 = {
 15 | ***
 16 | *
 17 | *
 18 | }
 19 | 
 20 | pattern p_6_4 = {
 21 | ****
 22 | *
 23 | *
 24 | *
 25 | }
 26 | 
 27 | pattern p_6_5 = {
 28 | *****
 29 | *
 30 | *
 31 | *
 32 | *
 33 | }
 34 | 
 35 | pattern p_6_6 = {
 36 | ******
 37 | *
 38 | *
 39 | *
 40 | *
 41 | *
 42 | }
 43 | 
 44 | pattern p_8_1 = {
 45 | *
 46 | }
 47 | 
 48 | pattern p_8_2 = {
 49 | **
 50 | *
 51 | }
 52 | 
 53 | pattern p_8_3 = {
 54 | ***
 55 | *
 56 | *
 57 | }
 58 | 
 59 | pattern p_8_4 = {
 60 | ****
 61 | *
 62 | *
 63 | *
 64 | }
 65 | 
 66 | pattern p_8_5 = {
 67 | *****
 68 | *
 69 | *
 70 | *
 71 | *
 72 | }
 73 | 
 74 | pattern p_8_6 = {
 75 | ******
 76 | *
 77 | *
 78 | *
 79 | *
 80 | *
 81 | }
 82 | 
 83 | pattern p_8_7 = {
 84 | *******
 85 | *
 86 | *
 87 | *
 88 | *
 89 | *
 90 | *
 91 | }
 92 | 
 93 | pattern p_8_8 = {
 94 | ********
 95 | *
 96 | *
 97 | *
 98 | *
 99 | *
100 | *
101 | *
102 | }
103 | 
104 | tiles all_tiles =
105 | [ p_6_1 ~one ~sym, p_6_2 ~one ~sym, p_6_3 ~one ~sym, p_6_4 ~one ~sym,
106 | p_6_5 ~one ~sym, p_6_6 ~one ~sym, p_8_1 ~one ~sym, p_8_2 ~one ~sym,
107 | p_8_3 ~one ~sym, p_8_4 ~one ~sym, p_8_5 ~one ~sym, p_8_6 ~one ~sym,
108 | p_8_7 ~one ~sym, p_8_8 ~one ~sym]
109 | 
110 | problem pbm10 = {
111 | **********
112 | **********
113 | **********
114 | **********
115 | **********
116 | **********
117 | **********
118 | **********
119 | **********
120 | **********
121 | } all_tiles
122 | 
123 | solve dlx pbm10 svg "solutions/pyth-6-8-10.svg"
124 | # count dlx pbm10
125 | # pbm10 : (DLX) 522752 solutions
126 | # pbm10 solutions counted in 121.210053s
127 | 


--------------------------------------------------------------------------------
/examples/cmb/pyth.ml:
--------------------------------------------------------------------------------
 1 | 
 2 | (* Given a Pythagorean triple (a,b,c), with a < b < c,
 3 |    tile a c*c square using the hooks (L shapes) from the two
 4 |    squares a*a and b*b *)
 5 | 
 6 | open Format
 7 | 
 8 | (*
 9 |    primitive Pythagorean triples are generated using
10 |      a = 2mn
11 |      b = (m^2 - n^2)
12 |      c = (m^2 + n^2)
13 | *)
14 | 
15 | let n = int_of_string Sys.argv.(1)
16 | let m = int_of_string Sys.argv.(2)
17 | let f = try int_of_string Sys.argv.(3) with _ -> 1
18 | 
19 | let rec gcd n m = if m = 0 then n else gcd m (n mod m)
20 | let gcd n m = if n > m then gcd n m else gcd m n
21 | 
22 | let () = assert (n < m)
23 | let () = assert (n mod 2 <> m mod 2)
24 | let () = assert (gcd n m = 1)
25 | 
26 | let a = f * 2*m*n
27 | let b = f * (m*m - n*n)
28 | let c = f * (m*m + n*n)
29 | let a = min a b and b = max a b
30 | let () = printf "%d %d %d@." a b c
31 | 
32 | let file = sprintf "pyth-%d-%d-%d.cmb" a b c
33 | let cout = open_out file
34 | let fmt = formatter_of_out_channel cout
35 | let () = fprintf fmt "debug on@\n@\n"
36 | let () = fprintf fmt "timing on@\n@\n"
37 | 
38 | let hooks n =
39 |   for k = 1 to n do
40 |     fprintf fmt "pattern p_%d_%d = {@\n" n k;
41 |     fprintf fmt "%s@\n" (String.make k '*');
42 |     for i = 1 to k - 1 do fprintf fmt "*@\n" done;
43 |     fprintf fmt "}@\n@\n"
44 |   done
45 | 
46 | let () = hooks a; hooks b
47 | 
48 | let () =
49 |   fprintf fmt "@[tiles all_tiles =@\n[ ";
50 |   let tiles n =
51 |     for k = 1 to n do
52 |       fprintf fmt "p_%d_%d ~one ~sym" n k;
53 |       if k < n then fprintf fmt ",@ "
54 |     done in
55 |   tiles a; fprintf fmt ",@ ";
56 |   tiles b; fprintf fmt "]@]@\n@\n"
57 | 
58 | let () =
59 |   fprintf fmt "problem pbm%d = {@\n" c;
60 |   for k = 1 to c do fprintf fmt "%s@\n" (String.make c '*') done;
61 |   fprintf fmt "} all_tiles@\n@\n";
62 |   fprintf fmt "solve dlx pbm%d svg \"solutions/pyth-%d-%d-%d.svg\"@\n" c a b c;
63 |   fprintf fmt "# count dlx pbm%d@\n" c
64 | 
65 | let () =
66 |   fprintf fmt "@."; close_out cout
67 | 
68 | 
69 | 


--------------------------------------------------------------------------------
/examples/cmb/sandbox.cmb:
--------------------------------------------------------------------------------
 1 | pattern chessboard = constant 2x2 true
 2 | 
 3 | pattern a = {**}
 4 | 
 5 | problem test = chessboard [a ~one ~sym ~maybe, {**} ~maybe ~sym]
 6 | 
 7 | assert {***} = {***}
 8 | 
 9 | solve dlx test ascii
10 | 
11 | 


--------------------------------------------------------------------------------
/examples/cmb/scott.cmb:
--------------------------------------------------------------------------------
 1 | ### Scott's pentaminos problem #############################################
 2 | ### we eliminate the symetries of the problem by using only one
 3 | ### orientation of pentamino F
 4 | 
 5 | include "pentaminos.cmb"
 6 | 
 7 | pattern scott_board = {
 8 | ********
 9 | ********
10 | ********
11 | ***..***
12 | ***..***
13 | ********
14 | ********
15 | ********
16 | }
17 | 
18 | problem scott_problem = scott_board all_pentaminos_nosym
19 | 
20 | # print scott_problem
21 | 
22 | timing on
23 | 
24 | # solve dlx scott_problem svg "solutions/scott.svg"
25 | 
26 | solve dlx scott_problem ascii
27 | count dlx scott_problem
28 | 
29 | # solve sat "minisat2" scott_problem svg "solutions/scott2.svg"
30 | 
31 | # solve equal_size scott_problem ascii
32 | # count equal_size scott_problem
33 | 
34 | # Local Variables:
35 | # compile-command: "../../src/main.exe scott.cmb"
36 | # End:
37 | 
38 | 


--------------------------------------------------------------------------------
/examples/cmb/stephane.cmb:
--------------------------------------------------------------------------------
  1 | 
  2 | # A 3D puzzle suggested by Stéphane Gonnord
  3 | 
  4 | pattern3 P1 = [{
  5 | **.
  6 | ...
  7 | },{
  8 | ...
  9 | ..*
 10 | }]
 11 | 
 12 | pattern3 P4 = [{
 13 | .**
 14 | ...
 15 | },{
 16 | ...
 17 | *..
 18 | }]
 19 | 
 20 | pattern3 P2 = [{
 21 | *..
 22 | ...
 23 | ...
 24 | },{
 25 | ...
 26 | .*.
 27 | ...
 28 | },{
 29 | ...
 30 | ...
 31 | ..*
 32 | }]
 33 | 
 34 | pattern3 P3 = [{
 35 | *..
 36 | .**
 37 | *..
 38 | },{
 39 | ..*
 40 | ...
 41 | ...
 42 | }]
 43 | 
 44 | pattern3 P5 = [{
 45 | *..
 46 | *..
 47 | },{
 48 | .**
 49 | ...
 50 | },{
 51 | ...
 52 | ..*
 53 | }]
 54 | 
 55 | pattern3 P6 = [{
 56 | ***
 57 | ...
 58 | ...
 59 | },{
 60 | *..
 61 | *..
 62 | ...
 63 | },{
 64 | ...
 65 | ...
 66 | .**
 67 | }]
 68 | 
 69 | 
 70 | ### sets of tiles ###########################################################
 71 | 
 72 | tiles3 pieces =
 73 | [ P1 ~one ~rot, P2 ~one ~rot, P3 ~one ~rot,
 74 |   P4 ~one ~rot, P5 ~one ~rot, P6 ~one ]
 75 | 
 76 | ### problem ##############################################################
 77 | 
 78 | debug on
 79 | timing on
 80 | 
 81 | pattern3 one_cube = [{
 82 | ***
 83 | ***
 84 | ***
 85 | },{
 86 | ***
 87 | **.
 88 | ***
 89 | },{
 90 | ***
 91 | ***
 92 | ***
 93 | }]
 94 | 
 95 | problem3 one_cube = one_cube pieces
 96 | 
 97 | solve3 dlx one_cube ascii # svg "stephane.svg"
 98 | all3 dlx one_cube
 99 | 
100 | # Local Variables:
101 | # compile-command: "../../src/main.exe stephane.cmb"
102 | # End:
103 | 


--------------------------------------------------------------------------------
/examples/cmb/test_sudoku.txt:
--------------------------------------------------------------------------------
 1 | 000206003
 2 | 060080000
 3 | 071003000
 4 | 006000910
 5 | 007809600
 6 | 024000800
 7 | 000100540
 8 | 000030080
 9 | 200608000
10 | 


--------------------------------------------------------------------------------
/examples/cmb/tetro.cmb:
--------------------------------------------------------------------------------
 1 | 
 2 | include "tetrominoes.cmb"
 3 | 
 4 | problem p4x10 = {
 5 | **********
 6 | **********
 7 | **********
 8 | **********
 9 | } all_tetrominoes_twice
10 | 
11 | count dlx p4x10 # 57472
12 | 
13 | problem p5x8 = {
14 | ********
15 | ********
16 | ********
17 | ********
18 | ********
19 | } all_tetrominoes_twice
20 | 
21 | count dlx p5x8 # 99392
22 | 
23 | 
24 | 
25 | 


--------------------------------------------------------------------------------
/examples/cmb/tetrominoes.cmb:
--------------------------------------------------------------------------------
 1 | 
 2 | # The 5 tetrominoes
 3 | #
 4 | # See for instance http://en.wikipedia.org/wiki/Tetromino
 5 | # Tiling problems involving the tetrominoes can be found in tetro.cmb
 6 | 
 7 | 
 8 | pattern I = {
 9 | ****
10 | }
11 | 
12 | pattern O = {
13 | **
14 | **
15 | }
16 | 
17 | pattern T = {
18 | ***
19 | .*.
20 | }
21 | 
22 | pattern L = {
23 | ***
24 | *..
25 | }
26 | 
27 | pattern S = {
28 | .**
29 | **.
30 | }
31 | 
32 | tiles all_tetrominoes =
33 | [ I ~one ~sym, O ~one ~sym, T ~one ~sym, L ~one ~sym, S ~one ~sym ]
34 | 
35 | tiles all_tetrominoes_twice =
36 | [ I ~one ~sym, O ~one ~sym, T ~one ~sym, L ~one ~sym, S ~one ~sym,
37 |   I ~one ~sym, O ~one ~sym, T ~one ~sym, L ~one ~sym, S ~one ~sym ]
38 | 
39 | tiles all_tetrominoes_nosym =
40 | [ I ~one ~sym, O ~one ~sym, T ~one ~sym, L ~one ~sym, S ~one ]
41 | 
42 | tiles some_tetrominoes =
43 | [ I ~maybe ~sym, O ~maybe ~sym, T ~maybe ~sym, L ~maybe ~sym, S ~maybe ~sym ]
44 | 
45 | 


--------------------------------------------------------------------------------
/examples/lib/backslide.ml:
--------------------------------------------------------------------------------
 1 | open Printf
 2 | open Combine
 3 | 
 4 | type btile = {n : bool; e : bool; s : bool; w : bool;}
 5 | 
 6 | 
 7 | let empty = {n = false; e = false; s = false; w = false;}
 8 | 
 9 | let print fmt t = fprintf fmt "(%B, %B, %B, %B)" t.n t.e t.s t.w
10 | let print_tiles = List.iter (printf "%a\n" print)
11 | 
12 | let print_line line =
13 |   Array.iteri (fun i e ->
14 |     let v = if e then 1 else 0 in
15 |     printf "%d" v;
16 |     if (i + 1) mod 4 = 0 then printf " ";
17 |     (* if (i + 1) mod 16 = 0 then printf "\n"; *)
18 |   ) line
19 | let print_matrix = Array.iter (fun e -> print_line e; printf "\n")
20 | 
21 | let xorr a b = a && not b || not a && b, a && b
22 | 
23 | let bsucc t =
24 |   let n, r  = xorr t.n true in
25 |   let e, r = xorr t.e r in
26 |   let s, r = xorr t.s r in
27 |   let w, _ = xorr t.w r in
28 |   {n; e; s; w}
29 | 
30 | 
31 | let build_tiles n =
32 |   let rec build n = function
33 |     | [] -> build n [empty]
34 |     | h :: _ as l -> if n = 0 then l
35 |       else build (n - 1) ((bsucc h) :: l)
36 |   in build n []
37 | 
38 | let length = 16
39 | let w = 4
40 | 
41 | let line tile t x y =
42 |   let a = Array.make ((w + 1) * length) false in
43 |   a.(tile) <- true;
44 |   if t.n && y <= 0 || t.e &&  x >= w - 1 || t.s && y >= w - 1 || t.w && x <= 0
45 |   then None
46 |   else begin
47 |     if t.n then a.((((y - 1) * w) + x) * 4 + 2 + length) <- true
48 |     else a.((y * w + x) * 4 + length) <- true;
49 |     if t.e then a.((y * w + x + 1) * 4 + 3 + length) <- true
50 |     else a.((y * w + x) * 4 + 1 + length) <- true;
51 |     if t.s then a.((((y + 1) * w) + x) * 4 + length) <- true
52 |     else a.((y * w + x) * 4 + 2 + length) <- true;
53 |     if t.w then a.((y * w + x - 1) * 4 + 1 + length) <- true
54 |     else a.((y * w + x) * 4 + 3 + length) <- true;
55 |     Some a
56 |   end
57 | 
58 | 
59 | 
60 | 
61 | let emc tiles =
62 |   let rec set_lines tile accl =
63 |     let rec step h i accl =
64 |       if i = 16 then accl else
65 |         let accl = match (line tile h (i mod 4) (i / 4)) with
66 |           | Some r -> r :: accl
67 |           | None -> accl in
68 |         step h (i + 1) accl
69 |     in function | [] -> accl | h :: tail -> set_lines (tile + 1)
70 |       ((step h 0 accl)) tail
71 |   in
72 |   Array.of_list (set_lines 0 [] tiles)
73 | 
74 | let print_solution _m = List.iter (fun s ->
75 |   print_line s)
76 | 
77 | 
78 | 
79 | let () =
80 |   let tiles = build_tiles 15 in
81 |   (* print_tiles tiles; *)
82 |   let matrix = emc tiles in
83 |   (* print_matrix matrix; *)
84 |   let p = Emc.D.create matrix in
85 |   let s = Emc.D.find_solution p in
86 |   let n = List.length s in
87 |   printf "matrix : %dx%d.\n" (Array.length matrix) (Array.length matrix.(0));
88 |   printf "solution size : %d.\n" n
89 | 


--------------------------------------------------------------------------------
/examples/lib/color.ml:
--------------------------------------------------------------------------------
  1 | (**************************************************************************)
  2 | (*                                                                        *)
  3 | (*  Combine - an OCaml library for combinatorics                          *)
  4 | (*                                                                        *)
  5 | (*  Copyright (C) 2012-2014                                               *)
  6 | (*    Remy El Sibaie                                                      *)
  7 | (*    Jean-Christophe Filliatre                                           *)
  8 | (*                                                                        *)
  9 | (*  This software is free software; you can redistribute it and/or        *)
 10 | (*  modify it under the terms of the GNU Library General Public           *)
 11 | (*  License version 2.1, with the special exception on linking            *)
 12 | (*  described in file LICENSE.                                            *)
 13 | (*                                                                        *)
 14 | (*  This software is distributed in the hope that it will be useful,      *)
 15 | (*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)
 16 | (*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)
 17 | (*                                                                        *)
 18 | (**************************************************************************)
 19 | 
 20 | (* 4-coloring planar graphs using Combine
 21 | 
 22 |    requires OCamlgraph *)
 23 | 
 24 | open Graph
 25 | open Format
 26 | open Combine
 27 | 
 28 | (* command line *)
 29 | let n_ = ref 30
 30 | let prob_ = ref 0.5
 31 | let seed_ = ref None
 32 | 
 33 | let arg_spec =
 34 |   ["-v", Arg.Int (fun i -> n_ := i),
 35 |    " <int>  number of vertices";
 36 |    "-prob", Arg.Float (fun f -> prob_ := f),
 37 |    " <float>  probability to discrad an edge";
 38 |    "-seed", Arg.Int (fun n -> seed_ := Some n),
 39 |    " <int>  random seed"
 40 |   ]
 41 | let () = Arg.parse arg_spec (fun _ -> ()) "usage: color <options>"
 42 | 
 43 | let n = !n_
 44 | let prob = !prob_
 45 | 
 46 | let seed = match !seed_ with
 47 |   | None -> Random.self_init (); Random.int (1 lsl 29)
 48 |   | Some s -> s
 49 | let () = Format.printf "seed = %d@." seed; Random.init seed
 50 | 
 51 | (* undirected graphs with integer coordinates and integer labels on edges *)
 52 | 
 53 | module IntInt = struct
 54 |   type t = int * int
 55 | end
 56 | module Int = struct
 57 |   type t = int
 58 |   let compare = compare
 59 |   let hash = Hashtbl.hash
 60 |   let equal = (=)
 61 |   let default = 0
 62 | end
 63 | module G = Imperative.Graph.AbstractLabeled(IntInt)(Int)
 64 | open G
 65 | 
 66 | (* a random graph with n vertices *)
 67 | module R = Rand.Planar.I(G)
 68 | let g0 = R.graph ~xrange:(20,780) ~yrange:(20,580) ~prob n
 69 | 
 70 | (* drawing *)
 71 | let round f = truncate (f +. 0.5)
 72 | let pi = 4.0 *. atan 1.0
 73 | 
 74 | open Graphics
 75 | let () = open_graph " 800x600"
 76 | 
 77 | let vertex_radius = 5
 78 | 
 79 | let draw_edge v1 v2 =
 80 |   let (xu,yu) = G.V.label v1 in
 81 |   let (xv,yv) = G.V.label v2 in
 82 |   set_color black;
 83 |   let dx = float (xv - xu) in
 84 |   let dy = float (yv - yu) in
 85 |   let r = sqrt (dx *. dx +. dy *. dy) in
 86 |   let d = float vertex_radius +. 3. in
 87 |   let xs, ys = float xu +. d *. dx /. r, float yu +. d *. dy /. r in
 88 |   let xd, yd = float xv -. d *. dx /. r, float yv -. d *. dy /. r in
 89 |   moveto (round xs) (round ys);
 90 |   lineto (round xd) (round yd)
 91 | 
 92 | let draw_vertex v =
 93 |   let (x,y) = G.V.label v in
 94 |   set_color red;
 95 |   draw_circle x y vertex_radius
 96 | 
 97 | let color_vertex v color =
 98 |   let x,y = G.V.label v in
 99 |   set_color color;
100 |   fill_circle x y vertex_radius
101 | 
102 | let draw_graph () =
103 |   clear_graph ();
104 |   set_color red;
105 |   set_line_width 1;
106 |   G.iter_vertex draw_vertex g0;
107 |   G.iter_edges draw_edge g0
108 | 
109 | let cols = [| white; red; green; blue; yellow; black |]
110 | 
111 | module Hv2 = Hashtbl.Make(
112 |   struct
113 |     type t = G.V.t * G.V.t
114 |     let equal (a,b) (c,d) = G.V.equal a c && G.V.equal b d
115 |     let hash (a,b) = (G.V.hash a + G.V.hash b) land max_int
116 |   end)
117 | 
118 | let num_edge =
119 |   let r = ref (-1) in
120 |   let h = Hv2.create 17 in
121 |   fun a b ->
122 |     let e = if V.compare a b < 0 then a, b else b, a in
123 |     try Hv2.find h e with Not_found -> incr r; Hv2.add h e !r; !r
124 | 
125 | let vertexi = Hashtbl.create 17
126 | 
127 | let emc_coloring () =
128 |   let v = nb_vertex g0 in
129 |   let e = nb_edges g0 in
130 |   Format.eprintf "V = %d@." v;
131 |   Format.eprintf "E = %d@." e;
132 |   let emc = Array.make (4*v) [] in
133 |   let set j i = emc.(j) <- i :: emc.(j) in
134 |   let i = ref 0 in
135 |   let add_vertex a =
136 |     Hashtbl.add vertexi !i a;
137 |     let j = 4 * !i in
138 |     set j     !i;
139 |     set (j+1) !i;
140 |     set (j+2) !i;
141 |     set (j+3) !i;
142 |     let add_edge b =
143 |       let c = v + 4 * num_edge a b in
144 |       set (j  ) (c  );
145 |       set (j+1) (c+1);
146 |       set (j+2) (c+2);
147 |       set (j+3) (c+3)
148 |     in
149 |     G.iter_succ add_edge g0 a;
150 |     incr i
151 |   in
152 |   G.iter_vertex add_vertex g0;
153 |   (* Format.eprintf "%a@." Emc.print_boolean_matrix emc; *)
154 |   v, v + 4*e, emc
155 | 
156 | open Unix
157 | 
158 | let utime f x =
159 |   let u = (times()).tms_utime in
160 |   let y = f x in
161 |   let ut = (times()).tms_utime -. u in
162 |   (y,ut)
163 | 
164 | let print_utime f x =
165 |   let (y,ut) = utime f x in
166 |   Format.printf "user time: %2.2f@." ut;
167 |   y
168 | 
169 | let print_solution fmt s = List.iter (fun i -> fprintf fmt "%d " i) s
170 | 
171 | let () =
172 |   draw_graph ();
173 |   let primary, columns, emc = emc_coloring () in
174 |   print_utime
175 |     (fun () ->
176 |       printf "DLX@.";
177 |       let dlx = Emc.D.create_sparse ~primary ~columns emc in
178 |       let s = Emc.D.find_solution dlx in
179 |       printf "  => %a@." print_solution s;
180 |       let show j =
181 |         let v = Hashtbl.find vertexi (j / 4) in
182 |         let c = 1 + j mod 4 in
183 |         color_vertex v cols.(c)
184 |       in
185 |       List.iter show s;
186 |       Format.printf "  DLX: found!@.")
187 |     ();
188 |   ignore (
189 |     let st = Graphics.wait_next_event [ Key_pressed ] in
190 |     if st.key = 'q' then exit 0
191 |   );
192 |   print_utime
193 |     (fun () ->
194 |       printf "SAT (with minisat2)@.";
195 |       let sat = Emc.Sat.create_sparse ~primary ~columns emc in
196 |       Emc.Sat.print_in_file "color.dimacs" sat;
197 |       let minisat2 ~input ~output = sprintf "minisat2 %s %s" input output in
198 |       let s = Emc.Sat.find_solution minisat2 sat in
199 |       printf "  => %a@." print_solution s;
200 |       let show j =
201 |         let v = Hashtbl.find vertexi (j / 4) in
202 |         let c = 1 + j mod 4 in
203 |         color_vertex v cols.(c)
204 |       in
205 |       List.iter show s;
206 |       Format.printf "  SAT: found!@.")
207 |     ();
208 |   ignore (
209 |     let st = Graphics.wait_next_event [ Key_pressed ] in
210 |     if st.key = 'q' then exit 0
211 |   );
212 |   print_utime
213 |     (fun () ->
214 |       printf "ZDD@.";
215 |       let zdd = Emc.Z.create_sparse ~primary ~columns emc in
216 |       Format.eprintf "  ZDD => %d@." (Emc.Z.count_solutions zdd))
217 |     ();
218 |   ignore (Graphics.wait_next_event [ Key_pressed ]);
219 |   close_graph ()
220 | 
221 | 
222 | (*
223 | Local Variables:
224 | compile-command: "make color.opt"
225 | End:
226 | *)
227 | 


--------------------------------------------------------------------------------
/examples/lib/dune:
--------------------------------------------------------------------------------
 1 | (executable
 2 |  (name queens)
 3 |  (modules queens)
 4 |  (libraries combine unix))
 5 | 
 6 | (executable
 7 |  (name sudoku)
 8 |  (modules sudoku)
 9 |  (libraries combine str unix))
10 | 
11 | (executable
12 |  (name backslide)
13 |  (modules backslide)
14 |  (libraries combine))
15 | 
16 | (executable
17 |  (name color)
18 |  (modules color)
19 |  (libraries combine graphics ocamlgraph unix))
20 | 


--------------------------------------------------------------------------------
/examples/lib/queens.ml:
--------------------------------------------------------------------------------
  1 | (**************************************************************************)
  2 | (*                                                                        *)
  3 | (*  Combine - an OCaml library for combinatorics                          *)
  4 | (*                                                                        *)
  5 | (*  Copyright (C) 2012-2014                                               *)
  6 | (*    Remy El Sibaie                                                      *)
  7 | (*    Jean-Christophe Filliatre                                           *)
  8 | (*                                                                        *)
  9 | (*  This software is free software; you can redistribute it and/or        *)
 10 | (*  modify it under the terms of the GNU Library General Public           *)
 11 | (*  License version 2.1, with the special exception on linking            *)
 12 | (*  described in file LICENSE.                                            *)
 13 | (*                                                                        *)
 14 | (*  This software is distributed in the hope that it will be useful,      *)
 15 | (*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)
 16 | (*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)
 17 | (*                                                                        *)
 18 | (**************************************************************************)
 19 | 
 20 | (* Solving the N-queens using DLX and ZDD.
 21 | 
 22 | The encoding of the N-queens problem to EMC is described in
 23 | Donald E. Knuth's paper "Dancing Links"
 24 | 
 25 | The EMC matrix has:
 26 | - N columns for the rows
 27 | - N columns for the columns
 28 | - 2N-1 columns for the left-right diagonals
 29 | - 2N-1 columns for the right-left diagonals
 30 | 
 31 | Each row in the EMC matrix corresponds to one way to place a queen.
 32 | Thus it has four ones, one for the column, one for the row, and one for each
 33 | diagonal.
 34 | 
 35 | Since some of the diagonals are not covered, only the first 2N columns
 36 | (rows and columns of the chessboard) are primary columns.
 37 | 
 38 | *)
 39 | 
 40 | open Format
 41 | open Combine
 42 | 
 43 | (* EMC size is N^2 * (6N-2)
 44 |    columns are the following
 45 | *)
 46 | 
 47 | let debug = ref false
 48 | let range = ref 0
 49 | let svg_file = ref ""
 50 | 
 51 | let msg = "usage: ./queens -n value"
 52 | let spec = ["-n", Arg.Set_int range,
 53 |               "  Range of the N-queens problem";
 54 |             "--svg", Arg.Set_string svg_file,
 55 |               "<file>  Output one solution in SVG format";
 56 |             "--debug", Arg.Set debug,
 57 |               "prints the EMC matrix"; ]
 58 | 
 59 | let () = Arg.parse spec (fun _ ->()) msg
 60 | let () = if !range = 0 then exit 0
 61 | let n = !range
 62 | let svg_file = !svg_file
 63 | 
 64 | let primary = 2 * n
 65 | 
 66 | let row i j =
 67 |   let f k = k = i || k = n + j || k = 2*n + i + j || k = 4*n-1 + n-1-i + j in
 68 |   Array.init (6 * n - 2) f
 69 | 
 70 | let emc =
 71 |   let lr = ref [] in
 72 |   for i = 0 to n - 1 do for j = 0 to n - 1 do lr := row i j :: !lr done done;
 73 |   Array.of_list !lr
 74 | 
 75 | (* List.iter (decode sudoku emc_array) s; *)
 76 | 
 77 | let decode board emc_array i =
 78 |   if i < Array.length emc_array - 1 then begin
 79 |     let c = ref 0 in
 80 |     let l = ref 0 in
 81 |     for j = 0 to 2 * n - 1 do
 82 |       if emc_array.(i).(j) then begin
 83 |         if j < n then begin
 84 |           l := j;
 85 |         end
 86 |         else
 87 |           c := j - n;
 88 |       end
 89 |     done;
 90 |     board.(!l).(!c) <- true
 91 |   end
 92 | 
 93 | let print_board_svg u fmt =
 94 |   for i = 0 to n do
 95 |     fprintf fmt "<line x1=\"%d\" y1=\"%d\" x2=\"%d\" y2=\"%d\" \
 96 | style=\"stroke:black;stroke-width:1;\" />@\n"
 97 |       0 (i * u) (u * n) (i * u);
 98 |     fprintf fmt "<line x1=\"%d\" y1=\"%d\" x2=\"%d\" y2=\"%d\" \
 99 | style=\"stroke:black;stroke-width:1;\" />@\n"
100 |       (i * u) 0 (i * u) (u * n);
101 |   done
102 | 
103 | let print_cross_svg x y u fmt =
104 |   fprintf fmt
105 |     "<line x1=\"%d\" y1=\"%d\" x2=\"%d\" y2=\"%d\" \
106 | style=\"stroke:#1F56D2;\"/>"
107 |     (x * u) (y * u) ((x + 1)* u) ((y + 1) * u);
108 |   fprintf fmt
109 |     "<line x1=\"%d\" y1=\"%d\" x2=\"%d\" y2=\"%d\" \
110 | style=\"stroke:#1F56D2;\"/>"
111 |     ((x + 1) * u) (y * u) (x * u) ((y + 1) * u)
112 | 
113 | let print_solution_to_svg fmt ~width ~height n board =
114 |   let u = 100 in
115 |   fprintf fmt
116 | "<?xml version=\"1.0\" standalone=\"no\"?> @\n\
117 | @[<hov 2><svg xmlns=\"http://www.w3.org/2000/svg\" \
118 | width=\"%d\" height=\"%d\">@\n"
119 |   width height;
120 |   for i = 0 to n - 1 do
121 |     for j = 0 to n - 1 do
122 |       if board.(j).(i) then
123 |         print_cross_svg i j u fmt
124 |     done
125 |   done;
126 |   print_board_svg u fmt;
127 |   fprintf fmt "@]@\n</svg>"
128 | 
129 | let print_solution_to_svg_file f ~width ~height n board =
130 |   let c = open_out f in
131 |   let fmt = formatter_of_out_channel c in
132 |   print_solution_to_svg fmt ~width ~height n board;
133 |   fprintf fmt "@.";
134 |   close_out c
135 | 
136 | let width = 100 * n + 1
137 | let height = width
138 | 
139 | let time () = (Unix.times()).Unix.tms_utime
140 | 
141 | let () =
142 |   printf "Solving the %d-queens@." n;
143 |   printf "EMC matrix is %a@." Emc.print_matrix_size emc;
144 |   if !debug then printf "%d@.%d@.%d@." primary (6*n-2-primary) (n*n);
145 |   let p = Emc.D.create ~primary emc in
146 |   if !debug then printf "%a@." Emc.print_boolean_matrix emc;
147 |   let board = Array.make_matrix n n false in
148 |   if svg_file <> "" then begin
149 |     let solution = Emc.D.find_solution p in
150 |     List.iter (decode board emc) solution;
151 |     printf "%a@." Emc.print_boolean_matrix board;
152 |     print_solution_to_svg_file svg_file ~width ~height n board
153 |   end else begin
154 |     let t = time () in
155 |     let s =  Emc.D.count_solutions p in
156 |     printf "DLX: %d solutions, in %2.2fs@." s (time () -. t);
157 |     let t = time () in
158 |     let p = Emc.Z.create ~primary emc in
159 |     printf "ZDD of size %d@." (Zdd.size p);
160 |     let s = Emc.Z.count_solutions p in
161 |     printf "ZDD: %d solutions, in %2.2fs@." s (time () -. t)
162 |   end
163 | 
164 | let () =
165 |   let s = Gc.stat () in
166 |   let m = float (Sys.word_size / 8) *. float s.Gc.top_heap_words in
167 |   let m = m /. 1024. /. 1024. in
168 |   printf "Memory max: %.2f Mb@." m
169 | 
170 | let () =
171 |   let mi, pr, ma = Gc.counters () in
172 |   let m = float (Sys.word_size / 8) *. (mi +. ma -. pr) in
173 |   let m = m /. 1024. /. 1024. in
174 |   printf "Memory used: %.2f Mb@." m
175 | 


--------------------------------------------------------------------------------
/examples/lib/sudoku.ml:
--------------------------------------------------------------------------------
  1 | (**************************************************************************)
  2 | (*                                                                        *)
  3 | (*  Combine - an OCaml library for combinatorics                          *)
  4 | (*                                                                        *)
  5 | (*  Copyright (C) 2012-2014                                               *)
  6 | (*    Remy El Sibaie                                                      *)
  7 | (*    Jean-Christophe Filliatre                                           *)
  8 | (*                                                                        *)
  9 | (*  This software is free software; you can redistribute it and/or        *)
 10 | (*  modify it under the terms of the GNU Library General Public           *)
 11 | (*  License version 2.1, with the special exception on linking            *)
 12 | (*  described in file LICENSE.                                            *)
 13 | (*                                                                        *)
 14 | (*  This software is distributed in the hope that it will be useful,      *)
 15 | (*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)
 16 | (*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)
 17 | (*                                                                        *)
 18 | (**************************************************************************)
 19 | 
 20 | 
 21 | (*
 22 | 
 23 | This module encodes Sudoku as EMC and solves it.
 24 | 
 25 | This program reads a Sudoku problem from a file, in the following format:
 26 | 
 27 | 000206003
 28 | 060080000
 29 | 071003000
 30 | 006000910
 31 | 007809600
 32 | 024000800
 33 | 000100540
 34 | 000030080
 35 | 200608000
 36 | 
 37 | Here is the correspondance between the Sudoku and its encoding as EMC:
 38 | - 9 rows x 9 values = 81 columns
 39 | - 9 columns x 9 values = 81 columns
 40 | - 9 subgrids x 9 values = 81 columns
 41 | - 81 cells = 81 columns
 42 | 
 43 | One row in the EMC matrix encodes the placement of one value in one cell.
 44 | For instance, setting the value of the cell (0, 0) to 4 corresponds to
 45 |  - 1 in the 4th column
 46 |  - 1 in the 85th column
 47 |  - 1 in the 166th column
 48 |  - 1 in the 243th column
 49 |  - 0 in all other columns
 50 | *)
 51 | 
 52 | open Format
 53 | open Combine
 54 | 
 55 | let size = 9
 56 | 
 57 | let emc_size = size * size * 4
 58 | 
 59 | let zdd = ref false
 60 | let dlx = ref false
 61 | 
 62 | 
 63 | let display_sudoku_line line =
 64 |   Array.iter (fun e -> printf "%d" e) line;
 65 |   printf "@."
 66 | 
 67 | 
 68 | let display_sudoku sudoku_array =
 69 |   Array.iter (fun e -> display_sudoku_line e) sudoku_array;
 70 |   printf "@."
 71 | 
 72 | 
 73 | let read_sudoku_line s =
 74 |   Array.init size
 75 |     (fun i ->
 76 |        (int_of_char s.[i]) - (int_of_char '0'))
 77 | 
 78 | 
 79 | let read s =
 80 |   let lines = Str.split (Str.regexp "\n") s in
 81 |   let sudoku_array = Array.make_matrix size size 0 in
 82 |   let rec read lines i =
 83 |     match lines with
 84 |       | [] -> ()
 85 |       | h::t ->
 86 |           if h <> "" then begin
 87 |             sudoku_array.(i) <- read_sudoku_line h;
 88 |             read t (i + 1)
 89 |           end else
 90 |             read t i
 91 |   in
 92 |   read lines 0;
 93 |   sudoku_array
 94 | 
 95 | 
 96 | 
 97 | let file = ref None
 98 | let out = ref ""
 99 | 
100 | let msg = "usage: project [options] file"
101 | let spec = ["-o", Arg.Set_string out, "  solution output in SVG format";
102 | 	   ]
103 | 
104 | let set_file f = match !file with
105 |   | Some _ -> Arg.usage [] msg; exit 1
106 |   | None when Sys.file_exists f -> file := Some f
107 |   | None -> eprintf "%s: no such file@." f; exit 1
108 | 
109 | let () = Arg.parse spec set_file msg
110 | 
111 | 
112 | let error_pieces_board () =
113 |   eprintf "problem must have board and piece(s) @.";
114 |   exit 1
115 | 
116 | let sudoku =
117 |   let c = match !file with
118 |     | Some f -> open_in f
119 |     | None -> stdin
120 |   in
121 |   let p =
122 |     try
123 |       let s = String.make (in_channel_length c) ' ' in
124 |       really_input c (Bytes.of_string s) 0 (in_channel_length c - 1);
125 |       read s
126 |     with Invalid_argument msg ->
127 |       eprintf "invalid input file: %s@." msg;
128 |       exit 1
129 |   in
130 |   begin match !file with Some _ -> close_in c | None -> () end;
131 |   p
132 | 
133 | 
134 | 
135 | let ok_in_cell v celli cellj sudoku =
136 |   for iteri = celli to celli + 2 do
137 |     for iterj = cellj to cellj + 2 do
138 |       if sudoku.(iteri).(iterj) = v then raise Exit
139 |     done
140 |   done
141 | 
142 | 
143 | let ok v i j sudoku =
144 |   try
145 |     if sudoku.(i).(j) <> 0 then raise Exit;
146 |     let celli, cellj = (i / 3) * 3, (j / 3) * 3 in
147 |     ok_in_cell v celli cellj sudoku;
148 |     let rec iteri_out_cell first last =
149 |       if first > last then ()
150 |       else if sudoku.(first).(j) = v then raise Exit
151 |       else iteri_out_cell (first + 1) last
152 |     in
153 |     let rec iterj_out_cell first last =
154 |       if first > last then ()
155 |       else if sudoku.(i).(first) = v then raise Exit
156 |       else iterj_out_cell (first + 1) last
157 |     in
158 |     iteri_out_cell 0 (celli - 1);
159 |     iteri_out_cell (celli + 3) (size - 1);
160 |     iterj_out_cell 0 (cellj - 1);
161 |     iterj_out_cell (cellj + 3) (size - 1);
162 |     true
163 |   with Exit -> false
164 | 
165 | 
166 | 
167 | let set_val v i j line =
168 |   (* Column *)
169 |   line.(9 * j + v - 1) <- true;
170 |   (* Line *)
171 |   line.(9 * (9 + i) + v - 1) <- true;
172 |   (* Group *)
173 |   line.(9 * (9 * 2 + (j / 3 + (i / 3) * 3)) +  v - 1) <- true;
174 |   (* Cell *)
175 |   line.(9 * (9 * 3 + i) + j) <- true
176 | 
177 | 
178 | 
179 | let get_line v i j =
180 |   let line = Array.make emc_size false in
181 |   set_val v i j line;
182 |   line
183 | 
184 | 
185 | let const_line sudoku =
186 |   let line = Array.make emc_size false in
187 |   for i = 0 to size - 1 do
188 |     for j = 0 to size - 1 do
189 |       let v = sudoku.(i).(j) in
190 |       if v <> 0 then begin
191 |         set_val v i j line
192 |       end
193 |     done
194 |   done;
195 |   line
196 | 
197 | 
198 | 
199 | let emc sudoku =
200 |   let lr = ref [const_line sudoku] in
201 |   for i = 0 to size - 1 do
202 |     for j = 0 to size - 1 do
203 |       for v = 1 to size do
204 |         if ok v i j sudoku then
205 |           lr := get_line v i j :: !lr
206 |       done
207 |     done
208 |   done;
209 |   Array.of_list !lr
210 | 
211 | 
212 | 
213 | 
214 | let print_emc_sudoku () =
215 |   for i = 1 to 9 do printf "%d        " i done;
216 |   for i = 1 to 9 do printf "%d        " i done;
217 |   for i = 1 to 9 do printf "%d        " i done;
218 |   printf "@.";
219 |   printf "colonne  ";
220 |   for _ = 1 to 8 do printf "         " done;
221 |   printf "ligne    ";
222 |   for _ = 1 to 8 do printf "         " done;
223 |   printf "cellule  ";
224 |   for _ = 1 to 8 do printf "         " done;
225 |   printf "@."
226 | 
227 | 
228 | let decode sudoku emc_array i =
229 |   if i < Array.length emc_array - 1 then begin
230 |     let c = ref 0 in
231 |     let l = ref 0 in
232 |     let v = ref 0 in
233 |     for j = 0 to 161 do
234 |       if emc_array.(i).(j) then begin
235 |         if j < 81 then begin
236 |           c := j / 9;
237 |           v := j mod 9 + 1
238 |         end
239 |         else
240 |           l := (j - 81) / 9;
241 |       end
242 |     done;
243 |     assert (!v <> 0);
244 |     sudoku.(!l).(!c) <- !v
245 |   end
246 | 
247 | let print_board_svg u fmt =
248 |   for i = 0 to 9 do
249 |     fprintf fmt "<line x1=\"%d\" y1=\"%d\" x2=\"%d\" y2=\"%d\" \
250 | style=\"stroke:black;stroke-width:1;\" />@\n"
251 |       0 (i * u) (u * 9) (i * u);
252 |     fprintf fmt "<line x1=\"%d\" y1=\"%d\" x2=\"%d\" y2=\"%d\" \
253 | style=\"stroke:black;stroke-width:1;\" />@\n"
254 |       (i * u) 0 (i * u) (u * 9);
255 |     fprintf fmt "<rect x=\"%d\" y=\"%d\" width=\"%d\" height=\"%d\" \
256 | style=\"stroke:black;fill-opacity:0;stroke-width:3;\"/>@\n"
257 |       ((i mod 3) * u * 3) ((i / 3) * u * 3) (u * 3) (u * 3)
258 |   done
259 | 
260 | let print_solution_to_svg fmt ~width ~height m =
261 |   let u = 100 in
262 |   fprintf fmt
263 | "<?xml version=\"1.0\" standalone=\"no\"?> @\n\
264 | @[<hov 2><svg xmlns=\"http://www.w3.org/2000/svg\" \
265 | width=\"%d\" height=\"%d\">@\n"
266 |   width height;
267 |   for i = 0 to 9 - 1 do
268 |     for j = 0 to 9 -1 do
269 |   fprintf fmt "<text x=\"%d\" y=\"%d\" style= \"font-size:50px;\
270 | text-anchor:middle;\" >\ %d</text>" (i * u + 50) (j * u + 65) m.(j).(i)
271 |     done
272 |   done;
273 |   print_board_svg u fmt;
274 |   fprintf fmt "@]@\n</svg>"
275 | 
276 | 
277 | let print_solution_to_svg_file f ~width ~height m =
278 |   let c = open_out f in
279 |   let fmt = formatter_of_out_channel c in
280 |   print_solution_to_svg fmt ~width ~height m;
281 |   fprintf fmt "@.";
282 |   close_out c
283 | 
284 | 
285 | let () =
286 |   let emc_array = emc sudoku in
287 |   display_sudoku sudoku;
288 |   printf "DLX : emc_size : %dx%d @."
289 |     (Array.length emc_array) (Array.length emc_array.(0));
290 |   try
291 |     let p = Emc.D.create emc_array in
292 |     let s = Emc.D.find_solution p in
293 |     let n = List.length s in
294 |     printf "solution size : %d@." n;
295 |     List.iter (decode sudoku emc_array) s;
296 |     display_sudoku sudoku;
297 |     if not (!out = "") then begin
298 |       print_solution_to_svg_file (!out) ~width:900 ~height:900 sudoku;
299 |       printf "out : %s@\n" !out
300 |     end;
301 |     printf "%d solutions@." (Emc.D.count_solutions p)
302 |   with Not_found -> printf "No solution@."
303 | 


--------------------------------------------------------------------------------
/misc/stats.txt:
--------------------------------------------------------------------------------
 1 | elsibaie - ~/ocaml-comb% time ./combine.opt --stats --zdd tests/modotri_8_8.rem
 2 | ########## Problems #########
 3 | 
 4 | problem domino8_8
 5 |   ********
 6 |   ********
 7 |   ********
 8 |   ********
 9 |   ********
10 |   ********
11 |   ********
12 |   ********
13 |   ZDD solutions: 92109458286284989468604
14 | 
15 | minor_words: 63188128
16 | promoted_words: 52645106
17 | major_words: 58974549
18 | minor_collections: 2071
19 | major_collections: 23
20 | heap_words: 45202944
21 | heap_chunks: 285
22 | top_heap_words: 45202944
23 | live_words: 44932680
24 | live_blocks: 10803744
25 | free_words: 170407
26 | free_blocks: 27307
27 | largest_free: 111043
28 | fragments: 99857
29 | compactions: 0
30 | ./combine.opt --stats --zdd tests/modotri_8_8.rem  8.24s user 0.31s system 99% cpu 8.571 total
31 | 
32 | 
33 | ------------------------------------------------------------------------------
34 | with weak pointers
35 | 
36 | ########## Problems #########
37 | 
38 | problem domino8_8
39 |   ********
40 |   ********
41 |   ********
42 |   ********
43 |   ********
44 |   ********
45 |   ********
46 |   ********
47 |   ZDD solutions: 92109458286284989468604
48 | 
49 | minor_words: 117667376
50 | promoted_words: 47731693
51 | major_words: 58722996
52 | minor_collections: 3715
53 | major_collections: 22
54 | heap_words: 43325440
55 | heap_chunks: 271
56 | top_heap_words: 43325440
57 | live_words: 31611413
58 | live_blocks: 7714613
59 | free_words: 11652758
60 | free_blocks: 2585186
61 | largest_free: 1279872
62 | fragments: 61269
63 | compactions: 0
64 | ./combine.opt --stats --zdd tests/modotri_8_8.rem  9.82s user 0.38s system 99% cpu 10.239 total
65 | 
66 | 


--------------------------------------------------------------------------------
/src/.gitignore:
--------------------------------------------------------------------------------
1 | main.exe
2 | 


--------------------------------------------------------------------------------
/src/dune:
--------------------------------------------------------------------------------
1 | (executable
2 |  (name main)
3 |  (promote (until-clean))
4 |  (libraries combine zarith unix))
5 | 


--------------------------------------------------------------------------------
/src/lib/ast.mli:
--------------------------------------------------------------------------------
 1 | (**************************************************************************)
 2 | (*                                                                        *)
 3 | (*  Combine - an OCaml library for combinatorics                          *)
 4 | (*                                                                        *)
 5 | (*  Copyright (C) 2012-2014                                               *)
 6 | (*    Remy El Sibaie                                                      *)
 7 | (*    Jean-Christophe Filliatre                                           *)
 8 | (*                                                                        *)
 9 | (*  This software is free software; you can redistribute it and/or        *)
10 | (*  modify it under the terms of the GNU Library General Public           *)
11 | (*  License version 2.1, with the special exception on linking            *)
12 | (*  described in file LICENSE.                                            *)
13 | (*                                                                        *)
14 | (*  This software is distributed in the hope that it will be useful,      *)
15 | (*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)
16 | (*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)
17 | (*                                                                        *)
18 | (**************************************************************************)
19 | 
20 | type dim = int * int
21 | 
22 | type binop = Union | Inter | Diff | Xor
23 | 
24 | type algo_emc = Dlx | Zdd | Sat of string
25 | 
26 | type file = string
27 | 
28 | type state = On | Off
29 | 
30 | type output = Svg of file | Ascii
31 | 
32 | type setop = Shift | SetXY of bool | Resize | Crop of dim
33 | type problem_command =
34 |   | CountEMC of algo_emc
35 |   | SolveEMC of algo_emc * output
36 |   | AllEMC   of algo_emc
37 |   | Count    of string
38 |   | Solve    of string * output
39 |   | Print
40 | 
41 | type compop = Equal
42 | 
43 | type pos = Lexing.position * Lexing.position
44 | 
45 | 
46 | type expr = {
47 |   expr_node : expr_node;
48 |   expr_pos : pos;
49 | }
50 | and expr_node =
51 |   | Pattern of bool array array
52 |   | Var of string
53 |   (* other operations: union, diff, rotations, etc. *)
54 |   | Binary of binop * expr * expr
55 |   | SetOp of setop * dim * expr
56 |   | Apply of D4.t * expr
57 | 
58 | type bool_expr =
59 |   | Boolean of bool
60 |   | Comparison of compop * expr * expr
61 | 
62 | type tile = expr * Tiling.symmetries * Tiling.multiplicity
63 | 
64 | type tiles =
65 |   | Tiles_id of string
66 |   | Tiles_list of tile list
67 | 
68 | type problem = string * expr * tiles
69 | 
70 | type decl = {
71 |   decl_node : decl_node;
72 |   decl_pos : pos;
73 | }
74 | 
75 | and decl_node =
76 |   | Dpattern of string * expr
77 |   | Dpattern3 of string * expr list
78 |   | Tiles of string * tile list
79 |   | Tiles3 of string * tile list
80 |   | Problem of problem
81 |   | Problem3 of problem
82 |   | Assert of bool_expr
83 |   | Command of problem_command * string
84 |   | Command3 of problem_command * string
85 |   | Dimacs of string * string
86 |   | Debug of state
87 |   | Timing of state
88 |   | Quit
89 |   | Include of string
90 |   | H2g2
91 | 
92 | 
93 | type queue = decl list
94 | 


--------------------------------------------------------------------------------
/src/lib/backtracking.ml:
--------------------------------------------------------------------------------
  1 | (**************************************************************************)
  2 | (*                                                                        *)
  3 | (*  Combine - an OCaml library for combinatorics                          *)
  4 | (*                                                                        *)
  5 | (*  Copyright (C) 2012-2014                                               *)
  6 | (*    Remy El Sibaie                                                      *)
  7 | (*    Jean-Christophe Filliatre                                           *)
  8 | (*                                                                        *)
  9 | (*  This software is free software; you can redistribute it and/or        *)
 10 | (*  modify it under the terms of the GNU Library General Public           *)
 11 | (*  License version 2.1, with the special exception on linking            *)
 12 | (*  described in file LICENSE.                                            *)
 13 | (*                                                                        *)
 14 | (*  This software is distributed in the hope that it will be useful,      *)
 15 | (*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)
 16 | (*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)
 17 | (*                                                                        *)
 18 | (**************************************************************************)
 19 | 
 20 | open Format
 21 | open Tiling
 22 | open Tiling.Pattern
 23 | open Tiling.Tile
 24 | open Tiling.Problem
 25 | 
 26 | let debug = ref false
 27 | 
 28 | type algorithm = (solution -> unit) -> problem -> unit
 29 | 
 30 | let algorithms = Hashtbl.create 17
 31 | let add = Hashtbl.add algorithms
 32 | let find = Hashtbl.find algorithms
 33 | 
 34 | let all_tiles_same_size tl =
 35 |   let size = ref None in
 36 |   let check_size t = match !size with
 37 |     | None -> size := Some t.pattern.size
 38 |     | Some s -> if s <> t.pattern.size then
 39 |         invalid_arg "equal_size: tiles of different sizes" in
 40 |   List.iter check_size tl;
 41 |   match !size with None -> assert false | Some s -> s
 42 | 
 43 | let add_tile grid ({pattern=p; _}, tx, ty) =
 44 |   let grid = Matrix.copy grid in
 45 |   for y = 0 to p.height - 1 do for x = 0 to p.width - 1 do
 46 |     if p.matrix.(y).(x) then begin
 47 |       if not grid.(ty + y).(tx + x) then raise Exit;
 48 |       grid.(ty + y).(tx + x) <- false
 49 |     end
 50 |   done done;
 51 |   grid
 52 | 
 53 | (* check that the connected component of c has an area multiple of size *)
 54 | let check_areas grid size =
 55 |   let grid = Matrix.copy grid in
 56 |   let h = Array.length grid - 1 in
 57 |   let w = Array.length grid.(0) - 1 in
 58 |   let rec check_rec s = function
 59 |     | [] -> if s mod size <> 0 then raise Exit
 60 |     | (y, x) :: rem ->
 61 | 	let s, rem = if x < w && grid.(y).(x+1) then begin
 62 | 	  grid.(y).(x+1) <- false; s+1, (y, x+1)::rem end else s,rem in
 63 | 	let s,rem = if y < h && grid.(y+1).(x) then begin
 64 | 	  grid.(y+1).(x) <- false; s+1, (y+1, x)::rem end else s,rem in
 65 | 	let s,rem = if x > 0 && grid.(y).(x-1) then begin
 66 | 	  grid.(y).(x-1) <- false; s+1, (y, x-1)::rem end else s,rem in
 67 | 	let s,rem = if y > 0 && grid.(y-1).(x) then begin
 68 | 	  grid.(y-1).(x) <- false; s+1, (y-1, x)::rem end else s,rem in
 69 | 	check_rec s rem
 70 |   in
 71 |   try
 72 |     for y = 0 to h do for x = 0 to w do
 73 |       if grid.(y).(x) then begin grid.(y).(x) <- false; check_rec 1 [(y, x)] end
 74 |     done done;
 75 |     true
 76 |   with Exit ->
 77 |     false
 78 | 
 79 | let rec backtracking f sol size grid todo pieces =
 80 |   if todo = 0 then f sol
 81 |   else if check_areas grid size then match pieces with
 82 |     | [] -> ()
 83 |     | tiles :: other_pieces ->
 84 |         let test_move (t, _x, _y as m) =
 85 |           try
 86 |             let grid = add_tile grid m in
 87 |             let sol = m :: sol in
 88 |             let todo = todo - size in
 89 |             match t.multiplicity with
 90 |               | Mone | Mmaybe -> backtracking f sol size grid todo other_pieces
 91 |               | Minf          -> backtracking f sol size grid todo pieces
 92 |           with Exit ->
 93 |             ()
 94 |         in
 95 |         List.iter test_move tiles;
 96 |         match tiles with
 97 |           | ({multiplicity = Mmaybe | Minf ; _},_,_) :: _ ->
 98 |               backtracking f sol size grid todo other_pieces
 99 |           | [] | ({ multiplicity = Mone ; _},_,_) :: _ -> ()
100 | 
101 | let possible_moves grid size tile =
102 |   let res = ref [] in
103 |   let test tile =
104 |     for ty = 0 to grid.height - tile.pattern.height do
105 |       for tx = 0 to grid.width - tile.pattern.width do
106 |         let m = (tile, tx, ty) in
107 |         try
108 |           let grid = add_tile grid.matrix m in
109 |           if check_areas grid size then res := m :: !res
110 |         with Exit -> ()
111 |       done
112 |     done
113 |   in
114 |   List.iter test (tile :: create_all_symmetries tile);
115 |   if !debug then printf "%d moves for tile %s@." (List.length !res) tile.name;
116 |   !res
117 | 
118 | let equal_size f p =
119 |   if p.pieces = [] then invalid_arg "equal_size: no tile given";
120 |   let size = all_tiles_same_size p.pieces in
121 |   if p.grid.size mod size <> 0 then
122 |     invalid_arg "equal_size: problem size is not a multiple of tile size";
123 |   let pieces = List.map (possible_moves p.grid size) p.pieces in
124 |   backtracking f [] size p.grid.matrix p.grid.size pieces
125 | 
126 | let () = add "equal_size" equal_size
127 | 


--------------------------------------------------------------------------------
/src/lib/backtracking.mli:
--------------------------------------------------------------------------------
 1 | (**************************************************************************)
 2 | (*                                                                        *)
 3 | (*  Combine - an OCaml library for combinatorics                          *)
 4 | (*                                                                        *)
 5 | (*  Copyright (C) 2012-2014                                               *)
 6 | (*    Remy El Sibaie                                                      *)
 7 | (*    Jean-Christophe Filliatre                                           *)
 8 | (*                                                                        *)
 9 | (*  This software is free software; you can redistribute it and/or        *)
10 | (*  modify it under the terms of the GNU Library General Public           *)
11 | (*  License version 2.1, with the special exception on linking            *)
12 | (*  described in file LICENSE.                                            *)
13 | (*                                                                        *)
14 | (*  This software is distributed in the hope that it will be useful,      *)
15 | (*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)
16 | (*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)
17 | (*                                                                        *)
18 | (**************************************************************************)
19 | 
20 | (** Traditional backtracking algorithms to solve tiling problems *)
21 | 
22 | open Tiling
23 | 
24 | val debug: bool ref
25 | 
26 | type algorithm = (Problem.solution -> unit) -> Problem.problem -> unit
27 | 
28 | val add: string -> algorithm -> unit
29 | val find: string -> algorithm
30 | 


--------------------------------------------------------------------------------
/src/lib/cube.ml:
--------------------------------------------------------------------------------
 1 | (**************************************************************************)
 2 | (*                                                                        *)
 3 | (*  Combine - an OCaml library for combinatorics                          *)
 4 | (*                                                                        *)
 5 | (*  Copyright (C) 2012-2014                                               *)
 6 | (*    Remy El Sibaie                                                      *)
 7 | (*    Jean-Christophe Filliatre                                           *)
 8 | (*                                                                        *)
 9 | (*  This software is free software; you can redistribute it and/or        *)
10 | (*  modify it under the terms of the GNU Library General Public           *)
11 | (*  License version 2.1, with the special exception on linking            *)
12 | (*  described in file LICENSE.                                            *)
13 | (*                                                                        *)
14 | (*  This software is distributed in the hope that it will be useful,      *)
15 | (*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)
16 | (*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)
17 | (*                                                                        *)
18 | (**************************************************************************)
19 | 
20 | (* Isometries of the cube; see for instance
21 |    http://www.math.caltech.edu/~2013-14/1term/ma006a/rotcube.pdf *)
22 | 
23 | type t = int array array (* 3x3 matrix *)
24 | 
25 | let compose m1 m2 = (* matrix multiplication *)
26 |   let mul i j = m1.(i).(0) * m2.(0).(j) + m1.(i).(1) * m2.(1).(j)
27 |     + m1.(i).(2) * m2.(2).(j) in
28 |   Array.init 3 (fun i -> Array.init 3 (mul i))
29 | 
30 | (* -x = w - 1 - x
31 |    -y = h - 1 - y
32 |    -z = d - 1 - z *)
33 | 
34 | let apply m ~w ~h ~d (x,y,z) =
35 |   let mulx c = if c = 0 then 0 else if c = 1 then x else w - 1 - x in
36 |   let muly c = if c = 0 then 0 else if c = 1 then y else h - 1 - y in
37 |   let mulz c = if c = 0 then 0 else if c = 1 then z else d - 1 - z in
38 |   let mul r = mulx r.(0) + muly r.(1) + mulz r.(2) in
39 |   mul m.(0), mul m.(1), mul m.(2)
40 | 
41 | let trans_size m (w,h,d) =
42 |   let mulx c = if c = 0 then 0 else w in
43 |   let muly c = if c = 0 then 0 else h in
44 |   let mulz c = if c = 0 then 0 else d in
45 |   let mul r = mulx r.(0) + muly r.(1) + mulz r.(2) in
46 |   mul m.(0), mul m.(1), mul m.(2)
47 | 
48 | let all =
49 |   let m = Array.make_matrix 3 3 0 in
50 |   let res = ref [] in
51 |   let rec make = function
52 |     | [] ->
53 |         res := Array.map Array.copy m :: !res
54 |     | (i,j) :: l ->
55 |         m.(i).(j) <- 1; make l; m.(i).(j) <- -1; make l; m.(i).(j) <- 0 in
56 |   List.iter make
57 |     [[0,0; 1,1; 2,2];
58 |      [0,0; 1,2; 2,1];
59 |      [0,1; 1,0; 2,2];
60 |      [0,1; 1,2; 2,0];
61 |      [0,2; 1,0; 2,1];
62 |      [0,2; 1,1; 2,0];
63 |     ];
64 |   !res
65 | 
66 | let () = assert (List.length all = 48)
67 | 
68 | let det m =
69 |   let m i j = m.(i).(j) in
70 |     m 0 0 * (m 1 1 * m 2 2 - m 2 1 * m 1 2)
71 |   - m 0 1 * (m 1 0 * m 2 2 - m 2 0 * m 1 2)
72 |   + m 0 2 * (m 1 0 * m 2 1 - m 2 0 * m 1 1)
73 | 
74 | let is_positive m =
75 |   det m = 1
76 | 
77 | let positive =
78 |   List.filter is_positive all
79 | 
80 | let () = assert (List.length positive = 24)
81 | 
82 | open Format
83 | 
84 | let print fmt m =
85 |   fprintf fmt "@[";
86 |   let row r = Array.iter (fun x -> fprintf fmt "%2d " x) r; fprintf fmt "@\n" in
87 |   Array.iter row m;
88 |   fprintf fmt "@]"
89 | 
90 | 


--------------------------------------------------------------------------------
/src/lib/cube.mli:
--------------------------------------------------------------------------------
 1 | (**************************************************************************)
 2 | (*                                                                        *)
 3 | (*  Combine - an OCaml library for combinatorics                          *)
 4 | (*                                                                        *)
 5 | (*  Copyright (C) 2012-2014                                               *)
 6 | (*    Remy El Sibaie                                                      *)
 7 | (*    Jean-Christophe Filliatre                                           *)
 8 | (*                                                                        *)
 9 | (*  This software is free software; you can redistribute it and/or        *)
10 | (*  modify it under the terms of the GNU Library General Public           *)
11 | (*  License version 2.1, with the special exception on linking            *)
12 | (*  described in file LICENSE.                                            *)
13 | (*                                                                        *)
14 | (*  This software is distributed in the hope that it will be useful,      *)
15 | (*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)
16 | (*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)
17 | (*                                                                        *)
18 | (**************************************************************************)
19 | 
20 | (** {2 The 48 isometries of the cube} *)
21 | 
22 | type t
23 | 
24 | val print : Format.formatter -> t -> unit
25 | 
26 | val compose: t -> t -> t
27 |   (** [compose i1 i2] returns the isometry result of the composition
28 |       of [i1] and [i2] *)
29 | 
30 | val apply: t -> w:int -> h:int -> d:int -> int * int * int -> int * int * int
31 |   (** [apply i w h d (x,y,z)] applies isometry [i]
32 |       to the point [x, y, z] *)
33 | 
34 | val trans_size : t -> int * int * int -> int * int * int
35 |   (** given a cuboid of size (w,h,d), [trans_size iso (w,h,d)] returns the size
36 |       (w',h',d') of the result cuboid by [iso] *)
37 | 
38 | val all: t list
39 |   (** all isometries (there are 48 o them) *)
40 | 
41 | val is_positive: t -> bool
42 | 
43 | val positive: t list
44 |   (** the 24 positive isometries *)
45 | 


--------------------------------------------------------------------------------
/src/lib/d4.ml:
--------------------------------------------------------------------------------
  1 | (**************************************************************************)
  2 | (*                                                                        *)
  3 | (*  Combine - an OCaml library for combinatorics                          *)
  4 | (*                                                                        *)
  5 | (*  Copyright (C) 2012-2014                                               *)
  6 | (*    Remy El Sibaie                                                      *)
  7 | (*    Jean-Christophe Filliatre                                           *)
  8 | (*                                                                        *)
  9 | (*  This software is free software; you can redistribute it and/or        *)
 10 | (*  modify it under the terms of the GNU Library General Public           *)
 11 | (*  License version 2.1, with the special exception on linking            *)
 12 | (*  described in file LICENSE.                                            *)
 13 | (*                                                                        *)
 14 | (*  This software is distributed in the hope that it will be useful,      *)
 15 | (*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)
 16 | (*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)
 17 | (*                                                                        *)
 18 | (**************************************************************************)
 19 | 
 20 | [@@@warning "-37"]
 21 | type t = Id | Rot90 | Rot180 | Rot270 | VertRefl | HorizRefl |
 22 |     Diag1Refl | Diag2Refl
 23 | 
 24 | type iso = t
 25 | 
 26 | let compose i1 i2 = match i1, i2 with
 27 |   | Id, a | a, Id -> a
 28 |     (* rotations *)
 29 |   | Rot90, Rot270
 30 |   | Rot270, Rot90
 31 |   | Rot180, Rot180 -> Id
 32 |   | Rot180, Rot270
 33 |   | Rot270, Rot180 -> Rot90
 34 |   | Rot90, Rot90
 35 |   | Rot270, Rot270 -> Rot180
 36 |   | Rot180, Rot90
 37 |   | Rot90, Rot180 -> Rot270
 38 |     (* reflections *)
 39 |   | VertRefl, VertRefl
 40 |   | HorizRefl, HorizRefl
 41 |   | Diag1Refl, Diag1Refl
 42 |   | Diag2Refl, Diag2Refl -> Id
 43 |   | VertRefl, Diag2Refl
 44 |   | Diag2Refl, HorizRefl
 45 |   | HorizRefl, Diag1Refl
 46 |   | Diag1Refl, VertRefl -> Rot90
 47 |   | VertRefl, HorizRefl
 48 |   | HorizRefl, VertRefl
 49 |   | Diag2Refl, Diag1Refl
 50 |   | Diag1Refl, Diag2Refl -> Rot180
 51 |   | HorizRefl, Diag2Refl
 52 |   | Diag2Refl, VertRefl
 53 |   | VertRefl, Diag1Refl
 54 |   | Diag1Refl, HorizRefl -> Rot270
 55 |     (* rotation/reflection *)
 56 |   | Rot90, VertRefl
 57 |   | Rot270, HorizRefl
 58 |   | Rot180, Diag2Refl
 59 |   | VertRefl, Rot270
 60 |   | HorizRefl, Rot90
 61 |   | Diag2Refl, Rot180 -> Diag1Refl
 62 |   | Rot90, HorizRefl
 63 |   | Rot180, Diag1Refl
 64 |   | Rot270, VertRefl
 65 |   | VertRefl, Rot90
 66 |   | HorizRefl, Rot270
 67 |   | Diag1Refl, Rot180 -> Diag2Refl
 68 |   | Rot90, Diag1Refl
 69 |   | Rot180, VertRefl
 70 |   | Rot270, Diag2Refl
 71 |   | VertRefl, Rot180
 72 |   | Diag1Refl, Rot270
 73 |   | Diag2Refl, Rot90 -> HorizRefl
 74 |   | Rot90, Diag2Refl
 75 |   | Rot180, HorizRefl
 76 |   | Rot270, Diag1Refl
 77 |   | HorizRefl, Rot180
 78 |   | Diag1Refl, Rot90
 79 |   | Diag2Refl, Rot270 -> VertRefl
 80 | 
 81 | 
 82 | let to_string = function
 83 |   | Id -> "Id"
 84 |   | HorizRefl -> "HorizRefl"
 85 |   | VertRefl -> "VertRefl"
 86 |   | Rot180 -> "Rot180"
 87 |   | Rot270 -> "Rot270"
 88 |   | Rot90 -> "Rot90"
 89 |   | Diag1Refl -> "Diag1Refl"
 90 |   | Diag2Refl -> "Diag2Refl"
 91 | 
 92 | let print fmt iso = Format.fprintf fmt "%s" (to_string iso)
 93 | 
 94 | module S = Set.Make (
 95 |   struct
 96 |     type t = iso
 97 |     let compare = Stdlib.compare
 98 |   end)
 99 | 
100 | let all =
101 |   ( S.add Id
102 |       ( S.add Rot90
103 | 	  ( S.add Rot270
104 | 	      ( S.add Rot180
105 | 		  ( S.add VertRefl
106 | 		      ( S.add HorizRefl
107 | 			  ( S.add Diag2Refl
108 | 			      ( S.add Diag1Refl S.empty))))))))
109 | 
110 | let is_positive = function
111 |   | Id | Rot90 | Rot180 | Rot270 -> true
112 |   | VertRefl | HorizRefl | Diag1Refl | Diag2Refl -> false
113 | 
114 | (* sanity checks for compose *)
115 | 
116 | (* 1. positivity rules *)
117 | let () =
118 |   S.iter (fun a ->
119 |     S.iter (fun b -> assert (
120 |       is_positive (compose a b) = (is_positive a = is_positive b))
121 |     ) all ) all
122 | 
123 | (* 2. compose is associative *)
124 | let () =
125 |   S.iter (
126 |     fun a ->
127 |       S.iter (
128 |         fun b ->
129 |           S.iter (
130 |             fun c ->
131 |               assert (compose a (compose b c) = compose (compose a b) c)) all
132 |       ) all ) all
133 | 
134 | [@@@warning "-27"]
135 | let apply = function
136 |   | Id -> (fun ~w ~h p -> p)
137 |   | Rot180 -> (fun ~w ~h (x, y) -> (w - 1 - x , h - 1 - y))
138 |   | HorizRefl -> (fun ~w ~h (x, y) -> (x, h - 1 - y))
139 |   | VertRefl -> (fun ~w ~h (x, y) -> (w - 1- x, y))
140 |   | Rot90 -> (fun ~w ~h (x, y) -> (h - 1 - y, x))
141 |   | Rot270 -> (fun ~w ~h (x, y) -> (y, w - 1 - x))
142 |   | Diag1Refl -> (fun ~w ~h (x, y) -> (y, x))
143 |   | Diag2Refl -> (fun ~w ~h (x, y) -> (h - 1 - y, w - 1 - x))
144 | 
145 | let trans_size iso (h, w) = match iso with
146 |   | Id
147 |   | HorizRefl
148 |   | VertRefl
149 |   | Rot180 -> (h, w)
150 |   | Rot270
151 |   | Rot90
152 |   | Diag1Refl
153 |   | Diag2Refl -> (w, h)
154 | 
155 | type subgroup = S.t
156 | 
157 | (* the 10 subgroups of D4 *)
158 | (* 1 element *)
159 | let id = S.singleton Id
160 | (* 2 elements *)
161 | let vert = S.union id (S.singleton VertRefl)
162 | let horiz = S.union id (S.singleton HorizRefl)
163 | let rot180 = S.union id (S.singleton Rot180)
164 | let diag1 = S.union id (S.singleton Diag1Refl)
165 | let diag2 = S.union id (S.singleton Diag2Refl)
166 | (* 4 elements *)
167 | let positive = S.add Rot180 (S.add Rot90 (S.add Rot270 id))
168 | let refl_hv = S.add Rot180 (S.add VertRefl (S.add HorizRefl id))
169 | let refl_12 = S.add Rot180 (S.add Diag1Refl (S.add Diag2Refl id))
170 | (* 8 elements = D4 itself *)
171 | let d4 = all
172 | 
173 | let subgroup s =
174 |   (* TODO: check that [s] is indeed a subgroup;
175 |      otherwise fail or saturate it *)
176 |   s
177 | 
178 | type group =
179 |   | Id | Vert | Horiz | Rot180 | Diag1 | Diag2 | Positive
180 |   | Refl_hv | Refl_12 | D4
181 | 
182 | let quotient g1 g2 =
183 |   if S.equal g2 id then g1
184 |   else if S.equal g1 g2 then id
185 |   else if S.equal g1 refl_hv then
186 |     if S.equal g2 vert then horiz
187 |     else if S.equal g2 horiz then vert
188 |     else if S.equal g2 rot180 then refl_hv
189 |     else invalid_arg "quotient"
190 |   else if S.equal g1 positive then
191 |     if S.equal g2 rot180 then positive
192 |     else invalid_arg "quotient"
193 |   else if S.equal g1 refl_12 then
194 |     if S.equal g2 diag1 then diag2
195 |     else if S.equal g2 diag2 then diag1
196 |     else if S.equal g2 rot180 then refl_12
197 |     else invalid_arg "quotient"
198 |   else if S.equal g1 d4 then
199 |     if S.equal g2 refl_hv then positive
200 |     else if S.equal g2 positive then d4
201 |     else if S.equal g2 refl_12 then positive
202 |     else if S.equal g2 vert then positive
203 |     else if S.equal g2 horiz then positive
204 |     else if S.equal g2 rot180 then d4
205 |     else if S.equal g2 diag2 then positive
206 |     else if S.equal g2 diag1 then positive
207 |     else assert false
208 |   else
209 |     invalid_arg "quotient"
210 | 
211 | let elements g = g
212 | 
213 | let _compl = function
214 |   | Id -> D4
215 |   | Vert -> Positive
216 |   | Horiz -> Positive
217 |   | Rot180 -> Refl_12
218 |   | Diag1 -> Refl_hv
219 |   | Diag2 -> Refl_hv
220 |   | Positive -> Vert
221 |   | Refl_hv -> Diag1
222 |   | Refl_12 -> Horiz
223 |   | D4 -> Id
224 | 
225 | let _generated_by _s =
226 |   failwith "to be implemented"
227 | 


--------------------------------------------------------------------------------
/src/lib/d4.mli:
--------------------------------------------------------------------------------
 1 | (**************************************************************************)
 2 | (*                                                                        *)
 3 | (*  Combine - an OCaml library for combinatorics                          *)
 4 | (*                                                                        *)
 5 | (*  Copyright (C) 2012-2014                                               *)
 6 | (*    Remy El Sibaie                                                      *)
 7 | (*    Jean-Christophe Filliatre                                           *)
 8 | (*                                                                        *)
 9 | (*  This software is free software; you can redistribute it and/or        *)
10 | (*  modify it under the terms of the GNU Library General Public           *)
11 | (*  License version 2.1, with the special exception on linking            *)
12 | (*  described in file LICENSE.                                            *)
13 | (*                                                                        *)
14 | (*  This software is distributed in the hope that it will be useful,      *)
15 | (*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)
16 | (*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)
17 | (*                                                                        *)
18 | (**************************************************************************)
19 | 
20 | (** {2 Dihedral group D4} *)
21 | 
22 | (** the 8 elements of D4 are the 8 isometries of the square *)
23 | type t =
24 |   | Id | Rot90 | Rot180 | Rot270
25 |   | VertRefl | HorizRefl | Diag1Refl | Diag2Refl
26 | 
27 | val print : Format.formatter -> t -> unit
28 | 
29 | val is_positive: t -> bool
30 | 
31 | val compose: t -> t -> t
32 |   (** [compose i1 i2] returns the isometry result of the composition
33 |       of [i1] and [i2] *)
34 | 
35 | val to_string : t -> string
36 | 
37 | val apply : t -> w:int -> h:int -> int * int -> int * int
38 |   (** [apply i w h x y] returns the couple result of the isometry [i]
39 |       applied on the couple [x, y] *)
40 | 
41 | val trans_size : t -> int * int -> int * int
42 |   (** given a rectangle of size (w,h), [trans_size iso (w,h)] returns the size
43 |       (w',h') of the result rectangle by [iso] *)
44 | 
45 | module S: Set.S with type elt = t
46 | 
47 | val all: S.t
48 |   (** all elements of D4 *)
49 | 
50 | type subgroup
51 | 
52 | val quotient : subgroup -> subgroup -> subgroup
53 |   (** computes the quotient of two subgroups of D4 *)
54 | 
55 | (** {2 The 10 subgroups of D4} *)
56 | 
57 | (** 1 element *)
58 | val id: subgroup			(* { Id } *)
59 | 
60 | (** 2 elements *)
61 | val vert: subgroup			(* { Id, VertRefl } *)
62 | val horiz: subgroup			(* { Id, HorizRefl } *)
63 | val rot180: subgroup
64 | val diag1: subgroup
65 | val diag2: subgroup
66 | 
67 | (** 4 elements *)
68 | val positive: subgroup
69 | val refl_hv: subgroup
70 | val refl_12: subgroup
71 | 
72 | (** 8 elements = D4 itself *)
73 | val d4: subgroup
74 | 
75 | val elements: subgroup -> S.t
76 | 
77 | val subgroup: S.t -> subgroup
78 | 
79 | 


--------------------------------------------------------------------------------
/src/lib/dlx.ml:
--------------------------------------------------------------------------------
  1 | (**************************************************************************)
  2 | (*                                                                        *)
  3 | (*  Combine - an OCaml library for combinatorics                          *)
  4 | (*                                                                        *)
  5 | (*  Copyright (C) 2012-2014                                               *)
  6 | (*    Remy El Sibaie                                                      *)
  7 | (*    Jean-Christophe Filliatre                                           *)
  8 | (*                                                                        *)
  9 | (*  This software is free software; you can redistribute it and/or        *)
 10 | (*  modify it under the terms of the GNU Library General Public           *)
 11 | (*  License version 2.1, with the special exception on linking            *)
 12 | (*  described in file LICENSE.                                            *)
 13 | (*                                                                        *)
 14 | (*  This software is distributed in the hope that it will be useful,      *)
 15 | (*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)
 16 | (*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)
 17 | (*                                                                        *)
 18 | (**************************************************************************)
 19 | 
 20 | type node = {
 21 |   mutable c: node;
 22 |   mutable s: int;
 23 |   mutable up: node;
 24 |   mutable down: node;
 25 |   mutable left: node;
 26 |   mutable right: node;
 27 |   mutable name : string;
 28 | }
 29 | 
 30 | type t = {
 31 |   header: node;
 32 |   nc    : int;  (* number of columns *)
 33 | }
 34 | 
 35 | let one_node () =
 36 |   let rec h = { name = "head"; c = h; s = 0; up = h;
 37 |                 down = h; left = h; right = h } in h
 38 | 
 39 | (* Adds n2 to the right of n1 in the DLM *)
 40 | let add_right n1 n2 =
 41 |   let tmp = n1.right in
 42 |   n1.right <- n2;
 43 |   n2.right <- tmp;
 44 |   n2.left <- n1;
 45 |   n2.right.left <- n2
 46 | 
 47 | (* Adds n2 under n1 in the DLM *)
 48 | let add_below n1 n2 =
 49 |   let tmp = n1.down in
 50 |   n1.down <- n2;
 51 |   n2.down <- tmp;
 52 |   n2.up <- n1;
 53 |   n2.down.up <- n2
 54 | 
 55 | (* Adds row after the headers in the DLM *)
 56 | let add_row headers row i =
 57 |   let dummy = one_node () in
 58 |   let rec addi_rec n previous =
 59 |     if n < Array.length row then
 60 |       if row.(n) then begin
 61 |         let element = one_node () in
 62 |         element.s <- i;
 63 |         element.c <- headers.(n);
 64 |         element.name <- "";
 65 |         headers.(n).s <- headers.(n).s + 1;
 66 |         if previous != dummy then add_right previous element;
 67 |         add_below headers.(n) element;
 68 |         addi_rec (n + 1) element
 69 |       end else
 70 |         addi_rec (n + 1) previous
 71 |   in
 72 |   addi_rec 0 dummy
 73 | 
 74 | (* Returns a DLM only with the headers *)
 75 | let generate_headers ?primary size h =
 76 |   let headers = Array.init size (fun _ -> one_node ()) in
 77 |   let primary = match primary with
 78 |     | None -> size
 79 |     | Some p -> if p < 0 || p > size then invalid_arg "create"; p
 80 |   in
 81 |   headers.(0).s <- 0;
 82 |   headers.(0).name <- "C0";
 83 |   add_right h headers.(0);
 84 |   for n = 1 to primary - 1 do
 85 |     headers.(n).s <- 0;
 86 |     headers.(n).name <- String.concat "" ["C";string_of_int n];
 87 |     add_right headers.(n - 1) headers.(n);
 88 |   done;
 89 |   headers (* on retourne le node array *)
 90 | 
 91 | (* Applies f to elements of the DLM, from left to right*)
 92 | let iter_right ?(self = true) f n =
 93 |   if self then f n;
 94 |   let rec rec_iter_right node =
 95 |     if node != n then begin
 96 |       f node;
 97 |       rec_iter_right node.right
 98 |     end
 99 |   in
100 |   rec_iter_right n.right
101 | 
102 | (* Creates a DLM from a boolean matrix *)
103 | let create ?primary m =
104 |   let h = one_node () in
105 |   let nc = Array.length m.(0) in
106 |   let headers = generate_headers ?primary nc h in
107 |   for i = Array.length m - 1 downto 0 do
108 |     add_row headers m.(i) i
109 |   done;
110 |   { header = h; nc = nc; }
111 | 
112 | let create_sparse ?primary ~columns:nc a =
113 |   let h = one_node () in
114 |   let headers = generate_headers ?primary nc h in
115 |   let row = Array.make nc false in
116 |   for i = Array.length a - 1 downto 0 do
117 |     Array.fill row 0 nc false;
118 |     List.iter (fun c -> row.(c) <- true) a.(i);
119 |     add_row headers row i
120 |   done;
121 |   { header = h; nc = nc; }
122 | 
123 | (* test create_sparse using create
124 | let create ?primary m =
125 |   let nc = Array.length m.(0) in
126 |   let row a =
127 |     let r = ref [] in
128 |     Array.iteri (fun i b -> if b then r := i :: !r) a;
129 |     !r
130 |   in
131 |   create_sparse ?primary ~columns:nc (Array.map row m)
132 | *)
133 | 
134 | (* Applies f to elements of the DLM, from up to down*)
135 | let iter_down ?(self = true) f n =
136 |   if self then f n;
137 |   let rec rec_iter_down node =
138 |     if node != n then begin
139 |       f node;
140 |       rec_iter_down node.down
141 |     end
142 |   in
143 |   rec_iter_down n.down
144 | 
145 | (* Applies f to elements of the DLM, from right to left *)
146 | let iter_left ?(self = true) f n =
147 |   if self then f n;
148 |   let rec rec_iter_left node =
149 |     if node != n then begin
150 |       f node;
151 |       rec_iter_left node.left
152 |     end
153 |   in
154 |   rec_iter_left n.left
155 | 
156 | (* Applies f to elements of the DLM, from down to up *)
157 | let iter_up ?(self = true) f n =
158 |   if self then f n;
159 |   let rec rec_iter_up node =
160 |     if node != n then begin
161 |       f node;
162 |       rec_iter_up node.up
163 |     end
164 |   in
165 |   rec_iter_up n.up
166 | 
167 | (* Removes the given column and all rows in column own list from
168 |  the DLM*)
169 | let cover column_header =
170 |   column_header.right.left <- column_header.left;
171 |   column_header.left.right <- column_header.right;
172 |   let cover_node n =
173 |     n.down.up <- n.up;
174 |     n.up.down <- n.down;
175 |     n.c.s <- n.c.s - 1
176 |   in
177 |   let cover_row n =
178 |     iter_right ~self:false cover_node n
179 |   in
180 |   iter_down ~self:false cover_row column_header
181 | 
182 | (* Un-removes the given column and all rows in column own list from
183 |  the DLM*)
184 | let uncover column_header =
185 |   let uncover_node n =
186 |     n.c.s <- n.c.s + 1;
187 |     n.down.up <- n;
188 |     n.up.down <- n
189 |   in
190 |   let uncover_row n =
191 |     iter_left ~self:false uncover_node n
192 |   in
193 |   iter_up ~self:false uncover_row column_header;
194 |   column_header.right.left <- column_header;
195 |   column_header.left.right <- column_header
196 | 
197 | (* Print the given solution *)
198 | let print_solution fmt (o, k) =
199 |   for i = 0 to k - 1  do
200 |     Format.fprintf fmt "%d" o.(i).s;
201 |     if i < k-1 then Format.fprintf fmt "@ "
202 |   done
203 | 
204 | (* Returns the min column *)
205 | let choose_min h =
206 |   let rec rec_chose min node =
207 |     if node == h then min
208 |     else if node.s < min.s then
209 |       rec_chose node node.right
210 |     else
211 |       rec_chose min node.right
212 |   in
213 |   rec_chose h.right h.right.right
214 | 
215 | (* Searches for all solutions, applying [f] on each *)
216 | let rec search f k h o =
217 |   if h == h.right then f (o, k)
218 |   else
219 |     let column = choose_min h in
220 |     let get_down r =
221 |       o.(k) <- r;
222 |       iter_right ~self:false (fun j -> cover j.c) r;
223 |       search f (k + 1) h o;
224 |       iter_left ~self:false (fun j -> uncover j.c) r
225 |     in
226 |       cover column;
227 |       iter_down ~self:false get_down column;
228 |       uncover column
229 | 
230 | type solution = node array * int
231 | 
232 | (* Returns a solution as an int list *)
233 | let list_of_solution (o, k) =
234 |   let rec rec_stl l i =
235 |     if i = k then l else rec_stl (o.(i).s :: l) (i + 1)
236 |   in
237 |   rec_stl [] 0
238 | 
239 | 
240 | (* Applies f to all solutions returned by function search *)
241 | let iter_solution f dlm =
242 |   let o = Array.init dlm.nc (fun _ -> one_node ()) in
243 |   search f 0 dlm.header o
244 | 
245 | let count_solutions m =
246 |   let r = ref 0 in
247 |   iter_solution (fun (_, _) -> r:= !r + 1) m;
248 |   !r
249 | 
250 | (* unused... *)
251 | let _get_solution_list m =
252 |   let list_ref = ref [] in
253 |   iter_solution (
254 |     fun (o, k) -> list_ref := list_of_solution (o, k) :: !list_ref
255 |   ) m;
256 |   !list_ref
257 | 
258 | (* Print the given solution as an int list *)
259 | let _print_list_solution fmt l =
260 |   List.iter (fun e -> Format.fprintf fmt "%d " e) l; Format.fprintf fmt "@."
261 | 
262 | exception Solution of (node array * int)
263 | 
264 | let get_first_solution m =
265 |   try
266 |     iter_solution (fun s -> raise (Solution s)) m;
267 |     raise Not_found
268 |   with
269 |     | Solution s -> s
270 | 


--------------------------------------------------------------------------------
/src/lib/dlx.mli:
--------------------------------------------------------------------------------
 1 | (**************************************************************************)
 2 | (*                                                                        *)
 3 | (*  Combine - an OCaml library for combinatorics                          *)
 4 | (*                                                                        *)
 5 | (*  Copyright (C) 2012-2014                                               *)
 6 | (*    Remy El Sibaie                                                      *)
 7 | (*    Jean-Christophe Filliatre                                           *)
 8 | (*                                                                        *)
 9 | (*  This software is free software; you can redistribute it and/or        *)
10 | (*  modify it under the terms of the GNU Library General Public           *)
11 | (*  License version 2.1, with the special exception on linking            *)
12 | (*  described in file LICENSE.                                            *)
13 | (*                                                                        *)
14 | (*  This software is distributed in the hope that it will be useful,      *)
15 | (*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)
16 | (*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)
17 | (*                                                                        *)
18 | (**************************************************************************)
19 | 
20 | (** Knuth's dancing links (aka DLX)
21 |     see http://en.wikipedia.org/wiki/Dancing_Links *)
22 | 
23 | type t
24 |   (** The internal data structure for DLX *)
25 | 
26 | val create: ?primary:int -> bool array array -> t
27 |   (** Creates a DLX data structure from a matrix of Boolean values.
28 |       The purpose of DLX is to solve the Exact Matrix Cover problem
29 |       for this matrix, that is to find one (or all) subsets of rows
30 |       such that each column contains exactly one value [true] for primary
31 |       columns and at most one [true] value for secondary columns.
32 | 
33 |       If [primary] is given, it means that the first [primary] columns are
34 |       primary; otherwise, all columns are primary columns. *)
35 | 
36 | val create_sparse: ?primary:int -> columns:int -> int list array -> t
37 |   (** To be used when the matrix is sparse.
38 |       [columns] is the total number of columns.
39 |       The array contains the rows, each row being the list of the columns
40 |       containing the value [true]. *)
41 | 
42 | type solution
43 |   (** Abstract type of a solution. *)
44 | 
45 | val list_of_solution: solution -> int list
46 |   (** Decodes a solution as a list of rows (rows are 0-based) *)
47 | 
48 | val get_first_solution: t -> solution
49 |   (** Returns the first solution that is found.
50 |       Raises [Not_found] if the problem has no solution. *)
51 | 
52 | val count_solutions: t -> int
53 |   (** Returns the number of solutions. *)
54 | 
55 | val iter_solution: (solution -> unit) -> t -> unit
56 |   (** [iter_solution f p] applies [f] on each solution of the problem [p],
57 |       one at a time.
58 |       CAVEAT: a solution is no longer valid as soon as iteration restarts.
59 |       Therefore solutions must not be stored as they are discovered.
60 |       If this is necessary, they must be first decoded using
61 |       [list_of_solution]. *)
62 | 
63 | val print_solution: Format.formatter -> solution -> unit
64 |   (** Print a solution, as a space-separated list of integers *)
65 | 


--------------------------------------------------------------------------------
/src/lib/dlxa.ml:
--------------------------------------------------------------------------------
  1 | (**************************************************************************)
  2 | (*                                                                        *)
  3 | (*  Combine - an OCaml library for combinatorics                          *)
  4 | (*                                                                        *)
  5 | (*  Copyright (C) 2012-2014                                               *)
  6 | (*    Remy El Sibaie                                                      *)
  7 | (*    Jean-Christophe Filliatre                                           *)
  8 | (*                                                                        *)
  9 | (*  This software is free software; you can redistribute it and/or        *)
 10 | (*  modify it under the terms of the GNU Library General Public           *)
 11 | (*  License version 2.1, with the special exception on linking            *)
 12 | (*  described in file LICENSE.                                            *)
 13 | (*                                                                        *)
 14 | (*  This software is distributed in the hope that it will be useful,      *)
 15 | (*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)
 16 | (*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)
 17 | (*                                                                        *)
 18 | (**************************************************************************)
 19 | 
 20 | (* Implementation of DLX using arrays and integer indices instead of
 21 |    records and (thus pointers).
 22 | 
 23 |    Each node is an integer.
 24 |    Node 0 is the main header.
 25 |    Nodes 1..nc are the columns headers.
 26 |    Nodes nc+1 and above are regular nodes.
 27 | *)
 28 | 
 29 | type t = {
 30 |   nc    : int;        (* number of columns) *)
 31 |   c     : int array;
 32 |   s     : int array;
 33 |   up    : int array;
 34 |   down  : int array;
 35 |   left  : int array;
 36 |   right : int array;
 37 |   name  : string array;
 38 |   mutable next: int; (* next node available *)
 39 | }
 40 | 
 41 | let one_node t =
 42 |   let n = t.next in
 43 |   t.next <- n + 1;
 44 |   t.name.(n) <- "head";
 45 |   t.c.(n) <- n;
 46 |   t.s.(n) <- 0;
 47 |   t.up.(n) <- n;
 48 |   t.down.(n) <- n;
 49 |   t.left.(n) <- n;
 50 |   t.right.(n) <- n;
 51 |   n
 52 | 
 53 | (* Adds n2 to the right of n1 in the DLM *)
 54 | let add_right t n1 n2 =
 55 |   let tmp = t.right.(n1) in
 56 |   t.right.(n1) <- n2;
 57 |   t.right.(n2) <- tmp;
 58 |   t.left.(n2) <- n1;
 59 |   t.left.(t.right.(n2)) <- n2
 60 | 
 61 | (* Adds n2 under n1 in the DLM *)
 62 | let add_below t n1 n2 =
 63 |   let tmp = t.down.(n1) in
 64 |   t.down.(n1) <- n2;
 65 |   t.down.(n2) <- tmp;
 66 |   t.up.(n2) <- n1;
 67 |   t.up.(t.down.(n2)) <- n2
 68 | 
 69 | (* Adds row after the headers in the DLM *)
 70 | let add_row t row i =
 71 |   let rec addi_rec n previous =
 72 |     if n < Array.length row then
 73 |       if row.(n) then begin
 74 |         let element = one_node t in
 75 |         assert (element > t.nc);
 76 |         let h = n + 1 in
 77 |         t.s.(element) <- i;
 78 |         t.c.(element) <- h;
 79 |         t.name.(element) <- "";
 80 |         t.s.(h) <- t.s.(h) + 1;
 81 |         if previous <> -1 then add_right t previous element;
 82 |         add_below t h element;
 83 |         addi_rec (n + 1) element
 84 |       end else
 85 |         addi_rec (n + 1) previous
 86 |   in
 87 |   addi_rec 0 (-1)
 88 | 
 89 | let generate_headers ?primary size t =
 90 |   let primary = match primary with
 91 |     | None -> size
 92 |     | Some p -> if p < 0 || p > size then invalid_arg "create"; p
 93 |   in
 94 |   (* create size nodes for the headers *)
 95 |   for _ = 1 to size do ignore (one_node t) done;
 96 |   (* and link the primary ones with node 0 *)
 97 |   for n = 1 to primary do
 98 |     t.s.(n) <- 0;
 99 |     t.name.(n) <- "C" ^ string_of_int (n - 1);
100 |     add_right t (n - 1) n;
101 |   done
102 | 
103 | let create ?primary m =
104 |   let nc = Array.length m.(0) in
105 |   let add n b = if b then n+1 else n in
106 |   let n = Array.fold_left (Array.fold_left add) (1 + nc) m in
107 |   let t = {
108 |     nc = nc;
109 |     c     = Array.make n 0;
110 |     s     = Array.make n 0;
111 |     up    = Array.make n 0;
112 |     down  = Array.make n 0;
113 |     left  = Array.make n 0;
114 |     right = Array.make n 0;
115 |     name  = Array.make n "";
116 |     next = 0;
117 |   } in
118 |   let n0 = one_node t in
119 |   assert (n0 = 0);
120 |   generate_headers ?primary nc t;
121 |   for i = Array.length m - 1 downto 0 do
122 |     add_row t m.(i) i
123 |   done;
124 |   t
125 | 
126 | let create_sparse ?primary ~columns m =
127 |   let nc = columns in
128 |   let n = Array.fold_left (fun acc l -> acc + List.length l) (1 + nc) m in
129 |   let t = {
130 |     nc = nc;
131 |     c     = Array.make n 0;
132 |     s     = Array.make n 0;
133 |     up    = Array.make n 0;
134 |     down  = Array.make n 0;
135 |     left  = Array.make n 0;
136 |     right = Array.make n 0;
137 |     name  = Array.make n "";
138 |     next = 0;
139 |   } in
140 |   let n0 = one_node t in
141 |   assert (n0 = 0);
142 |   generate_headers ?primary nc t;
143 |   let row = Array.make nc false in
144 |   for i = Array.length m - 1 downto 0 do
145 |     Array.fill row 0 nc false;
146 |     List.iter (fun c -> row.(c) <- true) m.(i);
147 |     add_row t row i
148 |   done;
149 |   t
150 | 
151 | (* Applies f to elements of the DLM, from left to right*)
152 | let iter_right t ?(self = true) f n =
153 |   if self then f n;
154 |   let right = t.right in
155 |   let rec rec_iter_right node =
156 |     if node != n then begin
157 |       f node;
158 |       rec_iter_right right.(node)
159 |     end
160 |   in
161 |   rec_iter_right right.(n)
162 | 
163 | (* Applies f to elements of the DLM, from up to down*)
164 | let iter_down t ?(self = true) f n =
165 |   if self then f n;
166 |   let down = t.down in
167 |   let rec rec_iter_down node =
168 |     if node != n then begin
169 |       f node;
170 |       rec_iter_down down.(node)
171 |     end
172 |   in
173 |   rec_iter_down down.(n)
174 | 
175 | (* Applies f to elements of the DLM, from right to left *)
176 | let iter_left t ?(self = true) f n =
177 |   if self then f n;
178 |   let left = t.left in
179 |   let rec rec_iter_left node =
180 |     if node != n then begin
181 |       f node;
182 |       rec_iter_left left.(node)
183 |     end
184 |   in
185 |   rec_iter_left left.(n)
186 | 
187 | (* Applies f to elements of the DLM, from down to up *)
188 | let iter_up t ?(self = true) f n =
189 |   if self then f n;
190 |   let up = t.up in
191 |   let rec rec_iter_up node =
192 |     if node != n then begin
193 |       f node;
194 |       rec_iter_up up.(node)
195 |     end
196 |   in
197 |   rec_iter_up up.(n)
198 | 
199 | (* Removes the given column and all rows in column own list from
200 |  the DLM*)
201 | let cover t h =
202 |   t.left.(t.right.(h)) <- t.left.(h);
203 |   t.right.(t.left.(h)) <- t.right.(h);
204 |   let cover_node n =
205 |     t.up.(t.down.(n)) <- t.up.(n);
206 |     t.down.(t.up.(n)) <- t.down.(n);
207 |     let c = t.c.(n) in
208 |     t.s.(c) <- t.s.(c) - 1
209 |   in
210 |   let cover_row n =
211 |     iter_right t ~self:false cover_node n
212 |   in
213 |   iter_down t ~self:false cover_row h
214 | 
215 | (* Un-removes the given column and all rows in column own list from
216 |  the DLM*)
217 | let uncover t h =
218 |   let uncover_node n =
219 |     let c = t.c.(n) in
220 |     t.s.(c) <- t.s.(c) + 1;
221 |     t.up.(t.down.(n)) <- n;
222 |     t.down.(t.up.(n)) <- n
223 |   in
224 |   let uncover_row n =
225 |     iter_left t ~self:false uncover_node n
226 |   in
227 |   iter_up t ~self:false uncover_row h;
228 |   t.left.(t.right.(h)) <- h;
229 |   t.right.(t.left.(h)) <- h
230 | 
231 | (* Returns the min column *)
232 | let choose_min t =
233 |   let rec rec_chose min node =
234 |     if node == 0 then min
235 |     else if t.s.(node) < t.s.(min) then
236 |       rec_chose node t.right.(node)
237 |     else
238 |       rec_chose min t.right.(node)
239 |   in
240 |   let c = t.right.(0) in
241 |   rec_chose c t.right.(c)
242 | 
243 | (* Searches for all solutions, applying [f] on each *)
244 | let rec search f k t o =
245 |   if t.right.(0) == 0 then f (o, k)
246 |   else
247 |     let column = choose_min t in
248 |     let get_down r =
249 |       o.(k) <- r;
250 |       iter_right t ~self:false (fun j -> cover t t.c.(j)) r;
251 |       search f (k + 1) t o;
252 |       iter_left t ~self:false (fun j -> uncover t t.c.(j)) r
253 |     in
254 |     cover t column;
255 |     iter_down t ~self:false get_down column;
256 |     uncover t column
257 | 
258 | (* Applies f to all solutions returned by function search *)
259 | let iter_solution f t =
260 |   let o = Array.make t.nc 0 in
261 |   search f 0 t o
262 | 
263 | let count_solutions m =
264 |   let r = ref 0 in
265 |   iter_solution (fun (_, _) -> r:= !r + 1) m;
266 |   !r
267 | 


--------------------------------------------------------------------------------
/src/lib/dlxa.mli:
--------------------------------------------------------------------------------
 1 | (**************************************************************************)
 2 | (*                                                                        *)
 3 | (*  Combine - an OCaml library for combinatorics                          *)
 4 | (*                                                                        *)
 5 | (*  Copyright (C) 2012-2014                                               *)
 6 | (*    Remy El Sibaie                                                      *)
 7 | (*    Jean-Christophe Filliatre                                           *)
 8 | (*                                                                        *)
 9 | (*  This software is free software; you can redistribute it and/or        *)
10 | (*  modify it under the terms of the GNU Library General Public           *)
11 | (*  License version 2.1, with the special exception on linking            *)
12 | (*  described in file LICENSE.                                            *)
13 | (*                                                                        *)
14 | (*  This software is distributed in the hope that it will be useful,      *)
15 | (*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)
16 | (*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)
17 | (*                                                                        *)
18 | (**************************************************************************)
19 | 
20 | (** Knuth's dancing links (aka DLX)
21 |     see http://en.wikipedia.org/wiki/Dancing_Links
22 | 
23 |     Alternative implementation using arrays and integer indices
24 |     instead of records and pointers.
25 | 
26 |     Experimentally, it is almost twice faster than Dlx (1.8 to be precise).
27 |     The reason is that mutations of record fields incurs some GC bookkeeping,
28 |     while mutation of mere integer arrays does not.
29 | *)
30 | 
31 | type t
32 |   (** The internal data structure for DLX *)
33 | 
34 | val create: ?primary:int -> bool array array -> t
35 |   (** Creates a DLX data structure from a matrix of Boolean values.
36 |       The purpose of DLX is to solve the Exact Matrix Cover problem
37 |       for this matrix, that is to find one (or all) subsets of rows
38 |       such that each column contains exactly one value [true] for primary
39 |       columns and at most one [true] value for secondary columns.
40 | 
41 |       If [primary] is given, it means that the first [primary] columns are
42 |       primary; otherwise, all columns are primary columns. *)
43 | 
44 | val create_sparse: ?primary:int -> columns:int -> int list array -> t
45 | 
46 | val count_solutions: t -> int
47 |   (** Returns the number of solutions. *)
48 | 
49 | 


--------------------------------------------------------------------------------
/src/lib/dune:
--------------------------------------------------------------------------------
 1 | (library
 2 |  (public_name combine)
 3 |  (modules
 4 |   ;
 5 |   matrix
 6 |   dlx
 7 |   dlxa
 8 |   zdd
 9 |   emc
10 |   d4
11 |   ;
12 |   cube
13 |   tiling
14 |   backtracking
15 |   ;
16 |   ast
17 |   parser
18 |   lexer
19 |   interp)
20 |  (modules_without_implementation ast))
21 | 
22 | (menhir
23 |  (modules parser))
24 | 
25 | (ocamllex
26 |  (modules lexer))
27 | 


--------------------------------------------------------------------------------
/src/lib/emc.ml:
--------------------------------------------------------------------------------
  1 | (**************************************************************************)
  2 | (*                                                                        *)
  3 | (*  Combine - an OCaml library for combinatorics                          *)
  4 | (*                                                                        *)
  5 | (*  Copyright (C) 2012-2014                                               *)
  6 | (*    Remy El Sibaie                                                      *)
  7 | (*    Jean-Christophe Filliatre                                           *)
  8 | (*                                                                        *)
  9 | (*  This software is free software; you can redistribute it and/or        *)
 10 | (*  modify it under the terms of the GNU Library General Public           *)
 11 | (*  License version 2.1, with the special exception on linking            *)
 12 | (*  described in file LICENSE.                                            *)
 13 | (*                                                                        *)
 14 | (*  This software is distributed in the hope that it will be useful,      *)
 15 | (*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)
 16 | (*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)
 17 | (*                                                                        *)
 18 | (**************************************************************************)
 19 | 
 20 | (* EMC Module *)
 21 | 
 22 | open Format
 23 | 
 24 | 
 25 | type solution = int list
 26 | (** a solution is a set of rows *)
 27 | 
 28 | let print_boolean_array fmt a =
 29 |   Array.iter (
 30 |     fun cell ->
 31 |       if cell then fprintf fmt "1"
 32 |       else fprintf fmt "0"
 33 |   ) a
 34 | 
 35 | (* display a boolean matrix *)
 36 | let print_boolean_matrix fmt m =
 37 |   Array.iter (
 38 |     fun col ->
 39 |       print_boolean_array fmt col;
 40 |       fprintf fmt "@\n"
 41 |   ) m
 42 | 
 43 | let print_matrix_size fmt p =
 44 |   fprintf fmt "%dx%d" (Array.length p) (Array.length p.(0))
 45 | 
 46 | 
 47 | module type S = sig
 48 |   type t
 49 |   val create: ?primary:int -> bool array array -> t
 50 |   val create_sparse: ?primary:int -> columns:int -> int list array -> t
 51 |   val find_solution: t -> solution
 52 |   val iter_solution: (solution -> unit) -> t -> unit
 53 |   val count_solutions: t -> int
 54 |   module type ARITH = sig
 55 |     type t
 56 |     val zero: t
 57 |     val one: t
 58 |     val add: t -> t -> t
 59 |   end
 60 |   module Count(A: ARITH) : sig
 61 |     val count_solutions: t -> A.t
 62 |   end
 63 | end
 64 | 
 65 | 
 66 | module D = struct
 67 |   type t = Dlx.t
 68 |   let create = Dlx.create
 69 |   let create_sparse = Dlx.create_sparse
 70 |   let find_solution p = Dlx.list_of_solution (Dlx.get_first_solution p)
 71 |   let iter_solution f p = Dlx.iter_solution (
 72 |     fun e -> f (Dlx.list_of_solution e)) p
 73 |   let count_solutions p = Dlx.count_solutions p
 74 |   module type ARITH = sig
 75 |     type t
 76 |     val zero: t
 77 |     val one: t
 78 |     val add: t -> t -> t
 79 |   end
 80 |   module Count = functor (A: ARITH) ->
 81 |   struct
 82 |     let count_solutions p =
 83 |       let r = ref A.zero in
 84 |       iter_solution (fun _ -> r:= A.add !r A.one) p;
 85 |       !r
 86 |   end
 87 | end
 88 | 
 89 | 
 90 | module Z = struct
 91 | 
 92 |   open Zdd
 93 | 
 94 |   type t = Zdd.t
 95 | 
 96 |   let column ?primary j n colj =
 97 |     (* we build the solution from bottom up, i.e. i = n-1,...,1,0 *)
 98 |     let rec build z zf i =
 99 |      (* z  = exactly one i such that m[i][j]=true
100 |         zf = only i such that m[i][j]=false *)
101 |       if i < 0 then z
102 |       else if colj i then build (construct i z zf) zf (i-1)
103 |       else build (construct i z z) (construct i zf zf) (i-1)
104 |     in
105 |     let primary = match primary with
106 |       | None -> true
107 |       | Some p -> j < p
108 |     in
109 |     build (if primary then bottom else top) top (n-1)
110 | 
111 |   let _inter_right_to_left fmt cols =
112 |     let width = Array.length cols in
113 |     let z = ref cols.(0) in
114 |     for j = 1 to width - 1 do
115 |       let c = cols.(j) in
116 |       fprintf fmt "size = %d@." (size !z);
117 |       z := inter c !z
118 |     done;
119 |     !z
120 | 
121 |   let _inter_left_to_right fmt cols =
122 |     let width = Array.length cols in
123 |     let z = ref cols.(width - 1) in
124 |     for j = width - 2 downto 0 do
125 |       let c = cols.(j) in
126 |       fprintf fmt "size = %d@." (size !z);
127 |       z := inter c !z
128 |     done;
129 |     !z
130 | 
131 |   let inter_middle_balancing cols =
132 |     let width = Array.length cols in
133 |     let min = 0 in
134 |     let max = width - 1 in
135 |     let rec balancing min max =
136 |       let mid = min + (max - min) / 2 + ((max - min) mod 2) in
137 |       if min = max then ()
138 |       else begin
139 |         for j = min to mid - 1 do
140 |           (* printf "%d <- %d/\\%d@." (mid + j - min) (mid + j - min) j; *)
141 |           cols.(mid + (j - min)) <- inter cols.(mid + (j - min)) cols.(j)
142 |         done;
143 |         balancing mid max
144 |       end
145 |     in
146 |     balancing min max;
147 |     cols.(max)
148 | 
149 |   let first_row _j h colj =
150 |     let rec lookup i = if i = h || colj i then i else lookup (i+1) in
151 |     lookup 0
152 | 
153 |   let create ?primary m =
154 |     let height = Array.length m in
155 |     let width = Array.length m.(0) in
156 |     let make_col j =
157 |       let colj i = m.(i).(j) in
158 |       first_row j height colj, column ?primary j height colj in
159 |     let cols = Array.init width make_col in
160 |     let compare (i1, _) (i2, _) = Stdlib.compare i2 i1 in
161 |     Array.sort compare cols;
162 |     inter_middle_balancing (Array.map snd cols)
163 | 
164 |   let create_sparse ?primary ~columns a =
165 |     let height = Array.length a in
166 |     let width = columns in
167 |     let cols = Hashtbl.create 17 in
168 |     Array.iteri
169 |       (fun i rowi -> List.iter (fun j -> Hashtbl.add cols j i) rowi) a;
170 |     let col = Array.make height false in
171 |     let make_col j =
172 |       Array.fill col 0 height false;
173 |       List.iter (fun i -> col.(i) <- true) (Hashtbl.find_all cols j);
174 |       let colj i = col.(i) in
175 |       first_row j height colj, column ?primary j height colj in
176 |     let cols = Array.init width make_col in
177 |     let compare (i1, _) (i2, _) = Stdlib.compare i2 i1 in
178 |     Array.sort compare cols;
179 |     inter_middle_balancing (Array.map snd cols)
180 | 
181 |   let find_solution p = choose_list p
182 |   let iter_solution f p = iter_list f p
183 |   let count_solutions p = cardinal p
184 | 
185 |   module type ARITH = sig
186 |     type t
187 |     val zero: t
188 |     val one: t
189 |     val add: t -> t -> t
190 |   end
191 |   module Count(A: ARITH) = struct
192 |     module C = Cardinal(A)
193 |     let count_solutions p = C.cardinal p
194 |   end
195 | end
196 | 
197 | module Sat = struct
198 | 
199 |   type lit = Pos of int | Neg of int
200 | 
201 |   type cnf = lit list list
202 | 
203 |   type t = {
204 |     fmla: cnf;
205 |     nbvars: int;
206 |   }
207 | 
208 |   let print_lit fmt = function
209 |     | Pos i -> fprintf fmt "%d " (i+1)
210 |     | Neg i -> fprintf fmt "-%d " (i+1)
211 | 
212 |   let print_clause fmt l =
213 |     List.iter (print_lit fmt) l;
214 |     fprintf fmt "0@\n"
215 | 
216 |   let print fmt t =
217 |     fprintf fmt "p cnf %d %d @\n" t.nbvars (List.length t.fmla);
218 |     List.iter (print_clause fmt) t.fmla
219 | 
220 |   let print_in_file f m =
221 |     let c = open_out f in
222 |     let fmt = formatter_of_out_channel c in
223 |     print fmt m;
224 |     fprintf fmt "@.";
225 |     close_out c
226 | 
227 |   (* Idea: one variable vi for each row (true iff the row is selected)
228 |      and thus the formula is
229 | 
230 |        forall primary column i.
231 |          exists row j st m[j,i]=1. vj
232 | 
233 |      and
234 | 
235 |        forall secondary column i.
236 |        forall row j st m[j,i]=1.
237 |        forall row j' st m[j',i]=1 and j'<> i. not(vj) or not(vj')
238 | 
239 |   *)
240 | 
241 |   let fmla_of_emc ~primary m =
242 |     let length, width = Array.length m, Array.length m.(0) in
243 |     let conj = ref [] in
244 |     for i = 0 to width - 1 do
245 |       if i < primary then begin
246 | 	let disj = ref [] in
247 | 	for j = 0 to length - 1 do
248 |           if m.(j).(i) then disj := Pos j :: !disj
249 | 	done;
250 | 	conj := !disj :: !conj;
251 |       end;
252 |       for j = 0 to length -1 do if m.(j).(i) then
253 |         for j2 = j + 1 to length -1 do if m.(j2).(i) then
254 |           conj := [Neg j; Neg j2] :: !conj
255 |         done
256 |       done
257 |     done;
258 |     !conj
259 | 
260 |   let create ~primary m =
261 |     { nbvars = Array.length m;
262 |       fmla = fmla_of_emc ~primary m; }
263 | 
264 |   let create_sparse ~primary ~columns a =
265 |     let length = Array.length a in
266 |     let conj = ref [] in
267 |     let a' = Array.make columns [] in
268 |     (* change the columns list array to row list array *)
269 |     for i = 0 to length - 1 do
270 |       List.iter (fun e ->
271 | 	a'.(e) <- i::a'.(e)
272 |       ) a.(i);
273 |     done;
274 |     let length' = Array.length a' in
275 |     (* create all the disjunction to limit the choice of a column in the fmla *)
276 |     let rec disj_of row = function
277 |       | [] -> ()
278 |       | h::t -> conj := [Neg row; Neg h] :: !conj; disj_of row t
279 |     in
280 |     let rec limit_col = function [] -> () | h::t -> disj_of h t; limit_col t in
281 |     for i = 0 to length' - 1 do
282 |       (* create the disjunction to force the choice of at least a 1 which
283 | 	 is on a primary column *)
284 |       if primary = length' || i < primary then begin
285 | 	let disj = ref [] in
286 | 	List.iter (fun e -> disj := Pos e :: !disj) a'.(i);
287 | 	conj := !disj :: !conj;
288 |       end;
289 |       limit_col a'.(i);
290 |     done;
291 |     { nbvars = length;
292 |       fmla = !conj; }
293 | 
294 |   type sat_solver = input:string -> output:string -> string
295 | 
296 |   let find_solution (sat_solver: sat_solver) t =
297 |     let input = Filename.temp_file "combine" ".dimacs" in
298 |     print_in_file input t;
299 |     let output = Filename.temp_file "combine" ".out" in
300 |     let sat_command = sat_solver ~input ~output in
301 |     ignore (Sys.command sat_command);
302 |     let c = open_in output in
303 |     let sol = ref [] in
304 |     try
305 |       let s = input_line c in
306 |       if s = "UNSAT" then raise Not_found;
307 |       if s <> "SAT" then
308 |         failwith (sprintf "Sat.find_solution: got '%s' from SAt solver" s);
309 |       let s = input_line c in
310 |       close_in c;
311 |       let rec read s =
312 |         let i, s = Scanf.sscanf s "%d %s@\n" (fun i s -> i, s) in
313 |         if i = 0 then !sol
314 |         else begin if i > 0 then sol := i-1 :: !sol; read s end
315 |       in
316 |       read s
317 |     with End_of_file ->
318 |       close_in c;
319 |       failwith "Sat.find_solution: unexpected end of file"
320 | 
321 | end
322 | 


--------------------------------------------------------------------------------
/src/lib/emc.mli:
--------------------------------------------------------------------------------
  1 | (**************************************************************************)
  2 | (*                                                                        *)
  3 | (*  Combine - an OCaml library for combinatorics                          *)
  4 | (*                                                                        *)
  5 | (*  Copyright (C) 2012-2014                                               *)
  6 | (*    Remy El Sibaie                                                      *)
  7 | (*    Jean-Christophe Filliatre                                           *)
  8 | (*                                                                        *)
  9 | (*  This software is free software; you can redistribute it and/or        *)
 10 | (*  modify it under the terms of the GNU Library General Public           *)
 11 | (*  License version 2.1, with the special exception on linking            *)
 12 | (*  described in file LICENSE.                                            *)
 13 | (*                                                                        *)
 14 | (*  This software is distributed in the hope that it will be useful,      *)
 15 | (*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)
 16 | (*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)
 17 | (*                                                                        *)
 18 | (**************************************************************************)
 19 | 
 20 | (** {2 Exact Matrix Cover problem}
 21 | 
 22 |     Given a matrix of Booleans values (say 0 and 1), the exact matrix problem
 23 |     (EMC) is to find a subset of rows such that each column contains exactly
 24 |     one 1.
 25 |     This module provides a common interface to solve this problem using
 26 |     two different techniques: Dancing Links (module D, see also
 27 |     {!Dlx}) and Zero-Suppressed Binary Decision Diagrams (module Z, see also
 28 |     {!Zdd}).
 29 | 
 30 |     The EMC problem is slightly generalized as follows: the [primary] first
 31 |     columns must be covered exactly once, and the remaining columns (called
 32 |     secondary columns) must be covered at most one.
 33 | *)
 34 | 
 35 | type solution = int list
 36 |     (** A solution is a set of rows *)
 37 | 
 38 | (** A common interface for ZDD and DLX *)
 39 | module type S = sig
 40 | 
 41 |   type t
 42 | 
 43 |   val create: ?primary:int -> bool array array -> t
 44 |     (** Creates an EMC problem. *)
 45 | 
 46 |   val create_sparse: ?primary:int -> columns:int -> int list array -> t
 47 |     (** To be used instead of [create] when the matrix is large but sparse. *)
 48 | 
 49 |   val find_solution: t -> solution
 50 |     (** Returns the first solution that is found.
 51 |         Raises [Not_found] if the problem has no solution. *)
 52 | 
 53 |   val iter_solution: (solution -> unit) -> t -> unit
 54 |     (** [Emc.iter_solution f p] applies [f] in turn to each solution. *)
 55 | 
 56 |   val count_solutions: t -> int
 57 |     (** The total number of solutions. *)
 58 | 
 59 |   module type ARITH = sig
 60 |     type t
 61 |     val zero: t
 62 |     val one: t
 63 |     val add: t -> t -> t
 64 |   end
 65 |     (** Minimal arithmetic module to count solutions *)
 66 | 
 67 |   module Count(A: ARITH) : sig val count_solutions: t -> A.t end
 68 |     (** To count solutions using any arithmetic implementation *)
 69 | 
 70 | end
 71 | 
 72 | (** DLX-based implementation *)
 73 | module D: S
 74 | 
 75 | (** ZDD-based implementation *)
 76 | module Z: S with type t = Zdd.t
 77 | 
 78 | (** SAT-based implementation *)
 79 | 
 80 | module Sat : sig
 81 | 
 82 |   type t
 83 | 
 84 |   val create: primary:int -> bool array array -> t
 85 |   val create_sparse: primary:int -> columns:int -> int list array -> t
 86 | 
 87 |   (** print SAT problem in DIMACS syntax *)
 88 |   val print : Format.formatter -> t -> unit
 89 |   val print_in_file: string -> t -> unit
 90 | 
 91 |   type sat_solver = input:string -> output:string -> string
 92 |       (** the command line to call a SAT solver built from two filenames,
 93 |           [input] for the input in DIMACS format, and
 94 |           [output] for the output of the SAT solver.
 95 |           E.g. the function for minisat2 is simply
 96 |           (fun ~input ~output -> sprintf "minisat2 %s %s" input output) *)
 97 | 
 98 |   val find_solution: sat_solver -> t -> solution
 99 |     (** Finds a solution using a SAT solver.
100 |         Raises [Not_found] is there is no solution *)
101 | 
102 | end
103 | 
104 | (** {2 Misc. functions for debugging purposes} *)
105 | 
106 | val print_boolean_matrix : Format.formatter -> bool array array -> unit
107 | val print_boolean_array : Format.formatter -> bool array -> unit
108 | val print_matrix_size: Format.formatter -> 'a array array -> unit
109 | 
110 | 
111 | 
112 | 
113 | 
114 | 


--------------------------------------------------------------------------------
/src/lib/interp.mli:
--------------------------------------------------------------------------------
 1 | (**************************************************************************)
 2 | (*                                                                        *)
 3 | (*  Combine - an OCaml library for combinatorics                          *)
 4 | (*                                                                        *)
 5 | (*  Copyright (C) 2012-2014                                               *)
 6 | (*    Remy El Sibaie                                                      *)
 7 | (*    Jean-Christophe Filliatre                                           *)
 8 | (*                                                                        *)
 9 | (*  This software is free software; you can redistribute it and/or        *)
10 | (*  modify it under the terms of the GNU Library General Public           *)
11 | (*  License version 2.1, with the special exception on linking            *)
12 | (*  described in file LICENSE.                                            *)
13 | (*                                                                        *)
14 | (*  This software is distributed in the hope that it will be useful,      *)
15 | (*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)
16 | (*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)
17 | (*                                                                        *)
18 | (**************************************************************************)
19 | 
20 | module type Time = sig
21 |   val gettimeofday: unit -> float
22 | end
23 | 
24 | module type N = sig
25 |   type t
26 |   val zero: t
27 |   val one: t
28 |   val add: t -> t -> t
29 |   val print : Format.formatter -> t -> unit
30 | end
31 | 
32 | val fast_dlx: bool ref
33 | 
34 | module Make : functor (T : Time) -> functor (N : N) -> sig
35 | 
36 |   val debug: bool ref
37 | 
38 |   type error
39 |   val print_error : Format.formatter -> error -> unit
40 |   exception Error of Ast.pos * error
41 | 
42 |   val interp: Format.formatter -> Format.formatter -> Ast.queue -> unit
43 |   val interp_problems: Format.formatter -> Format.formatter ->
44 |     Ast.queue -> Tiling.Problem.problem list * Tiling.Problem3.problem list
45 | 
46 | end
47 | 


--------------------------------------------------------------------------------
/src/lib/lexer.mll:
--------------------------------------------------------------------------------
  1 | (**************************************************************************)
  2 | (*                                                                        *)
  3 | (*  Combine - an OCaml library for combinatorics                          *)
  4 | (*                                                                        *)
  5 | (*  Copyright (C) 2012-2014                                               *)
  6 | (*    Remy El Sibaie                                                      *)
  7 | (*    Jean-Christophe Filliatre                                           *)
  8 | (*                                                                        *)
  9 | (*  This software is free software; you can redistribute it and/or        *)
 10 | (*  modify it under the terms of the GNU Library General Public           *)
 11 | (*  License version 2.1, with the special exception on linking            *)
 12 | (*  described in file LICENSE.                                            *)
 13 | (*                                                                        *)
 14 | (*  This software is distributed in the hope that it will be useful,      *)
 15 | (*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)
 16 | (*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)
 17 | (*                                                                        *)
 18 | (**************************************************************************)
 19 | 
 20 | {
 21 |   open Format
 22 |   open Lexing
 23 |   open Parser
 24 | 
 25 |   type grid = char * bool array array
 26 | 
 27 |   let lines = ref []
 28 | 
 29 |   let line_buffer = Buffer.create 1024
 30 |   let string_buffer = Buffer.create 1024
 31 | 
 32 |   let bool_array_of_string s =
 33 |     Array.init (String.length s) (fun i -> s.[i] = '*')
 34 | 
 35 |   let push_line () =
 36 |     let s = Buffer.contents line_buffer in
 37 |     Buffer.clear line_buffer;
 38 |     if s <> "" then lines := bool_array_of_string s :: !lines
 39 | 
 40 |   let create_bool_array () =
 41 |     let w = List.fold_left (fun w a -> max w (Array.length a)) 0 !lines in
 42 |     let m = Array.of_list !lines in
 43 |     lines := [];
 44 |     let adapt a =
 45 |       let n = Array.length a in
 46 |       if n = w then a else Array.init w
 47 |         (fun i -> if i < n then a.(i) else false)
 48 |     in
 49 |     Array.map adapt m
 50 | 
 51 |   exception Lexical_error of string
 52 | 
 53 |   let ident_of_keyword =
 54 |     let h = Hashtbl.create 17 in
 55 |     List.iter (fun (s, k) -> Hashtbl.add h s k)
 56 | [ "pattern",    PATTERN;
 57 |   "tiles",      TILES;
 58 |   "pattern3",   PATTERN3;
 59 |   "tiles3",     TILES3;
 60 |   "problem",    PROBLEM;
 61 |   "problem3",   PROBLEM3;
 62 |   "false",      FALSE;
 63 |   "true",       TRUE;
 64 |   "constant",   CONSTANT;
 65 |   "assert",     ASSERT;
 66 |   "print",      PRINT;
 67 |   "svg",        SVG_OUT;
 68 |   "ascii",      ASCII_OUT;
 69 |   "solve",      SOLVE;
 70 |   "solve3",     SOLVE3;
 71 |   "count",      COUNT;
 72 |   "count3",     COUNT3;
 73 |   "dimacs",     DIMACS;
 74 |   "include",    INCLUDE;
 75 |   "exit",       EXIT;
 76 |   "sat",        SAT;
 77 |   "dlx",        DLX;
 78 |   "answer_to_the_question_of_life_the_universe_and_everything", H2G2;
 79 |   "zdd",        ZDD;
 80 |   "debug",      DEBUG;
 81 |   "timing",     TIMING;
 82 |   "on",         ON;
 83 |   "off",        OFF;
 84 |   "diff",       DIFF;
 85 |   "union",      UNION;
 86 |   "inter",      INTER;
 87 |   "xor",        XOR;
 88 |   "set",        SET;
 89 |   "shift",      SHIFT;
 90 |   "resize",     RESIZE;
 91 |   "crop",       CROP;
 92 |   "apply",      APPLY;
 93 |   "Id",         ID;
 94 |   "Rot90",      ROT90;
 95 |   "Rot180",     ROT180;
 96 |   "Rot270",     ROT270;
 97 |   "VertRefl",   VERTREFL;
 98 |   "HorizRefl",  HORIZREFL;
 99 |   "Diag1Refl",  DIAG1REFL;
100 |   "Diag2Refl",  DIAG2REFL;
101 |   "all",        ALL;
102 |   "all3",       ALL3;
103 |       ];
104 |     fun s -> try Hashtbl.find h s with Not_found -> IDENT s
105 | 
106 | }
107 | 
108 | let space = [' ' '\t']
109 | let newline = '\n'
110 | let comment = '#' [^ '\n']* '\n'
111 | let letter = ['a'-'z' 'A'-'Z']
112 | let integer = ['0'-'9']+
113 | let ident = letter (letter | '_' | ['0'-'9'])*
114 | let options = ("exact" space* ['1'-'9']*)
115 | 
116 | 
117 | 
118 | 
119 | rule token = parse
120 |   | comment
121 |       { new_line lexbuf; token lexbuf }
122 |   | space+
123 |       { token lexbuf }
124 |   | newline
125 |       { new_line lexbuf; token lexbuf }
126 |   | "-"
127 |       { MINUS }
128 |   | "&&"
129 |       { AMPAMP }
130 |   | "||"
131 |       { BARBAR }
132 |   | "^"
133 |       { HAT }
134 |   | ident as id
135 |       { ident_of_keyword id }
136 |   | "\""
137 |       { let s = string lexbuf in STRING s}
138 |   | "~one"
139 |       { ONE }
140 |   | "~maybe"
141 |       { MAYBE }
142 |   | "~sym"
143 |       { SYM }
144 |   | "~rot"
145 |       { ROT }
146 |   | (integer as w) 'x' (integer as h)
147 |       { DIM (int_of_string w, int_of_string h) }
148 |   | "="
149 |       { EQUAL }
150 |   | "["
151 |       { LSBRA }
152 |   | "]"
153 |       { RSBRA }
154 |   | ","
155 |       { COMMA }
156 |   | "("
157 |       { LPAR }
158 |   | ")"
159 |       { RPAR }
160 |   | '{' space*
161 |       { read_lines lexbuf }
162 |   | '{' space* newline
163 |       { new_line lexbuf; read_lines lexbuf }
164 |   | _ as c
165 |       { raise (Lexical_error (sprintf "invalid character `%c'@." c)) }
166 |   | eof
167 |       { EOF }
168 | 
169 | and read_lines = parse
170 |   | space+
171 |       { read_lines lexbuf }
172 |   | comment | newline
173 |       { new_line lexbuf; push_line (); read_lines lexbuf }
174 |   | '$'
175 |       { push_line (); read_lines lexbuf }
176 |   | '}'
177 |     { push_line (); ASCII (create_bool_array ()) }
178 |   | _ as c
179 |       { Buffer.add_char line_buffer c; read_lines lexbuf }
180 |   | eof
181 |       { raise (Lexical_error "unterminated pattern") }
182 | 
183 | and string = parse
184 |   | "\""
185 |       { let s = Buffer.contents string_buffer in
186 |         Buffer.clear string_buffer;
187 |         s }
188 |   | newline
189 |       { new_line lexbuf;
190 |         Buffer.add_char string_buffer '\n';
191 |         string lexbuf }
192 |   | "\\" "\""
193 |       { Buffer.add_char string_buffer '"';
194 |         string lexbuf }
195 |   | "\\" "\\"
196 |       { Buffer.add_char string_buffer '\\';
197 |         string lexbuf }
198 |   | _ as c
199 |       { Buffer.add_char string_buffer c;
200 |         string lexbuf }
201 |   | eof
202 |       { raise (Lexical_error "unterminated string") }
203 | 
204 | 
205 | {
206 | 
207 |   let print_loc fmt lb =
208 |     let pos = lexeme_start_p lb in
209 |     let c = (pos.pos_cnum - pos.pos_bol) in
210 |     fprintf fmt "File \"%s\", line %d, characters %d-%d:" pos.pos_fname
211 |       pos.pos_lnum c c
212 | 
213 |   let parse_file fname =
214 |     let c = open_in fname in
215 |     let lb = from_channel c in
216 |     lb.lex_curr_p <- { lb.lex_curr_p with pos_fname = fname };
217 |     let p =
218 |       try
219 | 	Parser.queue token lb
220 |       with
221 | 	| Lexical_error msg ->
222 |   	  eprintf "%a@\nlexical error: %s@." print_loc lb msg;
223 |   	  exit 1
224 | 	| Parser.Error ->
225 | 	  eprintf "%a@\nsyntax error@." print_loc lb;
226 | 	  exit 1
227 |     in
228 |     close_in c;
229 |     p
230 | 
231 |   let parse_string efmt s =
232 |     let lb = from_string s in
233 |     lb.lex_curr_p <- { lb.lex_curr_p with pos_fname = "current channel" };
234 |     let p =
235 |       try
236 | 	Parser.queue token lb
237 |       with
238 |       | Lexical_error msg ->
239 |   	fprintf efmt "%a@\nlexical error: %s@." print_loc lb msg;
240 |   	exit 1
241 |       | Parser.Error ->
242 | 	fprintf efmt "%a@\nsyntax error@." print_loc lb;
243 | 	exit 1
244 |     in
245 |     p
246 | 
247 | 
248 | (***
249 |   let raw_parser c =
250 |     let lb = from_channel c in
251 |     read lb
252 | 
253 |   let read_problem c =
254 |     let pl = raw_parser c in
255 |     if List.length pl <= 1 then invalid_arg "read_problem";
256 |     let grid = ref None in
257 |     let pieces = ref [] in
258 |     let add (c, g) =
259 |       if c = '$' then
260 |         grid := Some g
261 |       else
262 |       	pieces := Tiling.create_piece ~n:(String.make 1 c) g :: !pieces
263 |     in
264 |     List.iter add pl;
265 |     match !grid with
266 |       | None -> invalid_arg "read_problem"
267 |       | Some g -> Tiling.create_problem g !pieces
268 | ***)
269 | 
270 | 
271 | }
272 | 


--------------------------------------------------------------------------------
/src/lib/matrix.ml:
--------------------------------------------------------------------------------
1 | 
2 | type 'a matrix = 'a array array
3 | 
4 | let copy m = Array.map Array.copy m
5 | 
6 | 
7 | 


--------------------------------------------------------------------------------
/src/lib/matrix.mli:
--------------------------------------------------------------------------------
1 | 
2 | type 'a matrix = 'a array array
3 | 
4 | val copy: 'a matrix -> 'a matrix
5 | 


--------------------------------------------------------------------------------
/src/lib/parser.mly:
--------------------------------------------------------------------------------
  1 | /**************************************************************************/
  2 | /*                                                                        */
  3 | /*  Combine - an OCaml library for combinatorics                          */
  4 | /*                                                                        */
  5 | /*  Copyright (C) 2012-2014                                               */
  6 | /*    Remy El Sibaie                                                      */
  7 | /*    Jean-Christophe Filliatre                                           */
  8 | /*                                                                        */
  9 | /*  This software is free software; you can redistribute it and/or        */
 10 | /*  modify it under the terms of the GNU Library General Public           */
 11 | /*  License version 2.1, with the special exception on linking            */
 12 | /*  described in file LICENSE.                                            */
 13 | /*                                                                        */
 14 | /*  This software is distributed in the hope that it will be useful,      */
 15 | /*  but WITHOUT ANY WARRANTY; without even the implied warranty of        */
 16 | /*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  */
 17 | /*                                                                        */
 18 | /**************************************************************************/
 19 | 
 20 | %{
 21 |   open Ast
 22 |   open Tiling
 23 |   open D4
 24 |   type option =
 25 |     | M of multiplicity
 26 |     | S of symmetries
 27 | 
 28 | %}
 29 | 
 30 | %token PATTERN TILES PROBLEM
 31 | %token PATTERN3 TILES3 PROBLEM3
 32 | %token CONSTANT FALSE TRUE
 33 | %token SET SHIFT CROP RESIZE APPLY
 34 | %token EXIT INCLUDE ASSERT
 35 | %token MINUS AMPAMP BARBAR HAT DIFF UNION XOR INTER ONE MAYBE SYM ROT
 36 | %token EQUAL LSBRA RSBRA RPAR LPAR COMMA
 37 | %token ID ROT90 ROT180 ROT270 VERTREFL HORIZREFL DIAG1REFL DIAG2REFL
 38 | %token ASCII_OUT SVG_OUT PRINT ALL ALL3
 39 | %token SOLVE SOLVE3 COUNT COUNT3 DIMACS DEBUG TIMING ON OFF DLX ZDD SAT
 40 | %token <string> IDENT
 41 | %token <string> STRING
 42 | %token <int * int> DIM
 43 | %token <bool array array> ASCII
 44 | %token H2G2
 45 | %token EOF
 46 | 
 47 | %nonassoc UNION INTER DIFF XOR APPLY prec_crop
 48 | %left AMPAMP MINUS BARBAR HAT
 49 | 
 50 | %start <Ast.queue> queue
 51 | 
 52 | %%
 53 | queue:
 54 |   l = list(decl); EOF { l }
 55 | ;
 56 | 
 57 | decl:
 58 | | PATTERN; id = IDENT; EQUAL; e = expr
 59 |     {{decl_pos = ($startpos, $endpos);
 60 |       decl_node = Dpattern (id, e)}}
 61 | | PATTERN3; id = IDENT; EQUAL; l = expr_list
 62 |     { { decl_pos = ($startpos, $endpos);
 63 |         decl_node = Dpattern3 (id, l) } }
 64 | | TILES; id = IDENT; EQUAL; l = tile_list
 65 |     {{decl_pos = ($startpos, $endpos);
 66 |       decl_node = Tiles (id, l)}}
 67 | | TILES3; id = IDENT; EQUAL; l = tile_list
 68 |     {{decl_pos = ($startpos, $endpos);
 69 |       decl_node = Tiles3 (id, l)}}
 70 | | PROBLEM; id = IDENT; EQUAL; e = expr; tl = tiles
 71 |     {{decl_pos = ($startpos, $endpos);
 72 |       decl_node = Problem (id, e, tl)}}
 73 | | PROBLEM3; id = IDENT; EQUAL; e = expr; tl = tiles
 74 |     {{decl_pos = ($startpos, $endpos);
 75 |       decl_node = Problem3 (id, e, tl)}}
 76 | | ASSERT; b = boolean_expr
 77 |     {{decl_pos = ($startpos, $endpos);
 78 |       decl_node = Assert b}}
 79 | | PRINT; id = IDENT {{decl_pos = ($startpos, $endpos);
 80 |       decl_node = Command (Print, id)}}
 81 | | SOLVE; a = algo_emc; id = IDENT; out = output
 82 |     {{decl_pos = ($startpos, $endpos);
 83 |       decl_node = Command (SolveEMC (a, out), id)}}
 84 | | SOLVE; a = IDENT; id = IDENT; out = output
 85 |     {{decl_pos = ($startpos, $endpos);
 86 |       decl_node = Command (Solve (a, out), id)}}
 87 | | SOLVE3; a = algo_emc; id = IDENT; out = output
 88 |     {{decl_pos = ($startpos, $endpos);
 89 |       decl_node = Command3 (SolveEMC (a, out), id)}}
 90 | | ALL; a = algo_emc; id = IDENT
 91 |     {{decl_pos = ($startpos, $endpos);
 92 |       decl_node = Command (AllEMC a, id)}}
 93 | | ALL3; a = algo_emc; id = IDENT
 94 |     {{decl_pos = ($startpos, $endpos);
 95 |       decl_node = Command3 (AllEMC a, id)}}
 96 | | COUNT; a = algo_emc; id = IDENT
 97 |     {{decl_pos = ($startpos, $endpos);
 98 |       decl_node = Command (CountEMC a, id)}}
 99 | | COUNT; a = IDENT; id = IDENT
100 |     {{decl_pos = ($startpos, $endpos);
101 |       decl_node = Command (Count a, id)}}
102 | | COUNT3; a = algo_emc; id = IDENT
103 |     {{decl_pos = ($startpos, $endpos);
104 |       decl_node = Command3 (CountEMC a, id)}}
105 | | DIMACS; id = IDENT; file = STRING
106 |     {{decl_pos = ($startpos, $endpos); decl_node = Dimacs (id, file) }}
107 | | DEBUG; st = state; {{decl_pos = ($startpos, $endpos);
108 |       decl_node = Debug st}}
109 | | TIMING; st = state; {{decl_pos = ($startpos, $endpos);
110 |       decl_node = Timing st}}
111 | | EXIT {{decl_pos = ($startpos, $endpos);
112 |       decl_node = Quit}}
113 | | INCLUDE; s = STRING {{decl_pos = ($startpos, $endpos);
114 |       decl_node = Include s}}
115 | | H2G2 {{decl_pos = ($startpos, $endpos);
116 |       decl_node = H2g2}}
117 | ;
118 | 
119 | algo_emc:
120 | | DLX             { Dlx }
121 | | ZDD             { Zdd }
122 | | SAT; s = STRING { Sat s }
123 | 
124 | state:
125 | | ON  { On }
126 | | OFF { Off }
127 | 
128 | opt:
129 | | ONE   { M Mone }
130 | | MAYBE { M Mmaybe }
131 | | SYM   { S Sall }
132 | | ROT   { S Spositive }
133 | 
134 | tiles:
135 | | l = tile_list { Tiles_list l }
136 | | id = IDENT    { Tiles_id  id }
137 | ;
138 | 
139 | tile_list:
140 | | LSBRA; l = separated_list(COMMA, tile); RSBRA { l }
141 | ;
142 | 
143 | output:
144 | | SVG_OUT; s = STRING { Svg s }
145 | | ASCII_OUT { Ascii }
146 | 
147 | isometry:
148 | | ID { Id }
149 | | ROT90 { Rot90 }
150 | | ROT180 { Rot180 }
151 | | ROT270 { Rot270 }
152 | | VERTREFL { VertRefl }
153 | | HORIZREFL { HorizRefl }
154 | | DIAG1REFL { Diag1Refl }
155 | | DIAG2REFL { Diag2Refl }
156 | ;
157 | 
158 | tile:
159 | | e = expr; o = list(opt)
160 |     { let option (s, m) = function
161 |         | M m' -> s, m' (* FIXME: fail on ambiguity *)
162 | 	| S s' -> s', m (* idem *)
163 |       in
164 |       let s,m = List.fold_left option (Snone, Minf) o in e,s,m }
165 | ;
166 | 
167 | expr_list:
168 | | LSBRA; l = separated_list(COMMA, expr); RSBRA { l }
169 | ;
170 | 
171 | expr:
172 | | LPAR; e = expr; RPAR
173 |     { e }
174 | | id = IDENT
175 |     {{expr_pos = ($startpos, $endpos);
176 |       expr_node = Var id}}
177 | | CONSTANT; d = DIM; b = bool
178 |     { let w,h = d in
179 |       { expr_pos = ($startpos, $endpos);
180 |         expr_node = Pattern (Array.make h (Array.make w b))} }
181 | | UNION; e1 = expr; e2 = expr
182 |       {{expr_pos = ($startpos, $endpos);
183 |          expr_node = Binary (Union, e1, e2)}}
184 | | INTER; e1 = expr; e2 = expr
185 |       {{expr_pos = ($startpos, $endpos);
186 |          expr_node = Binary (Inter, e1, e2)}}
187 | | DIFF; e1 = expr; e2 = expr
188 |       {{expr_pos = ($startpos, $endpos);
189 |          expr_node = Binary (Diff, e1, e2)}}
190 | | XOR; e1 = expr; e2 = expr
191 |       {{expr_pos = ($startpos, $endpos);
192 |          expr_node = Binary (Xor, e1, e2)}}
193 | | e1 = expr; MINUS ;e2 = expr
194 |       {{expr_pos = ($startpos, $endpos);
195 |          expr_node = Binary (Diff, e1, e2)}}
196 | | e1 = expr; AMPAMP ;e2 = expr
197 |       {{expr_pos = ($startpos, $endpos);
198 |          expr_node = Binary (Inter, e1, e2)}}
199 | | e1 = expr; BARBAR ;e2 = expr
200 |       {{expr_pos = ($startpos, $endpos);
201 |          expr_node = Binary (Union, e1, e2)}}
202 | | e1 = expr; HAT ;e2 = expr
203 |       {{expr_pos = ($startpos, $endpos);
204 |          expr_node = Binary (Xor, e1, e2)}}
205 | | SET; e = expr; d = DIM; b = bool
206 |     {{expr_pos = ($startpos, $endpos);
207 |        expr_node = SetOp (SetXY (b), d, e)} }
208 | | CROP; pos = DIM ;d = DIM; e = expr; %prec prec_crop
209 |     {{expr_pos = ($startpos, $endpos);
210 |     expr_node = SetOp (Crop(pos), d, e)}}
211 | | SHIFT; e = expr; d = DIM
212 |     {{expr_pos = ($startpos, $endpos);
213 |      expr_node = SetOp (Shift, d, e)}}
214 | | RESIZE; e = expr; d = DIM
215 |     {{expr_pos = ($startpos, $endpos);
216 |      expr_node = SetOp (Resize, d, e)}}
217 | | APPLY; iso = isometry; e = expr
218 |     {{expr_pos = ($startpos, $endpos);
219 |        expr_node = Apply (iso, e)}}
220 | | a = ASCII
221 |     {{ expr_pos = ($startpos, $endpos);
222 |        expr_node = Pattern a}}
223 | ;
224 | 
225 | bool:
226 | | FALSE { false }
227 | | TRUE  { true  }
228 | ;
229 | 
230 | boolean_expr:
231 | | b = bool { Boolean b }
232 | | e1 = expr; EQUAL; e2 = expr { Comparison (Equal, e1, e2)}
233 | ;
234 | 


--------------------------------------------------------------------------------
/src/lib/tiling.mli:
--------------------------------------------------------------------------------
  1 | (**************************************************************************)
  2 | (*                                                                        *)
  3 | (*  Combine - an OCaml library for combinatorics                          *)
  4 | (*                                                                        *)
  5 | (*  Copyright (C) 2012-2014                                               *)
  6 | (*    Remy El Sibaie                                                      *)
  7 | (*    Jean-Christophe Filliatre                                           *)
  8 | (*                                                                        *)
  9 | (*  This software is free software; you can redistribute it and/or        *)
 10 | (*  modify it under the terms of the GNU Library General Public           *)
 11 | (*  License version 2.1, with the special exception on linking            *)
 12 | (*  described in file LICENSE.                                            *)
 13 | (*                                                                        *)
 14 | (*  This software is distributed in the hope that it will be useful,      *)
 15 | (*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)
 16 | (*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)
 17 | (*                                                                        *)
 18 | (**************************************************************************)
 19 | 
 20 | (** Tiling problems modeling and encoding to EMC *)
 21 | 
 22 | (** Pattern representation as boolean matrix *)
 23 | module Pattern : sig
 24 | 
 25 |   (*
 26 |     y ^
 27 |       |
 28 |       |
 29 |     0 +----------> x
 30 |       0
 31 |   *)
 32 | 
 33 |   type t = private {
 34 |     matrix : bool array array;
 35 |     height : int;
 36 |     width  : int;
 37 |     size   : int;
 38 |   }
 39 | 
 40 |   val create: bool array array -> t
 41 |     (** [create m] creates a pattern of type t from a boolean matrix *)
 42 | 
 43 |   val apply: D4.t -> t -> t
 44 |     (** [apply i p] creates a new pattern which is the result of the
 45 |        transformation of [p] by [i] *)
 46 | 
 47 |   val resize: t -> w:int -> h:int -> t
 48 |     (** [resize p w h] change the size of [p] to [w] (width) and [h] (height).
 49 |       Points which are over [w] and [h] will not appear. *)
 50 | 
 51 |   val crop  : t -> x:int -> y:int -> w:int -> h:int -> t
 52 |     (** [crop p x y w h] creates a pattern from [p] with the rectangle of size
 53 |        [w, h] at position [x, y] in [p] *)
 54 | 
 55 |   val shift: t -> ofsx:int -> ofsy:int -> t
 56 |     (** [shift p ofsx ofsy] shift pattern [p] by [osfx, osfy] *)
 57 | 
 58 |   val union: t -> t -> t
 59 |     (** [union p1 p2] creates a pattern from the logical union beetween [p1] and
 60 |         [p2] *)
 61 | 
 62 |   val inter: t -> t -> t
 63 |     (** [inter p1 p2] creates a pattern from the logical intersection
 64 |      beetween [p1] and  [p2] *)
 65 | 
 66 |   val diff : t -> t -> t
 67 |     (** [inter p1 p2] creates a pattern from the logical difference
 68 |      beetween [p1] and  [p2] *)
 69 | 
 70 |   val xor : t -> t -> t
 71 |     (** [xor p1 p2] creates a pattern from the logical xor
 72 |      beetween [p1] and  [p2] *)
 73 | 
 74 |   val has_iso: D4.t -> t -> bool
 75 |     (** [has_iso t p] returns true if [p] is invariant by [i] *)
 76 | 
 77 |   val print : Format.formatter -> t -> unit
 78 |     (** print a pattern *)
 79 | 
 80 | end
 81 | 
 82 | type symmetries = Snone | Spositive | Sall
 83 | type multiplicity = Minf | Mone | Mmaybe
 84 | 
 85 | module Tile : sig
 86 | 
 87 |   type t = private {
 88 |     name: string;
 89 |     pattern: Pattern.t;
 90 |     multiplicity: multiplicity;
 91 |     symmetries: symmetries;
 92 |     isos: D4.subgroup;   (* the pattern is invariant by these isometries *)
 93 |   }
 94 | 
 95 |   val create: ?name:string -> ?s:symmetries -> ?m:multiplicity -> Pattern.t -> t
 96 |     (** construct a tile from his name, its symmetries [s] and
 97 |         its multiplicity [m]. [s] defaults to [Snone] and [m] defaults
 98 |         to [Minf] *)
 99 | 
100 |   val apply: D4.t -> t -> t
101 |     (** [apply i t] creates a new tile by applying transformation [i] to [t] *)
102 | 
103 |   val print: Format.formatter -> t -> unit
104 |     (** print a tile *)
105 | 
106 |   val create_all_symmetries: t -> t list
107 | 
108 | end
109 | 
110 | module Problem : sig
111 | 
112 |   type problem = private {
113 |     grid : Pattern.t;
114 |     pname : string;
115 |     pieces : Tile.t list;
116 |   }
117 | 
118 |   val create : ?name:string -> Pattern.t -> Tile.t list -> problem
119 |   (** construct a problem from his name, the board pattern and
120 |       a list of tiles *)
121 | 
122 |   val print: Format.formatter -> problem -> unit
123 |   (** print a problem *)
124 | 
125 |   type solution = (Tile.t * int * int) list
126 | 
127 |   val print_solution_to_svg : Format.formatter ->
128 |     width:int -> height:int -> problem -> solution -> unit
129 |   (** print a solution under the svg format *)
130 | 
131 |   val print_solution_to_svg_file : string ->
132 |     width:int -> height:int -> problem -> solution -> unit
133 |   (** print a solution to the svg format on the given file *)
134 | 
135 |   val print_solution_ascii :
136 |     Format.formatter -> problem -> solution -> unit
137 |   (** print a solution with ascii symboles to draw tiles*)
138 | 
139 |   module ToEMC: sig
140 | 
141 |     type emc = private {
142 |       columns: int;
143 |       primary: int;			      (* number of primary columns *)
144 |       emc    : int list array;
145 |       tiles  : (Tile.t * int * int) array;    (* row -> tile and its position *)
146 |     }
147 | 
148 |     val print_emc: Format.formatter -> emc -> unit
149 |     val print_emc_size: Format.formatter -> emc -> unit
150 | 
151 |     val make: problem -> emc
152 |     (** Encode the given problem under EMC *)
153 | 
154 |     val print_solution_to_svg : Format.formatter ->
155 |       width:int -> height:int -> problem -> emc -> int list -> unit
156 |     (** print a solution under the svg format *)
157 | 
158 |     val print_solution_to_svg_file : string ->
159 |       width:int -> height:int -> problem -> emc -> int list -> unit
160 |     (** print a solution to the svg format on the given file *)
161 | 
162 |     val print_solution_ascii :
163 |       Format.formatter -> problem -> emc -> int list -> unit
164 |     (** print a solution with ascii symboles to draw tiles*)
165 | 
166 |   end
167 | 
168 | end
169 | 
170 | 
171 | (** 3D tiling problems *)
172 | 
173 | module Tile3 : sig
174 | 
175 |   type t = private {
176 |     name: string;
177 |     pattern: Pattern.t array; (* depth -> pattern *)
178 |     height: int;
179 |     width: int;
180 |     depth: int;
181 |     multiplicity: multiplicity;
182 |     symmetries: symmetries;
183 |   }
184 | 
185 |   val create: ?name:string -> ?s:symmetries -> ?m:multiplicity ->
186 |     Pattern.t list -> t
187 | 
188 |   val print: Format.formatter -> t -> unit
189 | 
190 |   val create_all_symmetries: t -> t list
191 | 
192 | end
193 | 
194 | module Problem3 : sig
195 | 
196 |   type problem = private {
197 |     grid : Tile3.t;
198 |     pname : string;
199 |     pieces : Tile3.t list;
200 |   }
201 | 
202 |   val create : ?name:string -> Pattern.t list -> Tile3.t list -> problem
203 |   (** construct a problem from his name, the board pattern and
204 |       a list of tiles *)
205 | 
206 |   val print: Format.formatter -> problem -> unit
207 |   (** print a problem *)
208 | 
209 |   type solution = (Tile3.t * int * int * int) list
210 | 
211 |   module ToEMC: sig
212 | 
213 |     type emc = private {
214 |       primary: int;			      (* number of primary columns *)
215 |       emc    : bool array array;
216 |       tiles  : (Tile3.t * int * int * int) array; (* row -> tile and position *)
217 |     }
218 | 
219 |     val print_emc: Format.formatter -> emc -> unit
220 |     val print_emc_size: Format.formatter -> emc -> unit
221 | 
222 |     val make: problem -> emc
223 |     (** Encode the given problem under EMC *)
224 | 
225 |     val print_solution_ascii :
226 |       Format.formatter -> problem -> emc -> int list -> unit
227 |     (** print a solution with ascii symboles to draw tiles*)
228 | 
229 |   end
230 | 
231 | end
232 | 
233 | 
234 | 


--------------------------------------------------------------------------------
/src/lib/zdd.ml:
--------------------------------------------------------------------------------
  1 | (**************************************************************************)
  2 | (*                                                                        *)
  3 | (*  Combine - an OCaml library for combinatorics                          *)
  4 | (*                                                                        *)
  5 | (*  Copyright (C) 2012-2014                                               *)
  6 | (*    Remy El Sibaie                                                      *)
  7 | (*    Jean-Christophe Filliatre                                           *)
  8 | (*                                                                        *)
  9 | (*  This software is free software; you can redistribute it and/or        *)
 10 | (*  modify it under the terms of the GNU Library General Public           *)
 11 | (*  License version 2.1, with the special exception on linking            *)
 12 | (*  described in file LICENSE.                                            *)
 13 | (*                                                                        *)
 14 | (*  This software is distributed in the hope that it will be useful,      *)
 15 | (*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)
 16 | (*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)
 17 | (*                                                                        *)
 18 | (**************************************************************************)
 19 | 
 20 | (* ZDD *)
 21 | 
 22 | open Format
 23 | 
 24 | type unique = int
 25 | 
 26 | (* invariant:
 27 |  - elements increase when we descend in subtrees
 28 |  - the right subtree of a ZDD is never Bottom *)
 29 | type t = Bottom | Top | Node of unique * int * t * t
 30 | type zdd = t
 31 | 
 32 | module S = Set.Make(
 33 |   struct
 34 |     type t = int
 35 |     let compare = compare
 36 |   end
 37 |   )
 38 | type elt = S.t
 39 | 
 40 | 
 41 | let bottom = Bottom
 42 | let empty = bottom
 43 | let is_empty zdd = zdd == Bottom
 44 | 
 45 | let top = Top
 46 | 
 47 | let unique = function
 48 |   | Bottom -> 0
 49 |   | Top -> 1
 50 |   | Node (u , _, _, _) -> u
 51 | 
 52 | let hash_node i z1 z2 = (19 * (19 * i + unique z1) + unique z2) land max_int
 53 | 
 54 | let unique_ref = ref 2
 55 | 
 56 | module HashedZdd = struct
 57 |   type _t = zdd
 58 |   let hash = function
 59 |     | Bottom -> 0
 60 |     | Top -> 1
 61 |     | Node (_, i, z1, z2) -> hash_node i z1 z2
 62 |   let _equal k1 k2 = match k1, k2 with
 63 |     | Top, Top
 64 |     | Bottom, Bottom -> true
 65 |     | Node (_, i1, l1, r1), Node (_, i2, l2, r2) ->
 66 |         i1 = i2 && unique l1 = unique l2 && unique r1 = unique r2
 67 |     | _ -> false
 68 | end
 69 | 
 70 | module Weaktbl = struct
 71 | 
 72 |   type t = {
 73 |     mutable table : zdd Weak.t array;
 74 |     mutable totsize : int;             (* sum of the bucket sizes *)
 75 |     mutable limit : int;               (* max ratio totsize/table length *)
 76 |   }
 77 | 
 78 |   let hash = HashedZdd.hash
 79 | 
 80 |   let create sz =
 81 |     let sz = if sz < 7 then 7 else sz in
 82 |     let sz = if sz > Sys.max_array_length then Sys.max_array_length else sz in
 83 |     let emptybucket = Weak.create 0 in
 84 |     { table = Array.make sz emptybucket;
 85 |       totsize = 0;
 86 |       limit = 3; }
 87 | 
 88 |   let fold f t init =
 89 |     let rec fold_bucket i b accu =
 90 |       if i >= Weak.length b then accu else
 91 |         match Weak.get b i with
 92 |           | Some v -> fold_bucket (i+1) b (f v accu)
 93 |           | None -> fold_bucket (i+1) b accu
 94 |     in
 95 |     Array.fold_right (fold_bucket 0) t.table init
 96 | 
 97 |   let next_sz n = min (3*n/2 + 3) (Sys.max_array_length - 1)
 98 | 
 99 |   let rec resize t =
100 |     let oldlen = Array.length t.table in
101 |     let newlen = next_sz oldlen in
102 |     if newlen > oldlen then begin
103 |       let newt = create newlen in
104 |       newt.limit <- t.limit + 100;          (* prevent resizing of newt *)
105 |       fold (fun d () -> add newt d) t ();
106 |       t.table <- newt.table;
107 |       t.limit <- t.limit + 2;
108 |     end
109 | 
110 |   and add t z =
111 |     add_index t z ((hash z) mod (Array.length t.table))
112 | 
113 |   and add_index t d index =
114 |     let bucket = t.table.(index) in
115 |     let sz = Weak.length bucket in
116 |     let rec loop i =
117 |       if i >= sz then begin
118 |         let newsz = min (sz + 3) (Sys.max_array_length - 1) in
119 |         if newsz <= sz then
120 |           failwith "Hashcons.Make: hash bucket cannot grow more";
121 |         let newbucket = Weak.create newsz in
122 |         Weak.blit bucket 0 newbucket 0 sz;
123 |         Weak.set newbucket i (Some d);
124 |         t.table.(index) <- newbucket;
125 |         t.totsize <- t.totsize + (newsz - sz);
126 |         if t.totsize > t.limit * Array.length t.table then resize t;
127 |       end else begin
128 |         if Weak.check bucket i
129 |         then loop (i+1)
130 |         else Weak.set bucket i (Some d)
131 |       end
132 |     in
133 |     loop 0
134 | 
135 |   let hashconstruct t v z1 z2 =
136 |     if z2 = Bottom then z1 else
137 |     let index = (hash_node v z1 z2) mod (Array.length t.table) in
138 |     let bucket = t.table.(index) in
139 |     let sz = Weak.length bucket in
140 |     let rec loop i =
141 |       if i >= sz then begin
142 |         let hnode = Node (!unique_ref, v, z1, z2) in
143 |         incr unique_ref;
144 |         add_index t hnode index;
145 |         hnode
146 |       end else begin
147 |         match Weak.get_copy bucket i with
148 |           | Some Node(_, v', z1', z2') when v==v' && z1==z1' && z2==z2' ->
149 |               begin match Weak.get bucket i with
150 |                 | Some v -> v
151 |                 | None -> loop (i+1)
152 |               end
153 |           | _ -> loop (i+1)
154 |       end
155 |     in
156 |     loop 0
157 | 
158 | end
159 | 
160 | let hsize = 19997 (* 200323 *)
161 | 
162 | let global_table = Hashtbl.create 5003
163 | 
164 | let lt v = function
165 |   | Bottom | Top -> true
166 |   | Node (_, i, _, _) -> v < i
167 | 
168 | let construct v z1 z2 =
169 |   if not (lt v z1 && lt v z2) then invalid_arg "construct";
170 |   let t =
171 |     try Hashtbl.find global_table v
172 |     with Not_found ->
173 |       let h = Weaktbl.create hsize in Hashtbl.add global_table v h; h
174 |   in
175 |   Weaktbl.hashconstruct t v z1 z2
176 | 
177 | (*
178 | module ZddHashtbl = Hashtbl.Make(HashedZdd)
179 | 
180 | let global_table = ZddHashtbl.create hsize
181 | 
182 | let construct i z1 z2 =
183 | 
184 |   if z2 = Bottom then z1 else
185 | 
186 |     let zdd = Node (!unique_ref, i, z1, z2) in
187 |     try
188 |       ZddHashtbl.find global_table zdd
189 |     with Not_found ->
190 |       ZddHashtbl.add global_table zdd zdd;
191 |       incr unique_ref;
192 |       zdd
193 | 
194 |  *)
195 | 
196 | (* z1 = z2 iff z1 == z2 iff unique z1 = unique z2 *)
197 | 
198 | module H1 = Hashtbl.Make
199 |   (struct
200 |      type t = zdd
201 |      let hash = unique
202 |      let equal = (==)
203 |    end)
204 | 
205 | let memo_rec1 f =
206 |   let h = H1.create 17 in
207 |   let rec g x =
208 |     try H1.find h x
209 |     with Not_found -> let y = f g x in H1.add h x y; y
210 |   in
211 |   g
212 | 
213 | let cardinal = memo_rec1 (
214 |   fun cardinal -> function
215 |     | Top -> 1
216 |     | Bottom -> 0
217 |     | Node(_, _i, z1, z2) -> cardinal z1 + cardinal z2
218 |   )
219 | 
220 | module type ARITH = sig
221 |   type t
222 |   val zero: t
223 |   val one: t
224 |   val add: t -> t -> t
225 | end
226 | 
227 | module Cardinal(A: ARITH) : sig val cardinal: zdd -> A.t end = struct
228 | 
229 |   let cardinal = memo_rec1 (
230 |     fun cardinal -> function
231 |       | Top -> A.one
232 |       | Bottom -> A.zero
233 |       | Node(_, _, z1, z2) -> A.add (cardinal z1) (cardinal z2))
234 | 
235 | end
236 | 
237 | module H2 = Hashtbl.Make
238 |   (struct
239 |      type t = zdd * zdd
240 |      let hash (z1, z2) = (19 * unique z1 + unique z2) land max_int
241 |      let equal (z11, z12) (z21, z22) = z11 == z21 && z12 == z22
242 |    end)
243 | 
244 | let memo_rec2 f =
245 |   let h = H2.create hsize in
246 |   let rec g x =
247 |     try H2.find h x
248 |     with Not_found -> let y = f g x in H2.add h x y; y
249 |   in
250 |   g
251 | 
252 | let inter = memo_rec2 (
253 |   fun inter -> function
254 |     | Node(_, _, z1, _), Top
255 |     | Top, Node(_, _, z1, _) -> inter (z1, Top)
256 |     | Top, Top -> Top
257 |     | Bottom, _
258 |     | _, Bottom -> Bottom
259 |     | (Node (_u1, i1, l1, r1) as z1),
260 |         (Node (_u2, i2, l2, r2) as z2) ->
261 |         if i1 = i2 then
262 |           construct i1 (inter (l1, l2)) (inter (r1, r2))
263 |         else if i1 > i2 then
264 |           inter (z1, l2)
265 |         else
266 |           inter (z2, l1)
267 |   )
268 | 
269 | let inter z1 z2 =
270 |   inter (z1, z2)
271 | 
272 | let union = memo_rec2 (
273 |   fun union -> function
274 |     | Node(_, i, z1, z2), Top
275 |     | Top, Node(_, i, z1, z2) -> construct i (union (z1, Top)) z2
276 |     | Top, Top -> Top
277 |     | Bottom, z
278 |     | z, Bottom -> z
279 |     | (Node (_, i1, l1, r1) as z1), (Node (_, i2, l2, r2) as z2) ->
280 |         if i1 = i2 then
281 |           construct i1 (union (l1, l2)) (union (r1, r2))
282 |         else if i1 > i2 then
283 |           construct i2 (union (z1, l2)) r2
284 |         else (* i1 < i2 *)
285 |           construct i1 (union (l1, z2)) r1
286 |   )
287 | 
288 | let union z1 z2 =
289 |   union (z1, z2)
290 | 
291 | let diff = memo_rec2 (
292 |   fun diff -> function
293 |     | Node(_, i, z1, z2), Top -> construct i (diff (z1, Top)) z2
294 |     | Top, Node(_, _, z1, _) -> diff (Top, z1)
295 |     | Top, Top
296 |     | Bottom, _ -> Bottom
297 |     | z, Bottom -> z
298 |     | (Node (_, i1, l1, r1) as z1), (Node (_, i2, l2, r2) as z2) ->
299 |         if i1 = i2 then
300 |           construct i1 (diff (l1, l2)) (diff (r1, r2))
301 |         else if i1 > i2 then
302 |           diff (z1, l2)
303 |         else (* i1 < i2 *)
304 |           construct i1 (diff (l1, z2)) r1
305 |   )
306 | 
307 | let diff z1 z2 =
308 |   diff (z1, z2)
309 | 
310 | let subset = memo_rec2 (
311 |   fun subset -> function
312 |     | Bottom, _ | Top, Top -> true
313 |     | _, Bottom | Node _, Top -> false
314 |     | Top, Node(_, _, z1, _) -> subset (Top, z1)
315 |     | (Node (_, i1, l1, r1) as z1), Node (_, i2, l2, r2) ->
316 |         if i1 = i2 then
317 |           subset (l1, l2) && subset (r1, r2)
318 |         else if i1 > i2 then
319 |           subset (z1, l2)
320 |         else (* i1 < i2 *)
321 |           false
322 |   )
323 | 
324 | let subset z1 z2 =
325 |   subset (z1, z2)
326 | 
327 | let equal = (==)
328 | let compare z1 z2 = Stdlib.compare (unique z1) (unique z2)
329 | 
330 | let singleton s =
331 |   let elts = S.elements s in
332 |   let rec singleton =
333 |     function
334 |       | [] -> Top
335 |       | h::t -> construct h Bottom (singleton t)
336 |   in
337 |   singleton elts
338 | 
339 | let add s z = union (singleton s) z
340 | 
341 | let remove s z =
342 |   let elts = S.elements s in
343 |   let rec remove elts z = match elts, z with
344 |     | [], Top -> Bottom
345 |     | [], Node (_, _ ,z1, _ ) -> remove [] z1
346 |     | h::t, Node(_, i, z1, z2) ->
347 |         if i = h then begin
348 |           construct i z1 (remove t z2) end
349 |         else if h > i then
350 |           construct i (remove elts z1) z2
351 |         else z
352 |     | _ -> z
353 |   in
354 |   remove elts z
355 | 
356 | let mem s z =
357 |   let l = S.elements s in
358 |   let rec mem l z = match l, z with
359 |     | [], Top -> true
360 |     | [], Node (_, _ ,z1, _ ) -> mem [] z1
361 |     | h :: t, Node(_, i, z1, z2) ->
362 |         if h = i then mem t z2
363 |         else if h > i then mem l z1
364 |         else false
365 |     | _ -> false
366 |   in
367 |   mem l z
368 | 
369 | let size z =
370 |   let s = ref 0 in
371 |   let h = H1.create 17 in
372 |   let rec visit z =
373 |     if not (H1.mem h z) then begin
374 |       H1.add h z ();
375 |       match z with
376 |         | Bottom | Top -> ()
377 |         | Node (_, _, l, r) -> incr s; visit l; visit r
378 |     end
379 |   in
380 |   visit z;
381 |   !s
382 | 
383 | let choose zdd =
384 |   let rec any_element zdd s = match zdd with
385 |     | Node (_, i, _, ct) -> any_element ct (S.add i s)
386 |     | Top -> s
387 |     | Bottom -> raise Not_found
388 |   in
389 |   any_element zdd S.empty
390 | 
391 | let random_chose zdd =
392 |   let rec any_element zdd s = match zdd with
393 |     | Node (_, i, z1, z2) ->
394 |         let z = if Random.bool () && not (equal z1 Bottom) then z1
395 |         else if not (equal z2 Bottom) then z2 else z1 in
396 |         any_element z (S.add i s)
397 |     | Top -> s
398 |     | Bottom -> raise Not_found
399 |   in
400 |   any_element zdd S.empty
401 | 
402 | let choose_list zdd = S.elements (random_chose zdd)
403 | 
404 | let iter_list f zdd =
405 |   let rec iter_element f l = function
406 |     | Top -> f l
407 |     | Bottom -> ()
408 |     | Node (_, i, z1, z2)-> iter_element f l z1 ;
409 |                             iter_element f (i :: l) z2
410 |   in
411 |   iter_element f [] zdd
412 | 
413 | let iter f zdd =
414 |   let rec iter_element f s = function
415 |     | Top -> f s
416 |     | Bottom -> ()
417 |     | Node (_, i, z1, z2)-> iter_element f s z1 ;
418 |                             iter_element f (S.add i s) z2
419 |   in
420 |   iter_element f S.empty zdd
421 | 
422 | let fold f zdd acc =
423 |   let rec fold f s acc = function
424 |     | Top -> f s acc
425 |     | Bottom -> acc
426 |     | Node (_, i, z1, z2)->
427 |         let acc = fold f s acc z1 in
428 |         fold f (S.add i s) acc z2
429 |   in
430 |   fold f S.empty acc zdd
431 | 
432 | let for_all f zdd =
433 |   try
434 |     iter (fun e -> if not (f e) then raise Exit) zdd;
435 |     true
436 |   with
437 |     | Exit -> false
438 | 
439 | let exists f zdd =
440 |   try
441 |     iter (fun e -> if f e then raise Exit) zdd;
442 |     false
443 |   with
444 |     | Exit -> true
445 | 
446 | let filter p zdd =
447 |   let z = ref Bottom in
448 |   iter (fun e -> if p e then z := add e !z) zdd;
449 |   !z
450 | 
451 | let partition p zdd =
452 |   let z1 = ref Bottom in
453 |   let z2 = ref Bottom in
454 |   iter (fun e -> if p e then z1 := add e !z1 else z2 := add e !z2) zdd;
455 |   !z1, !z2
456 | 
457 | let split x z =
458 |   let z1 = ref Bottom in
459 |   let z2 = ref Bottom in
460 |   let present = ref false in
461 |   iter (fun e ->
462 |           let c = S.compare e x in
463 |           if c < 0 then z1 := add e !z1
464 |           else if c = 0 then present := true
465 |           else z2 := add e !z2) z;
466 |   !z1, !present, !z2
467 | 
468 | let elements zdd =
469 |   let l = ref [] in
470 |   iter (fun e -> l := e :: !l) zdd;
471 |   !l
472 | 
473 | let max_elt zdd =
474 |   let max = ref S.empty in
475 |   iter (fun e -> if S.compare e !max > 0 then max := e ) zdd;
476 |   !max
477 | 
478 | let min_elt zdd =
479 |   let min = ref S.empty in
480 |   iter (fun e -> if S.compare e !min < 0 then min := e ) zdd;
481 |   !min
482 | 
483 | (* pretty print *)
484 | 
485 | let print_set fmt s =
486 |   fprintf fmt "{";
487 |   S.iter (fun x -> fprintf fmt "%d,@ " x) s; fprintf fmt "}"
488 | 
489 | let print fmt ss =
490 |   fprintf fmt "{"; iter (fun s -> fprintf fmt "%a,@ " print_set s) ss;
491 |   fprintf fmt "}"
492 | 
493 | (* DOT output *)
494 | 
495 | open Format
496 | 
497 | let print_to_dot fmt z =
498 |   let h = H1.create 17 in (* ZDD -> node name *)
499 |   let name = let r = ref 0 in fun () -> incr r; "N" ^ string_of_int !r in
500 |   let rec visit = function
501 |     | Bottom ->
502 |         let s = name () in
503 |         fprintf fmt "node [shape = none, label=\"Bot\"]; %s;@\n" s; s
504 |     | Top ->
505 |         let s = name () in
506 |         fprintf fmt "node [shape = none, label=\"Top\"]; %s;@\n" s; s
507 |     | Node (_, i, l, r) ->
508 |         let nl = memo l in
509 |         let nr = memo r in
510 |         let n = name () in
511 |         fprintf fmt "node [shape = circle, label=\"%d\"]; %s;@\n" i n;
512 |         fprintf fmt "%s -> %s [style = dotted];@\n%s -> %s;@\n" n nl n nr;
513 |         n
514 |   and memo z = match z with
515 |     | Bottom | Top -> visit z
516 |     | _ -> try H1.find h z with Not_found -> let n = visit z in H1.add h z n; n
517 |   in
518 |   fprintf fmt "@[<hov 2>digraph ZDD {@\nmargin = 0;@\n";
519 |   ignore (visit z);
520 |   fprintf fmt "}@]@\n"
521 | 
522 | let print_to_dot_file f z =
523 |   let c = open_out f in
524 |   let fmt = formatter_of_out_channel c in
525 |   print_to_dot fmt z;
526 |   fprintf fmt "@.";
527 |   close_out c
528 | 
529 | let stat () = !unique_ref
530 | 


--------------------------------------------------------------------------------
/src/lib/zdd.mli:
--------------------------------------------------------------------------------
  1 | (**************************************************************************)
  2 | (*                                                                        *)
  3 | (*  Combine - an OCaml library for combinatorics                          *)
  4 | (*                                                                        *)
  5 | (*  Copyright (C) 2012-2014                                               *)
  6 | (*    Remy El Sibaie                                                      *)
  7 | (*    Jean-Christophe Filliatre                                           *)
  8 | (*                                                                        *)
  9 | (*  This software is free software; you can redistribute it and/or        *)
 10 | (*  modify it under the terms of the GNU Library General Public           *)
 11 | (*  License version 2.1, with the special exception on linking            *)
 12 | (*  described in file LICENSE.                                            *)
 13 | (*                                                                        *)
 14 | (*  This software is distributed in the hope that it will be useful,      *)
 15 | (*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)
 16 | (*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)
 17 | (*                                                                        *)
 18 | (**************************************************************************)
 19 | 
 20 | (** {1 Zero-suppressed binary decision diagrams.}
 21 |     See for instance The Art of Computer Programming, volume 4A p. 249 *)
 22 | 
 23 | type unique = int
 24 | type t = private Bottom | Top | Node of unique * int * t * t
 25 | 
 26 | val bottom: t
 27 | val top: t
 28 | val construct: int -> t -> t -> t
 29 |   (** Smart constructors for ZDD.
 30 |       [construct i z1 z2] raises [Invalid_argument] if [i] is not
 31 |       smaller than roots of [z1] and [z2]. *)
 32 | 
 33 | val unique: t -> int
 34 |   (** Each ZDD has a unique integer *)
 35 | 
 36 | (** {2 A ZDD represents a set of sets of integers.}
 37 |     Hence this module provides all operations from OCaml's [Set],
 38 |     with elements being sets of integers (see type [elt] below) *)
 39 | 
 40 | module S : Set.S with type elt = int
 41 | type elt = S.t
 42 | val empty : t
 43 | val is_empty : t -> bool
 44 | val mem : elt -> t -> bool
 45 | val add : elt -> t -> t
 46 | val singleton : elt -> t
 47 | val remove : elt -> t -> t
 48 | val union : t -> t -> t
 49 | val inter : t -> t -> t
 50 | val diff : t -> t -> t
 51 | val compare : t -> t -> int
 52 | val equal : t -> t -> bool
 53 | val subset : t -> t -> bool
 54 | val iter : (elt -> unit) -> t -> unit
 55 | val fold : (elt -> 'a -> 'a) -> t -> 'a -> 'a
 56 | val for_all : (elt -> bool) -> t -> bool
 57 | val exists : (elt -> bool) -> t -> bool
 58 | val filter : (elt -> bool) -> t -> t
 59 | val partition : (elt -> bool) -> t -> t * t
 60 | val cardinal : t -> int
 61 | val elements : t -> elt list
 62 | val min_elt : t -> elt
 63 | val max_elt : t -> elt
 64 | val choose : t -> elt
 65 | val split : elt -> t -> t * bool * t
 66 | 
 67 | val choose_list: t -> int list
 68 | val iter_list: (int list -> unit) -> t -> unit
 69 | 
 70 | (** {2 Memoization}
 71 |     The following functions are fixpoint operators to build recursive
 72 |     functions over ZDDs using memoization. *)
 73 | 
 74 | val memo_rec1: ((t -> 'a) -> t -> 'a) -> t -> 'a
 75 | 
 76 | val memo_rec2: ((t * t -> 'a) -> t * t -> 'a) -> t * t -> 'a
 77 | 
 78 | (** {2 Cardinal using big integers}
 79 |     Function [cardinal] above may easily overflow. Therefore, we also
 80 |     provide a functor to compute the cardinal of a ZDD using any arithmetic
 81 |     (e.g. Num, Gmp, Zarith, etc.) *)
 82 | 
 83 | module type ARITH = sig
 84 |   type t
 85 |   val zero: t
 86 |   val one: t
 87 |   val add: t -> t -> t
 88 | end
 89 | 
 90 | module Cardinal(A: ARITH) : sig val cardinal: t -> A.t end
 91 | 
 92 | (** {2 Other functions} *)
 93 | 
 94 | val size: t -> int
 95 |   (** Number of internal nodes of a given ZDD.
 96 |       Each node occupies 5 words, so the total space used by a ZDD [z]
 97 |       is [size z * 5 * Sys.word_size/8] bytes. *)
 98 | 
 99 | val print: Format.formatter -> t -> unit
100 |   (** Prints a ZDD as a set of sets of integers, e.g. [{ {0}, {1}, {1,2} }]. *)
101 | 
102 | val print_to_dot: Format.formatter -> t -> unit
103 |   (** [print_to_dot fmt z] prints a ZDD [z] in DOT format *)
104 | 
105 | val print_to_dot_file: string -> t -> unit
106 |   (** [print_to_dot f z] outputs ZDD [z] in DOT format in file [f] *)
107 | 
108 | val stat: unit -> int
109 |   (** Returns the total number of unique ZDD built so far *)
110 | 
111 | 


--------------------------------------------------------------------------------
/src/main.ml:
--------------------------------------------------------------------------------
 1 | (**************************************************************************)
 2 | (*                                                                        *)
 3 | (*  Combine - an OCaml library for combinatorics                          *)
 4 | (*                                                                        *)
 5 | (*  Copyright (C) 2012-2014                                               *)
 6 | (*    Remy El Sibaie                                                      *)
 7 | (*    Jean-Christophe Filliatre                                           *)
 8 | (*                                                                        *)
 9 | (*  This software is free software; you can redistribute it and/or        *)
10 | (*  modify it under the terms of the GNU Library General Public           *)
11 | (*  License version 2.1, with the special exception on linking            *)
12 | (*  described in file LICENSE.                                            *)
13 | (*                                                                        *)
14 | (*  This software is distributed in the hope that it will be useful,      *)
15 | (*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)
16 | (*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)
17 | (*                                                                        *)
18 | (**************************************************************************)
19 | 
20 | open Format
21 | open Combine
22 | 
23 | 
24 | let zdd = ref false
25 | let dlx = ref false
26 | let debug = ref false
27 | let stats = ref false
28 | let parse_only = ref false
29 | 
30 | let msg = "usage: project [options] file"
31 | let spec = [ "--debug", Arg.Set debug, "  Set the debug flag";
32 |             "--stats", Arg.Set stats, "  Set the stats flag";
33 | 	    "--parse-only", Arg.Set parse_only, "  Stop after parsing";
34 |             "--fast-dlx", Arg.Set Interp.fast_dlx, "  Use fast DLX";
35 |            ]
36 | 
37 | let file = ref None
38 | let set_file f = match !file with
39 |   | Some _ -> Arg.usage spec msg; exit 1
40 |   | None when Sys.file_exists f -> file := Some f
41 |   | None -> eprintf "%s: no such file@." f; exit 1
42 | 
43 | 
44 | module N = struct
45 |   type t = Z.t
46 |   let zero = Z.zero
47 |   let one = Z.one
48 |   let add = Z.add
49 |   let print = Z.pp_print
50 | end
51 | module T = struct
52 |   let gettimeofday = Unix.gettimeofday
53 | end
54 | 
55 | module MainInterp = Interp.Make(T)(N)
56 | 
57 | 
58 | let () = Arg.parse spec set_file msg
59 | let () = MainInterp.debug := !debug; Backtracking.debug := !debug
60 | 
61 | let error_pieces_board () =
62 |   eprintf "problem must have board and piece(s) @.";
63 |   exit 1
64 | 
65 | let ptree = match !file with
66 |   | Some f -> Lexer.parse_file f
67 |   | None -> exit 0
68 | 
69 | let () = if !parse_only then exit 0
70 | 
71 | open Lexing
72 | 
73 | let () =
74 |   try
75 |     MainInterp.interp std_formatter err_formatter ptree
76 |   with
77 |     | MainInterp.Error (pos, err) ->
78 |         let start, stop = pos in
79 |         printf "File \"%s\", line %d, characters %d-%d : @\n"
80 |           start.pos_fname start.pos_lnum
81 |           (start.pos_cnum - start.pos_bol)
82 |           (stop.pos_cnum - stop.pos_bol) ;
83 |         printf "Error: %a@\n" MainInterp.print_error err;
84 |         exit 1
85 |     | e ->
86 |         Printexc.print_backtrace stderr; flush stderr;
87 |         Format.eprintf "Uncaught exception: %s@." (Printexc.to_string e);
88 |         exit 1
89 | 
90 | let () =
91 |   if !stats then begin
92 |     Gc.print_stat stdout;
93 |     printf "ZDD: %d unique trees built@." (Zdd.stat ())
94 |   end
95 | 


--------------------------------------------------------------------------------
/tests/dune:
--------------------------------------------------------------------------------
 1 | (test
 2 |  (name test)
 3 |  (modules test)
 4 |  (libraries combine num unix)
 5 |  (deps
 6 |   (file ../examples/cmb/non-regression.cmb)))
 7 | 
 8 | (test
 9 |  (name test_sat)
10 |  (modules test_sat)
11 |  (libraries combine))
12 | 


--------------------------------------------------------------------------------
/tests/test.ml:
--------------------------------------------------------------------------------
  1 | (**************************************************************************)
  2 | (*                                                                        *)
  3 | (*  Combine - an OCaml library for combinatorics                          *)
  4 | (*                                                                        *)
  5 | (*  Copyright (C) 2012-2014                                               *)
  6 | (*    Remy El Sibaie                                                      *)
  7 | (*    Jean-Christophe Filliatre                                           *)
  8 | (*                                                                        *)
  9 | (*  This software is free software; you can redistribute it and/or        *)
 10 | (*  modify it under the terms of the GNU Library General Public           *)
 11 | (*  License version 2.1, with the special exception on linking            *)
 12 | (*  described in file LICENSE.                                            *)
 13 | (*                                                                        *)
 14 | (*  This software is distributed in the hope that it will be useful,      *)
 15 | (*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)
 16 | (*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)
 17 | (*                                                                        *)
 18 | (**************************************************************************)
 19 | 
 20 | (* Test Module *)
 21 | 
 22 | open Combine
 23 | open Zdd
 24 | open Tiling
 25 | open Tiling.Problem.ToEMC
 26 | open Format
 27 | open Emc
 28 | 
 29 | module N = struct
 30 |   type t = Num.num
 31 |   let zero = Num.num_of_int 0
 32 |   let one = Num.num_of_int 1
 33 |   let add = Num.add_num
 34 |   let print fmt n = Format.fprintf fmt "%s" (Num.string_of_num n)
 35 | end
 36 | module T = struct
 37 |   let gettimeofday = Unix.gettimeofday
 38 | end
 39 | 
 40 | module TestInterp = Interp.Make(T)(N)
 41 | 
 42 | let r = Lexer.parse_file "../examples/cmb/non-regression.cmb"
 43 | let problems, _ = TestInterp.interp_problems std_formatter err_formatter r
 44 | let p = List.hd problems
 45 | 
 46 | (* sets of sets of integers *)
 47 | module SS = struct
 48 |   include Set.Make(Zdd.S)
 49 |   let of_zdd z =
 50 |     List.fold_left (fun ss s -> add s ss) empty (Zdd.elements z)
 51 |   let to_zdd ss =
 52 |     fold Zdd.add ss Zdd.bottom
 53 |   (* n sets of <=k elements each, values in 0..m-1 *)
 54 |   let random n k m =
 55 |     let random_set () =
 56 |       let s = ref Zdd.S.empty in
 57 |       for _ = 1 to Random.int (k+1) do s := Zdd.S.add (Random.int m) !s done;
 58 |       !s
 59 |     in
 60 |     let ss = ref empty in
 61 |     for _ = 1 to n do ss := add (random_set ()) !ss done; !ss
 62 |   let print_set fmt s =
 63 |     fprintf fmt "{";
 64 |     Zdd.S.iter (fun x -> fprintf fmt "%d,@ " x) s; fprintf fmt "}"
 65 |   let print fmt ss =
 66 |     fprintf fmt "{"; iter (fun s -> fprintf fmt "%a,@ " print_set s) ss;
 67 |     fprintf fmt "}"
 68 | end
 69 | 
 70 | (* union/inter/diff *)
 71 | let () =
 72 |   for n = 0 to 10 do for k = 0 to 10 do
 73 |     let ss1 = SS.random n k 20 in
 74 |     let z1 = SS.to_zdd ss1 in
 75 |     let ss2 = SS.random n k 20 in
 76 |     let z2 = SS.to_zdd ss2 in
 77 |     assert (SS.equal (SS.union ss1 ss2) (SS.of_zdd (Zdd.union z1 z2)));
 78 |     assert (SS.equal (SS.inter ss1 ss2) (SS.of_zdd (Zdd.inter z1 z2)));
 79 |     assert (SS.equal (SS.diff  ss1 ss2) (SS.of_zdd (Zdd.diff  z1 z2)));
 80 |     assert (SS.subset  ss1 ss2 = Zdd.subset  z1 z2);
 81 |     (* || (eprintf "s1 = %a / s2 = %a@." SS.print ss1 SS.print ss2; false)); *)
 82 |   done done
 83 | 
 84 | let to_set l =
 85 |   let s = ref Zdd.S.empty in
 86 |   List.iter (fun e -> s := Zdd.S.add e !s) l;
 87 |   !s
 88 | 
 89 | let () =
 90 |   let z1 = construct 1 bottom top in
 91 |   let z2 = construct 2 bottom top in
 92 |   assert (mem (to_set [1]) z1);
 93 |   assert (mem (to_set [2]) z2);
 94 |   assert (mem (to_set [1]) (union z1 z2));
 95 |   assert (mem (to_set [2]) (union z1 z2))
 96 | 
 97 | let () =
 98 |   let s1 = to_set [1; 2; 3] in
 99 |   let s2 = to_set [1; 2] in
100 |   let z1 = Zdd.singleton s1 in
101 |   let z2 = Zdd.singleton s2 in
102 |   assert (Zdd.mem s1 z1);
103 |   assert (Zdd.is_empty (Zdd.remove s1 z1));
104 |   let z3 = Zdd.union z1 z2 in
105 |   assert (Zdd.mem s1 z3);
106 |   assert (Zdd.mem s2 z3)
107 | 
108 | let () =
109 |   let { columns = columns; primary = primary; emc = m; tiles = _uncode_tbl } =
110 |     Tiling.Problem.ToEMC.make p in
111 |   assert (Emc.Z.count_solutions (Emc.Z.create_sparse ~columns ~primary m)
112 |           = 12988816)
113 | 
114 | let p =
115 |   Pattern.create
116 |     [|
117 |      [|true; true;|];
118 |      [|true; false;|];
119 |     |]
120 | 
121 | let p2 =
122 |   Pattern.create
123 |     [|
124 |      [|true; true;|];
125 |      [|true; true;|];
126 |     |]
127 | 
128 | 
129 | let () =
130 |   let m = [|[|false; true; false|];
131 |             [|true; false; true|];
132 |             [|true; false; false|];
133 |             [|false; true; true|]|] in
134 |   let _sat = Sat.create ~primary:3 m in
135 |   () (* printf "%a@." Sat.print sat *)
136 | 
137 | 
138 | 
139 | (*
140 | 
141 | let () = printf "%a\n@." Pattern.print (Pattern.shift p 1 1)
142 | 
143 | let () = printf "%a\n@." Pattern.print (Pattern.union p (Pattern.shift p 1 1))
144 | 
145 | let () = printf "%a\n@." Pattern.print (Pattern.inter p (Pattern.shift p 1 1))
146 | 
147 | let () = printf "%a\n@." Pattern.print (Pattern.diff p (Pattern.shift p 1 1))
148 | let () = printf "%a\n@." Pattern.print (Pattern.diff p p)
149 | 
150 | 
151 |  *)
152 | 


--------------------------------------------------------------------------------
/tests/test_sat.ml:
--------------------------------------------------------------------------------
 1 | (**************************************************************************)
 2 | (*                                                                        *)
 3 | (*  Combine - an OCaml library for combinatorics                          *)
 4 | (*                                                                        *)
 5 | (*  Copyright (C) 2012-2014                                               *)
 6 | (*    Remy El Sibaie                                                      *)
 7 | (*    Jean-Christophe Filliatre                                           *)
 8 | (*                                                                        *)
 9 | (*  This software is free software; you can redistribute it and/or        *)
10 | (*  modify it under the terms of the GNU Library General Public           *)
11 | (*  License version 2.1, with the special exception on linking            *)
12 | (*  described in file LICENSE.                                            *)
13 | (*                                                                        *)
14 | (*  This software is distributed in the hope that it will be useful,      *)
15 | (*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)
16 | (*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)
17 | (*                                                                        *)
18 | (**************************************************************************)
19 | 
20 | open Combine
21 | 
22 | let emc =
23 |   [| [| true; false; true; true;  |];
24 |      [| false; true; true; false; |];
25 |      [| true; true; false; true; |];
26 |      [| true; false; false; true; |];
27 |      [| false; true; false; false |] |]
28 | 
29 | let sat = Emc.Sat.create ~primary:4 emc
30 | 
31 | let () = Format.printf "%a@." Emc.Sat.print sat
32 | 
33 | 


--------------------------------------------------------------------------------
/www/images/bg.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/backtracking/combine/26566b7ce74fc6bcf92c040b371d35115659453f/www/images/bg.png


--------------------------------------------------------------------------------
/www/images/exemple.svg:
--------------------------------------------------------------------------------
 1 | <?xml version="1.0" standalone="no"?> 
 2 | <svg xmlns="http://www.w3.org/2000/svg" width="200" height="200"
 3 | preserveAspectRatio="x200Y200 meet"
 4 | viewBox="0 0 200 200"
 5 | >
 6 |   <g style="stroke:#000000;stroke-width:1;stroke-linejoin:miter;stroke-miterlimit:4;stroke-opacity:1;">
 7 |   <rect x="75" y="125" width="25" height="25" style="fill:rgb(72, 242, 219);" />
 8 |   <rect x="25" y="150" width="25" height="25" style="fill:rgb(72, 242, 219);" />
 9 |   <rect x="50" y="150" width="25" height="25" style="fill:rgb(72, 242, 219);" />
10 |   <rect x="75" y="150" width="25" height="25" style="fill:rgb(72, 242, 219);" />
11 |   <rect x="25" y="175" width="25" height="25" style="fill:rgb(72, 242, 219);" />
12 |   </g>
13 |   <g style="stroke:#000000;stroke-width:1;stroke-linejoin:miter;stroke-miterlimit:4;stroke-opacity:1;">
14 |   <rect x="0" y="125" width="25" height="25" style="fill:rgb(242, 168, 72);" />
15 |   <rect x="25" y="125" width="25" height="25" style="fill:rgb(242, 168, 72);" />
16 |   <rect x="50" y="125" width="25" height="25" style="fill:rgb(242, 168, 72);" />
17 |   <rect x="0" y="150" width="25" height="25" style="fill:rgb(242, 168, 72);" />
18 |   <rect x="0" y="175" width="25" height="25" style="fill:rgb(242, 168, 72);" />
19 |   </g>
20 |   <g style="stroke:#000000;stroke-width:1;stroke-linejoin:miter;stroke-miterlimit:4;stroke-opacity:1;">
21 |   <rect x="0" y="75" width="25" height="25" style="fill:rgb(120, 72, 242);" />
22 |   <rect x="50" y="75" width="25" height="25" style="fill:rgb(120, 72, 242);" />
23 |   <rect x="0" y="100" width="25" height="25" style="fill:rgb(120, 72, 242);" />
24 |   <rect x="25" y="100" width="25" height="25" style="fill:rgb(120, 72, 242);" />
25 |   <rect x="50" y="100" width="25" height="25" style="fill:rgb(120, 72, 242);" />
26 |   </g>
27 |   <g style="stroke:#000000;stroke-width:1;stroke-linejoin:miter;stroke-miterlimit:4;stroke-opacity:1;">
28 |   <rect x="150" y="75" width="25" height="25" style="fill:rgb(75, 242, 72);" />
29 |   <rect x="125" y="100" width="25" height="25" style="fill:rgb(75, 242, 72);" />
30 |   <rect x="150" y="100" width="25" height="25" style="fill:rgb(75, 242, 72);" />
31 |   <rect x="100" y="125" width="25" height="25" style="fill:rgb(75, 242, 72);" />
32 |   <rect x="125" y="125" width="25" height="25" style="fill:rgb(75, 242, 72);" />
33 |   </g>
34 |   <g style="stroke:#000000;stroke-width:1;stroke-linejoin:miter;stroke-miterlimit:4;stroke-opacity:1;">
35 |   <rect x="150" y="0" width="25" height="25" style="fill:rgb(242, 72, 123);" />
36 |   <rect x="175" y="0" width="25" height="25" style="fill:rgb(242, 72, 123);" />
37 |   <rect x="150" y="25" width="25" height="25" style="fill:rgb(242, 72, 123);" />
38 |   <rect x="175" y="25" width="25" height="25" style="fill:rgb(242, 72, 123);" />
39 |   <rect x="150" y="50" width="25" height="25" style="fill:rgb(242, 72, 123);" />
40 |   </g>
41 |   <g style="stroke:#000000;stroke-width:1;stroke-linejoin:miter;stroke-miterlimit:4;stroke-opacity:1;">
42 |   <rect x="125" y="25" width="25" height="25" style="fill:rgb(72, 174, 242);" />
43 |   <rect x="75" y="50" width="25" height="25" style="fill:rgb(72, 174, 242);" />
44 |   <rect x="100" y="50" width="25" height="25" style="fill:rgb(72, 174, 242);" />
45 |   <rect x="125" y="50" width="25" height="25" style="fill:rgb(72, 174, 242);" />
46 |   <rect x="125" y="75" width="25" height="25" style="fill:rgb(72, 174, 242);" />
47 |   </g>
48 |   <g style="stroke:#000000;stroke-width:1;stroke-linejoin:miter;stroke-miterlimit:4;stroke-opacity:1;">
49 |   <rect x="100" y="0" width="25" height="25" style="fill:rgb(222, 242, 72);" />
50 |   <rect x="125" y="0" width="25" height="25" style="fill:rgb(222, 242, 72);" />
51 |   <rect x="50" y="25" width="25" height="25" style="fill:rgb(222, 242, 72);" />
52 |   <rect x="75" y="25" width="25" height="25" style="fill:rgb(222, 242, 72);" />
53 |   <rect x="100" y="25" width="25" height="25" style="fill:rgb(222, 242, 72);" />
54 |   </g>
55 |   <g style="stroke:#000000;stroke-width:1;stroke-linejoin:miter;stroke-miterlimit:4;stroke-opacity:1;">
56 |   <rect x="0" y="0" width="25" height="25" style="fill:rgb(211, 72, 242);" />
57 |   <rect x="25" y="0" width="25" height="25" style="fill:rgb(211, 72, 242);" />
58 |   <rect x="50" y="0" width="25" height="25" style="fill:rgb(211, 72, 242);" />
59 |   <rect x="75" y="0" width="25" height="25" style="fill:rgb(211, 72, 242);" />
60 |   <rect x="0" y="25" width="25" height="25" style="fill:rgb(211, 72, 242);" />
61 |   </g>
62 |   <g style="stroke:#000000;stroke-width:1;stroke-linejoin:miter;stroke-miterlimit:4;stroke-opacity:1;">
63 |   <rect x="25" y="25" width="25" height="25" style="fill:rgb(72, 242, 163);" />
64 |   <rect x="0" y="50" width="25" height="25" style="fill:rgb(72, 242, 163);" />
65 |   <rect x="25" y="50" width="25" height="25" style="fill:rgb(72, 242, 163);" />
66 |   <rect x="50" y="50" width="25" height="25" style="fill:rgb(72, 242, 163);" />
67 |   <rect x="25" y="75" width="25" height="25" style="fill:rgb(72, 242, 163);" />
68 |   </g>
69 |   <g style="stroke:#000000;stroke-width:1;stroke-linejoin:miter;stroke-miterlimit:4;stroke-opacity:1;">
70 |   <rect x="100" y="150" width="25" height="25" style="fill:rgb(242, 112, 72);" />
71 |   <rect x="50" y="175" width="25" height="25" style="fill:rgb(242, 112, 72);" />
72 |   <rect x="75" y="175" width="25" height="25" style="fill:rgb(242, 112, 72);" />
73 |   <rect x="100" y="175" width="25" height="25" style="fill:rgb(242, 112, 72);" />
74 |   <rect x="125" y="175" width="25" height="25" style="fill:rgb(242, 112, 72);" />
75 |   </g>
76 |   <g style="stroke:#000000;stroke-width:1;stroke-linejoin:miter;stroke-miterlimit:4;stroke-opacity:1;">
77 |   <rect x="175" y="50" width="25" height="25" style="fill:rgb(72, 81, 242);" />
78 |   <rect x="175" y="75" width="25" height="25" style="fill:rgb(72, 81, 242);" />
79 |   <rect x="175" y="100" width="25" height="25" style="fill:rgb(72, 81, 242);" />
80 |   <rect x="175" y="125" width="25" height="25" style="fill:rgb(72, 81, 242);" />
81 |   <rect x="175" y="150" width="25" height="25" style="fill:rgb(72, 81, 242);" />
82 |   </g>
83 |   <g style="stroke:#000000;stroke-width:1;stroke-linejoin:miter;stroke-miterlimit:4;stroke-opacity:1;">
84 |   <rect x="150" y="125" width="25" height="25" style="fill:rgb(132, 242, 72);" />
85 |   <rect x="125" y="150" width="25" height="25" style="fill:rgb(132, 242, 72);" />
86 |   <rect x="150" y="150" width="25" height="25" style="fill:rgb(132, 242, 72);" />
87 |   <rect x="150" y="175" width="25" height="25" style="fill:rgb(132, 242, 72);" />
88 |   <rect x="175" y="175" width="25" height="25" style="fill:rgb(132, 242, 72);" />
89 |   </g>
90 |   
91 | </svg>
92 | 


--------------------------------------------------------------------------------
/www/index.html:
--------------------------------------------------------------------------------
  1 | <!doctype html>
  2 | <!--[if lt IE 7]> <html class="no-js ie6" lang="en"> <![endif]-->
  3 | <!--[if IE 7]>    <html class="no-js ie7" lang="en"> <![endif]-->
  4 | <!--[if IE 8]>    <html class="no-js ie8" lang="en"> <![endif]-->
  5 | <!--[if gt IE 8]><!--> <html class="no-js" lang="en"> <!--<![endif]-->
  6 | <head>
  7 | 
  8 | <meta charset="utf-8" />
  9 | 
 10 | <title>Combine - an OCaml library for combinatorics</title>
 11 | 
 12 | <meta name="description" content="" />
 13 | 
 14 | <meta name="viewport" content="width=device-width, initial-scale=1.0" />
 15 | 
 16 | <link href="style.css" rel="stylesheet" />
 17 | 
 18 | </head>
 19 | 
 20 | <body>
 21 | 
 22 | <div id="wrapper">
 23 | 
 24 | <header id="header" class="clearfix" role="banner">
 25 | 
 26 | <hgroup>
 27 | <h1 id="site-title"><a href="index.html">Combine</a></h1>
 28 | <h2 id="site-description">an OCaml library for combinatorics</h2>
 29 | </hgroup>
 30 | 
 31 | </header>
 32 | 
 33 | <div id="main" class="clearfix">
 34 | 
 35 | 
 36 | <div id="content" role="main">
 37 | 
 38 | <article class="post">
 39 | 
 40 | <figure>
 41 | <embed src="images/exemple.svg" height="203px" class="thumbnail alignleft" type="image/svg+xml" />
 42 | </figure>
 43 | 
 44 | <div class="entry-content">
 45 | <p>
 46 | Combine is an OCaml library for combinatorics problem solving formed by several
 47 | modules:
 48 | <ul>
 49 | <li><a href="doc/Dlx.html">Dlx</a>: implements Knuth's dancing links</li>
 50 | <li><a href="doc/Zdd.html">Zdd</a>: implements Zero-suppressed binary decision diagrams </li>
 51 | <li><a href="doc/Emc.html">Emc</a>: a common interface to modules Dlx and Zdd to solve the
 52 | Exact Matrix Cover problem</li>
 53 | <li><a href="doc/Tiling.html">Tiling</a>: converts a 2D tiling problem into an EMC problem</li>
 54 | 
 55 | <hr />
 56 | 
 57 | <p>
 58 | Several combinatorics problems can easily be encoded as EMC problems, e.g.
 59 | <a href="sudoku.ml.html">Sudoku</a> or <a href="queens.ml.html">N-queens</a>.
 60 | </p>
 61 | 
 62 | <p>
 63 | Combine also contains an interpreter for a language (combine) to describe 2D
 64 | tiling problems (such as Pentominos) and solve them or counting their
 65 | solutions.  The archive contains some examples.
 66 | </p>
 67 | 
 68 | </ul>
 69 | </p>
 70 | 
 71 | </div> <!-- .entry-content -->
 72 | 
 73 | </article> <!-- .post 1 -->
 74 | 
 75 | 
 76 | </div> <!-- #main -->
 77 | 
 78 | <aside id="sidebar" role="complementary">
 79 |         <aside class="widget">
 80 |             <ul>
 81 |                 <li><a href="doc/index.html">Documentation</a></li>
 82 |                 <li><a href="download/">Download</a></li>
 83 |             </ul>
 84 |         </aside> <!-- .widget -->
 85 |     </aside> <!-- #sidebar -->
 86 | </div> <!-- #wrapper -->
 87 | 
 88 | 
 89 | <footer id="footer">
 90 | <p>
 91 | Copyright &copy; 2012,
 92 | Rémy El Sibaïe &
 93 | <a href="http://www.lri.fr/~filliatr/">Jean-Christophe Filliâtre</a>
 94 | 
 95 | </p>
 96 | </footer> <!-- #footer -->
 97 | 
 98 | </body>
 99 | </html>
100 | 


--------------------------------------------------------------------------------