/*
THE SOCIAL GOLFER PROBLEM

The coordinator of a local golf club has come to you with the following problem. In her club, there are 32 social golfers, each of whom play golf once a week, and always in groups of 4. She would like you to come up with a schedule of play for these golfers, to last as many weeks as possible, such that no golfer plays in the same group as any other golfer on more than one occasion.

Possible variants of the above problem include: finding a 10-week schedule with ``maximum socialisation''; that is, as few repeated pairs as possible (this has the same solutions as the original problem if it is possible to have no repeated pairs), and finding a schedule of minimum length such that each golfer plays with every other golfer at least once (``full socialisation'').

The problem can easily be generalized to that of scheduling m groups of n golfers over p weeks, such that no golfer plays in the same group as any other golfer twice (i.e. maximum socialisation is achieved). 

*/

/*
Implementation: George Rabanca
Modelling : "A Constraint Programming Approach to the Social Golfer Problem" 
	    John Fabricius

Each week of the schedule is represented by a 32 x 32 binary matrice in which S[i,j] = 1 iff player i and j have been in the same group in the respective week.
*/

golfers(Schedule):-
	cl('utils.pl'),

	make_schedule(Schedule, 6),

	%maximum socialization constraints
	numlist(1, 32, Players),
	foreach(Players, foreach(Players, socialization(Schedule))),

	fix_group(Schedule, 1, [1,2,3,4]),
	fix_group(Schedule, 2, [1,5,6,7]),
	fix_group(Schedule, 3, [1,8,9,10]),
	fix_group(Schedule, 4, [1,11,12,13]),
	fix_group(Schedule, 5, [1,14,15,16]),
	fix_group(Schedule, 6, [1,17,18,19]),

	flatten(Schedule, LabelThis),
	labelingff(LabelThis),
	
	write_schedule(Schedule, 1).

%makes constraints for a player I to be before player J
ordered_players([W1, W2| _], I, J):-
	(I < J, !,
		nth(I, W1, SI1),
		nth(I, W2, SI2),
		nth(J, W1, SJ1),
		nth(J, W2, SJ2),

		equal_schedules(SI1, SJ1, C1, 1),

		ordered_schedules(SI1, SJ1, C2),
		ordered_schedules(SI2, SJ2, C3),

		C1 #=> C3,
		#\ C1 #=> C2;
	true).

%fixes a group in a week
fix_group(Schedule, Week, Group):-
	Group = [A, B, C, D], 

	nth(Week, Schedule, WeekSchedule), 

	get_matrix_ij(WeekSchedule, A, B, 1), 
	get_matrix_ij(WeekSchedule, A, C, 1), 
	get_matrix_ij(WeekSchedule, A, D, 1).

%S is a binary representation of the group schedule for week Index
make_schedule([], 0):- !.
make_schedule([S|Schedule], Index):-
	make_week(S, 32), 

	numlist(1, 32, Players),

	%the schedule matrix for each week must be simmetric.
	foreach(Players, foreach(Players, make_simmetric(S))),

	%for all (x, y, z), if S[X,Y] = 1 && S[Y, Z] = 1 => S[X, Z] = 1	
	foreach(Players, make_transitive(S)), 

	%there are 4 players in each group
	all_rows_sum(S, 4),
	
	Index1 is Index - 1, 
	make_schedule(Schedule, Index1).

%Player is a binary list representing the group partners for player.
make_week([], 0):- !.
make_week([Player| Week], Index):-
	length(Player, 32),
	Player in [0,1],
	Index1 is Index -1 , 
	make_week(Week, Index1).

%S[i, j] = S[j, i]  and S[i, i] = 0
make_simmetric(S, I, J):-
	(I >=J, !,
		get_matrix_ij(S, I, J, Sij), 
		get_matrix_ij(S, J, I, Sji),

		(I = J, !,
			Sij #= 1; 
		 Sij #= Sji);
	 true
 	).
	
%for all (y, z), if S[X,Y] = 1 && S[Y, Z] = 1 => S[X, Z] = 1	
make_transitive(S, X):-
	numlist(1, 32, Players),

	foreach(Players, foreach(Players, make_transitive(S, X))).

%if S[X,Y] = 1 && S[Y, Z] = 1 => S[X, Z] = 1	
make_transitive(S, X, Y, Z):-
	(X \=Y, Y\= Z, Z > X, !,
		get_matrix_ij(S, X, Y, Sxy), 
		get_matrix_ij(S, Y, Z, Syz),
		get_matrix_ij(S, X, Z, Sxz),
	
		((Sxy #= 1) #/\ (Syz #= 1)) #=> (Sxz #= 1);
	
	true).

%makes sure that X and Y do not meet more than once in Schedule
socialization(Schedule, X, Y):-
	(X > Y, !,
		get_meetings(Schedule, X, Y, Meet), 
		%writeln(sum(Meet) #< 1),
		sum(Meet) #=< 1; 
	true).

%get all elements that represent meetings between X and Y.
get_meetings(Scheudle, X, Y, Meet):-
	get_meetings(Scheudle, X, Y, Meet, []).
get_meetings([], _, _, Meet, Meet).
get_meetings([S|Scheudle], X, Y, Meet, Acc):-
	get_matrix_ij(S, X, Y, Group),
	Acc1 = [Group | Acc], 
	get_meetings(Scheudle, X, Y, Meet, Acc1).


%write the schedule in a more readable way
write_schedule([], _).
write_schedule([Week | Schedule], Index):-
	writeln('Week ' - Index),
	get_week(Week, Groups),
	Index1 is Index + 1,
	write_schedule(Schedule, Index1).

get_week(Week, Groups):-
	get_week(Week, Groups, 1, []).
get_week([], Groups, _, Groups).
get_week([Player|Week], Groups, PlayerIndex, Acc):-
	get_player(Player, Group1), 
	%Group = [PlayerIndex | Group1], 
	Group = Group1,
	(set_member(Group, Acc) -> Acc1 = Acc; 
		writeln(Group),
		Acc1 = [Group | Acc]
	),

	PlayerIndex1 is PlayerIndex + 1, 
	get_week(Week, Groups, PlayerIndex1, Acc1).

get_player(Player, Group):-
	get_player(Player, Group, 1, []).
get_player([], Group, _,  Group).
get_player([X|Player], Group, OponentIndex, Acc):-
	( X = 1 ->
		Acc1 = [OponentIndex | Acc];
	 Acc1 = Acc),

	OponentIndex1 is OponentIndex + 1,
	get_player(Player, Group, OponentIndex1, Acc1).

set_member(Set, [S|SetList]):-
	(permutation(Set, S), !, true;
	 set_member(Set, SetList)).