/*
 * SICSTUS CLPFD DEMONSTRATION PROGRAM
 * Purpose   : Social Golfer Problem
 * Author    : Mats Carlsson
 *
 * We have 32 golfers, individual play.
 * We will golf for W weeks.
 * Set up the foursomes so that each person only golfs with the same
 * person once.
 *
 * Requires sicstus4. Global constraints:
 *
 * table(+Tuples, +Extension)
 *
 *   Extension - a list of tuples of integers, each of length N.
 *   Tuples - a list of tuples of dvars, each of length N.
 *
 *   Meaning: each tuple of Tuples is in the relation
 *   generated by Extension.
 *
 * +Expr1 #< +Expr2
 *
 * +Expr1 #= +Expr2
 *
 * all_different(+Dvars, +Options)
 *
 */

% | ?- golf(+NbGroups, +GroupSize, +NbWeeks, +LabelOption, +VarOrder).

% Best luck so far:
% | ?- golf(8,4,9,[min],bycolall).

:- module(golf, [golf/5]).

:- use_module(library(clpfd)).

golf(G, S, W, Opt, VarOrder) :-
        golfer(G, S, W, Schedule, Byrow, Bycol),
        var_order(VarOrder, Byrow, Bycol, All),
        statistics(runtime, [T1,_]),
        (   label_sets(All, Opt)
        ;   statistics(runtime, [T2,_]),
            format('[labeling failed in ~d msec]', [T2-T1]),
            flush_output,
            false
        ),
        display_rounds(Schedule, 0).

var_order(bycol, _, All, All).
var_order(byrow, All, _, All).
var_order(bycolall, _, Cols, [All]) :-
        append(Cols, All).
var_order(byrowall, Rows, _, [All]) :-
        append(Rows, All).

label_sets([], _).
label_sets([Set|Sets], Opt) :-
        labeling(Opt, Set),
        label_sets(Sets, Opt).

display_rounds([], _).
display_rounds([Round|Rounds], V) :-
        W #= V+1,
        format('Week ~d:\n', [W]),
        display_round(Round),
        display_rounds(Rounds, W).

display_round([]).
display_round([Four|Round]) :-
        format('                    ~d ~d ~d ~d\n', Four),
        display_round(Round).

golfer(G, S, W, Schedule, PlayersByRow, PlayersByCol) :-
        schedule(0, G, S, W, Schedule, PlayersByRow, PlayersByCol),
        Schedule = [FirstS|RestS],
        append(FirstS, Players),
        labeling([enum], Players), !,
        seed_rest(RestS, S),
        ordered_players_by_week(PlayersByRow),
        players_meet_disjoint(Schedule, G, S),
        first_s_alldiff(0, S, RestS).

schedule(W, _, _, W, [], [], []) :- !.
schedule(I, G, S, W, [Week|Schedule], [ByRow|ByRows], [ByCol|ByCols]) :-
        week(0, G, S, Week),
        append(Week, ByRow),
        all_distinct(ByRow),
        transpose(Week, WeekT),
        append(WeekT, ByCol),
        J #= I+1,
        schedule(J, G, S, W, Schedule, ByRows, ByCols).

week(G, G, _, []) :- !.
week(I, G, S, [Group|Week]) :-
        length(Group, S),
        GS #= G*S-1,
        Group ins 0..GS,
        J #= I+1,
        week(J, G, S, Week).

players_meet_disjoint(Schedule, G, S) :-
        append(Schedule, Groups),
        groups_meets(Groups, Tuples, [], MeetVars, []),
        GS #= G*S,
        ac_pair_vars(Tuples, GS),
        all_different(MeetVars).

ac_pair_vars(Tuples, GS) :-
        mult_table(0, 0, GS, Table),
        tuples_in(Tuples, Table).

mult_table(_, N, N, []) :- !.
mult_table(I, I, N, Table) :- !,
        J #= I+1,
        mult_table(0, J, N, Table).
mult_table(I, K, N, [[I,K,P]|Table]) :-
        P #= N*I + K,
        J #= I+1,
        mult_table(J, K, N, Table).

groups_meets([], Tuples, Tuples) --> [].
groups_meets([Group|Groups], Tuples1, Tuples3) -->
        group_meets(Group, Tuples1, Tuples2),
        groups_meets(Groups, Tuples2, Tuples3).

group_meets([], Tuples, Tuples) --> [].
group_meets([P|Ps], Tuples1, Tuples3) -->
        group_meets(Ps, P, Tuples1, Tuples2),
        group_meets(Ps, Tuples2, Tuples3).

group_meets([], _, Tuples, Tuples) --> [].
group_meets([Q|Qs], P, [[P,Q,PQ]|Tuples1], Tuples2) --> [PQ],
        group_meets(Qs, P, Tuples1, Tuples2).

seed_rest([], _).
seed_rest([Week|Rest], S) :-
        ascending_quotients(Week, S),
        seed_week(0, S, Week),
        seed_rest(Rest, S).

seed_week(S, S, Week) :- !,
        S1 #= S-1,
        seed_week(Week, S1).
seed_week(I, S, [[I|_]|Week]) :-
        J #= I+1,
        seed_week(J, S, Week).

seed_week([], _).
seed_week([[J|_]|Week], I) :-
        I #< J,
        seed_week(Week, J).

ascending_quotients([], _).
ascending_quotients([Group|Groups], S) :-
        ascending_quotient(Group, S),
        ascending_quotients(Groups, S).

ascending_quotient([P|Ps], S) :-
        P//S #= Q,
        ascending_quotient(Ps, Q, S).

ascending_quotient([], _, _).
ascending_quotient([P|Ps], Q0, S) :-
        P//S #= Q,
        Q0 #< Q,
        ascending_quotient(Ps, Q, S).

ordered_players_by_week([W|Ws]) :-
        ordered_players_by_week(Ws, W).

ordered_players_by_week([], _).
ordered_players_by_week([W|Ws], V) :-
        W = [_,Y|_],
        V = [_,X|_],
        X #< Y,
        ordered_players_by_week(Ws, W).

first_s_alldiff(S, S, _Schedule) :- !.
first_s_alldiff(I, S, Schedule) :-
        concat_ith(Schedule, I, Conc, []),
        all_distinct(Conc),
        J #= I+1,
        first_s_alldiff(J, S, Schedule).

concat_ith([], _) --> [].
concat_ith([Week|S], I) -->
        {nth0(I, Week, [_|Ps])},
        list(Ps),
        concat_ith(S, I).

list([]) --> [].
list([X|Xs]) --> [X], list(Xs).