Backtracking over list in crossword-style puzzle

Question

I'm creating a program that will take a list of words, and a square, crossword-style grid of spaces, and return the only solution, which is the filled crossword such that all words fit together coherently. The size of the grid is arbitrary, but it is always a square.

See here for an example of what I'm trying to do: http://en.wikipedia.org/wiki/Fill-In_(puzzle)

I have the meat of the program down. Essentially my first set of predicates take the grid and create logical variables for every slot, ignoring the blacked out slots (the #s). Then, I create a list of possible words greater than 1 slot long (words one letter long are not valid). The result is a grid with shape (a very simple example):

#_#
___
#_#

Where each row is an element of the "puzzle list" from top to bottom, ie

  Row 1   Row 2   Row 3
[[#,_,#],[_,_,_],[#,_,#]]

Will be filled with free logical variables like so:

#X#
ABC
#Z#

And the list will look like (Part 0):

[[#,X,#],[A,B,C],[#,Z,#]]

Then, a wordlist of the form:

[['M','E','N'],['N','E','W']]

Is given, with the end solution being

#M#
NEW
#N#

So far I fill the grid list with variables as in Part 0, and also fill a list with possible slots for words to go in (the "slot list"), where a slot is made for every string of vertical and horizontal spaces longer than 1 space in length (for this example):

[[A,B,C],[X,B,Z]]

So I successfully have these set up, such that unifying a word to a slot of the slot list will also unify that word to the matching variables in the puzzle list.

Now, all the inputs will be such that there is always only one way to arrange the words in the grid (unlike this example where there are two ways, just ignore that), so only one solution will be provided by the completed program (a solution being the filled puzzle grid).

The word-unification algorithm should be:

1. Take a word from the word list
2. Go through the slot list and unify with the first slot that succeeds
3. If there are no successful bindings, fail and backtrack to try a new 
   set of unifications
4. Keep failing and backtracking until a solution is found such that all 
   words bind successfully

My code for this unification of words to slots is below:

%%% Takes a word (W) and a list of slots (S|Ss) and attempts to bind it to a slot
bind_word(W,[S|Ss],Slots):- bind_w(W,[S|Ss],[],Slots).
bind_w(_,[],Acc,Acc).
bind_w(W,[S|Ss],Acc,Slots):-
(   W = S ->                    % Does the word bind to the next slot?
    append(Acc,[S],Acc1),       % YES Add the bound slot to the accumulator 
    append(Acc1,Ss,Acc2),       % Add the rest of the slots to the accumulator
    bind_w(_,[],Acc2,Slots)     % Exit with success
;   length(Ss,0) -> fail        % NO Word doesn't bind, if there are no slots left to bind then this has failed
;   append(Acc,[S],Acc1),       % NO Word doesn't bind, but there are slots left, append this unbound slot to the accumulator
    bind_w(W,Ss,Acc1,Slots)     % Move to the next slot
).
%%%

What I want it to do is if it hits

length(Ss,0) -> fail

then backtrack to the beginning and try again, but instead of trying again with the same bindings, consider the successful bindings as failures and skip over them, for example:

1. Try to bind the word B,E,N to the first slot, and it works
2. Try to bind the word M,A,X to the second slot, and it doesn't 
   work and there are no slots left
3. Backtrack to (1), and instead of binding BEN to slot one (which 
   succeeded before), skip to the next slot and try unifying BEN to 
   the second slot.

Unfortunately, when it hits

length(Ss,0) -> fail

it considers the entire thing as a failure and does not backtrack, but fails everything. The solving predicate is as follows:

%%% Takes a puzzle grid and a wordlist and solves the puzzle
solve_puzzle(Solution, [], Solution).
solve_puzzle(Puzzle, Wordlist, Solved):-
    fill_slots_H(Puzzle,Slots1,Puzzle1),        % Fill out the puzzle with logical variables in every blank space (results = Puzzle1), also get all the horizontal word slots (results = Slots1) 
    flip(Puzzle1,0,Puzzle1_Flipped),            % Flip the puzzle for vertical use (results = Puzzle1_Flipped)
    fill_slots_V(Puzzle1_Flipped,Slots1,Slots), % Take the vertical puzzle and append the slots for vertical words onto the end of the existing slot list SLOTS IS THE FINAL UNBOUND SLOT LIST
    flip(Puzzle1_Flipped,1,Puzzle_Final),       % Flip the puzzle back to normal PUZZLE_FINAL IS THE FINAL UNBOUND PUZZLE
    !,                                          % Make these choices final
    insert_words(Wordlist,Slots,Final_Slotlist),% Insert all the words into the slots and return the finished slot list 
    Slots = Final_Slotlist,                     % Bind all logical variables in the final slotlist to the slotlist linked to the puzzle
    solve_puzzle(Puzzle_Final, [], Solved).     % Puzzle is now filled, return it as the solution
%%%

%%% Takes a (W)ordlist, and (S)lot list and binds every word to a slot until the puzzle is finished
insert_words([],Slots,Slots).
insert_words([W|Ws], Current_Slotlist, Filled_Slotlist):- 
    bind_word(W,Current_Slotlist,Partial_Slotlist),
    insert_words(Ws, Partial_Slotlist, Filled_Slotlist).
%%%

I fill out the puzzle, get the list of horizontal word slots, then transpose the puzzle and get the list of vertical word slots (appending them to the horizontal one). Then, I fill out the slot list with words, unify the filled list with the empty slot list (which also unifies the words to the puzzle grid), then return the finished puzzle.

How do I make it so if it fails to unify a word, it backtracks and skips over any successes and tries another choice? I've thought of trying to bind, then if it fails, randomise the word list and try again, but that doesn't sound very logic-driven to me...

Thanks in advance.

Answer 1

You have been thinking a bit too much about the search algorithm, and too little about the logical meaning of your program. In Prolog you have to do both, and it can take a while to find the right balance.

If I understand you correctly, all you want is to take one word after the other, try to fit it into a slot, and backtrack chronologically. This is easy in Prolog. To do something for all words in the word list, you use recursion. To try slots in the slot list, you use member/2. The backtracking happens automatically:

solve(Ss) :-
    Ws=[[b,e,g],[w,e,b],[n,e,w],[b,e,n]],
    Ss=[[A,B,C],[D,B,F],[F,H,I],[C,H,L]],
    all_member(Ws, Ss).

all_member([], _).
all_member([W|Ws], Ss) :-
    member(W, Ss),
    all_member(Ws, Ss).

?- solve(Ss).
Ss = [[b, e, n], [w, e, b], [b, e, g], [n, e, w]]
Yes (0.00s cpu, solution 1, maybe more)
Ss = [[w, e, b], [b, e, n], [n, e, w], [b, e, g]]
Yes (0.00s cpu, solution 2, maybe more)
No (0.01s cpu)

[I have assumed that all words in the word list are different]

PS: Once you have corrected bind_w/4 by replacing the if-then-else with a disjunction, it essentially becomes a complex version of member/2. You don't need the accumulator pair and the appends, because all they do is construct a copy of the slots list (which you don't need, just use the original one). You also don't need the first clause of bind_w/4, because you want it to fail with an empty slot list. Once you remove this, you don't need the length-test any longer.

Answer 2

I actually figured it out. I didn't know that if-A-then-B-else-C throws out any choicepoints in Prolog, so all permutations of A were not being explored, as the if-then-else throws out all other permutations. Taking out the if-then-else from bind_w and replacing it with:

must be slots remaining,
unify word ; unify next slot.

worked, as there is a fail condition (slots remaining > 0) and a choicepoint (unify word with current slot, or unify with the next slot). If the fail condition is hit, then Prolog will backtrack and try a different branch.