program Puzzle15;
uses crt;
type Field=array[1..4,1..4] of byte;
     Fl=array[1..16] of byte;
const Def:FIELD=(( 1, 2, 3, 4),
                 ( 5, 6, 7, 8),
                 ( 9,10,11,12),
                 (13,14,15, 0));
      arr:array[1..9] of char=('Ù','','À',
                               '','°',chr(26),
                               '¿','','Ú');
      dirs:array[1..9,1..2] of byte=
      ( (2,4), (2,0), (2,6),
        (4,0), (0,0), (6,0),
        (4,8), (8,0), (6,8));
var i,j,n:integer;
    f,ff:text;
    ss:string;
    p,s,goal,g:field;
    ww:fl;
    c:char;
    lm,dx,nd,gx:integer;
    nt,ns:integer;
    sol,t:array[1..1000] of byte;
const up=2;down=8;left=4;right=6;

function cmp(a,b:field):boolean;
var i:byte;
begin
 cmp:=false;
 for i:=1 to 16 do if fl(a)[i]<>fl(b)[i] then Exit;
 cmp:=true;
end;

procedure Solve(k:byte);
begin
if nt>ns then Exit;
fl(s)[dx]:=fl(s)[k];
fl(s)[k]:=0;
dx:=k;
if (k=gx) and (nt<ns) aND cmp(goal,s)  then
begin
 ns:=nt;
 sol:=t;
end else
begin
inc(nt);
write(nt,#13);
t[nt]:=up;
if t[nt-1]<>down then
if dx>4 then Solve(dx-4);
t[nt]:=down;
if t[nt-1]<>up then
if dx<13 then Solve(dx+4);
t[nt]:=left;
if t[nt-1]<>Right then
if dx mod 4<>1 then Solve(dx-1);
t[nt]:=right;
if t[nt-1]<>left then
if dx mod 4<>0 then Solve(dx+1);
dec(nt);
end;
case t[nt] of
 up:dx:=dx+4;
 down:dx:=dx-4;
 left:dx:=dx+1;
 right:dx:=dx-1;
end;
fl(s)[k]:=fl(s)[dx];
fl(s)[dx]:=0;
end;


function Sgn(i:integer):integer;
begin
 if i=0 then sgn:=0 else
 if i>0 then sgn:=1 else sgn:=-1;
end;

procedure Show(f:field;c:integer);
var i,j:integer;
begin
 for i:=1 to 4 do
 begin
  GotoXY(c,i+5);
  for j:=1 to 4 do
   if f[i,j]<>0 then write(f[i,j]:3) else write('   ');
 end;
end;

procedure Show2(f:field;c:integer);
var i,j:integer;
begin
 for i:=1 to 4 do
 begin
  GotoXY(c,i+5);
  for j:=1 to 4 do
   if s[i,j]<>0 then write(arr[10-f[i,j]],' ') else write('* ');
 end;
end;

procedure Calc;
var i,j,k,d:integer;
begin
 for i:=1 to 16 do
   if fl(s)[i]<>0 then
   begin
    k:=fl(g)[ fl(s)[i] ];
    d:=5+sgn(((k-1) mod 4)-((i-1) mod 4));
    d:=d+3*sgn((k-1) div 4 - (i-1) div 4);
    fl(p)[i]:=d;
   end;
end;

procedure Way;
var  w,b:fl;
     i,j,d,g,bg,bd,dir:integer;

 procedure Find(k:byte);
 var gu:shortint;
 begin
 if (w[k]<>99) and (k<>gx) then Exit;
 if (d in [2]) and (lm=k) then Exit;
 if d<>1 then w[k]:=d;
 if (dir=dirs[ fl(p)[k],1]) or
     (dir=dirs[ fl(p)[k],2]) then gu:=3 else gu:=-1;
 g:=g+gu;
 if (k=gx) and (d>2) then
  begin
   if ((g>bg) or ((g=bg) and (d<bd))) and (d>4) then
   begin
    bg:=g;
    b:=w;
    bd:=d;
   end;
   w[k]:=99;
   g:=g-gu;
   Exit;
  end;
  inc(d);
  dir:=8;
  if k>4 then Find(k-4);
  dir:=2;
  if k<13 then Find(k+4);
  dir:=6;
  if k mod 4<>1 then Find(k-1);
  dir:=4;
  if k mod 4<>0 then Find(k+1);
  w[k]:=99;
  g:=g-gu;
  DEC(D);
 end;


begin
 for i:=1 to 16 do w[i]:=99;
 for i:=1 to 16 do B[i]:=099;
 g:=0;
 bg:=-100;
 bd:=0;
 d:=1;
 dir:=100;
 Find(dx);
 Show(field(b),40);
 writeln;
 write(bg,'    ');
 ww:=b;
end;

procedure Go(k:integer);
begin
 fl(s)[dx]:=fl(s)[k];
 fl(s)[k]:=0;
 dx:=k;
 Show(s,2);
 delay(200);
end;

function Diff:byte;
var i,sm:byte;
begin
 sm:=0;
 for i:=1 to 16 do if fl(s)[i]<>fl(goal)[i] then inc(sm);
 diff:=sm;
end;


procedure SolveIt;
begin
repeat
 Calc;
 Way;
 n:=2;
 repeat
 for i:=1 to 16 do if ww[i]=n then Break;
 Go(i);
 inc(n);
 until i=gx;
until diff<3;
 ns:=20;
 nt:=4;
 t[1]:=0;t[2]:=0;t[3]:=0;
 Solve(dx);
 writeln;
 writeln(ns);
 for i:=4 to ns do
  case sol[i] of
   up:go(dx+4);
   down:go(dx-4);
   left:go(dx-1);
   right:go(dx+1);
  end;
 Halt;
end;

begin
 s:=def;
 goal:=def;
 if (ParamSTR(1)<>'-solve') and (ParamSTR(1)<>'-show') then
 begin
  Assign(f,ParamSTR(1));
  Assign(ff,'d');
  rewrite(ff);
  reset(f);
  for i:=1 to 4 do
  begin
   readln(f,ss);
   for j:=1 to length(ss) do if ss[i]='X' then ss[i]:='0';
   writeln(ff,ss);
  end;
  Close(ff);Close(f);Reset(ff);
  for i:=1 to 4 do readln(ff,s[i,1],s[i,2],s[i,3],s[i,4]);
  Close(ff);
 end;
 if diff mod 2=0 then
  writeln('NO ANSWER!') else writeln('SOLUTION EXISTS!');
 ReadKey;
 lm:=0;
 ClrScr;
 {make G}
 for i:=1 to 16 do
  if fl(goal)[i]<>0 then
  fl(g)[ fl(goal)[i] ]:=i;
 dx:=16;
 gx:=16;
repeat
 Show(s,2);
 Calc;
 Show2(p,20);
 c:=ReadKey;
 nd:=dx;
 case c of
  '8':if dx>4 then nd:=dx-4;
  '2':if dx<13 then nd:=dx+4;
  '4':if dx mod 4<>1 then nd:=dx-1;
  '6':if dx mod 4<>0 then nd:=dx+1;
  ' ':SolveIt;

  's':begin
       ns:=20;
       nt:=3;
       t[1]:=0;t[2]:=0;t[3]:=0;
       Solve(dx);
       writeln;
       writeln(ns);
      end;
 end;
 lm:=0;
 if c=' ' then
 begin
  for i:=1 to 16 do if ww[i]=n then Break;
  nd:=i;
  inc(n);
  if nd<>dx then
 lm:=dx;
 end;
 fl(s)[dx]:=fl(s)[nd];
 fl(s)[nd]:=0;
 dx:=nd;
 if c<>' ' then begin
                   Way;n:=2;
                  end;
until c=#27;
end.