%
%  CPM Example
%
activity(ID, Duration, task(ID, Start, Finish)) :-
	{Finish == Start + Duration}.
	
order(task(_,_,Finish), task(_,Start,_)) :-
	{Finish =< Start}.
	
project(StartT, FinishT, Schedule) :-
	Start = task(start,StartT,StartT), Finish = task(finish,FinishT,FinishT),
	Schedule = [A,B,C,D,E,F,G],
	activity(a, 10, A), order(Start,A),
	activity(b, 20, B), order(Start,B),
	activity(c, 30, C), order(Start,C),
	activity(d, 18, D), order(A,D), order(B,D),
	activity(e,  8, E), order(B,E), order(C,E),
	activity(f,  3, F), order(D,F),
	activity(g,  4, G), order(E,G), order(F,G), order(G,Finish).

print_with_intervals(List) :-
	foreach(member(Item,List), (print_interval(Item),nl)).
	
%
% Job Shop Scheduling
%

tasks(Mod, Tasks, Bs, MaxWeight) :-
	findall(Mod:ID,Mod:task(ID,_,_),TIDs),  % list of task ID's
	maplist(def_task,TIDs,Tasks),           % define tasks	
	serialize(Tasks,[],MBs),                % apply constraints, collect (Machine,Boolean) pairs
	findall((M,T),Mod:task(_,M,T),Ms),      % calculate total load on each machine
	collect_times(Ms,[],MTs),
	sort(1,@>=,MTs,Weights),                % sorted by decreasing load
	ordered_booleans(Weights,MBs,L/L,Bs),   % order booleans by machine load
	Weights = [(MaxWeight,_)|_].            % return max load on any machine           

def_task(Mod:ID,task(Mod:ID,Start,Finish)) :-   % define a task with a Start and Finish
	Mod:task(ID,_Res,Dur),
	[Start,Finish]::integer(0,_),
	{Finish == Start+Dur}.
	
serialize([], Bs, Bs).
serialize([T|Ts], Bs, AllBs) :-
	serialize_(Ts, T, Bs, E),                   % apply constraints between T and rest of tasks Ts
	serialize(Ts, E, AllBs).
	
serialize_([], _, Bs, Bs).
serialize_([T|Ts], T0, Bs, AllBs) :-
	sequence(T0,T), !,
	serialize_(Ts, T0, Bs, AllBs).
serialize_([T|Ts], T0, Bs, AllBs) :-
	disjunct(T0,T,B), !,
	serialize_(Ts, T0, [B|Bs], AllBs).
serialize_([_|Ts], T0, Bs, AllBs) :-
	serialize_(Ts, T0, Bs, AllBs).
	
sequence(task(Mod:P,_SP,FP),task(Mod:Q,SQ,_FQ)) :-  % task ordering constraint
	task_ordered(Mod,P,Q),  % P precedes Q
	(Mod:task_order(P,Q) -> {FP =< SQ} ;  true).    % apply constraint if immediate predecessor
sequence(task(Mod:P,SP,_FP),task(Mod:Q,_SQ,FQ)) :-
	task_ordered(Mod,Q,P),  % P succeeds Q
	(Mod:task_order(Q,P) -> {FQ =< SP} ;  true).    % apply constraint if immediate successor   

task_ordered(Mod,P,Q) :- Mod:task_order(P,Q), !.
task_ordered(Mod,P,Q) :- 
	Mod:task_order(P,T),
	task_ordered(Mod,T,Q).

disjunct(task(Mod:T1, S1, F1), task(Mod:T2, S2, F2), (M,B)) :-  % resource competition constraint 
	Mod:task(T1,M,_), Mod:task(T2,M,_),             % T1 and T2 require the same resource
	B::boolean,
	{B == (F1=<S2), ~B == (F2=<S1)}.
disjunct(task(Mod:_, _, _), task(Mod:_, _, _), _) :-  !, fail.

ordered_booleans([],[],Bs/[],Bs).                   % using difference lists
ordered_booleans([(_,M)|Weights],MBs,Bs,OBs) :-
	collect_booleans(MBs,M,Bs,NxtMBs,NxtBs),        % collect bools for machine M
	ordered_booleans(Weights,NxtMBs,NxtBs,OBs).     % append remaining for rest of bools
	
collect_booleans([],_,OBs,[],OBs).
collect_booleans([(M,B)|MBs],M,Bs/[B|Tail],NxtMBs,OBs) :- !,
	collect_booleans(MBs,M,Bs/Tail,NxtMBs,OBs).
collect_booleans([MB|MBs],M,Bs,[MB|NxtMBs],OBs) :- 
	collect_booleans(MBs,M,Bs,NxtMBs,OBs).

collect_times([],TMs,TMs).
collect_times([(M,T)|MTs],TMsIn,TMsOut) :-
	(selectchk((AccIn,M),TMsIn,TMs) 
	 -> Acc is T+AccIn
	 ;  Acc = T, TMs = TMsIn
	),
	collect_times(MTs,[(Acc,M)|TMs],TMsOut).
	
schedule(Finish,Deadline,Tasks) :-
	schedule(user,Finish,Deadline,Tasks).
schedule(Mod,Finish,Deadline,Tasks) :-
	tasks(Mod,Tasks,Bs,_),
	memberchk(task(Mod:start,0,_),Tasks),        % set start time to 0 
	memberchk(task(Mod:finish,_,Finish),Tasks),  % set finish time =< Deadline 
	{Finish=<Deadline},
	enumerate(Bs),        % enumerate booleans to get a solution
	lower_bound(Finish).  % set to lower_bound 

opt_schedule(Finish,Deadline,Tasks) :-
	opt_schedule(user,Finish,Deadline,Tasks).
	
opt_schedule(Mod,Finish,Deadline,Tasks) :-
	tasks(Mod,Tasks,Bs,Min),
	memberchk(task(Mod:start,0,_),Tasks),   % set start time to 0 
	memberchk(task(Mod:finish,_,Finish),Tasks),  % set finish time =< Deadline 
	{Min =< Finish,Finish =< Deadline},
	min_ratchet_B((enumerate(Bs),
	lower_bound(Finish)),Finish).

critical_path(Tasks,ID,[ID|Path]) :-
	select(task(ID,_,F),Tasks,NxtTasks),
	member(task(NxtID,NxtS,_),NxtTasks), integer(NxtS),  % NxtS not an interval
	NxtS=F, !,
	critical_path(NxtTasks,NxtID,Path).
critical_path(_,ID,[ID]).	

%
% Find the lowest value of Objective generated by Goal subject to Constraint
%
min_ratchet_B(Goal,Objective) :-
	min_ratchet_B(Goal,Objective,true).         % no initial constraint

min_ratchet_B(Goal,Objective,Constraint) :-
	once((Constraint,Goal)),
	range(Objective,[_,B]),                
	nb_setval('$min_ratchet', (B,Goal)),        % save upper(Objective) with solution
	fail.                                       % and undo
min_ratchet_B(Goal,Objective,Constraint) :-
	catch(nb_getval('$min_ratchet', (Val,BGoal)),_,fail), % !,	
    domain(Objective, Dom), Dom =.. [Type,L,B], % range(Objective,[L,B]),
	(var(Val)                                   % if no new solution
	 ->	(Constraint = {Objective =< Last}  -> true ; Last = L),  % relax last constraint
	    nxt_target(Type,Last,B,NxtVal)
	  ;	{Objective =< Val},                     % else constrain Objective to better
	  	nb_setval('$min_ratchet', (_,BGoal)),   % mark as old
	    nxt_target(Type,L,Val,NxtVal)
	),
	!,
	min_ratchet_B(Goal,Objective,{Objective =< NxtVal}).  % continue with new constraint
min_ratchet_B(Goal,_Objective,_Constraint) :-   % final solution?
	catch(nb_getval('$min_ratchet', (_,BGoal)),_,fail),  % fail if no solution
	nb_delete('$min_ratchet'),	                % trash global var
	Goal = BGoal.                               % unify Goal with final result

nxt_target(integer,Lo,Hi,Target) :-
	Target is div(Lo+Hi+1,2),  % round to +inf
	Target < Hi.
nxt_target(real,Lo,Hi,Target) :-
	Target is (Lo+Hi)/2.0,
	current_prolog_flag(clpBNR_default_precision,P), 
	(Hi - Target)/Hi > 10.0**(-P).