Friday, 10 January 2014

Using prolog to solve the adjacent number cross puzzle.

I was introduced to the puzzle below late last year. I solved it after some trial and error and gained some insights into it. Firstly, I noticed that boxes C and F were touching or diagonal to almost every other box. Secondly both numbers 1 and 8 are adjacent to only one number.





























After solving the puzzle I wondered how difficult it would be to solve the puzzle using Prolog.

My first concern was how to represent the cross. I realised that the cells in the boxes were just a way of ensuring the restriction that certain pairs of numbers should be compared with each other. If I wrote down a list of all the possible pairs of letters, I could represent the cross and write a check for each pair. In the Prolog program below the list of nonAdjacent(...) clauses of the checkAdjacency(....) predicate represent all possible pairs. The letters I used as the arguments to the nonAdjacent(...) clauses match those I placed in the cross diagram above. So I would know once I had a value for each letter where they belonged in the solution.

For each pair of boxes I needed to ensure that the difference between each number they contained was greater than 1. I did this check in the nonadjacent(A,B) rule below. Note that I have used the Prolog maths functor abs to obtain the positive result from the subtraction of the two arguments.

The program is shown below.

/*
Programmer: Kevin Bentley
Date: 10-Dec-2013
Copyright(c) 2013 Kevin Bentley
*/

nonadjacent(A,B) :- abs(A - B) > 1.

checkAdjacency(A,B,C,D,E,F,G,H) :-
    nonadjacent(A,B),
    nonadjacent(A,C),
    nonadjacent(A,D),
    nonadjacent(B,C),
    nonadjacent(B,E),
    nonadjacent(B,F),
    nonadjacent(C,D),
    nonadjacent(C,E),
    nonadjacent(C,F),
    nonadjacent(C,G),
    nonadjacent(D,F),
    nonadjacent(D,G),
    nonadjacent(E,F),
    nonadjacent(E,H),
    nonadjacent(F,G),
    nonadjacent(F,H),
    nonadjacent(G,H).

% Return next letter X from list as second argument. 
% Return R the remaining list with X removed
extract(X,[X|R],R).
extract(X,[F|R],[F|S]) :-
    extract(X,R,S).

% Brute force search through every combination until a solution found.
solution(A,B,C,D,E,F,G,H) :-
    extract(A,[1,3,5,7,2,4,6,8],L1),
    extract(B,L1,L2),
    extract(C,L2,L3),
    extract(D,L3,L4),
    extract(E,L4,L5),
    extract(F,L5,L6),
    extract(G,L6,L7),
    extract(H,L7,_),
    checkAdjacency(A,B,C,D,E,F,G,H).

The extract(X,R,S) predicate I used is my first use of Prolog lists. As with all recursive rules there needs to be an exit clause to prevent unlimited recursion. I do this in the clause extract(X,[X|R],R). This will succeed at the point where there is a match with the current head of the list and remaining part of the list will be saved in the list R. This effectively completes the last recursive call (if any) made by the second predicate of extract. Note that if X is not in the list the clause will fail to match the argument [X|R] once the input list is reduced to an empty list. This is because Prolog cannot bind X to a head of an empty list.

The rule head extract(X,[F|R],[F|S]) takes the current head F of the input list and appends it to the front of the list variable S. The argument [F|R] is bound to the input list at the start of the call but the partial list S is unbound until the last recursive call of extract(X,R,S) succeeds (on the first predicate as this is always checked first on each call to extract).

R will be bound to a list containing the remaining part of the input list following X when there is a match on the first predicate extract(X,[X|R],R) . At this point it is the first time the third argument of this clause is fully known. This means in the last call to extract(X,R,S) that the argument S of this call will be bound to the remaining list R just discovered. Next the call to extract(X,[F|R],[F|S]) completes successfully returning S with F attached to the front of the list. The actual prepending of F to S occurs after the completion of each call of extract(X,R,S). As a result, S which was initialised to the  partial list R, grows with each letter being prepended to it in reverse order. Finally, the third argument becomes a copy of the original input list with X removed if X was found in the list. If X is not in the list the extract predicate fails and the third parameter is unbound.

Note that the built-in predicate select(?Elem, ?List, ?Rest) in SWI prolog could have served my purpose in this program but I wanted to understand and illustrate a sample Prolog list processing.

I have used the extract rule in my program to serve two roles. Firstly, to provide the next available number from a list. Secondly, to ensure that each number is used only once by removing the value from the list of available numbers. As you can see in the solution(A,B,C,D,E,F,G,H) predicate, the third parameter of each extract becomes the input list of the next use of extract. Once I have a value for each of the variable A to H, my program checks for any adjacent numbers. If any of these checks fail the solution backtracks through all the lists from L1 to L7 getting the next number from each one in turn. The solution from the running the program is given below.

?- Solution(A,B,C,D,E,F,G,H).
A = 7,
B = 3,
C = 1,
D = 4,
E = 5,
F = 8,
G = 6,
H = 2.

I noticed that my use of extract in the solution predicate looks like it could itself be used recursively and indeed this proves to be the case. I have drafted an alternative solution below which produces the same result but also shows that every permutation is being tried and tested. The permutate rules make use of the built library select functor described above. Notice how the permutated numbers in the list variable P can be individually bound to each of the eight solution variables A - H.

% Create permutation of List in first argument into permutated list of second argument.
permutate([],[]).
permutate(L,[X|P]) :-
    select(X,L,R),
    permutate(R,P).

solution(A,B,C,D,E,F,G,H) :-
    permutate([1,3,5,7,2,4,6,8],P),
    P = [A,B,C,D,E,F,G,H],
    checkAdjacency(A,B,C,D,E,F,G,H).

My next blog will look at a more complex puzzle called the knights tour...