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