/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Rotating workforce scheduling. ============================== Written by Markus Triska (triska@metalevel.at) Dec. 2009-2024 Tested with GNU Prolog. Sample invocation: $ gplc wf_gnu_prolog.pl $ ./wf_gnu_prolog GNU Prolog 1.4.5 (64 bits) Compiled Mar 24 2020, 20:46:07 with gcc By Daniel Diaz Copyright (C) 1999-2020 Daniel Diaz | ?- t(1). D D D D D D D - - D D A A N N N - - D D D D D A A - - A A A A A N N - - - N N N N - - - - A A A N N N - - A A A A A N N - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ t(N) :- t(N, [ff]). t(N, _Options) :- num_instance(N, I), instance_schedule(I, S), append(S, Vs), fd_labelingff(Vs), print_schedule(I, S). print_schedule(WF, Schedule) :- arg(4, WF, ShiftsMinMax0), maplist(write_row(ShiftsMinMax0), Schedule). write_row(ShiftsMinMax0, Row) :- write_row_(Row, ShiftsMinMax0). write_row_([N|Ns], ShiftsMinMax) :- ( N =:= 0 -> write(-) ; nth1(N, ShiftsMinMax, [N1|_]), write(N1) ), ( Ns == [] -> nl ; write(' '), write_row_(Ns, ShiftsMinMax) ). instance_schedule(WF, Schedule) :- WF = wf(L,NEmployees,TemporalMatrix,ShiftsMinMax0, OffMin-OffMax,WorkMin-WorkMax,Forbidden2,Forbidden3), length(Schedule, NEmployees), maplist(length_(L), Schedule), transpose(TemporalMatrix, TemporalCols), transpose(Schedule, ScheduleCols), maplist(col_cardinality(NEmployees), ScheduleCols, TemporalCols), shifts_minmax(ShiftsMinMax0, 1, ShiftsMinMax), maplist(arg(3), ShiftsMinMax, Maxes), maplist(l_geq_max(L), [OffMax,WorkMax|Maxes]), phrase(arcs([n_min_max(0,OffMin,OffMax)|ShiftsMinMax], []), Arcs), arcs_nodes(Arcs, Nodes), append(Schedule, Vs0), Schedule = [FirstRow|_], append(Vs0, FirstRow, Vs), maplist(shift_off, Vs, Offs), phrase(arcs([n_min_max(1,OffMin,OffMax),n_min_max(0,WorkMin,WorkMax)], []), WorkArcs), arcs_nodes(WorkArcs, WorkNodes), automaton(Offs, [source(start)|WorkNodes], WorkArcs), automaton(Vs, [source(start)|Nodes], Arcs), maplist(forbidden_2(Vs, ShiftsMinMax0), Forbidden2), maplist(forbidden_3(Vs, ShiftsMinMax0), Forbidden3), fd_labelingff(Offs). forbidden_3(Vs, ShiftsMinMax0, ABC) :- Vs = [V1,V2|Rest], maplist(shift_to_num(ShiftsMinMax0), ABC, [A,B,C]), forbidden_3_(Rest, V1, V2, A, B, C). forbidden_2(Vs, ShiftsMinMax0, AB) :- Vs = [First|Rest], maplist(shift_to_num(ShiftsMinMax0), AB, [A,B]), forbidden_2_(Rest, First, A, B). shift_to_num(ShiftsMinMax0, Shift, N) :- ( Shift == ('-') -> N = 0 ; once(nth1(N, ShiftsMinMax0, [Shift|_])) ). forbidden_2_([], _, _, _). forbidden_2_([V|Vs], Prev, A, B) :- Prev #= A #==> V #\= B, forbidden_2_(Vs, V, A, B). forbidden_3_([], _, _, _, _, _). forbidden_3_([V|Vs], Prev0, Prev1, A, B, C) :- Prev0 #= A #/\ Prev1 #= B #==> V #\= C, forbidden_3_(Vs, Prev1, V, A, B, C). arcs_nodes(Arcs, Nodes) :- phrase(arcs_nodes(Arcs), Nodes0), sort(Nodes0, Nodes1), delete(Nodes1, s(fail), Nodes2), maplist(sink, Nodes2, Nodes). shift_off(S, O) :- S #= 0 #<=> O. l_geq_max(L, Max) :- ( L >= Max -> true ; throw(simple_cyclicity_handling_not_working) ). sink(S, sink(S)). arcs_nodes([]) --> []. arcs_nodes([arc(N0,_,N1)|As]) --> [N0,N1], arcs_nodes(As). arcs([], _) --> []. arcs([NMM|Ns], Left) --> [arc(start, N, s(N,1))], { NMM = n_min_max(N,Min,Max), Max1 #= Max + 1 }, arcs_same(N, 1, Max), arcs_others(Ns, N, Min, Max1), arcs_others(Left, N, Min, Max1), arcs(Ns, [NMM|Left]). arcs_others([], _, _, _) --> []. arcs_others([n_min_max(N0,_,_)|Ns], N, Min, Max) --> arcs_others_(N, N0, Min, Max), arcs_others(Ns, N, Min, Max). arcs_others_(_, _, Max, Max) --> !. arcs_others_(X, Y, Min0, Max) --> [arc(s(X,Min0), Y, s(Y,1))], { Min1 #= Min0 + 1 }, arcs_others_(X, Y, Min1, Max). arcs_same(_, C, C) --> !. %, [arc(s(N,C), N, s(fail))]. %arcs_same(N, C, C) --> !, [arc(s(N,C), N, s(fail))]. arcs_same(N, C0, C) --> [arc(s(N,C0), N, s(N,C1))], { C1 #= C0 + 1 }, arcs_same(N, C1, C). shifts_minmax([], _, []). shifts_minmax([[_,_,_,Min,Max]|Shifts], N, [n_min_max(N,Min,Max)|Ns]) :- N1 #= N + 1, shifts_minmax(Shifts, N1, Ns). col_cardinality(NEmployees, ScheduleCol, TemporalCol) :- length(TemporalCol, NumShifts), numlist(1, NumShifts, Keys), pairs_keys_values(Pairs, Keys, TemporalCol), sum(TemporalCol, #=, Total), NumPause #= NEmployees - Total, my_global_cardinality(ScheduleCol, [0-NumPause|Pairs]). my_global_cardinality(Vs, Pairs) :- !, global_cardinality(Vs, Pairs). my_global_cardinality(Vs, Pairs) :- maplist(gcc_(Vs), Pairs). gcc_(Vs, Key-Num) :- maplist(eq_b(Key), Vs, Bs), sum(Bs, #=, Num). eq_b(X, Y, B) :- X #= Y #<=> B. length_(L, Ls) :- length(Ls, L). sum([V|Vs], #=, Sum) :- sum_(Vs, V, S), S #= Sum. sum_([], T, T). sum_([V|Vs], T0, T) :- sum_(Vs, T0+V, T). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% global_cardinality(Vs, Pairs) :- global_cardinality_(Pairs, Vs). global_cardinality_([], _). global_cardinality_([V-C|VCs], Vs) :- fd_exactly(C, Vs, V), global_cardinality_(VCs, Vs). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Sample instances. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ num_instance(1, wf(7,9,[[2,2,2,2,2,2,2],[2,2,2,3,3,3,2],[2,2,2,2,2,2,2]],[['D',360,480,2,7],['A',840,480,2,6],['N',1320,480,2,4]],2-4,4-7,[['N','D'],['N','A'],['A','D']],[])). num_instance(2, wf(7,9,[[2,2,2,2,2,2,2],[2,2,2,2,2,2,2],[2,2,2,2,2,2,2]],[['D',360,480,4,7],['A',840,480,4,7],['N',1320,480,4,7]],2-4,4-7,[['N','D'],['N','A'],['A','D']],[])). num_instance(3, wf(7,17,[[5,4,4,4,4,4,3],[5,4,4,4,4,4,4],[4,3,3,3,4,4,4]],[['D',360,480,2,7],['A',840,480,2,6],['N',1320,480,2,5]],2-4,4-7,[['N','D'],['N','A'],['A','D']],[])). num_instance(4, wf(7,13,[[5,5,5,5,5,5,0],[5,5,5,5,5,5,0],[1,1,1,1,1,0,0]],[['D',360,480,2,6],['A',840,480,2,6],['N',1320,480,2,4]],1-4,3-7,[['N','D'],['N','A'],['A','D']],[['N',-,'N'],['A',-,'D'],['N',-,'A'],['N',-,'D']])). num_instance(5, wf(7,11,[[3,3,3,3,3,3,0],[3,3,3,3,3,3,0],[3,3,3,3,3,0,3]],[['D',360,480,2,6],['A',840,480,2,5],['N',1320,480,2,4]],1-4,4-7,[['N','D'],['N','A'],['A','D']],[['N',-,'N'],['A',-,'D'],['N',-,'A'],['N',-,'D']])). num_instance(6, wf(7,7,[[2,2,2,2,2,2,0],[2,2,2,2,2,2,0],[2,2,2,2,2,0,2]],[['D',360,480,2,6],['A',840,480,2,6],['N',1320,480,2,6]],1-4,4-7,[['N','D'],['N','A'],['A','D']],[['N',-,'N'],['A',-,'D'],['N',-,'A'],['N',-,'D']])). num_instance(7, wf(7,29,[[5,5,5,5,5,5,5],[5,5,5,5,5,5,5],[5,5,5,5,5,5,5]],[['D',360,480,2,7],['A',840,480,2,6],['N',1320,480,2,5]],2-4,4-7,[['N','D'],['N','A'],['A','D']],[])). num_instance(8, wf(7,16,[[5,5,5,5,5,2,0],[5,5,5,5,5,2,0],[3,3,3,3,2,0,3]],[['D',360,480,2,7],['A',840,480,2,6],['N',1320,480,2,5]],2-4,3-7,[['N','D'],['N','A'],['A','D']],[])). num_instance(9, wf(7,47,[[15,15,15,15,15,6,0],[15,15,15,15,15,6,0],[9,9,9,9,6,0,9]],[['D',360,480,2,7],['A',840,480,2,7],['N',1320,480,2,6]],2-4,2-7,[['N','D'],['N','A'],['A','D']],[])). num_instance(10, wf(7,27,[[7,7,7,7,7,4,4],[7,7,7,7,7,4,4],[7,7,7,7,7,4,4]],[['D',360,480,2,7],['A',840,480,2,6],['N',1320,480,2,5]],2-4,4-7,[['N','D'],['N','A'],['A','D']],[])). num_instance(11, wf(7,30,[[17,16,13,14,16,16,14],[3,7,6,7,3,4,7],[1,1,1,1,1,1,1]],[['D',360,480,2,6],['A',840,480,2,5],['N',1320,480,2,4]],2-4,3-7,[['N','D'],['N','A'],['A','D']],[])). num_instance(12, wf(7,20,[[9,9,9,9,9,9,5],[7,7,7,7,7,3,7]],[['D',360,480,2,6],['A',840,480,2,5]],2-4,4-7,[['A','D']],[])). num_instance(13, wf(7,24,[[10,11,9,12,10,11,6],[6,6,7,4,6,6,7],[0,0,0,2,0,1,0]],[['D',360,480,2,6],['A',840,480,2,5],['N',1320,480,1,4]],2-4,3-7,[['N','D'],['N','A'],['A','D']],[])). num_instance(14, wf(7,13,[[7,7,6,6,5,5,3],[3,3,3,3,3,4,3],[2,2,2,2,2,0,0]],[['D',360,480,2,6],['A',840,480,2,5],['N',1320,480,2,4]],1-4,4-7,[['N','D'],['N','A'],['A','D']],[['A',-,'D'],['N',-,'A'],['N',-,'D']])). num_instance(15, wf(7,64,[[35,35,30,30,25,25,15],[15,15,20,15,15,20,15],[10,10,10,10,10,0,0]],[['D',360,480,2,6],['A',840,480,2,6],['N',1320,480,2,5]],1-4,3-6,[['N','D'],['N','A'],['A','D']],[['N',-,'N'],['A',-,'D'],['N',-,'A'],['N',-,'D']])). num_instance(16, wf(7,29,[[15,13,14,15,13,15,14],[5,5,5,5,6,4,5],[1,1,1,1,1,0,1]],[['D',360,480,2,6],['A',840,480,2,5],['N',1320,480,2,4]],2-4,4-7,[['N','D'],['N','A'],['A','D']],[])). num_instance(17, wf(7,33,[[14,12,11,12,14,12,12],[10,10,11,11,10,10,10]],[['D',360,480,2,6],['A',840,480,2,5]],2-4,3-7,[['A','D']],[])). num_instance(18, wf(7,53,[[10,10,10,10,10,10,10],[10,10,10,10,10,10,10],[10,10,10,10,10,10,10]],[['D',360,480,2,7],['A',840,480,2,6],['N',1320,480,2,5]],2-4,4-7,[['N','D'],['N','A'],['A','D']],[])). num_instance(19, wf(7,120,[[55,55,55,55,55,55,55],[25,25,25,25,25,25,25],[5,5,5,5,5,5,5]],[['D',360,480,2,6],['A',840,480,2,5],['N',1320,480,2,4]],2-4,3-7,[['N','D'],['N','A'],['A','D']],[])). num_instance(20, wf(7,163,[[72,79,80,78,82,76,74],[39,40,44,43,43,38,40],[5,6,5,6,6,6,5]],[['D',360,480,2,6],['A',840,480,2,6],['N',1320,480,2,5]],1-4,3-6,[['N','D'],['N','A'],['A','D']],[['A',-,'D'],['N',-,'A'],['N',-,'D'],['N',-,'N']])). d(G) :- portray_clause(G), nl, G. transpose(Ms, Ts) :- ( Ms = [] -> Ts = [] ; Ms = [F|_], transpose(F, Ms, Ts) ). transpose([], _, []). transpose([_|Rs], Ms, [Ts|Tss]) :- lists_firsts_rests(Ms, Ts, Ms1), transpose(Rs, Ms1, Tss). lists_firsts_rests([], [], []). lists_firsts_rests([[F|Os]|Rest], [F|Fs], [Os|Oss]) :- lists_firsts_rests(Rest, Fs, Oss). append([], []). append([L|Ls], As) :- append(L, Ws, As), append(Ls, Ws). automaton(Sigs, Ns, As) :- memberchk(source(Source), Ns), phrase((arcs_relation(As, Relation)), [[]-0], S), include(sink, Ns, Sinks0), maplist(arg(1), Sinks0, Sinks), phrase(nodes_nums(Sinks, SinkNums0), S, _), phrase(node_num(Source, Start), S, _), phrase(transitions(Sigs, Start, End), Tuples), maplist(fd_relation(Relation), Tuples), fd_domain(End, SinkNums0). transitions([], S, S) --> []. transitions([Sig|Sigs], S0, S) --> [[S0,Sig,S1]], transitions(Sigs, S1, S). nodes_nums([], []) --> []. nodes_nums([Node|Nodes], [Num|Nums]) --> node_num(Node, Num), nodes_nums(Nodes, Nums). arcs_relation([], []) --> []. arcs_relation([arc(S0,L,S1)|As], [[From,L,To]|Rs]) --> node_num(S0, From), node_num(S1, To), arcs_relation(As, Rs). node_num(Node, Num), [Nodes-C] --> [Nodes0-C0], { ( member(N-I, Nodes0), N == Node -> Num = I, C = C0, Nodes = Nodes0 ; Num = C0, C is C0 + 1, Nodes = [Node-C0|Nodes0] ) }. sink(sink(_)). numlist(N, N, [N]) :- !. numlist(N0, N, [N0|Rest]) :- N0 < N, N1 is N0 + 1, numlist(N1, N, Rest). pairs_keys_values([], [], []). pairs_keys_values([K-V|KVs], [K|Ks], [V|Vs]) :- pairs_keys_values(KVs, Ks, Vs). include(Goal, List, Included) :- include_(List, Goal, Included). include_([], _, []). include_([X1|Xs1], P, Included) :- ( call(P, X1) -> Included = [X1|Included1] ; Included = Included1 ), include_(Xs1, P, Included1). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Custom allocation - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ instance_schedule(WF, Schedule, Missings) :- instance_schedule(WF, Schedule), length(Schedule, NEmployees), arg(3, WF, TemporalMatrix), transpose(TemporalMatrix, TemporalCols), transpose(Schedule, ScheduleCols), maplist(col_cardinality_missing(NEmployees), ScheduleCols, TemporalCols, Missings). col_cardinality_missing(NEmployees, ScheduleCol, TemporalCol, Missing) :- length(TemporalCol, NumShifts), numlist(1, NumShifts, Keys), sum(TemporalCol, #=, Total), NumPause #= NEmployees - Total, d(pairs_keys_values(CPairs, [0|Keys], Counters)), d(maplist(counter_remaining, Counters, [NumPause|TemporalCol], Remaining)), d(pairs_keys_values(Missing, [0|Keys], Remaining)), %d(global_cardinality(ScheduleCol, CPairs)). maplist(gcc_(ScheduleCol), CPairs). counter_remaining(Counter, Required, Remaining) :- Remaining #= Required - Counter. %?- pairs_keys_values(Pairs, [0,1,2], Cs). missing(ScheduleCol, Key-Required, Key-Remaining) :- maplist(eq_b(Key), ScheduleCol, Bs), sum(Bs, #=, Sum), Remaining #= Required - Sum. custom(N) :- num_instance(N, I), d(instance_schedule(I, S, M)), transpose(S, T), fill_columns(T, M), print_schedule(I, S). fill_columns(Columns, Missings) :- %portray_clause(Missings), maplist(put_column, Columns, Missings), %portray_clause(putting-Columns), % append(Missings, Pairs), % pairs_keys_values(Pairs, _, Vs), % maplist(fd_sup, Vs, Sups), % portray_clause(Sups), ( (ground(Columns)) -> true ; fill_columns(Columns, Missings) ). a :- a. % missing_most([], _, []). % missing_most([Missing|Ms], C, [Num-col_type_var(C,Type,Var)|Rest]) :- % pairs_keys_values(Missing, _, Vs), % maplist(fd_sup, Vs, Sups), % pairs_keys_values(Pairs0, Sups, Missing), % keysort(Pairs0, Pairs1), % reverse(Pairs1, Pairs), % Pairs = [Num-(Type-Var)|_], % C1 is C + 1, % missing_most(Ms, C1, Rest). put_column(Column, Missing) :- pairs_keys_values(Missing, _, Vs), (maplist(fd_max, Vs, Sups)), (pairs_keys_values(Pairs0, Sups, Missing)), (keysort(Pairs0, Pairs1)), %Pairs1 = Pairs, (reverse(Pairs1, Pairs)), ( member(_-(Type-V), Pairs), var(V) -> % put Type into this column include(var, Column, Vars), maplist(fd_size, Vars, Doms), pairs_keys_values(SPairs, Doms, Vars), keysort(SPairs, Selection), member(Sel, Selection), Sel = _-Type % member(Type, Vars) ; true ).