1% ----------------------------------------------------------------------
2% BEGIN LICENSE BLOCK
3% Version: CMPL 1.1
4%
5% The contents of this file are subject to the Cisco-style Mozilla Public
6% License Version 1.1 (the "License"); you may not use this file except
7% in compliance with the License.  You may obtain a copy of the License
8% at www.eclipse-clp.org/license.
9%
10% Software distributed under the License is distributed on an "AS IS"
11% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied.  See
12% the License for the specific language governing rights and limitations
13% under the License.
14%
15% The Original Code is  The ECLiPSe Constraint Logic Programming System.
16% The Initial Developer of the Original Code is  Cisco Systems, Inc.
17% Portions created by the Initial Developer are
18% Copyright (C) 1995-2006 Cisco Systems, Inc.  All Rights Reserved.
19%
20% Contributor(s): ECRC GmbH
21% Contributor(s): IC-Parc, Imperal College London
22%
23% END LICENSE BLOCK
24%
25% System:	ECLiPSe Constraint Logic Programming System
26% Version:	$Id: cp_min.pl,v 1.2 2011/04/01 07:12:07 jschimpf Exp $
27% ----------------------------------------------------------------------
28
29/*
30/*
31 * SEPIA PROLOG SOURCE MODULE
32 */
33
34/*
35 * COST-PARALLEL MINIMIZATION
36 *
37 * IDENTIFICATION:      cp_min.pl
38 *
39 * AUTHOR:		Steven Prestwich and Shyam Mudambi
40 *
41 * DESCRIPTION:     This library implements the cost-parallel
42                    minimization predicates. There are currently
43		    4 strategies implemented:
44		i. min : the base strategy (an improved version
45	                 of minimize/5).
46	       ii. omin: cost-parallel version of min.
47	      iii. pmin: min with pessimistic search (used only for
48	                 sub-optimal solutions).
49	       iv. opmin: cost-parallel version of pmin.
50
51 */
52
53:- module(cp_min).
54:- use_module(library(fd)).
55:- use_module(library(par_util)).
56
57%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
58
59:- TopPreds = (
60    cp_minimize/4,
61    cp_minimize/8,
62    cp_par_member/3,
63    cp_par_indomain/2),
64    export(TopPreds).
65
66:-  tool(cp_minimize/4, cp_minimize_body/5),
67    tool(cp_minimize/8, cp_minimize_body/9).
68
69:- setval(verbose,0). /* set this to 1 for verbose output */
70
71/* minimum distance to maintain between cost-parallel searches */
72/* Should be user tunable? */
73delta(10).
74
75/* CP-Flag specifies whether to use optimisitic searches */
76/* CP-Flag = on -> omin else min */
77cp_minimize_body(Goal,Cost,CP_Flag,CostMonitor,Module) :-
78   (var(Cost) ; Cost \= [_|_]),
79   !,
80   cp_minimize_body(Goal, [Cost], CP_Flag, CostMonitor, Module).
81cp_minimize_body(Goal,List,CP_Flag,CostMonitor,Module) :-
82   (check_list_domain(List) ->
83       max_list_domain(List,Max),
84       min_list_domain(List,Min),
85       cp_minimize_body(Goal,List,Min,Max,0,CP_Flag, off, CostMonitor,Module)
86   ;
87	error(5, cp_minimize(Goal, List, CP_Flag, CostMonitor), Module)
88    ).
89
90/* Psm_Flag specifies whether to use pessimistic search when
91searching for sub-optimal solutions */
92cp_minimize_body(Goal,Cost,L,H,P,CP_Flag, Psm_Flag, CostMonitor,Module) :-
93   (var(Cost); Cost \= [_|_]),
94   !,
95   cp_minimize_body(Goal,[Cost],L,H,P,CP_Flag, Psm_Flag, CostMonitor,Module).
96cp_minimize_body(Goal,List,L,H,P,CP_Flag, Psm_Flag, CostMonitor,Module) :-
97   (check_list_domain(List) ->
98        write_debug("Cost domain is {"),
99	write_debug(L),
100	write_debug(".."),
101	write_debug(H),
102	writeln_debug("}"),
103	HP is ((100 * H) // (100 - P)) + 1, % ensures first solution when P>0
104	/* Utility predicates */
105	get_flag(hostname,Host),
106	get_flag(workers,Host:W),
107	initialise_cost,
108	initialise_soln,
109	set_cost(HP),
110	(CP_Flag = on ->
111	    delta(Delta),
112	    search_factors(W,L,H,Delta,Factors),
113	    write_debug("Speculation factors = "),
114	    writeln_debug(Factors),
115	    FactorsArr =.. [f|Factors],
116	    functor(FactorsArr, f, Numspec),
117	    multiple_searches(FactorsArr-Numspec,Goal,List,P,L,H,CostMonitor,Psm_Flag,Module)
118	;
119	    multiple_searches(f-0,Goal,List,P,L,H,CostMonitor,Psm_Flag,Module)),
120	(get_soln(Goal,List,Optimal) ->
121	    write("Optimal cost "),
122	    write(Optimal),
123	    (P==0 ->
124		nl
125	    ;  write(" to "),
126	    write(P),
127	    writeln("%"))
128	;
129	    writeln("   warning: cp_minimization found no solutions"),
130	    fail)
131    ;
132	!,
133	error(5, cp_minimize(Goal,List,L,H,P,CP_Flag, Psm_Flag, CostMonitor),
134	      Module)).
135
136
137search_factors(W,L,H,Delta,Factors) :-
138   ((H - L)/ Delta - W =< 0 ->
139       Lnfactor is H - L,
140       Delta1 is 1
141   ;
142       Lnfactor is (H - L)/ Delta - W,
143       Delta1 is Delta),
144   Alpha is max(0, ln(Lnfactor) / W),
145   Beta is max(0,ln(Delta1)),
146   search_factors(1,W,Alpha,Beta,Delta1,Factors).
147
148search_factors(I,W,Alpha,Beta,Delta,[Factor|Factors]) :-
149   I < W,
150   !,
151   I1 is I + 1,
152   search_factors(I1,W,Alpha,Beta,Delta,Factors),
153   Factor is fix(Delta * (I - 1) + exp(Alpha * I + Beta) + 0.5).
154search_factors(_,_,_,_,_,[]).
155
156:- parallel multiple_searches/9.
157
158multiple_searches(Factors-Numspec,Goal,Cost,P,L,H,CostMonitor,_Psm_Flag,Module) :-
159   fork(Numspec, Search),
160   arg(Search,Factors,F),
161   exhaustive_search(spec,Search,Goal,Cost,P,L,H,F,CostMonitor,Module).
162multiple_searches(_,Goal,Cost,P,L,H,CostMonitor,_Psm_Flag,Module) :-
163   not exhaustive_search(cons,dummy,Goal,Cost,P,L,H,P,CostMonitor,Module),
164   !.
165multiple_searches(_,Goal,Cost,P,L,H,CostMonitor, on,Module) :-
166   P > 0,
167   exhaustive_search(zero,dummy,Goal,Cost,P,L,H,0,CostMonitor,Module).
168
169exhaustive_search(SearchType,Index,Goal,Cost,P,L,_H,Factor,CostMonitor,
170	Module) :-
171	P100 is 100 - P,
172	(SearchType == zero ->
173	    CostMonitor = zero(Cost,P100),
174	    writeln_debug("   Zero")
175	;
176	    SearchType == spec ->
177	       write_debug("   Spec "),
178	       writeln_debug(Factor),
179	       (P == 0 ->
180		   CostMonitor = spec(Cost,Factor,Index)
181	       ;
182	           CostMonitor = spec(Cost,Factor,Index,P100))
183	    ;
184	       P == 0 ->
185	           writeln_debug("   Cons"),
186		   CostMonitor = cons(Cost)
187	       ;
188	           writeln_debug("   Cons"),
189		   CostMonitor = cons(Cost,P100)),
190        anti_thrashing(CostMonitor),
191        set_list_gt(Cost, L),
192	call(Goal)@Module,
193	anti_thrashing(CostMonitor),
194	max_list_domain(Cost, Max),
195	NewMax is Max - 1,
196	set_cost(NewMax),
197	set_soln(Goal,Cost,Max),
198	(getval(verbose,1) ->
199	    write_debug("Current cost "),
200	    writeln_debug(Max)
201	;
202	    true),
203	fail.
204exhaustive_search(_,_,_,_,_,_,_,Factor,_,_) :-
205	write_debug("   Halt "),
206	writeln_debug(Factor),
207	fail.
208
209% COST-PARALLELISM PROGRAMMING TOOLS
210
211cp_par_indomain(X,I) :-
212   dom(X,D),
213   cp_par_member(X,D,I).
214
215cp_par_member(X,L,I) :-
216   functor(I,Func,_),
217   (Func == cons ->
218      anti_thrashing(I),
219      cp_par_member1(X,L,I)
220   ;Func == spec ->
221     cp_member(X,L,I)          % (1) without hybridisation
222%      arg(3,I,Index),           % (2) with
223%      spec_member(Index,X,L,I)  %     hybridisation
224   ;  cp_member(X,L,I)).
225
226spec_member(N,X,L,I) :-
227   N2 is N // 2,
228   Parities is N2 + 2,
229   Direction is N - N2 * 2,
230   (Direction == 0 ->
231      countdown(Parities,1,Parity,I)
232  ;   countup(1,Parities,Parity,I)),
233   parity_mem(L,Parities,Parity,X,I).
234
235parity_mem(L,Parities,Parity,X,I) :-
236   Parity1 is Parity - 1,
237   discard(Parity1,L,L1),
238   (L1=[X|_]
239   ;N is Parities - Parity1,
240    discard(N,L1,L2),
241    anti_thrashing(I),
242    parity_mem(L2,Parities,Parity,X,I)).
243
244discard(0,L,L) :- !.
245discard(N,[_|L],R) :-
246   N1 is N - 1,
247   discard(N1,L,R).
248
249countup(A,_,A,_).
250countup(A,B,C,I) :-
251   A < B,
252   anti_thrashing(I),
253   D is A + 1,
254   countup(D,B,C,I).
255
256countdown(A,_,A,_).
257countdown(A,B,C,I) :-
258   A > B,
259   anti_thrashing(I),
260   D is A - 1,
261   countdown(D,B,C,I).
262
263cp_member(X,[X|_],_I).
264cp_member(X,[_,H|T],I) :-
265   anti_thrashing(I),
266   cp_member(X,[H|T],I).
267
268:- parallel cp_par_member1/3.
269
270cp_par_member1(X,[X|_],_I).
271cp_par_member1(X,[_,H|T],I) :-
272   anti_thrashing(I),
273   cp_par_member1(X,[H|T],I).
274
275anti_thrashing(cons(Cost)) :- !,
276   get_cost(CC),
277   set_list_lteq(Cost,CC).
278anti_thrashing(cons(Cost,P100)) :- !,
279   get_cost(CC),
280   CCF is (CC * P100 + 50) // 100,
281   set_list_lteq(Cost,CCF).
282anti_thrashing(spec(Cost,Factor,_)) :- !,
283   get_cost(CC),
284   CCF is CC - Factor,
285   set_list_lteq(Cost,CCF).
286anti_thrashing(spec(Cost,Factor,_,P100)) :- !,
287   get_cost(CC),
288   CCF is (CC * P100 + 50) // 100 - Factor,
289   set_list_lteq(Cost,CCF).
290anti_thrashing(zero(Cost,P100)) :-
291   get_cost(CC),
292   CCF is (CC * P100 + 50) // 100,
293   CCF < CC,
294   set_list_lteq(Cost,CC).
295
296
297/* Utility predicates */
298initialise_cost :-
299   set_cost(dummy).
300
301get_cost(C) :-
302     getval(limiting_cost, C).
303
304set_cost(C) :-
305     setval(limiting_cost, C).
306
307initialise_soln :-
308   setval(sol,dummy).
309
310get_soln(Goal,Cost,Optimal) :-
311   getval(sol,lc(Goal,Cost,Optimal)).
312
313set_soln(Goal,Cost,Optimal) :-
314   setval(sol,lc(Goal,Cost,Optimal)).
315
316conv_to_dvars([],[]).
317conv_to_dvars([H|L],[H|R]) :-
318	is_integer_domain(H),
319	!,
320	conv_to_dvars(L,R).
321conv_to_dvars([H|L],[V|R]) :-
322	V #= H,
323	conv_to_dvars(L,R).
324
325check_list_domain([]).
326check_list_domain([H|R]) :-
327	is_integer_domain(H),
328	check_list_domain(R).
329
330max_list_domain([H|Rest],Max) :-
331	maxdomain(H,CurMax),
332	max_list_domain(Rest,CurMax,Max).
333
334max_list_domain([],Max,Max).
335max_list_domain([H|Rest],CurMax,Max) :-
336	maxdomain(H,HMax),
337	(HMax > CurMax ->
338	    max_list_domain(Rest,HMax, Max)
339	;
340	    max_list_domain(Rest,CurMax,Max)).
341
342min_list_domain([H|Rest],Min) :-
343	mindomain(H,CurMin),
344	min_list_domain(Rest,CurMin,Min).
345
346min_list_domain([],Min,Min).
347min_list_domain([H|Rest],CurMin,Min) :-
348	mindomain(H,HMin),
349	(HMin < CurMin ->
350	    min_list_domain(Rest,HMin, Min)
351	;
352	    min_list_domain(Rest,CurMin,Min)).
353
354set_list_gt([],_).
355set_list_gt([C|Cs],Val) :-
356	C #> Val,
357	set_list_gt(Cs,Val).
358
359set_list_lteq([],_).
360set_list_lteq([C|Cs], Val) :-
361	C #<= Val,
362	set_list_lteq(Cs,Val).
363
364
365writeln_debug(String) :-
366	(getval(verbose,1) ->
367	    writeln(String)
368	;
369	    true).
370
371write_debug(String) :-
372	(getval(verbose,1) ->
373	    write(String)
374	;
375	    true).
376
377nl_debug :-
378	(getval(verbose,1) ->
379	    nl
380	;
381	    true).
382