program liu;
const
a:array[1..3,1..2] of byte=(1,5,2,4,3,0);
tru:array[1..3,1..2] of byte =(1,4,2,5,3,0);
type
arr:array[1..3,1..2] of byte;
var
s:array[1..124] of string;
c,x,y:byte;
lu:string;
lum:integer;
procedure try(b:arr;n,m:byte );
var
x1,z,y1,i,j,k:byte;
a1:arr;
lu1:string;
begin
for j:=1 to 3 do
for k:=1 to 2 do if
b[j,k]<>tru[j,k] then break
else if (j=3) and (k=2)
then writeln('ok');
for i:=1 to 4 do
begin
fillchar(lu1,sizeof(lu1),0);
for j:=1 to 3 do
for k:=1 to 2 do a1[j,k]:=b[j,k];
x1:=n;y1:=m;
case i of
1:if (m-1>0) then y1:=m-1;
2:if (m+1<=2) then y1:=m+1;
3:if (n-1>0) then x1:=n-1;
4:if (n+1<=3) then x1:=n+1;
end;
if (x1<>x) or (y1<>y) then
begin
z:=a1[n,m]; a1[n,m]:=a1[x1,y1]; a[x1,y1]:=z;
for j:=1 to 3 do
for k:=1 to 2 do lu1:=lu1+'a1[j,k]';
for j:=lum down to 1 do if if lu1=s[j] then
break
else
begin
inc(lum);
s[lum]:=lu1;
try(a1,x1,y1);
end;
end;
end;
begin
lum:=1;
s[lum]:=a;
try(a,3,2);
end.
