I'm facing this difficult exercise, I already saw other exercises about crosswords (i.e. the last exercise of "p-99: ninety-nine prolog programs", or the one reported in "Prolog programming for AI" by Bratko), but this is different and more difficult, because here we don't have any template to fill.
Text:
Write a Prolog program to generate a crossword. Suppose you have a dictionary of facts like this: w(Word,Lentgth). Write a predicate crossword(C,W,H) to instantiate C, to all possible list (crossword) of lists (crossword row) of character of the dictionary, where a black cell is represented by an asterisk.
Example:
w(online,6).
w(prolog,6).
w(perl,5).
w(emacs,5).
w(linux,5).
w(gnu,3).
w(mac,3).
w(nfs,3).
w(sql,3).
w(web,3).
w(xml,3).
w(a,1).
w(b,1).
w(e,1).
w(i,1).
w(l,1).
w(m,1).
w(n,1).
w(o,1).
w(q,1).
w(r,1).
w(s,1).
w(t,1).
w(u,1).
w(w,1).
?- crossword(C,9,6).
C=[[p,r,o,l,o,g,*,*,e],
[e,*,n,*,*,n,*,*,m],
[r,*,l,i,n,u,x,*,a],
[l,*,i,*,f,*,m,a,c],
[*,*,n,*,s,q,l,*,s],
[*,w,e,b,*,*,*,*,*]]
Given Hints
1) You could add to the dictionary these "black" words:
black(*,1).
black(**,2).
black(***,3).
black(****,4).
black(*****,5).
2) Each row is sequence of "white" words (normal words) and "black" words interleaved, and this sequence can begin/finish with both.
3) I suggest you to manage the 2 possibility of the previous point with 2 different clause.
4) A crossword is a matrix of character, so its transpose is still a crossword.
5) The transpose crossword is already instantiated, so you only have to check its feasibility with the dictionary.
This is what came in my mind: create a list of H (heigh of crossword, row) lists (the rows of the crossword), for each list (row) I try to insert words from the dictionary followed by "black" words and then again a word, until the row is full, or the same thing starting from a "black". When the the crossword is full, I transpose it and check is the transpose is a valid crossword too: each word contained is a valid word from the dictionary. I know this is a very inefficient method, I tried with a little dictionary to generate crossword 2x2, it generates correctly the firsts two, but seem to take years for the third. I don't know if there is something wrong in my code, maybe it gets stuck somewhere. Do you know a more efficient way to solve this problem or you see something to be improved in my code?
crossword(C,W,H):- create(C,H),
insert_words(C,W,[],_),
clpfd:transpose(C,Traspose),
isok(Traspose).
insert_words([],_,U,U).
insert_words([H|T],W,Uacc,U):-
(add_white(H,[],C,[],Uacc,Udef);
add_black(H,[],C,[],Uacc,Udef)),
insert_words(T,C,Udef,U).
create(Puzzle,H) :- length(Puzzle,H).
add_white(P,P,0,_,U,U).
add_white(P,Row,R,Used,Uacc,Udef):-
R\=0,
w(Word,L),
\+member(Word,Used),
\+member(Word,Uacc),
R2 is R-L,
R2 >= 0,
atom_chars(Word,Word2),
append(Row,Word2,Row2),
append(Used,[Word],Used2),
append(Uacc,[Word],Uacc2),
add_black(P,Row2,R2,Used2,Uacc2,Udef).
add_white(P,Row,R,Used,Uacc,Udef):-
R\=0,
w(Word,L),
\+member(Word,Used),
R2 is R-L,
R2 < 0,
append(Used,[Word],Used2),
add_white(P,Row,R,Used2,Uacc,Udef).
add_white(P,Row,R,Used,Uacc,Udef):-
R\=0,
w(Word,_),
member(Word,Used),
add_white(P,Row,R,Used,Uacc,Udef).
add_black(P,P,0,_,U,U).
add_black(P,Row,R,Used,Uacc,Udef):-
R\=0,
black(Black,L),
R2 is R-L,
R2 >= 0,
atom_chars(Black,Black2),
append(Row,Black2,Row2),
add_white(P,Row2,R2,Used,Uacc,Udef).
add_black(P,Row,R,Used,Uacc,Udef):-
R\=0,
black(_,L),
R2 is R-L,
R2 < 0,
add_black(P,Row,R,Used,Uacc,Udef).
isok([]).
isok([H|T]):-split(H,*,R),
check(R),
isok(T).
split(L,C,R):-split2(L,C,X),trim(X,R).
split2(In, Sep, [Left|Rest]) :-
append(Left, [Sep|Right], In), !, split2(Right, Sep, Rest).
split2(In, _Sep, [In]).
trim([],[]).
trim([H|T],[H|T2]):-H\=[],trim(T,T2).
trim([H|T],Y):-H=[],trim(T,Y).
check([]).
check([H|T]):-
atom_chars(X,H),
w(X,_),
check(T).
I'm using this little dictionary, instead of the original one, to test my program and generate simple 2x2 crosswords, but as I said before it seems to get stuck after correctly found 2 solutions.
w(ci,2).
w(ca,2).
w(i,1).
w(a,1).
black(*,1).
