Prolog for eight puzzle

Question

%999 represent Blank tile.

goal([999,0,1, 2,3,4, 5,6,7]).

%To move left in any row ther are two cases:
%Case_1: Blank tile in the second index.
%Case_2: Blank tile in the third index.

% move left in the top row
move([X0,999,X2, X3,X4,X5, X6,X7,X8],
     [999,X0,X2, X3,X4,X5, X6,X7,X8]). %second

move([X0,X1,999, X3,X4,X5, X6,X7,X8],
     [X0,999,X1, X3,X4,X5, X6,X7,X8]). %third


% move left in the middle row
move([X0,X1,X2, X3,999,X5, X6,X7,X8],
     [X0,X1,X2, 999,X3,X5, X6,X7,X8]). %second

move([X0,X1,X2, X3,X4,999, X6,X7,X8]
    ,[X0,X1,X2, X3,999,X4, X6,X7,X8]). %third

% move left in the bottom row
move([X0,X1,X2, X3,X4,X5, X6,999,X8],
     [X0,X1,X2, X3,X4,X5, 999,X6,X8]). %second

move([X0,X1,X2, X3,X4,X5, X6,X7,999],
     [X0,X1,X2, X3,X4,X5, X6,999,X7]). %third

% To move right in any row there are two cases:
% Case_1: 999 tile in the first index.
% Case_2: 999 tile in the second index.

% move right in the top row
move([999,X1,X2, X3,X4,X5, X6,X7,X8],
     [X1,999,X2, X3,X4,X5, X6,X7,X8]). %first

move([X0,999,X2, X3,X4,X5, X6,X7,X8],
     [X0,X2,999, X3,X4,X5, X6,X7,X8]). %seond

%% move right in the middle row
move([X0,X1,X2, 999,X4,X5, X6,X7,X8],
     [X0,X1,X2, X4,999,X5, X6,X7,X8]). %first

move([X0,X1,X2, X3,999,X5, X6,X7,X8],
     [X0,X1,X2, X3,X5,999,X6,X7,X8]). %second

%% move right in the bottom row
move([X0,X1,X2, X3,X4,X5, 999,X7,X8],
     [X0,X1,X2, X3,X4,X5, X7,999,X8]). %first

move([X0,X1,X2, X3,X4,X5, X6,999,X8],
     [X0,X1,X2, X3,X4,X5, X6,X8,999]). %second

%It is not possible to move up when existing in the top row.
% so, moving up will only be possible from bottom and middle rows from
% the three indecies.

%% move up from the middle row
move([X0,X1,X2, 999,X4,X5, X6,X7,X8],
     [999,X1,X2, X0,X4,X5, X6,X7,X8]). %first

move([X0,X1,X2, X3,999,X5, X6,X7,X8],
     [X0,999,X2, X3,X1,X5, X6,X7,X8]). %second

move([X0,X1,X2, X3,X4,999, X6,X7,X8],
     [X0,X1,999, X3,X4,X2, X6,X7,X8]).  %third

%% move up from the bottom row
move([X0,X1,X2, X3,X4,X5, 999,X7,X8],
     [X0,X1,X2, 999,X4,X5, X3,X7,X8]). %first

move([X0,X1,X2, X3,X4,X5, X6,999,X8],
     [X0,X1,X2, X3,999,X5, X6,X4,X8]). %second

move([X0,X1,X2, X3,X4,X5, X6,X7,999],
     [X0,X1,X2, X3,X4,999, X6,X7,X5]). %third

%  moving down only from the middle and top rows from the three
%  indicies.

%  move down from the top row
move([999,X1,X2, X3,X4,X5, X6,X7,X8],
     [X3,X1,X2, 999,X4,X5, X6,X7,X8]). %first

move([X0,999,X2, X3,X4,X5, X6,X7,X8],
     [X0,X4,X2, X3,999,X5, X6,X7,X8]). %second

move([X0,X1,999, X3,X4,X5, X6,X7,X8],
     [X0,X1,X5, X3,X4,999, X6,X7,X8]). %third

%% move down from the middle row
move([X0,X1,X2, 999,X4,X5, X6,X7,X8],
     [X0,X1,X2, X6,X4,X5, 999,X7,X8]). %first

move([X0,X1,X2, X3,999,X5, X6,X7,X8],
     [X0,X1,X2, X3,X7,X5, X6,999,X8]). %second

move([X0,X1,X2, X3,X4,999, X6,X7,X8],
     [X0,X1,X2, X3,X4,X8, X6,X7,999]). %third



dfs(S, Path, Path) :-
    goal(S),!.

dfs(S, Checked, Path) :-
    % try a move
    move(S, S2),
    % ensure the resulting state is new
    \+member(S2, Checked),
    % and that this state leads to the goal
    dfs(S2, [S2|Checked], Path).

%SS: state start
%SE: state end
%path(SS, Checked, MoveList):-
   % move(SS, Snext),
   % \+member(Snext, Checked),
   % path(Snext,[Snext|Checked], [Snext, SS|MoveList]).

%path(_,_, MoveList):-
    %output(MoveList).

% Printing
%output([]) :- nl.
%output([[A,B]|MoveList]) :-
%   output(MoveList),
%   write(B), write(' -> '), write(A), nl.

find :-
    dfs([6,1,3 4,999,5, 7,2,0],_,_).

Answer 1

An alternative approach where the current "state" (representing the state of the board) in the search space is represented by matrix: a list of 3 lists. The positions in this matrix are given by column and row coordinates, each ranging from 0 to 2:

 +--------------> Col (0,1,2)
 |
 |   [[A0,B0,C0],
 |    [D0,E0,F0],
 |    [G0,H0,I0]]
 V
 Row (0,1,2)

If a matrix position shall represent the "empty cell", we write empty list at that position (because it looks nice), otherwise we write one of the integers 0..7

target( [[ [] ,0 ,1],   
         [  2 ,3 ,4],
         [  5 ,6 ,7]]).

from( [[6 ,1  ,3],
       [4 ,[] ,5],
       [7 ,2  ,0]]).

% A *backtrackable* predicate which proposes a new position (RowNew,ColNew)
% for the hole at position (Row,Col). The hole is moved in direction 
% MoveDirection
% This is not as nice as pattern matching over a pair of
% states because you can't make it run "backwards" to determine a
% move and input matrix from an output matrix.

% new_hole_position(Row,Col,RowNew,ColNew,MoveDirection)

new_hole_position(Row,Col,RowNew,Col,down)  :- Row < 2, RowNew is Row+1. 
new_hole_position(Row,Col,RowNew,Col,up)    :- Row > 0, RowNew is Row-1. 
new_hole_position(Row,Col,Row,ColNew,right) :- Col < 2, ColNew is Col+1.
new_hole_position(Row,Col,Row,ColNew,left)  :- Col > 0, ColNew is Col-1.

% Pick the value at (Row,Col) from MatrixIn into ValOld and
% Put ValNew at (Row,Col), giving MatrixOut. This is used to
% generate a new state from an existing state and a "hole move".

pick_and_put_matrix(Row,Col,MatrixIn,ValOld,ValNew,MatrixOut) :-
   pick_and_put(Row,MatrixIn,RowlistOld,RowlistNew,MatrixOut),
   pick_and_put(Col,RowlistOld,ValOld,ValNew,RowlistNew).

pick_and_put(Index,ListIn,ValOld,ValNew,ListOut) :-
   length(Prefix,Index), 
   append([Prefix,[ValOld],Suffix],ListIn),
   append([Prefix,[ValNew],Suffix],ListOut),
   !.

% Moving the hole from (Row,Col) to (RowNew,ColNew)

move_hole(Row,Col,RowNew,ColNew,MatrixIn,MatrixOut) :-
   pick_and_put_matrix(Row,Col,MatrixIn,[],Val,MatrixMid),
   pick_and_put_matrix(RowNew,ColNew,MatrixMid,Val,[],MatrixOut).

% Find out where the hole is in MatrixIn as we don't
% keep track of that information.

cur_hole_position(Row,Col,MatrixIn) :-
   nth0(Row,MatrixIn,RowList),
   cur_hole_position_in_row(Col,RowList),!.
   
cur_hole_position_in_row(Col,RowList) :- 
   nth0(Col,RowList,[]).

% For showing off, the number of states visited is counted in
% a thread-local variable that is non-backtrackably incremented.

nb_inc_counter :-
  nb_getval(counter,X),
  XX is X+1,
  nb_setval(counter,XX).
  
% The search proper. Perform a single move from one state (matrix) 
% to the next state (matrix)
%
% move(+CurrentState,+GoalState,
%      -SolutionAsGrowingOpenListToWhichOneAppends
%      +StatesOnPathSoAsToNotVisitAStateTwiceToWhichOnePrepends,
%      +DepthCountdownForIterativeDeepening)

move(Matrix,Matrix,[],_,_) :- !.
move(MatrixIn,MatrixTarget,[MatrixMid|Moves],MatrixesOnPath,Depth) :-
   Depth > 1, 
   nb_inc_counter,
   cur_hole_position(Row,Col,MatrixIn),
   new_hole_position(Row,Col,RowNew,ColNew,_MoveDirection),
   move_hole(Row,Col,RowNew,ColNew,MatrixIn,MatrixMid),
   \+ member(MatrixMid,MatrixesOnPath),
   SmallerDepth is Depth-1,
   move(MatrixMid,MatrixTarget,Moves,[MatrixMid|MatrixesOnPath],SmallerDepth).

% Printout curclicues

print_and_reset_counter :-
   nb_getval(counter,C),
   (C>0 
    -> format("Examined ~d positions~n",[C]) 
    ;  true),
   nb_setval(counter,0).

format_moves([Matrix],_) :-
   format_matrix(Matrix).
format_moves([Matrix,Matrix2|Moves],Index) :-
   format_matrix(Matrix),
   format("Move ~d~n",[Index]),
   Index2 is Index+1,
   format_moves([Matrix2|Moves],Index2).

format_matrix([[A,B,C],[D,E,F],[G,H,I]]) :-
   enlarge(A,AE),
   enlarge(B,BE),
   enlarge(C,CE),
   enlarge(D,DE),
   enlarge(E,EE),
   enlarge(F,FE),
   enlarge(G,GE),
   enlarge(H,HE),
   enlarge(I,IE),
   format("+--------+~n",[]),
   format("|~s,~s,~s|~n",[AE,BE,CE]),
   format("|~s,~s,~s|~n",[DE,EE,FE]),
   format("|~s,~s,~s|~n",[GE,HE,IE]),
   format("+--------+~n",[]).
   
enlarge(X,XE) :-
   format(string(S)," ~q",[X]),
   sub_string(S,_,2,0,XE).

% "Main" predicate.

run(Moves) :- 
   from(MatrixFrom),
   target(MatrixTarget),  
   nb_setval(counter,0),
   between(1,30,MaxDepth), % backtrackable; iterative deepening
   print_and_reset_counter,
   format("Maximum depth is ~d~n",[MaxDepth]),
   move(MatrixFrom,MatrixTarget,Moves,[MatrixFrom],MaxDepth),
   announce_success([MatrixFrom|Moves]).

announce_success(Moves) :-   
   length(Moves,Length),
   AdjustedLength is Length-1,
   nb_getval(counter,C),
   format("Found a solution of ~d moves by examination of ~d positions.~n",[AdjustedLength,C]),
   format_moves(Moves,1).

And so:

?- run(Moves).
Maximum depth is 1
Maximum depth is 2
Examined 1 positions
Maximum depth is 3
Examined 5 positions
Maximum depth is 4
Examined 13 positions
Maximum depth is 5
Examined 21 positions
Maximum depth is 6
Examined 37 positions
Maximum depth is 7
Examined 69 positions
Maximum depth is 8
Examined 133 positions
Maximum depth is 9
Examined 213 positions
Maximum depth is 10
Examined 373 positions
Maximum depth is 11
Examined 645 positions
Maximum depth is 12
Examined 1189 positions
Maximum depth is 13
Examined 1941 positions
Maximum depth is 14
Examined 3437 positions
Maximum depth is 15
Examined 5797 positions
Maximum depth is 16
Examined 10517 positions
Maximum depth is 17
Examined 17349 positions
Maximum depth is 18
Examined 30965 positions
Maximum depth is 19
Examined 51765 positions
Maximum depth is 20
Examined 93333 positions
Maximum depth is 21
Examined 154709 positions
Maximum depth is 22
Examined 277093 positions
Maximum depth is 23
Examined 461541 positions
Maximum depth is 24
Examined 829917 positions
Maximum depth is 25
Examined 1378229 positions
Maximum depth is 26
Examined 2472253 positions
Maximum depth is 27
Found a solution of 26 moves by examination of 3712817 positions.
+--------+
| 6, 1, 3|
| 4,[], 5|
| 7, 2, 0|
+--------+
Move 1
+--------+
| 6, 1, 3|
|[], 4, 5|
| 7, 2, 0|
+--------+
Move 2
+--------+
|[], 1, 3|
| 6, 4, 5|
| 7, 2, 0|
+--------+
Move 3
+--------+
| 1,[], 3|
| 6, 4, 5|
| 7, 2, 0|
+--------+
Move 4
+--------+
| 1, 4, 3|
| 6,[], 5|
| 7, 2, 0|
+--------+
Move 5
+--------+
| 1, 4, 3|
| 6, 2, 5|
| 7,[], 0|
+--------+
Move 6
+--------+
| 1, 4, 3|
| 6, 2, 5|
|[], 7, 0|
+--------+
Move 7
+--------+
| 1, 4, 3|
|[], 2, 5|
| 6, 7, 0|
+--------+
Move 8
+--------+
| 1, 4, 3|
| 2,[], 5|
| 6, 7, 0|
+--------+
Move 9
+--------+
| 1, 4, 3|
| 2, 5,[]|
| 6, 7, 0|
+--------+
Move 10
+--------+
| 1, 4,[]|
| 2, 5, 3|
| 6, 7, 0|
+--------+
Move 11
+--------+
| 1,[], 4|
| 2, 5, 3|
| 6, 7, 0|
+--------+
Move 12
+--------+
|[], 1, 4|
| 2, 5, 3|
| 6, 7, 0|
+--------+
Move 13
+--------+
| 2, 1, 4|
|[], 5, 3|
| 6, 7, 0|
+--------+
Move 14
+--------+
| 2, 1, 4|
| 5,[], 3|
| 6, 7, 0|
+--------+
Move 15
+--------+
| 2, 1, 4|
| 5, 3,[]|
| 6, 7, 0|
+--------+
Move 16
+--------+
| 2, 1, 4|
| 5, 3, 0|
| 6, 7,[]|
+--------+
Move 17
+--------+
| 2, 1, 4|
| 5, 3, 0|
| 6,[], 7|
+--------+
Move 18
+--------+
| 2, 1, 4|
| 5,[], 0|
| 6, 3, 7|
+--------+
Move 19
+--------+
| 2, 1, 4|
| 5, 0,[]|
| 6, 3, 7|
+--------+
Move 20
+--------+
| 2, 1,[]|
| 5, 0, 4|
| 6, 3, 7|
+--------+
Move 21
+--------+
| 2,[], 1|
| 5, 0, 4|
| 6, 3, 7|
+--------+
Move 22
+--------+
| 2, 0, 1|
| 5,[], 4|
| 6, 3, 7|
+--------+
Move 23
+--------+
| 2, 0, 1|
| 5, 3, 4|
| 6,[], 7|
+--------+
Move 24
+--------+
| 2, 0, 1|
| 5, 3, 4|
|[], 6, 7|
+--------+
Move 25
+--------+
| 2, 0, 1|
|[], 3, 4|
| 5, 6, 7|
+--------+
Move 26
+--------+
|[], 0, 1|
| 2, 3, 4|
| 5, 6, 7|
+--------+

Answer 2

Another alternative solution, where:

• states are represented as terms, and
• iterative deepening search is controled through the use of predicate length/2.

With this implementation, a solution was found in approximately 40 seconds (SWI-Prolog, v.8.2.4).

ids :-
   start(State),
   length(Moves, N),
   dfs([State], Moves, Path), !,
   show([start|Moves], Path),
   format('~nmoves = ~w~n', [N]).

dfs([State|States], [], Path) :-
   goal(State), !,
   reverse([State|States], Path).

dfs([State|States], [Move|Moves], Path) :-
   move(State, Next, Move),
   not(memberchk(Next, [State|States])),
   dfs([Next,State|States], Moves, Path).

show([], _).
show([Move|Moves], [State|States]) :-
   State = state(A,B,C,D,E,F,G,H,I),
   format('~n~w~n~n', [Move]),
   format('~w ~w ~w~n',[A,B,C]),
   format('~w ~w ~w~n',[D,E,F]),
   format('~w ~w ~w~n',[G,H,I]),
   show(Moves, States).

% Empty position is marked with '*'

start( state(6,1,3,4,*,5,7,2,0) ).

goal( state(*,0,1,2,3,4,5,6,7) ).

move( state(*,B,C,D,E,F,G,H,J), state(B,*,C,D,E,F,G,H,J), right).
move( state(*,B,C,D,E,F,G,H,J), state(D,B,C,*,E,F,G,H,J), down ).
move( state(A,*,C,D,E,F,G,H,J), state(*,A,C,D,E,F,G,H,J), left ).
move( state(A,*,C,D,E,F,G,H,J), state(A,C,*,D,E,F,G,H,J), right).
move( state(A,*,C,D,E,F,G,H,J), state(A,E,C,D,*,F,G,H,J), down ).
move( state(A,B,*,D,E,F,G,H,J), state(A,*,B,D,E,F,G,H,J), left ).
move( state(A,B,*,D,E,F,G,H,J), state(A,B,F,D,E,*,G,H,J), down ).
move( state(A,B,C,*,E,F,G,H,J), state(*,B,C,A,E,F,G,H,J), up   ).
move( state(A,B,C,*,E,F,G,H,J), state(A,B,C,E,*,F,G,H,J), right).
move( state(A,B,C,*,E,F,G,H,J), state(A,B,C,G,E,F,*,H,J), down ).
move( state(A,B,C,D,*,F,G,H,J), state(A,*,C,D,B,F,G,H,J), up   ).
move( state(A,B,C,D,*,F,G,H,J), state(A,B,C,D,F,*,G,H,J), right).
move( state(A,B,C,D,*,F,G,H,J), state(A,B,C,D,H,F,G,*,J), down ).
move( state(A,B,C,D,*,F,G,H,J), state(A,B,C,*,D,F,G,H,J), left ).
move( state(A,B,C,D,E,*,G,H,J), state(A,B,*,D,E,C,G,H,J), up   ).
move( state(A,B,C,D,E,*,G,H,J), state(A,B,C,D,*,E,G,H,J), left ).
move( state(A,B,C,D,E,*,G,H,J), state(A,B,C,D,E,J,G,H,*), down ).
move( state(A,B,C,D,E,F,*,H,J), state(A,B,C,D,E,F,H,*,J), left ).
move( state(A,B,C,D,E,F,*,H,J), state(A,B,C,*,E,F,D,H,J), up   ).
move( state(A,B,C,D,E,F,G,*,J), state(A,B,C,D,E,F,*,G,J), left ).
move( state(A,B,C,D,E,F,G,*,J), state(A,B,C,D,*,F,G,E,J), up   ).
move( state(A,B,C,D,E,F,G,*,J), state(A,B,C,D,E,F,G,J,*), right).
move( state(A,B,C,D,E,F,G,H,*), state(A,B,C,D,E,*,G,H,F), up   ).
move( state(A,B,C,D,E,F,G,H,*), state(A,B,C,D,E,F,G,*,H), left ).

Running example:

?- time(ids).

start

6 1 3
4 * 5
7 2 0

left

6 1 3
* 4 5
7 2 0

up

* 1 3
6 4 5
7 2 0

right

1 * 3
6 4 5
7 2 0

down

1 4 3
6 * 5
7 2 0

right

1 4 3
6 5 *
7 2 0

down

1 4 3
6 5 0
7 2 *

left

1 4 3
6 5 0
7 * 2

left

1 4 3
6 5 0
* 7 2

up

1 4 3
* 5 0
6 7 2

right

1 4 3
5 * 0
6 7 2

right

1 4 3
5 0 *
6 7 2

down

1 4 3
5 0 2
6 7 *

left

1 4 3
5 0 2
6 * 7

left

1 4 3
5 0 2
* 6 7

up

1 4 3
* 0 2
5 6 7

right

1 4 3
0 * 2
5 6 7

right

1 4 3
0 2 *
5 6 7

up

1 4 *
0 2 3
5 6 7

left

1 * 4
0 2 3
5 6 7

left

* 1 4
0 2 3
5 6 7

down

0 1 4
* 2 3
5 6 7

right

0 1 4
2 * 3
5 6 7

right

0 1 4
2 3 *
5 6 7

up

0 1 *
2 3 4
5 6 7

left

0 * 1
2 3 4
5 6 7

left

* 0 1
2 3 4
5 6 7

moves = 26
% 97,719,612 inferences, 40.344 CPU in 40.991 seconds (98% CPU, 2422175 Lips)
true.