% ----------------------------------------------------------------------
% BEGIN LICENSE BLOCK
% Version: CMPL 1.1
%
% The contents of this file are subject to the Cisco-style Mozilla Public
% License Version 1.1 (the "License"); you may not use this file except
% in compliance with the License.  You may obtain a copy of the License
% at www.eclipse-clp.org/license.
% 
% Software distributed under the License is distributed on an "AS IS"
% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied.  See
% the License for the specific language governing rights and limitations
% under the License. 
% 
% The Original Code is  The ECLiPSe Constraint Logic Programming System. 
% The Initial Developer of the Original Code is  Cisco Systems, Inc. 
% Portions created by the Initial Developer are
% Copyright (C) 1995-2006 Cisco Systems, Inc.  All Rights Reserved.
% 
% Contributor(s): ECRC GmbH
% Contributor(s): IC-Parc, Imperal College London
% 
% END LICENSE BLOCK
%
% System:	ECLiPSe Constraint Logic Programming System
% Version:	$Id: cp_min.pl,v 1.2 2011/04/01 07:12:07 jschimpf Exp $
% ----------------------------------------------------------------------

/*
/*
 * SEPIA PROLOG SOURCE MODULE
 */

/*
 * COST-PARALLEL MINIMIZATION
 *
 * IDENTIFICATION:      cp_min.pl 
 *
 * AUTHOR:		Steven Prestwich and Shyam Mudambi
 *
 * DESCRIPTION:     This library implements the cost-parallel
                    minimization predicates. There are currently
		    4 strategies implemented:
		i. min : the base strategy (an improved version
	                 of minimize/5).
	       ii. omin: cost-parallel version of min.
	      iii. pmin: min with pessimistic search (used only for
	                 sub-optimal solutions).
	       iv. opmin: cost-parallel version of pmin.

 */

:- module(cp_min).
:- use_module(library(fd)).
:- use_module(library(par_util)).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

:- TopPreds = (
    cp_minimize/4,
    cp_minimize/8,
    cp_par_member/3,
    cp_par_indomain/2),
    export(TopPreds).

:-  tool(cp_minimize/4, cp_minimize_body/5),
    tool(cp_minimize/8, cp_minimize_body/9).

:- setval(verbose,0). /* set this to 1 for verbose output */

/* minimum distance to maintain between cost-parallel searches */
/* Should be user tunable? */
delta(10).

/* CP-Flag specifies whether to use optimisitic searches */
/* CP-Flag = on -> omin else min */
cp_minimize_body(Goal,Cost,CP_Flag,CostMonitor,Module) :-
   (var(Cost) ; Cost \= [_|_]),
   !,
   cp_minimize_body(Goal, [Cost], CP_Flag, CostMonitor, Module).
cp_minimize_body(Goal,List,CP_Flag,CostMonitor,Module) :-
   (check_list_domain(List) ->
       max_list_domain(List,Max),
       min_list_domain(List,Min), 
       cp_minimize_body(Goal,List,Min,Max,0,CP_Flag, off, CostMonitor,Module)
   ;
	error(5, cp_minimize(Goal, List, CP_Flag, CostMonitor), Module)
    ).

/* Psm_Flag specifies whether to use pessimistic search when
searching for sub-optimal solutions */
cp_minimize_body(Goal,Cost,L,H,P,CP_Flag, Psm_Flag, CostMonitor,Module) :-
   (var(Cost); Cost \= [_|_]),
   !,
   cp_minimize_body(Goal,[Cost],L,H,P,CP_Flag, Psm_Flag, CostMonitor,Module).
cp_minimize_body(Goal,List,L,H,P,CP_Flag, Psm_Flag, CostMonitor,Module) :-
   (check_list_domain(List) ->
        write_debug("Cost domain is {"),
	write_debug(L),
	write_debug(".."),
	write_debug(H),
	writeln_debug("}"),
	HP is ((100 * H) // (100 - P)) + 1, % ensures first solution when P>0
	/* Utility predicates */
	get_flag(hostname,Host),
	get_flag(workers,Host:W),
	initialise_cost,
	initialise_soln,
	set_cost(HP),
	(CP_Flag = on ->
	    delta(Delta),
	    search_factors(W,L,H,Delta,Factors),
	    write_debug("Speculation factors = "),
	    writeln_debug(Factors),
	    FactorsArr =.. [f|Factors],
	    functor(FactorsArr, f, Numspec),
	    multiple_searches(FactorsArr-Numspec,Goal,List,P,L,H,CostMonitor,Psm_Flag,Module) 
	;
	    multiple_searches(f-0,Goal,List,P,L,H,CostMonitor,Psm_Flag,Module)),   
	(get_soln(Goal,List,Optimal) ->
	    write("Optimal cost "),
	    write(Optimal),
	    (P==0 ->
		nl
	    ;  write(" to "),
	    write(P),
	    writeln("%"))
	;  
	    writeln("   warning: cp_minimization found no solutions"),
	    fail)
    ;
	!,
	error(5, cp_minimize(Goal,List,L,H,P,CP_Flag, Psm_Flag, CostMonitor),
	      Module)).


search_factors(W,L,H,Delta,Factors) :-
   ((H - L)/ Delta - W =< 0 ->
       Lnfactor is H - L,
       Delta1 is 1
   ;
       Lnfactor is (H - L)/ Delta - W,
       Delta1 is Delta),
   Alpha is max(0, ln(Lnfactor) / W),
   Beta is max(0,ln(Delta1)),
   search_factors(1,W,Alpha,Beta,Delta1,Factors).

search_factors(I,W,Alpha,Beta,Delta,[Factor|Factors]) :-
   I < W,
   !,
   I1 is I + 1,
   search_factors(I1,W,Alpha,Beta,Delta,Factors),
   Factor is fix(Delta * (I - 1) + exp(Alpha * I + Beta) + 0.5).
search_factors(_,_,_,_,_,[]).

:- parallel multiple_searches/9.

multiple_searches(Factors-Numspec,Goal,Cost,P,L,H,CostMonitor,_Psm_Flag,Module) :-
   fork(Numspec, Search),
   arg(Search,Factors,F),
   exhaustive_search(spec,Search,Goal,Cost,P,L,H,F,CostMonitor,Module).
multiple_searches(_,Goal,Cost,P,L,H,CostMonitor,_Psm_Flag,Module) :-
   not exhaustive_search(cons,dummy,Goal,Cost,P,L,H,P,CostMonitor,Module),
   !.
multiple_searches(_,Goal,Cost,P,L,H,CostMonitor, on,Module) :-
   P > 0,
   exhaustive_search(zero,dummy,Goal,Cost,P,L,H,0,CostMonitor,Module).

exhaustive_search(SearchType,Index,Goal,Cost,P,L,_H,Factor,CostMonitor,
	Module) :-
	P100 is 100 - P,
	(SearchType == zero ->
	    CostMonitor = zero(Cost,P100),
	    writeln_debug("   Zero")
	;
	    SearchType == spec ->
	       write_debug("   Spec "),
	       writeln_debug(Factor),
	       (P == 0 ->
		   CostMonitor = spec(Cost,Factor,Index)
	       ;  
	           CostMonitor = spec(Cost,Factor,Index,P100))
	    ;
	       P == 0 ->
	           writeln_debug("   Cons"),
		   CostMonitor = cons(Cost)
	       ;  
	           writeln_debug("   Cons"),
		   CostMonitor = cons(Cost,P100)),
        anti_thrashing(CostMonitor),
        set_list_gt(Cost, L), 
	call(Goal)@Module,
	anti_thrashing(CostMonitor),
	max_list_domain(Cost, Max),
	NewMax is Max - 1,
	set_cost(NewMax),
	set_soln(Goal,Cost,Max),
	(getval(verbose,1) ->
	    write_debug("Current cost "),
	    writeln_debug(Max)
	;
	    true),
	fail.
exhaustive_search(_,_,_,_,_,_,_,Factor,_,_) :-
	write_debug("   Halt "),
	writeln_debug(Factor),
	fail.

% COST-PARALLELISM PROGRAMMING TOOLS

cp_par_indomain(X,I) :-
   dom(X,D),
   cp_par_member(X,D,I).

cp_par_member(X,L,I) :-
   functor(I,Func,_),
   (Func == cons ->
      anti_thrashing(I),
      cp_par_member1(X,L,I)
   ;Func == spec ->
     cp_member(X,L,I)          % (1) without hybridisation
%      arg(3,I,Index),           % (2) with
%      spec_member(Index,X,L,I)  %     hybridisation
   ;  cp_member(X,L,I)).

spec_member(N,X,L,I) :-
   N2 is N // 2,
   Parities is N2 + 2,
   Direction is N - N2 * 2,
   (Direction == 0 ->
      countdown(Parities,1,Parity,I)
  ;   countup(1,Parities,Parity,I)),
   parity_mem(L,Parities,Parity,X,I).

parity_mem(L,Parities,Parity,X,I) :-
   Parity1 is Parity - 1,
   discard(Parity1,L,L1),
   (L1=[X|_]
   ;N is Parities - Parity1,
    discard(N,L1,L2),
    anti_thrashing(I),
    parity_mem(L2,Parities,Parity,X,I)).

discard(0,L,L) :- !.
discard(N,[_|L],R) :-
   N1 is N - 1,
   discard(N1,L,R).

countup(A,_,A,_).
countup(A,B,C,I) :-
   A < B,
   anti_thrashing(I),
   D is A + 1,
   countup(D,B,C,I).

countdown(A,_,A,_).
countdown(A,B,C,I) :-
   A > B,
   anti_thrashing(I),
   D is A - 1,
   countdown(D,B,C,I).

cp_member(X,[X|_],_I).
cp_member(X,[_,H|T],I) :-
   anti_thrashing(I),
   cp_member(X,[H|T],I).

:- parallel cp_par_member1/3.

cp_par_member1(X,[X|_],_I).
cp_par_member1(X,[_,H|T],I) :-
   anti_thrashing(I),
   cp_par_member1(X,[H|T],I).

anti_thrashing(cons(Cost)) :- !,
   get_cost(CC),
   set_list_lteq(Cost,CC).
anti_thrashing(cons(Cost,P100)) :- !,
   get_cost(CC),
   CCF is (CC * P100 + 50) // 100,
   set_list_lteq(Cost,CCF).
anti_thrashing(spec(Cost,Factor,_)) :- !,
   get_cost(CC),
   CCF is CC - Factor,
   set_list_lteq(Cost,CCF).
anti_thrashing(spec(Cost,Factor,_,P100)) :- !,
   get_cost(CC),
   CCF is (CC * P100 + 50) // 100 - Factor,
   set_list_lteq(Cost,CCF).
anti_thrashing(zero(Cost,P100)) :-
   get_cost(CC),
   CCF is (CC * P100 + 50) // 100,
   CCF < CC,
   set_list_lteq(Cost,CC).


/* Utility predicates */
initialise_cost :-
   set_cost(dummy).

get_cost(C) :-
     getval(limiting_cost, C).

set_cost(C) :-
     setval(limiting_cost, C).

initialise_soln :-
   setval(sol,dummy).

get_soln(Goal,Cost,Optimal) :-
   getval(sol,lc(Goal,Cost,Optimal)).

set_soln(Goal,Cost,Optimal) :-
   setval(sol,lc(Goal,Cost,Optimal)).

conv_to_dvars([],[]).
conv_to_dvars([H|L],[H|R]) :-
	is_integer_domain(H),
	!,
	conv_to_dvars(L,R).
conv_to_dvars([H|L],[V|R]) :-
	V #= H,
	conv_to_dvars(L,R).

check_list_domain([]).
check_list_domain([H|R]) :- 
	is_integer_domain(H),
	check_list_domain(R).

max_list_domain([H|Rest],Max) :-
	maxdomain(H,CurMax),
	max_list_domain(Rest,CurMax,Max).

max_list_domain([],Max,Max).
max_list_domain([H|Rest],CurMax,Max) :-
	maxdomain(H,HMax),
	(HMax > CurMax ->
	    max_list_domain(Rest,HMax, Max)
	;
	    max_list_domain(Rest,CurMax,Max)).

min_list_domain([H|Rest],Min) :-
	mindomain(H,CurMin),
	min_list_domain(Rest,CurMin,Min).

min_list_domain([],Min,Min).
min_list_domain([H|Rest],CurMin,Min) :-
	mindomain(H,HMin),
	(HMin < CurMin ->
	    min_list_domain(Rest,HMin, Min)
	;
	    min_list_domain(Rest,CurMin,Min)).

set_list_gt([],_).
set_list_gt([C|Cs],Val) :-
	C #> Val,
	set_list_gt(Cs,Val).

set_list_lteq([],_).
set_list_lteq([C|Cs], Val) :-
	C #<= Val,
	set_list_lteq(Cs,Val).


writeln_debug(String) :-
	(getval(verbose,1) ->
	    writeln(String)
	;
	    true).

write_debug(String) :-
	(getval(verbose,1) ->
	    write(String)
	;
	    true).

nl_debug :-
	(getval(verbose,1) ->
	    nl
	;
	    true).
