% Modified version of a program written and posted to comp.lang.prolog by Mats Carlsson. :- use_module(library(tor_clpfd)). go1 :- golf(8,4,6,[ff,enum],bycolall). vars_twicereordered --> vars_reordered, vars_reordered. vars_reordered(Vars0,Vars) :- length(Vars0,N0), N1 #= N0 / 2, length(VarsA,N1), phrase((iseq(VarsA), seq(VarsB)), Vars0), phrase(interleaved_with(VarsB,VarsA), Vars). interleaved_with([], []) --> []. interleaved_with([], [E|Es]) --> seq([E|Es]). interleaved_with([E|Es],[]) --> seq([E|Es]). interleaved_with([E|Es],[F|Fs]) --> [E,F], interleaved_with(Es,Fs). seq([]) --> []. seq([E|Es]) --> [E], seq(Es). iseq([]) --> []. iseq([E|Es]) --> iseq(Es), [E]. g(N) :- golf(8,4,N,[ff],bycolall). custom_allocation(Weeks) :- custom_allocation_(Weeks). % length(Weeks, W), % L1 is W // 2, % length(Firsts, L1), % append(Firsts, Nexts, Weeks), % custom_allocation_(Firsts), % custom_allocation_(Nexts). custom_allocation_(Weeks) :- Weeks = [First|_], flatten(First, Ls), length(Ls, L), Upper is L - 1, numlist(0, Upper, Players), %vars_reordered(Players, Players1), Players1 = Players, distribute(Players1, Weeks). distribute([], _). distribute([P|Ps], Weeks) :- try_player(Weeks, P), distribute(Ps, Weeks). try_player([], _). try_player([W|Ws], Player) :- flatten(W, Vars), member(Player, Vars), try_player(Ws, Player). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% custom_allocation2(Weeks0) :- %maplist(transpose, Weeks0, Weeks), Weeks0 = Weeks, all_nths(Weeks, 0), all_nths(Weeks, 1), all_nths(Weeks, 2), all_nths(Weeks, 3), all_nths(Weeks, 4), all_nths(Weeks, 5), all_nths(Weeks, 6), all_nths(Weeks, 7). all_nths(Weeks, N) :- maplist(nth0(N), Weeks, Nths), flatten(Nths, Vs), labeling([ff], Vs). % all_nths([], _). % all_nths([Week|Weeks], N) :- % do_nth(Week, N), % all_nths(Weeks, N). % do_nth(Week, N) :- % nth0(N, Week, Elem), % labeling([ff], Elem). %?- gtrace, (golf(8,4,5, [min], bycolall)). %?- time(golf(8,4,9, [ff,custom,show], bycolall)). %?- time(golf(8,4,9, [min,show], bycolall)). %?- time(golf(2,3,1, [ff,show], bycolall)). %:- time(golf(8,5,3, [ff,show],bycolall)). %init_postscript :- !. init_postscript :- open(pipe('gs -dGraphicsAlphaBits=4 -dNOPAUSE -dNOPROMPT -g800x600 -q'), write, Out, [buffer(false)]), tell(Out). firstsix(Week) :- Week = [[0|_], [1|_], [2|_], [3|_], [4|_], [5|_], [6|_]|_]. firstseven(Week) :- Week = [_,_,_,_,_,_,_,[7|_]]. schedule(G,S,W,Schedule) :- length(Schedule, W), maplist(length_(G), Schedule), maplist(maplist(length_(S)), Schedule). length_(L, Ls) :- length(Ls, L). golf(G, S, W, Opt, VarOrder) :- ( memberchk(show, Opt) -> init_postscript, format("% instance: ~w ~w ~w\n", [G,S,W]), format("(golf.ps) run\n"), format("~w ~w ~w init\n", [G,S,W]), finish ; true ), schedule(G,S,W,Schedule), ( memberchk(show, Opt) -> golf_show(Schedule) ; true ), golfer(G, S, W, Schedule, Byrow, Bycol), var_order(VarOrder, Byrow, Bycol, All), statistics(runtime, [T1,_]), ( ( memberchk(custom, Opt) -> custom_allocation(Schedule) ; memberchk(custom2, Opt) -> custom_allocation2(Schedule) ; delete(Opt, show, Opt1), label_sets(All, Opt1) ) %format("labelled\n") ; format("failed\n"), statistics(runtime, [T2,_]), format('[labeling failed in ~d msec]', [T2-T1]), flush_output, fail ), ( memberchk(show, Opt) -> %format("{} loop"), true ; display_rounds(Schedule, 0) ). golf_show(Schedule) :- show_weeks(Schedule, 1), flush_output. show_weeks([], _). show_weeks([W|Ws], WN) :- show_groups(W, 1, WN), WN1 is WN + 1, show_weeks(Ws, WN1). show_groups([], _, _). show_groups([G|Gs], GN, WN) :- show_group(G, GN, 1, WN), GN1 is GN + 1, show_groups(Gs, GN1, WN). show_group([], _, _, _). show_group([P|Ps], GN, PN, WN) :- %format("~w ~w ~w c\n", [GN,PN,WN]), freeze(P, show_ps(P, GN, PN, WN)), PN1 is PN + 1, show_group(Ps, GN, PN1, WN). show_ps(P, GN, PN, WN) :- T is cputime, format("% ~ws\n", [T]), format("(~w) ~w ~w ~w g\n", [P,GN,PN,WN]), flush_output. show_ps(_, GN, PN, WN) :- format("~w ~w ~w c\n", [GN,PN,WN]), flush_output, fail. %?- time(golf(8,4,7,[show], bycolall)). %?- time(golf(8,4,1,[show], bycolall)). var_order(bycol, _, All, All). var_order(bycol_interleaved, _, Cols, All) :- interleave(Cols, All). var_order(byrow, All, _, All). var_order(bycolall, _, Cols, [All]) :- append(Cols, All). var_order(byrowall, Rows, _, [All]) :- append(Rows, All). interleave([], []). interleave([A,B], [A,B]). interleave([A,B,C], [A,B,C]). interleave([A,B,C,D|Vs], [A|Rest]) :- append(Vs, [B,C,D], Next), interleave(Next, Rest). label_sets([], _). label_sets([Set|Sets], Opt) :- search(labeling(Opt, Set)), label_sets(Sets, Opt). display_rounds(_,_). % display_rounds(Rounds, _) :- format("schedule(~w).\n", [Rounds]). % display_rounds([], _). % display_rounds([Round|Rounds], V) :- % W is V+1, % format('Week ~d:\n', [W]), % display_round(Round), % display_rounds(Rounds, W). display_round([]). display_round([Four|Round]) :- format("~w\n", [Four]), %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), once(search(label(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), my_all_distinct(ByRow), transpose(Week, WeekT), append(WeekT, ByCol), J is I+1, schedule(J, G, S, W, Schedule, ByRows, ByCols). week(G, G, _, []) :- !. week(I, G, S, [Group|Week]) :- length(Group, S), GS is G*S-1, Group ins 0..GS, J is I+1, week(J, G, S, Week). players_meet_disjoint(Schedule, G, S) :- append(Schedule, Groups), groups_meets(Groups, Tuples, [], MeetVars, []), GS is G*S, ac_pair_vars(Tuples, GS, _IDs), %MeetVars in IDs, all_different(MeetVars). table_ids([]) --> []. table_ids([[_,_,ID]|Ts]) --> [ID], table_ids(Ts). ac_pair_vars(Tuples, GS, IDs) :- mult_table(0, 0, GS, Table), phrase(table_ids(Table), IDs), tuples_in(Tuples, Table). mult_table(_, N, N, []) :- !. mult_table(I, I, N, Table) :- !, J is I+1, mult_table(0, J, N, Table). mult_table(I, K, N, [[I,K,P]|Table]) :- P is N*I + K, J is 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 is S-1, seed_week(Week, S1). seed_week(I, S, [[I|_]|Week]) :- J is 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, []), my_all_distinct(Conc), J is I+1, first_s_alldiff(J, S, Schedule). concat_ith([], _) --> []. concat_ith([Week|S], I) --> {nth0(I, Week, [_|Ps])}, Ps, concat_ith(S, I). finish :- format("copypage\n"), % fill the buffer to make 'gs' process all generated output ignore((between(1,500,_), format("%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%\n"), fail)), flush_output. %?- time(golf(8,4,3,[max],bycol)). %?- X is 17 //4. %?- gtrace, domain_contract(split(22,from_to(21,21),from_to(23,23)), 4, D). %?- domain_contract(from_to(21,21), 4, D). %?- time(golf(8,4,9,[ff,custom,show],bycol)). %?- time(golf(8,4,9,[var_max_impact,val_min_impact,show],bycolall)). %?- time(golf(8,4,5,[var_max_impact,val_min_impact,show],bycolall)). %?- time(golf(8,4,4,[ff,show],bycolall)). %?- time(golf(5,3,7,[ff,show],bycolall)). %?- time(golf(8,4,10,[ff,show],bycolall)). %?- time(g(6)). %?- [X,Y,Z] in 0..31, A #= X / 4, B #= Y / 4, A #< B. %?- X#> 5. %?- X #= Y / 7. %?- trace, domain_contract(split(11, from_to(8, 10), from_to(12, 23)), 4, D). % Yes %?- time(golf(3,3,4,[],bycol)). %?- profile(golf(3,4,1,[leftmost],bycolall)). %?- [X,Y] ins 0..32, X / 4 #= XD, Y / 4 #= YD, YD #> XD. %?- [X,Y] ins 0..32, X / 4 #= XD, Y / 4 #= YD, YD #> XD, YD #\= 7. %?- X in 0..10, labeling([max(X)],[X]). %?- 23 #= X * Y, X #> 0, Y #> 0. %?- Z from [21,23], X * 4 #= Z, X #> 0. %?- X from [21,23], X / 4 #= Z. %?- Z from [21,23], Z #= X*4. %?- tuples_in([[A,B],[C,D]], [[3,4],[5,6]]). %?- X in [2,4,5]. % Kirkman %?- time(golf(5,3,6,[custom],bycolall)). %?- time(golf(8,4,9,[show,custom,ff],bycolall)). %?- time(golf(8,4,9,[show,ff,custom],bycolall)). %?- time(golf(3,2,5,[ff],bycolall)). %?- time(golf(3,3,4,[ff],bycolall)). %?- time(golf(9,4,7,[custom,show,ff],bycolall)). %?- time(golf(5,3,7,[ff,show],bycolall)). %?- time(golf(8,6,7,[ff,show,custom],bycolall)). %?- nb_setval(count, 0), golf(4,4,5,[],bycolall), nb_getval(count, C), C1 is C + 1, nb_setval(count, C1), fail. %?- golf(10,1,1,[ff],bycolall). %?- golf(8,4,1,[ff],bycolall). %?- time(golf(8,4,10,[show,custom2],bycol)). %?- time(golf(8,4,7,[ff,show],bycolall)). %?- numlist(0, 31, Ns), vars_reordered(Ns, Ns1) ; fail. %?- X #> 0. %?- time(golf(8,4,9,[show,custom],bycolall)). %?- golf(4,4,2, [], bycolall). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ %?- time(golf(5,5,6,[ff],bycolall)). %?- go6. %?- golf(20,2,15,[ff,show],bycolall). %?- golf(39,2,15,[ff],bycolall). %?- go6. %?- go6. %?- sh %?- (golf(5,3,5,[ff,show],bycolall)). %?- profile(golf(8,4,3,[min,show],bycolall)). %@ %?- time(golf(8,4,9,[min],bycolall)). %?- time(golf(8,4,2,[min],bycolall)). run :- golf(8,4,9,[min],bycolall). runs :- golf(8,4,9,[min,show],bycolall). %?- golf(39,2,10,[min,show],bycolall). %@ %?- golf(8,4,9,[min,show],bycolall). %?- run. my_all_distinct(Vs) :- !, all_different(Vs). %my_all_distinct(Vs) :- !, all_distinct(Vs). %my_all_distinct(Vs) :- !, clpfd:weak_arc_all_distinct(Vs). my_all_distinct(Vs) :- domains_union(Vs, UD), clpfd:domain_to_list(UD, Ls), maplist(my_gcc, Ls, Pairs), global_cardinality(Vs, Pairs). my_gcc(E, E-B) :- B in 0..1. %?- time(golf(8,4,9,[min],bycolall)). %?- time(runs). domains_union([V|Vs], Dom) :- clpfd:element_domain(V, VD), domains_union_(Vs, VD, Dom). domains_union_([], D, D). domains_union_([V|Vs], D0, D) :- clpfd:element_domain(V, VD), clpfd:domains_union(VD, D0, D1), domains_union_(Vs, D1, D). %?- time(run). %?- go6. %@ schedule([[[0,1,2,3],[4,5,6,7],[8,9,10,11],[12,13,14,15],[16,17,18,19],[20,21,22,23],[24,25,26,27],[28,29,30,31]],[[0,8,13,18],[1,9,17,25],[2,10,19,26],[3,11,20,27],[4,12,22,29],[5,14,23,30],[6,15,24,28],[7,16,21,31]],[[0,9,14,19],[1,12,18,27],[2,17,20,30],[3,8,21,28],[4,10,23,31],[5,13,24,29],[6,16,22,25],[7,11,15,26]],[[0,10,15,22],[1,8,14,16],[2,9,21,27],[3,12,24,30],[4,13,26,28],[5,11,18,25],[6,19,20,31],[7,17,23,29]],[[0,11,17,21],[1,13,19,22],[2,23,25,28],[3,9,16,29],[4,15,27,30],[5,12,26,31],[6,10,14,18],[7,8,20,24]],[[0,12,16,20],[1,10,21,29],[2,11,14,22],[3,15,17,31],[4,9,18,24],[5,19,27,28],[6,8,23,26],[7,13,25,30]]]). %@ % 20,632,950 inferences, 4.656 CPU in 4.757 seconds (98% CPU, 4431646 Lips) %@ true .