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) 1995 - 2006 Cisco Systems, Inc.  All Rights Reserved.
18%
19% Contributor(s): Vassilis Liatsos, IC-Parc
20%
21% END LICENSE BLOCK
22% ----------------------------------------------------------------------
23% System:	ECLiPSe Constraint Logic Programming System
24% Version:	$Id: cumulative_examples.pl,v 1.1 2006/09/23 01:53:25 snovello Exp $
25
26% Author:      Vassilis Liatsos
27% Description
28% Examples using the cumulative constraint
29% ----------------------------------------------------------------------
30
31
32%:- use_module(cumulative).
33%:- use_module(edge_finder).
34%:- use_module(edge_finder3).
35%:- use_module('../lib_icparc/edge_finder').
36% :- use_module('../lib_icparc/edge_finder3').
37% :- use_module(cumulative).
38
39:- lib(fd_global).
40:- lib(edge_finder).
41:- lib(branch_and_bound).
42
43/*
44
45This small resource scheduling problem is taken from
46"Introducing Global Constraints in CHIP" by N.Beldiceanu and E.Contejean
47Mathl. Comput. Modellinmg Vol. 20, No. 12, pp 97-123, 1994
48
49Data for scheduling problem
50
51--------------------------------------------
52task     | t1 | t2 | t3 | t4 | t5 | t6 | t7 |
53---------+----+----+----+----+----+----+----|
54duration | 16 |  6 | 13 |  7 |  5 | 18 |  4 |
55---------+----+----+----+----+----+----+----|
56resource |  2 |  9 |  3 |  7 | 10 |  1 | 11 |
57--------------------------------------------
58
59*/
60
61% Optimisation strategy: step or dichotomic
62:- setval(strategy,step).
63
64go(LO):-
65	cputime(Start),
66	LO = [O1,O2,O3,O4,O5,O6,O7],
67	LD = [16,6,13,7,5,18,4],
68	LR = [2,9,3,7,10,1,11],
69	LE = [E1,E2,E3,E4,E5,E6,E7],
70	LO :: 1..30,
71	LE :: 1..30,
72	O1 + 16 #= E1,
73	O2 + 6 #= E2,
74	O3 + 13 #= E3,
75	O4 + 7 #= E4,
76	O5 + 5 #= E5,
77	O6 + 18 #= E6,
78	O7 + 4 #= E7,
79	cumulative(LO,LD,LR,13),
80	maxlist(LE,Cost),
81	getval(strategy,Strategy),
82	Options = bb_options with strategy:Strategy,
83	bb_min(labeling(LO),Cost,Options),
84	cputime(End),
85	Time is End - Start,
86	printf("Proof of optimality in %.2f sec(s)\n",[Time]).
87
88/*
89
90Classical Rectangle Packing Problems
91Taken from: "Extending CHIP in Order to Solve Complex
92Scheduling and Placement Problems"
93
94*/
95
96% Pfefferkorn
97pfefferkorn(Solutions):-
98	cputime(Start),
99	LO = [O1,O2,O3,O4,O5,O6],
100	LD = [6,4,2,2,2,2],
101	LR = [2,2,3,3,3,1],
102	LE = [E1,E2,E3,E4,E5,E6],
103	LO :: 1..9,
104	LE :: 1..9,
105	O1 + 6 #= E1,
106	O2 + 4 #= E2,
107	O3 + 2 #= E3,
108	O4 + 2 #= E4,
109	O5 + 2 #= E5,
110	O6 + 2 #= E6,
111	% Symmetry constraints
112%	O3 #<= O4, O4 #<= O5,
113	cumulative(LO,LD,LR,5),
114
115%	LO = [1, 5, 1, 3, 7, 5],
116%	O1 = 1, later, O2 = 5,later, O3 = 1,later, O4 = 3,later, O5 = 7, later,O6 = 5,later,
117
118	findall(LO,label_deleteff(LO),Solutions),
119	once(member(LO,Solutions)),
120	length(Solutions,No),
121	printf('Number of solutions: %w\n',[No]),
122        cputime(End),
123	Time is End - Start,
124	printf("Solutions found in %.2f sec(s)\n",[Time]).
125
126later:- true.
127/*
128cucumulative_ef2mulative_ef2([1, 5, 1, O4{[3..7]}, O5{[3..7]}, O6{[2..7]}], [6, 4, 2, 2, 2, 2], [2, 2, 3, 3, 3, 1], [12, 8, 6, 6, 6, 2], 'HANDLE'(16'081087c0)) (dbg)?- skip
129  (1078) 1  FAIL   cumulative_ef2([1, 5, 1, O4{[3..7]}, O5{[3..7]}, O6{[2..7]}], [6, 4, 2, 2, 2, 2], [2, 2, 3, 3, 3, 1], [12, 8, 6, 6, 6, 2], 'HANDLE'(16'081087c0)) (dbg)?-
130*/
131test :-
132 O4::3..7,
133 O5::3..7,
134 O6::2..7,
135 cumulative([1,5,1,O4,O5,O6],[6, 4, 2, 2, 2, 2], [2, 2, 3, 3, 3, 1],5).
136%	LO = [1, 5, 1, 3, 7, 5],
137% Lauriere
138lauriere(Solutions):-
139	cputime(Start),
140	LO = [O1,O2,O3,O4,O5,O6],
141	[D1,R1] :: [6,2],
142	[D2,R2] :: [4,2],
143	[D3,R3,D4,R4,D5,R5] :: [2,3],
144	[D6,R6] :: [2,1],
145	LD = [D1,D2,D3,D4,D5,D6],
146	LR = [R1,R2,R3,R4,R5,R6],
147	LE = [E1,E2,E3,E4,E5,E6],
148	LO :: 1..9,
149	LE :: 1..9,
150	O1 + D1 #= E1,
151	O2 + D2 #= E2,
152	O3 + D3 #= E3,
153	O4 + D4 #= E4,
154	O5 + D5 #= E5,
155	O6 + D6 #= E6,
156	D1 ## R1, D2 ## R2, D3 ## R3, D4 ## R4, D5 ## R5, D6 ## R6,
157	cumulative(LO,LD,LR,5),
158	Vars = [O1,D1,O2,D2,O3,D3,O4,D4,O5,D5,O6,D6],
159	findall(Vars,labeling(Vars),Solutions),
160	once(member(Vars,Solutions)),
161	length(Solutions,No),
162	printf('Number of solutions: %w\n',[No]),
163        cputime(End),
164	Time is End - Start,
165	printf("Solutions found in %.2f sec(s)\n",[Time]).
166
167
168
169% Tong
170tong(Solutions):-
171	cputime(Start),
172	LO = [O1,O2,O3,O4],
173	LD = [D1,D2,D3,D4],
174	LR = [R1,R2,R3,R4],
175	LE = [E1,E2,E3,E4],
176	LD::4..9,
177	LR::4..9,
178	LO :: 1..10,
179	LE :: 1..10,
180	O1 + D1 #= E1,
181	O2 + D2 #= E2,
182	O3 + D3 #= E3,
183	O4 + D4 #= E4,
184	(foreach(D,LD),foreach(R,LR),fromto(0,In,Out,Sum) do
185            Out =  D*R +In
186 	),
187	TotalArea is 9*9,
188	TotalArea #= Sum,
189	% O1 #<= O2, O2 #<= O3, O3 #<= O4,
190	cumulative(LO,LD,LR,9),
191	Vars = [O1,D1,R1,O2,D2,R2,O3,D3,R3,O4,D4,R4],
192	findall(Vars,labeling(Vars),Solutions),
193	once(member(Vars,Solutions)),
194	length(Solutions,No),
195	printf('Number of solutions: %w\n',[No]),
196        cputime(End),
197	Time is End - Start,
198	printf("Solutions found in %.2f sec(s)\n",[Time]).
199
200
201
202% Reingold
203reingold(Solutions):-
204	cputime(Start),
205	LO = [O1,O2,O3,O4,O5,O6,O7],
206	LD = [D1,D2,D3,D4,D5,D6,D7],
207	LR = [R1,R2,R3,R4,R5,R6,R7],
208	LE = [E1,E2,E3,E4,E5,E6,E7],
209	LD::1..22,
210	LR::1..13,
211	LO :: 1..23,
212	LE :: 1..23,
213	O1 + D1 #= E1,
214	O2 + D2 #= E2,
215	O3 + D3 #= E3,
216	O4 + D4 #= E4,
217	O5 + D5 #= E5,
218	O6 + D6 #= E6,
219	O7 + D7 #= E7,
220	(foreach(D,LD),foreach(R,LR),fromto(0,In,Out,Sum) do
221            Out =  D*R +In
222 	),
223	TotalArea is 22*13,
224	TotalArea #= Sum,
225%	TotalArea #>= Sum, TotalArea #<=Sum,
226
227	D1 #< D2, D2 #< D3, D3 #< D4, D4 #< D5, D5 #< D6, D6 #< D7,
228	R1 #> R2, R2 #> R3, R3 #> R4, R4 #> R5, R5 #> R6, R6 #> R7,
229
230%       A solution for this problem - used to test the constraints
231%       [D1,D2,D3,D4,D5,D6,D7] = [4,5,6,7,13,16,18],
232%       [R1,R2,R3,R4,R5,R6,R7] = [11,10,9,7,3,2,1],
233
234	cumulative(LO,LD,LR,13),
235%	cumulative_ef(LO,LD,LR,13),
236
237%	cannot_be_included(LD,LR),
238	cannot_be_included(LD,LR,[],Bools),
239	Vars = [O1,D1,R1,O2,D2,R2,O3,D3,R3,O4,D4,R4,O5,D5,R5,O6,D6,R6,O7,D7,R7],
240%	Vars = [D1,R1,D2,R2,D3,R3,D4,R4,D5,R5,D6,R6,D7,R7,O1,O2,O3,O4,O5,O6,O7],
241	findall(Vars,(label_deleteff(Bools),label_deleteff(Vars),writeln(sol(LD,LR))),Solutions),
242	once(member(Vars,Solutions)),
243	length(Solutions,No),
244	printf('Number of solutions: %w\n',[No]),
245        cputime(End),
246	Time is End - Start,
247	printf("Solutions found in %.2f sec(s)\n",[Time]).
248
249
250label_deleteff([V|Vs]):-
251	deleteff(Var,[V|Vs],Rest),
252	indomain(Var),
253	label_deleteff(Rest).
254label_deleteff([]).
255
256cannot_be_included([D|Ds],[R|Rs],Sofar,Bools):-
257	cannot_be_included_aux(D,Ds,R,Rs,Sofar,NewSofar),
258	cannot_be_included(Ds,Rs,NewSofar,Bools).
259cannot_be_included([],[],Bools,Bools).
260
261
262cannot_be_included_aux(D1,[D2|Ds],R1,[R2|Rs],Sofar,Bools):-
263	B::0..1,
264	rectangle_not_included(D1,R1,D2,R2,B),
265	New = [B|Sofar],
266	cannot_be_included_aux(D1,Ds,R1,Rs,New,Bools).
267cannot_be_included_aux(_,[],_,[],Bools,Bools).
268
269
270rectangle_not_included(D1,R1,D2,R2,B):-
271	(nonvar(B)->
272	    (B==0 ->
273		D1 #> R2, D2 #> R1
274	    ;
275	        R1 #> D2, D1 #< R2
276	    )
277	;
278	    dvar_range(D1,D1min,D1max),
279	    dvar_range(D2,D2min,D2max),
280	    dvar_range(R1,R1min,R1max),
281	    dvar_range(R2,R2min,R2max),
282	    (((D1min > R2max);(D2min > R1max)) ->
283		B ## 1, D1 #> R2, D2 #> R1
284	    ;
285	        (((R1min > D2max);(R2min > D1max)) ->
286		    B ## 0, R1 #> D2, R2 #> D1
287		;
288		    Var = v(D1,R1,D2,R2),
289		    suspend(rectangle_not_included(D1,R1,D2,R2,B),4,[Var->min,Var->max,B->inst])
290		)
291	    )
292	).
293
294/*
295
296
297cannot_be_included([D|Ds],[R|Rs]):-
298	cannot_be_included_aux(D,Ds,R,Rs),
299	cannot_be_included(Ds,Rs).
300cannot_be_included([],[]).
301
302cannot_be_included_aux(D1,[D2|Ds],R1,[R2|Rs]):-
303	rectangle_not_included(D1,R1,D2,R2),
304	cannot_be_included_aux(D1,Ds,R1,Rs).
305cannot_be_included_aux(_,[],_,[]).
306
307rectangle_not_included(D1,R1,D2,R2):-
308	% Assume D1 > D2 and R1 < R2
309	dvar_range(D1,D1min,D1max),
310	dvar_range(D2,D2min,D2max),
311	dvar_range(R1,R1min,R1max),
312	dvar_range(R2,R2min,R2max),
313	( R2max < D1min -> R1 #< D2
314        ; R1max < D2min -> R2 #<D2
315        ; D2max < R1min -> D1 #< R2
316        ; D1max < R2min -> D2 #< R1
317        ; suspend(rectangle_not_included(D1,R1,D2,R2),4,[D1,D2,R1,R2]->constrained)
318        ).
319
320rectangle_not_included(D1,R1,D2,R2):-
321	% Assume D1 > D2 and R1 < R2
322	((D1 #> R2, R1 #< D2) ; (R1 #> D2, D1 #< R2)).
323
324
325rectangle_not_included(D1,R1,D2,R2):-
326
327	setval(prop,false),
328	dvar_range(D1,D1min,D1max),
329	dvar_range(D2,D2min,D2max),
330	dvar_range(R1,R1min,R1max),
331	dvar_range(R2,R2min,R2max),
332	(D1max < D2min -> R1 #> R2, setval(prop,true) ; true),
333	(R1max < R2min -> D1 #> D2, setval(prop,true) ; true),
334	(D2max < D1min -> R2 #> R1, setval(prop,true) ; true),
335	(R2max < R1min -> D2 #> D1, setval(prop,true) ; true),
336	(getval(prop,true) ->
337	    true
338	;
339	    suspend(rectangle_not_included(D1,R1,D2,R2),4,[D1,D2,R1,R2]->constrained)
340	).
341
342rectangle_not_included(D1,W1,D2,W2):-
343	( (D1 #> D2 , W2 #> W1)    % case (i)
344        ; (D2 #> D1 , W1 #> W2)    % case (ii)
345        ; (D1 #> W2 , D2 #> W1)    % case (iii)
346        ; (W2 #> D1 , W1 #> D2) ).  % case (iv)
347
348
349*/
350% Vassilis
351test(LO):-
352    LO = [O1,O2,O3,O4],
353    LD = [2,2,2,2],
354    LR = [2,2,2,2],
355    LE = [E1,E2,E3,E4],
356    LO :: 0..4,
357    LE :: 0..4,
358    O1 + 2 #= E1,
359    O2 + 2 #= E2,
360    O3 + 2 #= E3,
361    O4 + 2 #= E4,
362    % symmetry constraints
363    cumulative(LO,LD,LR,4),
364    labeling(LO),writeln(LO).
365
366
367
368