...Removing All Doubt

A few months back Randy Kimmerly posted a blog about one the puzzles on my desk.

Twisted in the correct way it will form a 3x3x3 cube. It is a snake cube puzzle that goes by the commercial name of Cubra©. Randy got excited about the puzzle not for the puzzle itself but by the challenge of writing a program that will produce the solution. He wrote a very clever C# program to produce a solution. I thought the solution would be more concise in Prolog so I volunteered to produce a Prolog version. I had to dust off my Prolog skills, I hadn't used Prolog since I used to support Turbo Prolog for Borland, so my skills are a bit rusty. Here is my solution,

linkTurns([f, f, t, f, t, t, t, t, f, t, t, t, t, t, t, t, 
   t, f, t, t, t, f, t, t, t, f]).

inrange(0). inrange(1). inrange(2).
cell(X, Y, Z) :- inrange(X), inrange(Y), inrange(Z).

move(right, cell(X, Y, Z), cell(X1, Y, Z)) :- X1 is X + 1, cell(X1, Y, Z).
move(left, cell(X, Y, Z), cell(X1, Y, Z)) :- X1 is X - 1, cell(X1, Y, Z).
move(down, cell(X, Y, Z), cell(X, Y1, Z)) :- Y1 is Y + 1, cell(X, Y1, Z).
move(up, cell(X, Y, Z), cell(X, Y1, Z)) :- Y1 is Y - 1, cell(X, Y1, Z).
move(in, cell(X, Y, Z), cell(X, Y, Z1)) :- Z1 is Z + 1, cell(X, Y, Z1).
move(out, cell(X, Y, Z), cell(X, Y, Z1)) :- Z1 is Z - 1, cell(X, Y, Z1).

legalTurn(left, X) :- member(X, [up, down, in, out]).
legalTurn(right, X) :- member(X, [up, down, in, out]).
legalTurn(up, X) :- member(X, [left, right, in, out]).
legalTurn(down, X) :- member(X, [left, right, in, out]).
legalTurn(in, X) :- member(X, [left, right, up, down]).
legalTurn(out, X) :- member(X, [left, right, up, down]).

free(X, Y) :- member(X, Y), !, fail.
free(_, _).

solution(Cells, Moves, [], Cells, Moves).
solution([LastCell|UsedCells], [LastMove|OldMoves], 
   [t|Turns], ResultCells, ResultMoves) :-
   legalTurn(LastMove, NewMove), move(NewMove, LastCell, NewCell), 
   free(NewCell, UsedCells),   solution([NewCell, LastCell|UsedCells], 
   [NewMove, LastMove|OldMoves], Turns, ResultCells, ResultMoves).
solution([LastCell|UsedCells], [LastMove|OldMoves], 
   [f|Turns], ResultCells, ResultMoves) :- 
   move(LastMove, LastCell, NewCell), free(NewCell, UsedCells), 
   solution([NewCell, LastCell|UsedCells], [LastMove, LastMove|OldMoves], 
   Turns, ResultCells, ResultMoves).

solution(Cells, Moves) :- linkTurns(L), solution([cell(0, 0, 0)], 
   [right], L, Cells, Moves).


print_solution([], []).
print_solution([Cell|Cells], [Move|Moves]) :- 
   print_solution(Cells, Moves), write(Move), put(9), write('to '), 
   write(Cell), nl.

goal :- solution(Cells, Moves), print_solution(Cells, Moves).

The clause linkTurns/1 represents where the string of blocks turns and where it doesn't. inrange/1 represents the valid ranges the coordinates of a block can have, 0, 1 or 2. This is used to build cell/3 which represents the locations the blocks can occupy in a 3x3 result. move/3 calculates how to get from one block to another.  legalTurn/2 generates legal turns. free/2 helps decide if a cell is already occupied.  solution/5 calculates the solution; and solution/2 is a simplified wrapper around solution/5. print_solution/2 is a utility clause to help print the solution in a some what readable form. Finally goal is a clause that kicks off the whole process (a dead giveaway to Turbo Prolog roots).

This will only print one solution (because of the implied cut in using I/O) even though there are two possible. To see both use,

  ?- solution(Cells, Moves).

You will notice that both solutions are reflexive of each other so you could say there is really only one solution.

I found an interesting site here that discusses these puzzles as well as gives a break down of how many of these kinds of puzzle there can be.