{Starting number: 17
 Supported switches: -solve and -show (not full algorithms)
}

unit U17Game;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Grids, ExtCtrls, Spin;

const Lines=4;      //The number of lines in a table
      dUp=1;        //Direction constants
      dRi=2;
      dDn=-1;
      dLe=-2;
      GoalStateTable:array [1..16] of TPoint =
       ((X:0;Y:0),(X:1;Y:0),(X:2;Y:0),(X:3;Y:0),
        (X:0;Y:1),(X:1;Y:1),(X:2;Y:1),(X:3;Y:1),
        (X:0;Y:2),(X:1;Y:2),(X:2;Y:2),(X:3;Y:2),
        (X:0;Y:3),(X:1;Y:3),(X:2;Y:3),(X:3;Y:3));
type
  TForm1 = class(TForm)
    sgTable: TStringGrid;
    eFile: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    bCheckTable: TButton;
    mOutput: TMemo;
    Label3: TLabel;
    bSolve: TButton;
    OpenDialog1: TOpenDialog;
    bOpenFile: TButton;
    rbKeyPress: TRadioButton;
    RadioButton1: TRadioButton;
    procedure FormCreate(Sender: TObject);
    procedure bCheckTableClick(Sender: TObject);
    procedure bSolveClick(Sender: TObject);
    procedure bOpenFileClick(Sender: TObject);
  private
    P,
    Hole:TPoint;        //Coordinates of the hole
    F:Text;             //The file
    FileName:string;    //Name of file
    Table:array [0..Lines-1,0..Lines-1] of Byte;//Table
    function Find(Num:Byte):TPoint;
    procedure LoadTableFromFile;
    function CheckTable:Boolean;
    procedure OpenFile;
    procedure CheckSwitches;
    procedure FillTable;
    procedure Solve;
    procedure Shift(Dir:ShortInt);
    procedure GoAround(P:TPoint);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Solve;
{Solves the game}
var O,D:TPoint;
begin
 Hole:=Find(16);

 P:=Find(1);
 O:=GoalStateTable[1];

 //Chooses the destination coordinates of the hole:
 if O.X<P.X then D:=Point(P.X-1,P.Y) else
 if O.X>P.X then D:=Point(P.X+1,P.Y) else
 if O.Y>P.Y then D:=Point(P.X,P.Y+1) else
 if O.Y<P.Y then D:=Point(P.X,P.Y);

 //Moves the hole to the destination coordinates:
 while not ((Hole.X>=P.X-1) and (Hole.X<=P.X+1) and (Hole.Y>=P.Y-1) and (Hole.Y<=P.Y+1)) do
 begin
  if D.Y<Hole.Y then Shift(dDn) else
  if D.Y>Hole.Y then Shift(dUp);
  if D.X<Hole.X then Shift(dRi) else
  if D.X>Hole.X then Shift(dLe);
 end;


{ P:=Hole;Shift(dLe);

 repeat
  GoAround(P);
  O:=P;
  P:=Hole;
  if Hole.X>O.X then Shift(dRi) else
  if Hole.X<O.X then Shift(dLe) else
  if Hole.Y>O.Y then Shift(dDn) else
  if Hole.Y<O.Y then Shift(dUp);
 until (P.X=0)and(P.Y=0);
}
end; {Solve}

function TForm1.Find(Num:Byte):TPoint;
{Returns the number Num position in the table}
var I,J:Integer;
begin
 for I:=0 to 3 do
  for J:=0 to 3 do
   if Table[I,J]=Num then
    Result:=Point(I,J);
end; {Find}

procedure TForm1.Shift(Dir:ShortInt);
{Moves the hole}
var NX,NY:ShortInt;
begin
 NX:=Hole.X;
 NY:=Hole.Y;
 case Dir of
  dUp:begin mOutput.Lines.Add('UP');   Inc(NY); end;
  dDn:begin mOutput.Lines.Add('DOWN'); Dec(NY); end;
  dLe:begin mOutput.Lines.Add('LEFT'); Inc(NX); end;
  dRi:begin mOutput.Lines.Add('RIGHT');Dec(NX); end;
 end;
 Table[Hole.X,Hole.Y]:=Table[NX,NY];
 sgTable.Cells[Hole.X,Hole.Y]:=sgTable.Cells[NX,NY];
 sgTable.Cells[NX,NY]:='';
 Hole:=Point(NX,NY);

 //Delay:
 if rbKeyPress.Checked then
  ShowMessage('Press Enter or Escape.');
end; {Shift}

procedure TForm1.FillTable;
{Fills the visible table by the values in array table}
var I,J:Integer;
begin
 for I:=0 to Lines-1 do
  for J:=0 to Lines-1 do
   if Table[J,I]<>16 then
    sgTable.Cells[J,I]:=IntToStr(Table[J,I]) else
    sgTable.Cells[J,I]:='';
end; {FillTable}

procedure TForm1.CheckSwitches;
{Checks if the switches are OK}
begin
 if ParamCount>2 then
 begin
  ShowMessage('To lot of parameters.');
  Exit;
 end;

 if ParamCount=2 then
 begin
  if (UpperCase(ParamStr(1))<>'-SOLVE') and (UpperCase(ParamStr(1))<>'-SHOW') then
   ShowMessage('Invalid switch: "'+ParamStr(1)+'"');
 end;
end; {CheckSwitches}

procedure TForm1.OpenFile;
{Opens the file FileName}
begin
 {$I-}
 AssignFile(F,FileName);
 Reset(F);
 if IOResult<>0 then
 begin
  ShowMessage('Missing file name or file does not exist.');
  Exit;
 end;
 {$I+}
 eFile.Text:=FileName;
end; {OpenFile}

procedure TForm1.LoadTableFromFile;
{Loads the table form the opened file and closes that file}
var I,J:Integer;
begin
 for I:=0 to Lines-1 do
 begin
  for J:=0 to Lines-1 do
   try
    Read(F,Table[J,I]);
   except
    Table[J,I]:=Lines*Lines;
   end;
  Readln(F);
 end;
 CloseFile(F);
end; {LoadDataFromFile}

function TForm1.CheckTable:Boolean;
{Checks the table}
var Sign,K,I,J:Integer;
    Cards:set of Byte;
    OK:Boolean;
begin
 //Checks if the table is well entered:
 OK:=True;
 Cards:=[];
 for I:=0 to Lines-1 do
  for J:=0 to Lines-1 do
   if (Table[I,J] in Cards) or not (Table[I,J] in [0..Lines*Lines]) then
   begin
    OK:=False;
    Break;
   end else
    Cards:=Cards+[Table[I,J]];
 if not OK then
 begin
  Result:=False;
  ShowMessage('Error in table.');
  Exit;
 end;
 
 //Checks if the table is transformable {finds the sign of permutation}:
 Sign:=0;
 for I:=0 to Lines-1 do
  for J:=0 to Lines-1 do
   for K:=I*Lines+J+1 to Lines*Lines-1 do
    Sign:=Sign+Byte(Table[K mod Lines,K div Lines]<Table[J,I]);
 Result:=Sign mod 2 = 0;
end; {CheckTable}

procedure TForm1.FormCreate(Sender: TObject);
begin
 //Gets the file name from parameters:
 FileName:=ParamStr(ParamCount);
 eFile.Text:=FileName;

 OpenFile;
 LoadTableFromFile;
 FillTable;
 CheckSwitches;
end;

procedure TForm1.bCheckTableClick(Sender: TObject);
begin
 if not CheckTable then
  ShowMessage('This is bad table.') else
  ShowMessage('This is transformable table.');
end;

procedure TForm1.bSolveClick(Sender: TObject);
begin
 if CheckTable then
  Solve else
  ShowMessage('This is bad table, I can''t solve it.');
end;

procedure TForm1.bOpenFileClick(Sender: TObject);
begin
 if OpenDialog1.Execute then
  eFile.Text:=OpenDialog1.FileName;
 FileName:=eFile.Text;
 OpenFile;
 LoadTableFromFile;
 FillTable;
end;

{*******************************************************************************}

procedure TForm1.GoAround(P:TPoint);
{Moves the hole around position P
(Unused)}
var DirY,DirX:ShortInt;
begin
 if P.Y=Hole.Y then
 begin
  if P.Y>0 then DirY:=dDn else DirY:=dUp;
  if P.X<Hole.X then DirX:=dRi else DirX:=dLe;
  Shift(DirY);
  if (Hole.X=0)and(DirX=dRi) or (Hole.X=Lines)and(DirX=dDn) then Exit;
  Shift(DirX);
  if (Hole.X=0)and(DirX=dRi) or (Hole.X=Lines)and(DirX=dDn) then Exit;
  Shift(DirX);
  Shift(-DirY);
 end else
 begin
  if P.X>0 then DirX:=dRi else DirX:=dLe;
  if P.Y<Hole.X then DirY:=dUp else DirY:=dDn;
  Shift(DirX);
  if (Hole.Y=0)and(DirY=dUp) or (Hole.Y=Lines)and(DirY=dDn) then Exit;
  Shift(DirY);
  if (Hole.Y=0)and(DirY=dUp) or (Hole.Y=Lines)and(DirY=dDn) then Exit;
  Shift(DirY);
  Shift(-DirX);
 end;
end; {GoAround}

end.