@kuniaki.mukai wrote:

Here is an old codes of mine for solving n-puzzle, which is still

in the directory util of pack library pac. The codes produces long

redundant series of basic moves for even parity permutations,

and I have still no idea on how to find minimum (minimal ?) solutions.

I have checked that the codes, which

was written 30 years ago, still works for cgi.

```
:- module(npuzzle,[]).
% N-puzzle program K. Mukai SFC Keio
% 1995.6.26 20:22
%
% unsolvable case
% | ?- npuzzle([[15,14,13,12],[11,10,9,8],[7,6,5,4],[3,2,1,0]],X).
%
% solvable case
% | ?- npuzzle([[14,15,13,12],[11,10,9,8],[7,6,5,4],[3,2,1,0]],X).
% | ?- npuzzle([[24,23,22,21,20],[19,18,17,16,15],[14,13,12,11,10],
% [9,8,7,6,5],[4,3,2,1,0]],P).
% :- use_module(library(lists)).
non_member(X,Y):- member(X,Y),!,fail.
non_member(_,_).
% for generating benchmark tests
makepuzzle(N,X):-J is N*N-1, matrix(N,N,X),setnpuzzle(J,X).
matrix(1,N,[X]):-!,length(X,N).
matrix(K,N,[T|R]):- J is K-1, length(T,N), matrix(J,N,R).
setnpuzzle(_,[]):-!.
setnpuzzle(X,[[]|Y]):-!,setnpuzzle(X,Y).
setnpuzzle(X,[[X|Y]|Z]):-!,U is X-1, setnpuzzle(U,[Y|Z]).
test(N,X,L):-
makepuzzle(N,A),
npuzzle(A,P),
flatten(P,Pf),
length(Pf,L),
reverse2(A,[],Ar),
opposite(P,Po),
apply(Po,Ar,B),
reverse2(B,[],X).
% | ?- test(5,X,_).
%
% X = [[ 1, 2, 3, 4, 5],
% [ 6, 7, 8, 9,10],
% [11,12,13,14,15],
% [16,17,18,19,20],
% [21,22,23,24, 0]]
%
% main predicate
npuzzle_web(X, 'Result' = Y) :- npuzzle(X,Y).
npuzzle(X,Y):-
reverse2(X,[],Xr), % reverse rows and columns
makelinear(Xr,[_|Z]), % see as a list of integers
bubblesort(Z,_,G), % lists of switches (i,j)
length(G,N),
0 =:= N mod 2, % even permutation means being solvable.
!,
switch2cycle(G,L), % even permutaions to 3-cyclic permutaions.
cycle2path(L,Xr,_,Y1),
opposite(Y1,Y2),
flatten(Y2,Y). % left-right, up-down reverse
npuzzle(_,'unsolvable: odd permutation').
cycle2path([],X,X,[]).
cycle2path([X|Y],Z,U,[P,Q]):-
cycle(X,Z,Z1,P),
cycle2path(Y,Z1,U,Q).
makelinear([],[]).
makelinear([X|Y],Z):-
makelinear(Y,Z1),
append(X,Z1,Z).
bubblesort([],[],[]).
bubblesort([X|Y],Z,U):-
bubblesort(Y,V,W),
insert(X,V,Z,P),
append(W,P,U).
insert(X,[],[X],[]):-!.
insert(X,[Y|Z],[X,Y|Z],[]):-X>Y,!.
insert(X,[Y|Z],[Y|U],[[Y,X]|V]):-insert(X,Z,U,V).
% product of two 2-cyclic permutations is a product of
% 3-cyclic permutations.
makecyclic([X,Y],[Z,U],[]):-member(X,[Z,U]),member(Y,[Z,U]),!.
makecyclic([X,Y],[X,U],[[X,Y,U]]):-!.
makecyclic([X,Y],[U,X],[[X,Y,U]]):-!.
makecyclic([Y,X],[U,X],[[X,Y,U]]):-!.
makecyclic([Y,X],[X,U],[[X,Y,U]]):-!.
makecyclic([X,U],[Y,Z],[[X,Y,Z],[X,Y,U]]).
switch2cycle([],[]).
switch2cycle([X,Y|Z],U):-
makecyclic(X,Y,C),
switch2cycle(Z,U1),
append(C,U1,U).
cycle(A,[X,Y|Z],[X1,Y1|Z],P):-
contain(A,[X,Y]),!,
cycle2n(A,[X,Y],[X1,Y1],P).
cycle(A,X,Y,P):-
X=[[_,_]|_],!, % two columns matrix
zip(X,X1), % for reducing to two rows matrix.
cycle(A,X1,Y1,P1),
zip(Y1,Y),
zip_path(P1,P).
cycle(A,[[0|X],Y|Z],[R1,R2|Z2],[P,d,Q,u,Pi]):-
cleartop(A,[[0|X],Y],[[0|X1],[U|Y1]],P),
inverse(P,Pi),
cycle(A,[[0|Y1]|Z],[[0|Y2]|Z2],Q),
apply([u,Pi],[[U|X1],[0|Y2]],[R1,R2]).
cleartop(A,[[0,X|R],[Z,U|S]|W],[R1,R2|W],[P,Q]):-
cleartop1(A,[[0,X],[Z,U]],[[0,X1],[Z1,U1]],P),
cleartop2(A,[[0,X1|R],[Z1,U1|S]],[R1,R2],Q).
cleartop1(A,[[0,X],[Z,U]],[[0,X],[Z,U]],[]):-non_member(Z,A),!.
cleartop1(A,[[0,X],[Z,U]],V,P):-non_member(X,A),!,
triple2path([Z,X,U],[[0,X],[Z,U]],V,P).
cleartop1(_,[[0,X],[Z,U]],V,P):-
triple2path([Z,U,X],[[0,X],[Z,U]],V,P).
cleartop2(A,[[0,X|R],[Y,Z|S]],D,[P,Q]):-
member(U,A),
member(U,[X|R]),!,
cleartop3(U,A,[[0,X|R],[Y,Z|S]],T,P),
cleartop2(A,T,D,Q).
cleartop2(_,X,X,[]).
cleartop3(N,A,[X,[Y,Z,U|S]],T,P):-member(Z,A),!,
cycle2n([Z,N,U],[X,[Y,Z,U|S]],T,P).
cleartop3(N,_,[X,[Y,Z,U|S]],T,P):-
cycle2n([N,Z,U],[X,[Y,Z,U|S]],T,P).
% | ?- cycle2n([1,2,3],[[0,1,4],[2,5,3]],X,P).
% P = [r,[[l,d,r,u],[[r,d,l,u],[[l,d,r,u],[]]]],[r,d,l,u],
% [[[[],[d,l,u,r]],[d,r,u,l]],[d,l,u,r]],l]
% X = [[0,2,4],[3,5,1]] ?
cycle2n([A,B,C],[[0,X|R],[Y,Z|S]],[[0,X1|R],[Y1,Z1|S]],Q):-
member(X,[A,B,C]),
member(Y,[A,B,C]),
member(Z,[A,B,C]),!,
triple2path([A,B,C],[[0,X],[Y,Z]],[[0,X1],[Y1,Z1]],Q).
cycle2n(P,[[0,X,U|R],[Y,Z,V|S]],
[[0,X3,U3|R2],[Y3,Z3,V3|S2]],
[r,H,G,Hi,l]):-
clearleft(P,[[X,0,U],[Y,Z,V]],[[X1,0,U1],[Y1,Z1,V1]],H),
inverse(H,Hi),
cycle2n(P,[[0,U1|R],[Z1,V1|S]],[[0,U2|R2],[Z2,V2|S2]],G),
apply(Hi,[[X1,0,U2],[Y1,Z2,V2]],[[X3,0,U3],[Y3,Z3,V3]]).
equalcycperm([A,B,C],[A,B,C]).
equalcycperm([B,C,A],[A,B,C]).
equalcycperm([C,A,B],[A,B,C]).
move1(r,[[0,X],Y],[[X,0],Y]).
move1(d,[[X,0],[Y,Z]],[[X,Z],[Y,0]]).
move1(l,[X,[Z,0]],[X,[0,Z]]).
move1(u,[[X,Y],[0,Z]],[[0,Y],[X,Z]]).
move1(r,[Y,[0,X]],[Y,[X,0]]).
move1(u,[[X,Y],[Z,0]],[[X,0],[Z,Y]]).
move1(l,[[X,0],Y],[[0,X],Y]).
move1(d,[[0,X],[Y,Z]],[[Y,X],[0,Z]]).
turn(Z,[[A,B|X1],[C,D|X2]|X],[[E,F|X1],[G,H|X2]|X]):-
turn1(Z,[[A,B],[C,D]],[[E,F],[G,H]]).
turn1([d,r,u,l],[[0,A],[B,C]],[[0,B],[C,A]]).
turn1([r,d,l,u],[[0,A],[B,C]],[[0,C],[A,B]]).
turn1([l,d,r,u],[[A,0],[B,C]],[[B,0],[C,A]]).
turn1([d,l,u,r],[[A,0],[B,C]],[[C,0],[A,B]]).
turn1([l,u,r,d],[[A,B],[C,0]],[[B,C],[A,0]]).
turn1([u,l,d,r],[[A,B],[C,0]],[[C,A],[B,0]]).
turn1([r,u,l,d],[[A,B],[0,C]],[[C,A],[0,B]]).
turn1([u,r,d,l],[[A,B],[0,C]],[[B,C],[0,A]]).
% | ?- apply([r,d,r,u],[[0,1,2],[3,4,5]],X).
% X = [[1,4,0],[3,5,2]] ?
apply(X,Y,Z):-apply(X,[],[],Y,M,N,U),restore(M,N,U,Z).
apply([],M,N,X,M,N,X).
apply([A,B,C,D|W],M,N,X,M1,N1,X1):-
turn([A,B,C,D],X,X2),!,
apply(W,M,N,X2,M1,N1,X1).
apply([A|W],M,N,X,M1,N1,X1):-!,
apply(A,M,N,X,M2,N2,X2),
apply(W,M2,N2,X2,M1,N1,X1).
apply(A,M,N,[[X,Y|R],[U,V|S]|T],M,N,[[X1,Y1|R],[U1,V1|S]|T]):-
move1(A,[[X,Y],[U,V]],[[X1,Y1],[U1,V1]]),!.
apply(u,M,[R|Rs],X,M1,N1,X1):-apply(u,M,Rs,[R|X],M1,N1,X1).
apply(d,M,N,[X|Y],M1,N1,X1):-apply(d,M,[X|N],Y,M1,N1,X1).
apply(l,[C|M],N,X,M1,N1,X1):-!,
revmulticons(C,N,N2,C2),
multicons(C2,X,X3),
apply(l,M,N2,X3,M1,N1,X1).
apply(r,M,N,X,M1,N1,X1):-
firstcolumn(N,Cn,N2),
firstcolumn(X,Cx,X2),
reverse(Cn,Cx,C),
apply(r,[C|M],N2,X2,M1,N1,X1).
triple2path(T,[[0,X],[Z,Y]],[[0,Y],[X,Z]],[r,d,l,u]):-
equalcycperm(T,[X,Y,Z]),!.
triple2path(T,[[Z,0],[Y,X]],[[X,0],[Z,Y]],[d,l,u,r]):-
equalcycperm(T,[X,Y,Z]),!.
triple2path(T,[[Y,Z],[X,0]],[[Z,X],[Y,0]],[l,u,r,d]):-
equalcycperm(T,[X,Y,Z]),!.
triple2path(T,[[X,Y],[0,Z]],[[Y,Z],[0,X]],[u,r,d,l]):-
equalcycperm(T,[X,Y,Z]),!.
triple2path(_,[[0,X],[Z,Y]],[[0,Z],[Y,X]],[d,r,u,l]):-!.
triple2path(_,[[Z,0],[Y,X]],[[Y,0],[X,Z]],[l,d,r,u]):-!.
triple2path(_,[[Y,Z],[X,0]],[[X,Y],[Z,0]],[u,l,d,r]):-!.
triple2path(_,[[X,Y],[0,Z]],[[Z,X],[0,Y]],[r,u,l,d]).
% | ?- clearleft([1,2,3],[[1,0,4],[2,5,3]],R,P).
% P = [[l,d,r,u],[[r,d,l,u],[[l,d,r,u],[]]]],
% R = [[5,0,3],[4,2,1]] ?
clearleft(C,[[X,0,Y],[Z,U,V]],[[X,0,Y],[Z,U,V]],[]):-
non_member(X,C),
non_member(Z,C),!.
clearleft(C,[[X,0,Y],[Z,U,V]],R,[P,Q]):-
member(U,C),!,
out(A,[Y,V],C),
remove(A,[Y,V],[B]),
triple2path([U,A,B],[[0,Y],[U,V]],[M,N],P),
clearleft(C,[[X|M],[Z|N]],R,Q).
clearleft(C,[[X,0,Y],[Z,U,V]],R,[P,Q]):-
member(X,C),!,
triple2path([U,X,Z],[[X,0],[Z,U]],[[X1,0],[Z1,U1]],P),
clearleft(C,[[X1,0,Y],[Z1,U1,V]],R,Q).
clearleft(C,[[X,0,Y],[Z,U,V]],R,[P,Q]):-
triple2path([U,Z,X],[[X,0],[Z,U]],[[X1,0],[Z1,U1]],P),
clearleft(C,[[X1,0,Y],[Z1,U1,V]],R,Q).
%
% member(X,[X|_]).
% member(X,[_|Y]):-member(X,Y).
%flatten(X,Y):-flatten(X,Y,[]).
%flatten([],X,X):-!.
%flatten(X,[X|Z],Z):-atomic(X),!.
%flatten([X|Y],Z,U):-flatten(X,Z,V),flatten(Y,V,U).
remove(_,[],[]).
remove(X,[X|Y],Y).
remove(X,[U|Y],[U|Z]):-X\==U,remove(X,Y,Z).
out(A,X,Y):-member(A,X),non_member(A,Y).
reverse([],X,X).
reverse([X|Y],Z,U):-reverse(Y,[X|Z],U).
reverse2([],X,X).
reverse2([X|Y],Z,U):-reverse(X,[],Xr), reverse2(Y,[Xr|Z],U).
restore(X,Y,Z,U):-reverse(Y,Z,Z1),restorecol(X,Z1,U).
restorecol([],X,X).
restorecol([X|Y],Z,U):-multicons(X,Z,Z1),restorecol(Y,Z1,U).
multicons([],[],[]).
multicons([X|Y],[Z|U],[[X|Z]|V]):-multicons(Y,U,V).
revmulticons(A,[],[],A).
revmulticons(A,[X|Y],[[D|X]|Y1],B):-revmulticons(A,Y,Y1,[D|B]).
contain([],_).
contain([X|Y],Z):-contain1(X,Z),contain(Y,Z).
contain1(X,[Y|_]):-member(X,Y),!.
contain1(X,[_|R]):-contain1(X,R).
firstcolumn([],[],[]).
firstcolumn([[X|X1]|R],[X|Y],[X1|S]):-firstcolumn(R,Y,S).
zip_path([],[]).
zip_path([X|Y],[Xt|Yt]):-
zip_path(X,Xt),
zip_path(Y,Yt).
zip_path(X,Y):-zip_path1(X,Y).
zip_path1(d,r).
zip_path1(r,d).
zip_path1(u,l).
zip_path1(l,u).
opposite(u,d).
opposite(d,u).
opposite(l,r).
opposite(r,l).
opposite([],[]).
opposite([X|Y],[Xo|Yo]):-opposite(X,Xo), opposite(Y,Yo).
inverse([],[]).
inverse(r,l).
inverse(l,r).
inverse(d,u).
inverse(u,d).
inverse([X|Y],Z):-inverse([X|Y],[],Z).
inverse([],X,X).
inverse([X|Y],Z,U):-inverse(X,Xi), inverse(Y,[Xi|Z],U).
```