% The CSIRO Software License, Version 1.0
% (based on the Apache Software License Version 1.1)
% 
% 
% Copyright (c) 2001 Commonwealth Scientific and Industrial
% Research Organisation (CSIRO).  All rights 
% reserved.
% 
% Redistribution and use in source and binary forms, with or without
% modification, are permitted provided that the following conditions
% are met:
% 
% 1. Redistributions of source code must retain the above copyright
%    notice, this list of conditions and the following disclaimer. 
% 
% 2. Redistributions in binary form must reproduce the above copyright
%    notice, this list of conditions and the following disclaimer in
%    the documentation and/or other materials provided with the
%    distribution.
% 
% 3. The end-user documentation included with the redistribution,
%    if any, must include the following acknowledgment:  
%       "This product includes software developed by 
%        CSIRO (http://www.cmis.csiro.au/)."
%    Alternately, this acknowledgment may appear in the software itself,
%    if and wherever such third-party acknowledgments normally appear.
% 
% 4. The name "CSIRO" must
%    not be used to endorse or promote products derived from this
%    software without prior written permission. For written 
%    permission, please contact address@hidden
% 
% 5. Products derived from this software may not be called "CSIRO",
%    nor may "CSIRO" appear in their name, without prior written
%    permission of CSIRO.
% 
% THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESSED OR IMPLIED
% WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
% OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
% DISCLAIMED.  IN NO EVENT SHALL CSIRO OR
% ITS CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
% SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
% LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
% USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
% ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
% OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
% OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
% SUCH DAMAGE.

:- include(lambda).

max_element(L, X) :-
	reduce(L, max, #=, X).

min_element(L, X) :-
	reduce(L, min, #=, X).

max_element(I, L, X) :-
	fd_element_var(I, L, X),
	max_element(L, X).

min_element(I, L, X) :-
	fd_element_var(I, L, X),
	min_element(L, X).

plus__([], [], []).
plus__([S|STL], [D|DTL], [F|FTL]) :-
	S + D #= F,
	plus__(STL, DTL, FTL).

intersect(S, D, B) :-
	plus__(S, D, F),
	max_element(_, S, LatestStart),
	min_element(_, F, EarliestFinish),
	LatestStart #< EarliestFinish #<=> B.

intersect(S1, D1, S2, D2, B) :-
	((S1 #=< S2 #/\ S2 #< S1 + D1) #\/
	 (S2 #=< S1 #/\ S1 #< S2 + D2)) #<=> B.

cumulative(S, D, R, L) :- quad_cumulative(S, D, R, L).

% Cumulative/4 constraint.
% For each activity find the set of activities it intersects with (including
% itself), assert that this resources consumed by this set is less than
% the limit.
% Generates a number of constraints which is quadratic in the number of
% activities.
quad_cumulative(S, D, R, L) :-
	quad_cumulative__(1, S, D, R, L).

quad_cumulative__(I, S, D, R, L) :-
	( nth(I, S, SI) ->
		nth(I, D, DI),
		map(intersect(SI, DI), S, D, B),
		inner_product(R, B, *, +, #=<, L),
		I_recur is I + 1,
		quad_cumulative__(I_recur, S, D, R, L)
	;
		true
	).





% Cumulative/4 constraint, enumerate all possible subsets and 
% assert that subsets that consume more resources than the limit
% do not have an intersection.
% Generates a number of constraints which is exponential in the
% number of activities.
exp_cumulative(S, D, R, L) :-
	exp_cumulative__([], S, [], D, [], R, L).

exp_cumulative__([], [], [], [], [], [], _) :- !.
exp_cumulative__([_], [], [_], [], [_], [], _) :- !.
exp_cumulative__(S, [], D, [], R, [], L) :- !,
	intersect(S, D, B),
	sum(R, #=, T),
	B #==> T #=< L.

exp_cumulative__(Sacc, [S|STL], Dacc, [D|DTL], Racc, [R|RTL], L) :-
	exp_cumulative__(Sacc, STL, Dacc, DTL, Racc, RTL, L),
	exp_cumulative__([S|Sacc], STL, [D|Dacc], DTL, [R|Racc], RTL, L).



reduce_expr([X|TL], Op, R) :-
	( TL = [] ->
		R = X
	;
		curry(Op, [X, RTL], R),
		reduce_expr(TL, Op, RTL)
	).

reduce_weak([X|TL], Op, R) :-
	( TL = [] ->
		R = X
	;
		curry(Op, [X, RTL_], R),
		RTL #= RTL_,
		reduce_weak(TL, Op, RTL)
	).

	


reduce(LHS_, Op, RelOp, RHS) :-
	catch((
		reduce_expr(LHS_, Op, LHS),
		curry(RelOp, [LHS, RHS], G),
		call(G)
	), resource_error(too_big_fd_constraint), (
		reduce_weak(LHS_, Op, LHS),
		curry(RelOp, [LHS, RHS], G),
		call(G)
	)).
		
		

sum(LHS, RelOp, RHS) :-
	reduce(LHS, +, RelOp, RHS).

inner_product(V1, V2, MultOp, PlusOp, RelOp, RHS) :-
	inner_product__(V1, V2, MultOp, VM),
	reduce(VM, PlusOp, RelOp, RHS).

inner_product__([], [], _, []).
inner_product__([X|XTL], [Y|YTL], MultOp, [M|MTL]) :-
	curry(MultOp, [X,Y], M),
	inner_product__(XTL, YTL, MultOp, MTL).


% Serialized constraint.
serialized(S, D) :-
	plus__(S, D, F),
	serialized__(S, F).

serialized(S, D, [resource(R)]) :-
	plus__(S, D, F),
	serialized__(S, F),
	make_resource__(S, F, R).

make_resource__([], [], []).
make_resource__([S|STL], [F|FTL], [[S,F]|RTL]) :-
	make_resource__(STL, FTL, RTL).

serialized__([], []).
serialized__([_], [_]) :- !.
serialized__([S1,S2|STL], [F1,F2|FTL]) :-
	F1 #=< S2 #\/ F2 #=< S1,
	serialized__([S1|STL], [F1|FTL]),
	serialized__([S2|STL], [F2|FTL]).


or__order(first, S1, [S2,_]) :- S1 #< S2.
or__order(last, S1, [S2,_]) :- S1 #> S2.

or__key_pair(est, [S,F], K-[S,F]) :- fd_min(S, K).
or__key_pair(lst, [S,F], K-[S,F]) :- fd_max(S, SM), K is -SM.
or__key_pair(ect, [S,F], K-[S,F]) :- fd_min(F, K).
or__key_pair(lct, [S,F], K-[S,F]) :- fd_max(F, FM), K is -FM.



% Order a sequence of activities. The parameters P1 and P2 use
% the same scheme as the SICStus parameters. P1 may be first or last.
% P2 may be est (earliest start time), lst (latest start time),
% ect (earliest completion time), or lct (latest completion time).
order_resource([P1,P2], R) :-
	order_resource__(R, [P1,P2]). 

order_resource__([], _).
order_resource__(R, [P1,P2]) :-
	map(or__key_pair(P2), R, PairList),
	keysort(PairList, SortedPairList),
	select(_-[S,_], SortedPairList, PairList_Rem),
	map(make_pair, _, R_Rem, PairList_Rem),
	map(or__order(P1,S), R_Rem),
	order_resource__(R_Rem, [P1,P2]).