/* * 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).