{
StartNr:09
Switch:-solve
}
type desk=array[0..3,0..3] of shortint;
     pospoint=^position;
     position=record
                mat:desk;
                punct:word;
                mov:word;
                father:pospoint;
                next:pospoint;
                emptyx,emptyy:byte;
                moved:byte;
              end;
const direction:array[1..4] of string[10]=('RIGHT','LEFT','DOWN','UP');
var x,y,z,q:byte;
    startfname,endfname:string;
    startpos,tmpdesk,endpos:desk;
    transflst:array[1..16] of byte;
    f:text;
    error:boolean;
    errorcode:string;
    newposlist,tmpposlist,oldlistfirst,oldlistlast,bestpos:pospoint;
    best:word;
    parity,solve,show:boolean;
    empx,empy:byte;



function eval(var pos:desk):word;
var punct:word;
    x,y:byte;
begin
punct:=0;
for x:=0 to 3 do
  for y:=0 to 3 do
    if pos[x,y]<>0 then punct:=punct+sqr((pos[x,y]-1) mod 4-x)+sqr((pos[x,y]-1) div 4-y);
eval:=punct*5;
end;



function upcasestr(s:string):string;
var sup:string;
    x:byte;
begin
sup:='';
for x:=1 to length(s) do
  sup:=sup+upcase(s[x]);
upcasestr:=sup;
end;



procedure readparams;
begin
solve:=false;
show:=false;
endfname:='';
if paramcount=0 then begin
  error:=true;
  errorcode:='Wrong parameters!';
  end;
if paramcount=1 then startfname:=paramstr(1);
if paramcount=2 then
  begin
  if upcasestr(paramstr(1))='-SOLVE' then
    begin
    solve:=true;
    startfname:=paramstr(2);
    end;
  if upcasestr(paramstr(1))='-SHOW' then
    begin
    show:=true;
    startfname:=paramstr(2);
    end;
  if (upcasestr(paramstr(1))<>'-SOLVE') and (upcasestr(paramstr(1))<>'-SHOW') then
    begin
    startfname:=paramstr(1);
    endfname:=paramstr(2);
    end;
  end;
if paramcount=3 then
  begin
  if upcasestr(paramstr(1))='-SOLVE' then solve:=true;
  if upcasestr(paramstr(1))='-SHOW' then show:=true;
  if (upcasestr(paramstr(1))<>'-SOLVE') and (upcasestr(paramstr(1))<>'-SHOW') then
    begin
    error:=true;
    errorcode:='Wrong parameters!';
    end;
  startfname:=paramstr(2);
  endfname:=paramstr(3);
  end;
end;



procedure readpos(filename:string;var startpos:desk);
var x,y:byte;
    s:string;
    c:char;
    cod:integer;
begin
assign(f,filename);
reset(f);
for y:=0 to 3 do
  for x:=0 to 3 do
    begin
    c:=#32;
    while (ord(c) in [9,32,13,10]) and not eof(f) do
      read(f,c);
    s:='';
    while not(ord(c) in [9,32,13,10]) and not eof(f) do
      begin
      s:=s+c;
      read(f,c);
      end;
    val(s,startpos[x,y],cod);
    if (cod<>0) and (upcasestr(s)<>'X') then
      begin
      error:=true;
      errorcode:='Error reading file!';
      end;
    end;
close(f);
end;



function equal(var mat1,mat2:desk):boolean;
var x,y:byte;
begin
equal:=true;
for x:=0 to 3 do
  for y:=0 to 3 do
    if mat1[x,y]<>mat2[x,y] then equal:=false;
end;



procedure put(var pos:desk;father_:pospoint;movnr:word;ex,ey,moved_:byte);
var insertpos:pospoint;
    putin:boolean;
begin
new(tmpposlist);
with tmpposlist^ do
  begin
  mat:=pos;
  father:=father_;
  mov:=movnr;
  emptyx:=ex;
  emptyy:=ey;
  punct:=eval(mat)+mov;
  moved:=moved_;
  insertpos:=oldlistfirst;
  while (insertpos<>nil) and ((insertpos^.punct<>punct) or not equal(insertpos^.mat,mat)) do
    insertpos:=insertpos^.next;
  putin:=true;
  if (insertpos<>nil) then
    if (mov<insertpos^.mov) then insertpos:=insertpos^.next
      else putin:=false;
  insertpos:=newposlist^.next;
  if putin then
    begin
    while (insertpos^.next<>nil) and (insertpos^.next^.punct<punct) do
      insertpos:=insertpos^.next;
    next:=insertpos^.next;
    insertpos^.next:=tmpposlist;
    end;
  end;
end;



procedure getempty(var mat:desk;var emptyx,emptyy:byte);
var x,y:byte;
begin
for x:=0 to 3 do
  for y:=0 to 3 do
    if mat[x,y]=0 then begin emptyx:=x;emptyy:=y;end;
end;



procedure findsol;
begin
new(tmpposlist);
with tmpposlist^ do
  begin
  mat:=startpos;
  punct:=eval(mat);
  mov:=0;
  father:=nil;
  next:=nil;
  getempty(mat,emptyx,emptyy);
  end;
new(newposlist);
newposlist^.next:=tmpposlist;
new(oldlistfirst);
oldlistfirst^.next:=nil;
oldlistlast:=oldlistfirst;
while newposlist^.next<>nil do
  begin
  if newposlist^.next^.punct=newposlist^.next^.mov then
    begin
      with newposlist^.next^ do
        if mov<best then begin best:=mov;bestpos:=newposlist^.next;end;
      oldlistlast^.next:=newposlist^.next;
      newposlist^.next:=newposlist^.next^.next;
      oldlistlast:=oldlistlast^.next;
      oldlistlast^.next:=nil;
    end
    else begin
      if newposlist^.next^.mov<best then
      with newposlist^.next^ do
        begin
        if emptyx>0 then
          begin
          tmpdesk:=mat;
          tmpdesk[emptyx,emptyy]:=tmpdesk[emptyx-1,emptyy];
          tmpdesk[emptyx-1,emptyy]:=0;
          put(tmpdesk,newposlist^.next,mov+1,emptyx-1,emptyy,1);
          end;
        if emptyx<3 then
          begin
          tmpdesk:=mat;
          tmpdesk[emptyx,emptyy]:=tmpdesk[emptyx+1,emptyy];
          tmpdesk[emptyx+1,emptyy]:=0;
          put(tmpdesk,newposlist^.next,mov+1,emptyx+1,emptyy,2);
          end;
        if emptyy>0 then
          begin
          tmpdesk:=mat;
          tmpdesk[emptyx,emptyy]:=tmpdesk[emptyx,emptyy-1];
          tmpdesk[emptyx,emptyy-1]:=0;
          put(tmpdesk,newposlist^.next,mov+1,emptyx,emptyy-1,3);
          end;
        if emptyy<3 then
          begin
          tmpdesk:=mat;
          tmpdesk[emptyx,emptyy]:=tmpdesk[emptyx,emptyy+1];
          tmpdesk[emptyx,emptyy+1]:=0;
          put(tmpdesk,newposlist^.next,mov+1,emptyx,emptyy+1,4);
          end;
        end;
      oldlistlast^.next:=newposlist^.next;
      newposlist^.next:=newposlist^.next^.next;
      oldlistlast:=oldlistlast^.next;
      oldlistlast^.next:=nil;
      end;
  end;
dispose(newposlist);
dispose(oldlistfirst);
end;



procedure dispsol(pos:pospoint);
begin
if pos^.father<>nil then
  begin
  dispsol(pos^.father);
  write(direction[pos^.moved],' ');
  end;
end;



begin
best:=50;
bestpos:=nil;
error:=false;
readparams;
if not error then
  begin
  readpos(startfname,startpos);
  if not error then
    begin
    if endfname<>'' then
      begin
      readpos(endfname,endpos);
      for x:=0 to 3 do
        for y:=0 to 3 do
          if endpos[x,y]<>0 then
            begin
            transflst[x+y*4+1]:=endpos[x,y];
            for z:=0 to 3 do
              for q:=0 to 3 do
                if startpos[z,q]=endpos[x,y] then tmpdesk[z,q]:=x+y*4+1;
            end;
      startpos:=tmpdesk;
      end;
    findsol;
    if bestpos=nil then writeln('No solution!') else
    if solve then
      begin
      writeln('The solution is:');
      dispsol(bestpos);
      writeln;
      end else writeln('It is possible!');
(*    getempty(startpos,empx,empy);
    startpos[empx,empy]:=16;
    for x:=0 to 3 do
      for y:=0 to 3 do
        if startpos[x,y]<>0 then parity:=parity xor (abs((startpos[x,y]-1) mod 4-x)+abs((startpos[x,y]-1) div 4-y)=0);
    startpos[empx,empy]:=0;
    if parity {or (eval(startmat) mod 2)} then writeln('It is not possible!!!')
      else begin end;*)
    end;
  end;
if error then
  begin
  writeln('*** Error! ***');
  writeln(errorcode);
  end;
readln;
end.