1% BEGIN LICENSE BLOCK
2% Version: CMPL 1.1
3%
4% The contents of this file are subject to the Cisco-style Mozilla Public
5% License Version 1.1 (the "License"); you may not use this file except
6% in compliance with the License.  You may obtain a copy of the License
7% at www.eclipse-clp.org/license.
8%
9% Software distributed under the License is distributed on an "AS IS"
10% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied.  See
11% the License for the specific language governing rights and limitations
12% under the License.
13%
14% The Original Code is  The ECLiPSe Constraint Logic Programming System.
15% The Initial Developer of the Original Code is  Cisco Systems, Inc.
16% Portions created by the Initial Developer are
17% Copyright (C) 2006 Cisco Systems, Inc.  All Rights Reserved.
18%
19% Contributor(s):
20%
21% END LICENSE BLOCK
22
23/*
24Article: 5653 of comp.lang.prolog
25Newsgroups: comp.lang.prolog
26Path: ecrc!Germany.EU.net!mcsun!ub4b!news.cs.kuleuven.ac.be!bimbart
27From: bimbart@cs.kuleuven.ac.be (Bart Demoen)
28Subject: boolean constraint solvers
29Message-ID: <1992Oct19.093131.11399@cs.kuleuven.ac.be>
30Sender: news@cs.kuleuven.ac.be
31Nntp-Posting-Host: hera.cs.kuleuven.ac.be
32Organization: Dept. Computerwetenschappen K.U.Leuven
33Date: Mon, 19 Oct 1992 09:31:31 GMT
34Lines: 120
35
36	?- calc_constr(N,C,L) . % with N instantiated to a positive integer
37
38generates in the variable C a datastructure that can be interpreted as a
39boolean expression (and in fact is so by SICStus Prolog's bool:sat) and in L
40the list of variables involved in this boolean expression; so
41
42	?- calc_constr(N,C,L) , bool:sat(C) , bool:labeling(L) .
43			% with N instantiated to a positive integer
44
45shows the instantiations of L for which the boolean expression is true
46e.g.
47
48	| ?- calc_constr(3,C,L) , bool:sat(C) , bool:labeling(L) .
49	% C = omitted
50	L = [1,0,1,0,1,0,1,0,1] ? ;
51
52	no
53
54it is related to a puzzle which I can describe if people are interested
55
56SICStus Prolog can solve this puzzle up to N = 9  on my machine; it then
57fails because of lack of memory (my machine has relatively little: for N=9
58SICStus needs 14 Mb - and about 50 secs runtime + 20 secs for gc on Sparc 1)
59
60I am interested in hearing about boolean constraint solvers that can deal with
61the expression generated by the program below, for large N and in reasonable
62time and space; say N in the range 10 to 20: the number of solutions for
63different N varies wildly; there is exactly one solution for N = 10,12,13,15,20
64but for N=18 or 19 there are several thousand, so perhaps it is best to
65restrict attention to N with only one solution - unless that is unfair to your
66solver
67
68in case you have to adapt the expression for your own boolean solver, in
69the expression generated, ~ means negation, + means disjunction,
70* means conjunction and somewhere in the program, 1 means true
71
72
73Thanks
74
75Bart Demoen
76*/
77
78:- [bool]. % load in boolean ECH handler
79
80% test(N,L) :- calc_constr(N,C,L) , bool:sat(C) , bool:labeling(L) .
81test(N,L) :-   calc_constr(N,C,L) , solve_bool(C,1).
82testbl(N,L) :- calc_constr(N,C,L) , solve_bool(C,1), labeling.
83testul(N,L) :- calc_constr(N,C,L) , solve_bool(C,1), label_bool(L).
84
85calc_constr(N,C,L) :-
86		M is N * N ,
87		functor(B,b,M) ,
88		B =.. [_|L] ,
89		cc(N,N,N,B,C,1) .
90
91cc(0,M,N,B,C,T) :- ! ,
92		NewM is M - 1 ,
93		cc(N,NewM,N,B,C,T) .
94cc(_,0,_,B,C,C) :- ! .
95cc(I,J,N,B,C,T) :-
96		neighbours(I,J,N,B,C,S) ,
97		NewI is I - 1 ,
98		cc(NewI,J,N,B,S,T) .
99
100
101neighbours(I,J,N,B,C,S) :-
102		add(I,J,N,B,L,R1) ,
103		add(I-1,J,N,B,R1,R2) ,
104		add(I+1,J,N,B,R2,R3) ,
105		add(I,J-1,N,B,R3,R4) ,
106		add(I,J+1,N,B,R4,[]) ,	% L is the list of neighbours of (I,J)
107					% including (I,J)
108		odd(L,C,S) .
109
110add(I,J,N,B,S,S) :- I =:= 0 , ! .
111add(I,J,N,B,S,S) :- J =:= 0 , ! .
112add(I,J,N,B,S,S) :- I > N , ! .
113add(I,J,N,B,S,S) :- J > N , ! .
114add(I,J,N,B,[X|S],S) :- A is (I-1) * N + J , arg(A,B,X) .
115
116
117% odd/2 generates the constraint that an odd number of elements of its first
118% argument must be 1, the rest must be 0
119
120odd(L,C*S,S):- exors(L,C).
121
122  exors([X],X).
123  exors([X|L],X#R):- L=[_|_],
124	exors(L,R).
125
126
127/*
128% did this by enumeration, because there are only 4 possibilities
129
130odd([A],	A * S,S) :- ! .
131
132odd([A,B,C],	((A * ~~(B) * ~~(C)) +
133		(A * B * C) +
134		( ~~(A) * B * ~~(C)) +
135		( ~~(A) * ~~(B) * C))  * S,S)
136		:- ! .
137
138odd([A,B,C,D],	((A * ~~(B) * ~~(C) * ~~(D)) +
139		(A * B * C * ~~(D)) +
140		(A * B * ~~(C) * D) +
141		(A * ~~(B) * C * D) +
142		( ~~(A) * B * ~~(C) * ~~(D)) +
143		( ~~(A) * B * C * D) +
144		( ~~(A) * ~~(B) * C * ~~(D)) +
145		( ~~(A) * ~~(B) * ~~(C) * D))  * S,S )
146		:- ! .
147
148odd([A,B,C,D,E],((A * ~~(B) * ~~(C) * ~~(D) * ~~(E)) +
149		(A * B * C * ~~(D) * ~~(E)) +
150		(A * B * ~~(C) * D * ~~(E)) +
151		(A * ~~(B) * C * D * ~~(E)) +
152		(A * B * ~~(C) * ~~(D) * E) +
153		(A * ~~(B) * C * ~~(D) * E) +
154		(A * ~~(B) * ~~(C) * D * E) +
155		(A * B * C * D * E) +
156		( ~~(A) * B * ~~(C) * ~~(D) * ~~(E)) +
157		( ~~(A) * B * ~~(C) * D * E) +
158		( ~~(A) * B * C * ~~(D) * E) +
159		( ~~(A) * B * C * D * ~~(E)) +
160		( ~~(A) * ~~(B) * C * ~~(D) * ~~(E)) +
161		( ~~(A) * ~~(B) * C * D * E) +
162		( ~~(A) * ~~(B) * ~~(C) * D * ~~(E)) +
163		( ~~(A) * ~~(B) * ~~(C) * ~~(D) * E))  * S,S ) :- ! .
164
165*/
166
167
168
169
170
171
172
173
174