/*
 *  cross.pl:		Prolog source code implementing fc-mrv
 *			algorithm for crossword solver.
 *  Implemented by:	Psallidas Fotis
 *  std code:		std06170
 *  A.M. code:		1115200600170
 *  Reason:		Logic Programming course
 *  Semester:		Spring 2009
 *
 */


/*
 *	Crossword solver:
 *		For every slot to be filled there is a domain set with the 
 *		words which can fill the slot.When we have a pick for
 *		a slot,we inform the next slots' domains which havent been filled yet.
 *		The inform gets down by removing from the same length domains
 *		the word we picked for the previous slot and by removing the words
 *		and by removing from all of the slot domains the words which cannot match
 *		due to the cross of the word we filled.The slot we pick to fill 
 *		is the slot with the minimum domain set length.
 */

 /*
  *	Writelist:Predicate for printing list members
  */
writelist([]).
writelist([H | T]):-
	write(H),nl,
	writelist(T).

 /*
  *	Predicates to prepare the structures which are about to 
  *	be used by fc-mrv
  */
vertical([[] | _], []).
vertical(L,[H | R]):-
	first(L,H),
	rest(L,M),
	vertical(M,R).

first([],[]).
first([ [H | _] | T1] , [ H | T2]):-
	first(T1,T2).

rest([],[]).
rest([[_ | R] | T1], [R | T2]):-
	rest(T1,T2).

expand([], []).
expand([H1 | T1], [H2 | T2]) :-
	name(H1, H2),
	expand(T1, T2).

fill(S,R):- fillit(S,1,1,R),! .
fillit(S,S,_,[]).
fillit(S,X,_,[H | T]):-
	X < S,
	fillity(S,X,1,H),
	NX is +(X,1),
	fillit(S,NX,1,T).
fillity(S,_,S,[]).
fillity(S,X,Y,['#' | R]):-
	black(X,Y),
	NY is +(Y,1),
	fillity(S,X,NY,R).
fillity(S ,X ,Y,[ _ | R]):-
	NY is +(Y ,1),
	fillity(S,X,NY,R).

splitter([],[]).
splitter([H | T],R):-
	combine(H,R1),
	splitter(T,R2),
	append(R1,R2,R).

combine(L,[]):-make(L,[]),!.
combine(L, [H | T]) :-
	make(L, I),
	assemble(I, H, M),
	make(M,R),
	combine(R,T).

assemble([H | R] , [ H | T ], O):- var(H),assemble(R,T,O),!.
assemble(T,[],T).

make([H1 , H2 | T ],R):- var(H1),atom(H2),make(T,R),!.
make([H | T] , R):- atom(H),make(T,R),!.
make([X],[]):- var(X).
make(R,R).


 /*
  *	FC operations
  */

/* check if A can be unified with B , but dont unify them now. */
unifiable(A,B):- A\=B , ! ,fail.
unifiable(_,_).

/* find the domain set of a single slot */
slot_domains([],_,[]).
slot_domains([H | T],S,[ H | R]):-
	unifiable(S,H),
	slot_domains(T,S,R),!.

slot_domains([_ | T],S,D):-
	slot_domains(T,S,D).

/* find the domain sets for all of the slots */
fix_domains(_,[],[]).
fix_domains(Words,[H | T],[Q| R]):-
	slot_domains(Words,H,Q),
	fix_domains(Words,T,R).
	
/* update all the domains */
update(_,[],[]):- !.
update(_,[],_).
update(W,[H | T], [H | Q]):-
	unifiable(H,W),
	update(W,T,Q),!.
update(W,[_ | T],Q):-
	update(W,T,Q),!.

same_len(W,[H | _]):-
	length(W,L),
	length(H,N),
	L =:= N.
update_domains([],[],[]).
update_domains([SH | ST],[H | T],[Q | R]):-
	same_len(SH,H),
	update(SH,H,Q),
	length(Q,QL),
	QL > 0,
	update_domains(ST,T,R),!.
update_domains([_ | ST],[H | T],[H | R]):-
	update_domains(ST,T,R).

/* remove from domain sets the value which got used to fill previous slot */
update_same(_,[],[]).
update_same(W,[H | T], Q):-
	unifiable(H,W),
	update_same(W,T,Q),!.
update_same(W,[H | T],[ H | Q]):-
	update_same(W,T,Q),!.

update_samelen(_,[],[]).
update_samelen(W,[H | T],[Q | R]):-
	same_len(W,H),!,
	update_same(W,H,Q),
	length(Q,QL),
	QL > 0,
	update_samelen(W,T,R),!.
update_samelen(W,[H | T],[H | R]):-
	update_samelen(W,T,R).


/* delete item from a list which is located in a certain position */
delete_in_pos([],_,[],_,_):- !.
delete_in_pos([],_,_,_,_).
delete_in_pos([SH | ST],POS,[SH | NST],CUR,DELETED):-
	CUR =\= POS,
	NCUR is CUR + 1,
	delete_in_pos(ST,POS,NST,NCUR,DELETED),!.

delete_in_pos([DELETED | ST] , POS,NSLOTS,POS,DELETED):-
	CUR is POS +1,
	delete_in_pos(ST,POS,NSLOTS,CUR,DELETED).

delete_in_pos(LIST,POS,NLIST,DELETED):-
	delete_in_pos(LIST,POS,NLIST,1,DELETED).
 /*
  *	Mrv
  */
min(X, Y, X, S, _, S) :-
	X < Y, !.
min(_, Y, Y, _, Z, Z).
mrv(P, Q) :-
	mrv(1, P, _, Q), !.
mrv(Q, [[_] | _], 1, Q).
mrv(Q, [D], L, Q) :-
	length(D, L).
mrv(P1, [D | B], L, P) :-
	length(D, L1),
	N is P1+1,
	mrv(N, B, L2, P2),
	min(L1, L2, L, P1, P2, P).

 /*
  *	Main Solver implementing
  *	FC-MRV functionality.
  */
solve([],[]).
solve(DOMAINS,SLOTS):-
	mrv(DOMAINS,POS),
	delete_in_pos(DOMAINS,POS,NDOMAINS,DOMAIN),
	delete_in_pos(SLOTS,POS,NSLOTS,SLOT),
	member(SLOT,DOMAIN),
	update_samelen(SLOT,NDOMAINS,Q),
	update_domains(NSLOTS,Q,P),
	solve(P,NSLOTS).

 /*
  *	Printing Crossword
  */
printit([]).
printit([ '#' | T]):-
	write(#),write(#),write(#),
	printit(T).

printit([H | T]):-
	write(' '),put(H),write(' '),
	printit(T).

print_cross([]).
print_cross([H | T]):-
	printit(H),nl,
	print_cross(T),!.


	
crossword(Result):-
	dimension(F),
	words(W),
/* prepare all the strcutures needed by fc-mrv */
	expand(W,L),
	SIZE is F + 1,
	fill(SIZE,Table),
	vertical(Table,Vtable),
	splitter(Table,H),
	splitter(Vtable,V),
	append(H,V,TV),
	fix_domains(L,TV,DOMAINS),!,
/* slove crossword */
	solve(DOMAINS,TV),
/* print solution */
	print_cross(Table),
	expand(VV,V),
	expand(HV,H),
	append(HV,VV,Result).

