% Social Golfer problem
% http://4c.ucc.ie/~tw/csplib//prob/prob010/index.html

% September 11 2003
% Pairwise representation (without sbds)

:- include(liste).

golf(G,S,W,R) :-
	% Data
	N is G*S,
	length(R,N),
	init_triangle(R,N,W),
	length(TriSInf,N),
	triangle_strict_inf(R,TriSInf,N),
	length(Square,N),
	triangle_to_square(TriSInf,R,Square),
	flatten(R,Vars),
	% Breaking symmetries statically
%	nth(1,R,First_Player),First_Player=[_|RFirst_Player],
%	ordering_weeks(RFirst_Player),
	% Constraint
	group_buildings(Square,R,W,S,N),
	% Redundant constraints
%	reverse(TriSInf,RStrictInf),
%	Wp1 is W+1,
%	plus_diag(RStrictInf,TriInf,Wp1),
%	transitivity_redund(TriInf),
	% Labeling
	randomize,	
	fd_labeling(Vars,[variable_method(first_fail),value_method(random)]),
	convert_repr(Square,1,ListList,W,G),
	nl,nl,nl,write_sol(ListList).


init_triangle([],_,_).
init_triangle([P1|LP],N,W) :-
	length(LP,N2),
	LgP1 is N2+1,
	length(P1,LgP1),
	P1=[Id|LVar],
	fd_domain(LVar,0,W),
	Wp1 is W+1,
	fd_domain(Id,Wp1,Wp1),
	init_triangle(LP,N,W).

triangle_strict_inf(_,[],_).
triangle_strict_inf(R,[P1|TriInf],N) :-
	length(TriInf,LgRst),
	I is  N-LgRst,
	LgP1 is N-LgRst-1,
	length(P1,LgP1),
	tr_Tri(P1,R,1,I),
	triangle_strict_inf(R,TriInf,N).

tr_Tri([],_,_,_) :-!.
tr_Tri([X|LP1],R,J,I) :-
	J2 is J+1,
	I2 is I-1,
	nth(J,R,P2),
	nth(I,P2,X),
	tr_Tri(LP1,R,J2,I2).

triangle_to_square([],[],[]).
triangle_to_square([Pinf|LTriInf],[Psup|LPTriSup],[Psq|LPSq]) :-
	append(Pinf,Psup,Psq),
	triangle_to_square(LTriInf,LPTriSup,LPSq).
	
plus_diag([],[],_).	
plus_diag([P|RP],[P2|RP2],W):-
	reverse(P,P22),
	append([W],P22,P2),
	plus_diag(RP,RP2,W).

% Breaking Symmetries
ordering_weeks([]).
ordering_weeks([_]).
ordering_weeks([A|[B|R]]) :-
	A#>=B,
	ordering_weeks([B|R]).

last_week([],_,_,_,[]):-!.
last_week([P|LP],G,S,W,L) :-
	Sm1 is S-1,
	fix_P(P,S,Sm1,W,L1),
	last_week(LP,G,S,W,L2),
	append(L1,L2,L).

fix_P(_,_,0,_,[]):-!.
fix_P(P,S,Sm1,W,[X|R]):-
	I is S+(Sm1-1)*Sm1,
	nth(I,P,X),
	Sm2 is Sm1-1,
	fix_P(P,S,Sm2,W,R).

% Constraints
group_buildings([],[],_,_,_).
group_buildings([P1|LPlayer],[P11|LPlayerTri],W,S,N) :-
	Sm1 is S-1,
	NbZero is N-W*(S-1)-1,
	P11=[_|RP11],
	(NbZero=0->fd_domain(RP11,1,W);
		fd_exactly(NbZero,P1,0)),
	group_week(P1,W,Sm1),
	
	% Redundant constraints
	magicNumber(S,W,Sum1),
	compute_sum(P1,Sum2),	
	Sum2#=Sum1+W+1,

	transitivity(RP11,LPlayerTri),
	group_buildings(LPlayer,LPlayerTri,W,S,N).


group_week(_,0,_) :-!.
group_week(P1,W,S) :-
	Wm1 is W-1,	
	fd_exactly(S,P1,W),
	group_week(P1,Wm1,S).

transitivity([],_).
transitivity([_],_) :-!.
transitivity([V1|LV],[Player|LPlayer]) :-
	Player=[_|RPlayer],
	cond_const(V1,LV,RPlayer),
	transitivity(LV,LPlayer).

cond_const(_,[],_):-!.
cond_const(V1,[V2|RV],[V3|RPlayer]) :-
	fd_transitivity([V1,V2,V3]),
	cond_const(V1,RV,RPlayer).

% Redundant Constraints
compute_sum([], 0).
compute_sum([E|L], S):-
	compute_sum(L, S1),
	S #= S1 + E.
magicNumber(S, 1, S1):-
	!,
	S1 is S - 1.
magicNumber(S, W, MagicNumber):-
	W1 is W - 1,
	magicNumber(S, W1, MagicNumberW1),
	MagicNumber is MagicNumberW1 + W * (S - 1).
	

transitivity_redund([]).
transitivity_redund([P1|LPlayer]):-
	P1=[_|RP1],
	transitivity(RP1,LPlayer),
	transitivity_redund(LPlayer).

group_redund(_,_,0):-!.
group_redund(R,NbGr,W) :-
	fd_exactly(NbGr,R,W),
	Wm1 is W-1,
	group_redund(R,NbGr,Wm1).

% Adapted labeling
labeling_golf([_],_):-!.
labeling_golf([P|LP],K) :-
	P=[_|RP],
	randomize,
	labeling_player(RP,[],LP,1),
	Kp1 is K+1,
	labeling_golf(LP,Kp1).

labeling_first_player([],_,_,_).
labeling_first_player([V|LV],LV0,LP,J) :-
	(V>0->same_group(LV0,1,J,LP,V);true),
	Jp1 is J+1,
	append(LV0,[V],LV1),
	labeling_first_player(LV,LV1,LP,Jp1).
	
labeling_player([],_,_,_).
labeling_player([V|LV],LV0,LP,J) :-
	fd_labeling(V,[value_method(random)]),
	(V>0->same_group(LV0,1,J,LP,V);true),
	Jp1 is J+1,
	append(LV0,[V],LV1),
	labeling_player(LV,LV1,LP,Jp1).
	
same_group([],_,_,_,_):-!.
same_group([V1|LV1],I,J,LP,V1) :-
	!,
	nth(I,LP,P2),
	JJ is J-I+1,
	nth(JJ,P2,V2),
	V2#=V1,
	Ip1 is I+1,
	same_group(LV1,Ip1,J,LP,V1).
same_group([_|LV1],I,J,LP,V2) :-
	nth(I,LP,P2),
	JJ is J-I+1,
	nth(JJ,P2,V3),
	V3#\=V2,
	Ip1 is I+1,
	same_group(LV1,Ip1,J,LP,V2).


% Display
write_sol([]).
write_sol([P|LP]):-
	write_week(P),
	nl,
	write_sol(LP).

write_week([]).
write_week([Group|LG]):-
	write_group(Group),
	write(' |'),
	write_week(LG).

write_group([]).
write_group([I|R]):-
	write(I),write(' '),
	write_group(R).
	
convert_repr([],_,L,W,_):-
	length(L,W),
	init_list(L,[]),
	!.
convert_repr([P|LP],I,L2,W,G):-
	Ip1 is I+1,
	convert_repr(LP,Ip1,L,W,G),
	group_week(P,I,W,LG),
	rec_weeks(LG,L,W,L2).

group_week(_,_,0,[]):-!.
group_week(P,I,W,LG):-
	setof(IG,nth(IG,P,W),G),
	sort([I|G],Group1),
	Wm1 is W-1,
	group_week(P,I,Wm1,LG2),
	append([Group1],LG2,LG).
	
rec_weeks([],L,0,L).
rec_weeks([LGW|LG],L,W,L3):-
	Wm1 is W-1,
	rec_weeks(LG,L,Wm1,L2),
	nth(W,L,Week),
	(member(LGW,Week)->
		L3=L2;
		append(Week,[LGW],Week2),
		sort(Week2,Week3),
		replace_list(W,L2,Week3,L3)
	).
		
write_sq([]).
write_sq([Lg|R]):-
	write(Lg),nl,
	write_sq(R).