/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - A simple greedy heuristic based on the *freedom* of sets of golfers is able to solve instance 8-4-9 of the social golfer problem, thus matching the best results obtained so far with constraint-based approaches. Written by Markus Triska (triska@metalevel.at), 2008-2021 Public domain code. Tested with Scryer Prolog. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ :- use_module(library(assoc)). :- use_module(library(clpz)). :- use_module(library(between)). :- use_module(library(lists)). :- use_module(library(reif)). :- use_module(library(format)). :- use_module(library(dcgs)). :- use_module(library(debug)). greedy(G, P, W, S) :- init(G, P, N, S0), phrase(week(0, W, N, S0), S). init(G, P, N1, State) :- N #= G * P, N1 #= N - 1, Bitmap #= (1 << N) - 1, findall(Player-Bitmap, between(0,N1,Player), State0), list_to_assoc(State0, State). week(N, N, _, _) --> !. week(N0, N, P, S0) --> [Gs], { numlist(0, P, Ps), groups(Ps, S0, S1, Gs, []), N1 #= N0 + 1 }, week(N1, N, P, S1). groups([], S, S) --> !. groups(Ps0, S0, S) --> [[A,B,C,D]], { list_pairs(Ps0, S0, Pairs0, []), keysort(Pairs0, Pairs1), member(_-p(A,B,NA,NB), Pairs1), member(_-p(C,D,NC,ND), Pairs1), A #\= C, A #\= D, B #\= C, B #\= D, Pattern #= (1 << A) \/ (1< []. list_pairs([L|Ls], S0) --> { get_assoc(L, S0, NL) }, pair_up(Ls, S0, NL, L), list_pairs(Ls, S0). pair_up([], _, _, _) --> []. pair_up([B|Bs], S0, NA, A) --> { get_assoc(B, S0, NB), Num #= popcount(NA/\NB) }, ( { NA /\ (1<= 4 } -> [Num-p(A,B,NA,NB)] ; [] ), pair_up(Bs, S0, NA, A). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - A solution for instance 8-4-9: ?- greedy(8, 4, 9, Ws), maplist(portray_clause, Ws). [[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,4,8,12],[1,5,9,13],[2,6,10,14],[3,7,11,15],[16,20,24,28],[17,21,25,29],[18,22,26,30],[19,23,27,31]]. [[0,16,5,21],[1,17,4,20],[2,18,7,23],[3,19,6,22],[8,24,13,29],[9,25,12,28],[10,26,15,31],[11,27,14,30]]. [[0,26,6,28],[1,27,7,29],[2,24,4,30],[3,25,5,31],[8,18,14,20],[9,19,15,21],[10,16,12,22],[11,17,13,23]]. [[0,11,18,25],[1,10,19,24],[2,9,16,27],[3,8,17,26],[4,15,22,29],[5,14,23,28],[6,13,20,31],[7,12,21,30]]. [[0,13,7,10],[1,12,6,11],[2,15,5,8],[3,14,4,9],[16,29,23,26],[17,28,22,27],[18,31,21,24],[19,30,20,25]]. [[0,19,14,29],[1,18,15,28],[2,17,12,31],[3,16,13,30],[4,23,10,25],[5,22,11,24],[6,21,8,27],[7,20,9,26]]. [[0,20,15,27],[1,21,14,26],[2,22,13,25],[3,23,12,24],[4,16,11,31],[5,17,10,30],[6,18,9,29],[7,19,8,28]]. [[0,17,9,24],[1,16,8,25],[2,19,11,26],[3,18,10,27],[4,21,13,28],[5,20,12,29],[6,23,15,30],[7,22,14,31]]. Ws = [[[0,1,2,3],[4,5,6,7],[8,9,10,11],[12,13,14,15],[16,17,18,19],[20,21,22|...],[24,25|...],[28|...]],[[0,4,8,12],[1,5,9,13],[2,6,10,14],[3,7,11,15],[16,20,24|...],[17,21|...],[18|...],...],[[0,16,5,21],[1,17,4,20],[2,18,7,23],[3,19,6|...],[8,24|...],[9|...],...|...],[[0,26,6,28],[1,27,7,29],[2,24,4|...],[3,25|...],[8|...],...|...],[[0,11,18,25],[1,10,19|...],[2,9|...],[3|...],...|...],[[0,13,7|...],[1,12|...],[2|...],...|...],[[0,19|...],[1|...],...|...],[[0|...],...|...],[...|...]] ; ... - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */