8-puzzle has a solution in prolog using manhattan distance

Question

The 8-puzzle will be represented by a 3x3 list of lists positions where the empty box will be represented by the value 9, as shown below: [[9,1,3],[5,2,6],[4,7,8]]

Possibility Solution: Only half of the initial positions of the 8-puzzle are solvable. There is a formula that allows to know from the beginning if you can solve the puzzle.To determine whether an 8-puzzle is solvable, for each square containing a value N is calculated how many numbers less than N there after the current cell. For example, to the initial status:

• 1 no numbers less then = 0
• Empty (9) - has to subsequently 3,5,2,6,4,7,8 = 7
• 3 have = 1 to 2
• 5 has subsequently to 2,4 = 2
• 2 no number under it happen = 0
• 6 is subsequently 4 = 1
• 4 no numbers less then = 0
• 7 no minor numbers after = 0
• 8 no numbers less then = 0

After that, we calculate the Manhattan distance between the position of the empty and position (3.3). For the above example, the empty box is in the position (1.2), so Manhattan distance that is: d = abs (3-1) + abs (3-2) = 3 Finally, add up all the calculated values​​. If the result is even, implies that the puzzle is solvable, but it is odd not be resolved. 0 +7 +1 +2 +0 +1 +0 +0 +0 +3 = 14

The solution is designed to create a knowledge base with all possible states of a number on the board and we'll see how many numbers less than N there after the current position.

Here's my code:

%***********************Have Solution*********************************

posA(9,8). posA(8,7). posA(7,6). posA(6,5). posA(5,4). posA(4,3). posA(3,2). posA(2,1). posA(1,0).

posB(9,7). posB(8,7). posB(8,6). posB(7,6). posB(7,5). posB(7,4). 
posB(6,5). posB(6,4). posB(6,3). posB(6,2). posB(5,4). posB(5,3). posB(5,2). posB(5,1).  posB(5,0). 
posB(4,3). posB(4,2). posB(3,2). posB(3,1).  posB(2,1). posB(2,0). posB(1,0).

posC(9,6). posC(8,6). posC(8,5). posC(7,6). posC(7,5). posC(7,4). posC(6,5). posC(6,4). posC(6,3).
posC(5,4). posC(5,3). posC(5,2). posC(4,3). posC(4,2). posC(4,1). posC(4,0).
posC(3,2). posC(3,1). posC(3,0). posC(2,1). posC(1,0).

posD(9,5). posD(8,5). posD(8,4). posD(7,5). posD(7,4). posD(7,3). posD(6,5). posD(6,4). posD(6,3).
posD(6,2). posD(5,4). posD(5,3). posD(5,2). posD(5,1). posD(4,3). posD(4,2). posD(4,1). posD(5,0).
posD(3,2). posD(3,1). posD(3,0). posD(2,1). posD(1,0).

posE(9,4). posE(8,4). posE(8,3). posE(7,4). posE(7,3). posE(7,2). posE(6,4). posE(6,3). posE(6,2). posE(6,1).
posE(5,4). posE(5,3). posE(5,2). posE(5,1). posE(5,0). posE(4,3). posE(4,2). posE(4,1). posE(4,0).
posE(3,2). posE(3,1). posE(3,0). posE(2,1). posE(2,0). posE(1,0).

posF(9,3). posF(8,3). posF(8,2). posF(7,1). posF(7,2). posF(7,3). posF(6,0). posF(6,1). posF(6,2). 
posF(6,3). posF(5,0). posF(5,1). posF(5,2). posF(5,3). posF(4,0). posF(4,1). posF(4,2). posF(4,3).
posF(2,0). posF(2,1). posF(3,0). posF(3,1). posF(3,2). posF(1,0).

posG(9,2). posG(8,0). posG(8,1). posG(8,2).  posG(7,0). posG(7,1). posG(7,2).
posG(6,0). posG(6,1). posG(6,2). posG(5,0).  posG(5,1). posG(5,2). posG(4,0). posG(4,1). posG(4,2).
posG(3,0). posG(3,1). posG(3,2). posG(2,0).  posG(2,1). posG(1,0).

posH(9,1). posH(8,0). posH(8,1). posH(7,0). posH(7,1). posH(6,0). posH(6,1). posH(5,0). posH(5,1). 
posH(4,0). posH(4,1). posH(3,0). posH(3,1). posH(2,0). posH(1,1). posH(1,0).

posI(9,0). posI(8,0). posI(7,0). posI(6,0). posI(5,0). posI(4,0). posI(3,0). posI(2,0). posI(1,0).  

haveSolution([[A,B,C],[D,E,F],[G,H,I]]):- distManhattan([A,B,C,D,E,F,G,H,I], Z),
                                         posA(A,Pa), posB(B,Pb), posC(C,Pc),
                                         posD(D,Pd), posE(E,Pe), posF(F,Pf),
                                         posG(G,Pg), posH(H,Ph), posI(I,Pi),
                                         P is Pa+Pb+Pc+Pd+Pe+Pf+Pg+Ph+Pg+Pi+Z, 0 is P mod 2,
                                         write('The 8-puzzle have solution').

%%*************************Manhattan distance***********************
distManhattan([A,B,C,D,E,F,G,H,I], Dist):-  A=9, Dist is abs(3-1)+abs(3-1), !;
                                            B=9, Dist is abs(3-1)+abs(3-2), !;
                                            C=9, Dist is abs(3-1)+abs(3-3), !;
                                            D=9, Dist is abs(3-2)+abs(3-1), !;
                                            E=9, Dist is abs(3-2)+abs(3-2), !;
                                            F=9, Dist is abs(3-2)+abs(3-3), !;
                                            G=9, Dist is abs(3-3)+abs(3-1), !;
                                            H=9, Dist is abs(3-3)+abs(3-2), !;
                                            I=9, Dist is abs(3-3)+abs(3-3).

The problem is that I am making a mistake because there are situations where I can have more than one alternative, eg>:

|  1 |  9 | 3  |
|  5 |  2 | 6  |
|  4 |  7 | 8  |    


posA(1,0)+posB(9,7)+posC(3,1)+posD(5,2)+posE(2,0)+posF(6,1)+posG(4,0)+posH(7,0)+posI(8,0).

The right solution for posC(C,Pc) is posC(3,1), that is 1; but there are other ramifications that sometimes cause incorrect outputs ... what am I doing wrong in my code and how I can change it?

Granddaughter

I can't (no more) answer... here a solver puzzle(1, board(1,9,3, 5,2,6, 4,7,8)). eight_puzzle(Num) :- puzzle(Num, Board), solve(Board, []). solve(board(1,2,3,4,5,6,7,8,9), Steps) :- maplist(writeln, Steps). solve(Board, Steps) :- appy_move(Board, Move), \+ memberchk(Move, Steps), solve(Board, [Move|Steps]). appy_move(Board, P-Q) :- arg(P, Board, 9), % P is the empty cell C is (P - 1) mod 3 + 1, ( P > 3, Q is P - 3 ; P < 7, Q is P + 3 ; C > 1, Q is P - 1 ; C < 3, Q is P + 1 ), arg(Q, Board, N), setarg(P, Board, N), setarg(Q, Board, 9). Was funny to code... – Precursory

@Precursory your code doesn't work for board(8,7,4,6,9,5,3,2,1) which is solved by 5-6, 6-9, 9-8, 8-7, 7-4, 4-1, 1-2, 2-3 ... – Christenachristendom

For the question here is the code that give the value of V (0 or 1) : haveSolution(In, V):- flatten(In, L), foldl(\X^Y^Z^(compute_1(X, L, CX), Z is Y+CX), L, 0, R), distManhattan(L, DM), V is (DM+R) mod 2. compute_1(X, [X], 0) :- !. compute_1(X, [X|R], V) :- !, compute_2(X, R, 0, V). compute_1(X, [_X|R], V) :- compute_1(X, R, V). compute_2(_X, [], V, V). compute_2(X, [H | T], VC, V) :- ( X > H -> VC1 is VC+1; VC1 = VC), compute_2(X, T, VC1, V). distManhattan(L, Dist) :- nth0(Ind, L, 9), Lig is Ind // 3 + 1, Col is Ind mod 3 + 1, Dist is 6 - Lig - Col. – Christenachristendom

@joel76: do you mind to post the entire sequence? Steps you posted are ok, but I'd like to find the bug, and isn't really easy (it run more than 30M inferences before failing...) – Precursory

The entire sequence is (hope there is no typo !) : 5-6, 6-9, 9-8, 8-7, 7-4, 4-1, 1-2, 2-3, 3-6, 6-9, 9-8, 8-7, 7-4, 4-1, 1-2, 2-3, 3-6, 6-9, 9-8, 8-7, 7-4, 4-1, 1-2, 2-3, 3-6, 6-9. Empty case turns around the board in "clock-wise" (sorry for my poor english !). – Christenachristendom

@joel76: thanks! but are you doing by hand? my solver find the first sequence matching what you previously posted from 'step number' 1206069 (I've stored all steps and sequences to analyze the problem...) – Precursory

Yes, it's by hand. I will try to understand your approach. – Christenachristendom

@Capellic you can't find the solution because you have \+ memberchk(Move, Steps), in your code and in my solution there are for example 6-9 4 times, (but you can avoid move P-Q and next Q-P which leads to no move). – Christenachristendom

@joel76: Yes, I found the bug. Thanks again! It's a pity the question has been deleted, I'll add to your reputation at next chance. – Precursory

I've changed the solver to solve the bug pointed out by joel: ` solve(Board, SoFar, Boards) :- appy_move(Board), signature(Board, Sig), \+ memberchk(Sig, SoFar), solve(Board, [Sig|SoFar], Boards). appy_move(Board) :- arg(P, Board, 9), % P is the empty cell C is (P - 1) mod 3 + 1, ( P < 7, Q is P + 3 ; C < 3, Q is P + 1 ; P > 3, Q is P - 3 ; C > 1, Q is P - 1 ), arg(Q, Board, N), setarg(P, Board, N), setarg(Q, Board, 9). signature(board(A,B,C,D,E,F,G,H,I), Sig) :- Sig is A*100000000+ B*10000000+ C*1000000+ D*100000+ E*10000+ F*1000+ G*100+ H*10+ I. ` – Precursory

@Precursory the question has been reopened, you can post your answer. :) – Gregorio

Answer 1

This answer looks at the problem from a different point of view:

• Single board configurations are represented using the compound structure board/9.
• Configurations that are equal up to sliding a single piece are connected by relation m/2.

So let's define m/2!

m(board(' ',B,C,D,E,F,G,H,I), board(D, B ,C,' ',E,F,G,H,I)).
m(board(' ',B,C,D,E,F,G,H,I), board(B,' ',C, D ,E,F,G,H,I)).

---

m(board(A,' ',C,D,E,F,G,H,I), board(' ',A, C , D, E ,F,G,H,I)).
m(board(A,' ',C,D,E,F,G,H,I), board( A ,C,' ', D, E ,F,G,H,I)).
m(board(A,' ',C,D,E,F,G,H,I), board( A ,E, C , D,' ',F,G,H,I)).

---

m(board(A,B,' ',D,E,F,G,H,I), board(A,' ',B,D,E, F ,G,H,I)).
m(board(A,B,' ',D,E,F,G,H,I), board(A, B ,F,D,E,' ',G,H,I)).

---

m(board(A,B,C,' ',E,F,G,H,I), board(' ',B,C,A, E ,F, G ,H,I)).
m(board(A,B,C,' ',E,F,G,H,I), board( A ,B,C,E,' ',F, G ,H,I)).
m(board(A,B,C,' ',E,F,G,H,I), board( A ,B,C,G, E ,F,' ',H,I)).

---

m(board(A,B,C,D,' ',F,G,H,I), board(A, B ,C,' ',D, F ,G, H ,I)).
m(board(A,B,C,D,' ',F,G,H,I), board(A,' ',C, D ,B, F ,G, H ,I)).
m(board(A,B,C,D,' ',F,G,H,I), board(A, B ,C, D ,F,' ',G, H ,I)).
m(board(A,B,C,D,' ',F,G,H,I), board(A, B ,C, D ,H, F ,G,' ',I)).

---

m(board(A,B,C,D,E,' ',G,H,I), board(A,B,' ',D, E ,C,G,H, I )).
m(board(A,B,C,D,E,' ',G,H,I), board(A,B, C ,D,' ',E,G,H, I )).
m(board(A,B,C,D,E,' ',G,H,I), board(A,B, C ,D, E ,I,G,H,' ')).

---

m(board(A,B,C,D,E,F,' ',H,I), board(A,B,C,' ',E,F,D, H ,I)).
m(board(A,B,C,D,E,F,' ',H,I), board(A,B,C, D ,E,F,H,' ',I)).

---

m(board(A,B,C,D,E,F,G,' ',I), board(A,B,C,D,' ',F, G ,E, I )).
m(board(A,B,C,D,E,F,G,' ',I), board(A,B,C,D, E ,F,' ',G, I )).
m(board(A,B,C,D,E,F,G,' ',I), board(A,B,C,D, E ,F,  G,I,' ')).

---

m(board(A,B,C,D,E,F,G,H,' '), board(A,B,C,D,E,' ',G, H ,F)).
m(board(A,B,C,D,E,F,G,H,' '), board(A,B,C,D,E, F ,G,' ',H)).

---

Almost done! To connect the steps, we use the meta-predicate path/4 together with length/2 for performing iterative deepening.

The following problem instances are from @CapelliC's answer:

?- length(Path,N), path(m,Path,/* from */ board(1,' ',3,5,2,6,4,7, 8 ),
                               /*  to  */ board(1, 2 ,3,4,5,6,7,8,' ')).
N =  6, Path = [board(1,' ',3,5,2,6,4,7,8), board(1,2,3,5,' ',6,4,7,8),
                board(1,2,3,' ',5,6,4,7,8), board(1,2,3,4,5,6,' ',7,8),
                board(1,2,3,4,5,6,7,' ',8), board(1,2,3,4,5,6,7,8,' ')] ? ;
N = 12, Path = [board(1,' ',3,5,2,6,4,7,8), board(1,2,3,5,' ',6,4,7,8),
                board(1,2,3,5,7,6,4,' ',8), board(1,2,3,5,7,6,' ',4,8),
                board(1,2,3,' ',7,6,5,4,8), board(1,2,3,7,' ',6,5,4,8),
                board(1,2,3,7,4,6,5,' ',8), board(1,2,3,7,4,6,' ',5,8),
                board(1,2,3,' ',4,6,7,5,8), board(1,2,3,4,' ',6,7,5,8),
                board(1,2,3,4,5,6,7,' ',8), board(1,2,3,4,5,6,7,8,' ')] ? ;
...

?- length(Path,N), path(m,Path,/* from */ board(8,7,4,6,' ',5,3,2, 1 ),
                               /*  to  */ board(1,2,3,4, 5 ,6,7,8,' ')).
N = 27, Path = [board(8,7,4,6,' ',5,3,2,1), board(8,7,4,6,5,' ',3,2,1),
                board(8,7,4,6,5,1,3,2,' '), board(8,7,4,6,5,1,3,' ',2),
                board(8,7,4,6,5,1,' ',3,2), board(8,7,4,' ',5,1,6,3,2),
                board(' ',7,4,8,5,1,6,3,2), board(7,' ',4,8,5,1,6,3,2),
                board(7,4,' ',8,5,1,6,3,2), board(7,4,1,8,5,' ',6,3,2),
                board(7,4,1,8,5,2,6,3,' '), board(7,4,1,8,5,2,6,' ',3),
                board(7,4,1,8,5,2,' ',6,3), board(7,4,1,' ',5,2,8,6,3),
                board(' ',4,1,7,5,2,8,6,3), board(4,' ',1,7,5,2,8,6,3),
                board(4,1,' ',7,5,2,8,6,3), board(4,1,2,7,5,' ',8,6,3),
                board(4,1,2,7,5,3,8,6,' '), board(4,1,2,7,5,3,8,' ',6),
                board(4,1,2,7,5,3,' ',8,6), board(4,1,2,' ',5,3,7,8,6),
                board(' ',1,2,4,5,3,7,8,6), board(1,' ',2,4,5,3,7,8,6),
                board(1,2,' ',4,5,3,7,8,6), board(1,2,3,4,5,' ',7,8,6),
                board(1,2,3,4,5,6,7,8,' ')] ? ;
N = 29, Path = [...] ? ;
...

Starspangled

Answer 2

Here is a solver, not an answer to the original question. Joel76 already addressed the problem in comments, and thus he will get the deserved reputation when he will answer.

But the 8-puzzle was interesting to solve, and pose some efficiency problem. Here is my best effort, where I used library(nb_set) in attempt to achieve reasonable efficiency on full solutions enumeration.

Note: nb_set is required to keep track of visited also on failed paths. The alternative is a :- dynamic visited/1. but that turned out to be too much slow.

/*  File:    8-puzzle.pl
    Author:  Carlo,,,
    Created: Feb  4 2013
    Purpose: solve 8-puzzle
*/

:- module(eight_puzzle,
      [eight_puzzle/3
      ]).

:- use_module(library(nb_set)).

% test cases from Stack Overflow thread with Joel76
test0(R) :- eight_puzzle([1,2,3,4,5,6,7,8,0], [1,0,3, 5,2,6, 4,7,8], R).
test1(R) :- eight_puzzle([1,2,3,4,5,6,7,8,0], [8,7,4, 6,0,5, 3,2,1], R).

%%  eight_puzzle(+Target, +Start, -Moves) is ndet
%
%   public interface to solver
%
eight_puzzle(Target, Start, Moves) :-
    empty_nb_set(E),
    eight_p(E, Target, Start, Moves).

%%  -- private here --

eight_p(_, Target, Target, []) :-
    !.
eight_p(S, Target, Current, [Move|Ms]) :-
    add_to_seen(S, Current),
    setof(Dist-M-Update,
          (  get_move(Current, P, M),
         apply_move(Current, P, M, Update),
         distance(Target, Update, Dist)
          ), Moves),
    member(_-Move-U, Moves),
    eight_p(S, Target, U, Ms).

%%  get_move(+Board, +P, -Q) is semidet
%
%   based only on coords, get next empty cell
%
get_move(Board, P, Q) :-
    nth0(P, Board, 0),
    coord(P, R, C),
    (   R < 2, Q is P + 3
    ;   R > 0, Q is P - 3
    ;   C < 2, Q is P + 1
    ;   C > 0, Q is P - 1
    ).

%%  apply_move(+Current, +P, +M, -Update)
%
%   swap elements at position P and M
%
apply_move(Current, P, M, Update) :-
    assertion(nth0(P, Current, 0)), % constrain to this application usage
    ( P > M -> (F,S) = (M,P) ; (F,S) = (P,M) ),
    nth0(S, Current, Sv, A),
    nth0(F, A, Fv, B),
    nth0(F, C, Sv, B),
    nth0(S, Update, Fv, C).

%%  coord(+P, -R, -C)
%
%   from linear index to row, col
%   size fixed to 3*3
%
coord(P, R, C) :-
    R is P // 3,
    C is P mod 3.

%%  distance(+Current, +Target, -Dist)
%
%   compute Manatthan distance between equals values
%
distance(Current, Target, Dist) :-
    aggregate_all(sum(D),
              (   nth0(P, Current, N), coord(P, Rp, Cp),
              nth0(Q, Target, N), coord(Q, Rq, Cq),
              D is abs(Rp - Rq) + abs(Cp - Cq)
              ), Dist).

%%  add_to_seen(+S, +Current)
%
%   fail if already in, else store
%
add_to_seen(S, [A,B,C,D,E,F,G,H,I]) :-
    Sig is
    A*100000000+
    B*10000000+
    C*1000000+
    D*100000+
    E*10000+
    F*1000+
    G*100+
    H*10+
    I,
    add_nb_set(Sig, S, true)

Test case that Joel76 posed to show the bug in my first effort:

?- time(eight_puzzle:test1(R)).
% 25,791 inferences, 0,012 CPU in 0,012 seconds (100% CPU, 2137659 Lips)
R = [5, 8, 7, 6, 3, 0, 1, 2, 5|...] ;
% 108,017 inferences, 0,055 CPU in 0,055 seconds (100% CPU, 1967037 Lips)
R = [5, 8, 7, 6, 3, 0, 1, 2, 5|...] ;
% 187,817,057 inferences, 93,761 CPU in 93,867 seconds (100% CPU, 2003139 Lips)
false.

Precursory