{

Este programa es un resolvedor del Juego del 15. Está hecho de acuerdo con el
pseudocódigo y las indicaciones que aparecen en la página 71 del documento
Harnessing Computational Resources for Efficient Exhaustive Search, de R. U.
Gasser. El algoritmo utilizado es IDA* (iterative-deepening A*), desarrollado
por R. E. Korf en 1985. Este algoritmo es válido para un juego 3x3, pero no
puede resolver la mayoría de posiciones de la versión 4x4. El documento de
Gasser explica mejoras para atacar esta versión.

RVR, 27 de noviembre de 2004

}

const
   fils = 3;
   cols = 3;
   nhueco = fils * cols;
   MaxMovs = 1000;

   NORTE = 0;
   OESTE = 1;
   SUR   = 2;
   ESTE  = 3;

type
   Estado = record
      Ninguno : Boolean;
      Hueco : record
         X, Y : Byte;
      end;
      Tablero : array[1..fils, 1..cols] of Byte;
   end;
   Direccion = NORTE..ESTE;
   ListaMovs = record
      Long : Word;
      Lista : array[1..MaxMovs] of Direccion;
   end;

var
   MaxProfund : Word;
   Solucion : ListaMovs;


procedure Reset(var e : Estado);
var
   i, j : Byte;
begin
   e.Ninguno := False;
   e.Hueco.X := 4;
   e.Hueco.Y := 4;
   for i := 1 to fils do begin
      for j := 1 to cols do begin
         e.Tablero[i, j] := (i - 1) * 4 + j;
      end;
   end;
end;

procedure PonEstado(var e : Estado; var Datos);
var
   i, j : Byte;
   arr : array[1..65000] of Byte absolute Datos;
   c : Word;
begin
   e.Ninguno := False;
   c := 0;
   for i := 1 to fils do begin
      for j := 1 to cols do begin
         Inc(c);
         if arr[c] = nhueco then begin
            e.Hueco.X := j;
            e.Hueco.Y := i;
         end;
         e.Tablero[i, j] := arr[c];
      end;
   end;
end;

procedure MuestraEstado(e : Estado);
var
   i, j : Byte;
begin
   for i := 1 to fils do begin
      for j := 1 to cols do begin
         if e.Tablero[i, j] = nhueco then
            Write('   ')
         else Write(e.Tablero[i, j]:3);
      end;
      WriteLn;
   end;
   WriteLn;
end;

function Desliza(e : Estado; dir : Direccion) : Estado;
var
   dev : Estado;
begin
   if
      (dir = NORTE) and (e.Hueco.Y = 1   ) or
      (dir = OESTE) and (e.Hueco.X = 1   ) or
      (dir = SUR  ) and (e.Hueco.Y = fils) or
      (dir = ESTE ) and (e.Hueco.X = cols)
   then begin
      dev.Ninguno := True;
      Desliza := dev;
      Exit;
   end;
   dev := e;
   if dir = NORTE then begin
      dev.Tablero[dev.Hueco.Y, dev.Hueco.X] := dev.Tablero[dev.Hueco.Y-1, dev.Hueco.X];
      dev.Tablero[dev.Hueco.Y-1, dev.Hueco.X] := nhueco;
      Dec(dev.Hueco.Y);
   end else
   if dir = SUR then begin
      dev.Tablero[dev.Hueco.Y, dev.Hueco.X] := dev.Tablero[dev.Hueco.Y+1, dev.Hueco.X];
      dev.Tablero[dev.Hueco.Y+1, dev.Hueco.X] := nhueco;
      Inc(dev.Hueco.Y);
   end else
   if dir = OESTE then begin
      dev.Tablero[dev.Hueco.Y, dev.Hueco.X] := dev.Tablero[dev.Hueco.Y, dev.Hueco.X-1];
      dev.Tablero[dev.Hueco.Y, dev.Hueco.X-1] := nhueco;
      Dec(dev.Hueco.X);
   end else
   if dir = ESTE then begin
      dev.Tablero[dev.Hueco.Y, dev.Hueco.X] := dev.Tablero[dev.Hueco.Y, dev.Hueco.X+1];
      dev.Tablero[dev.Hueco.Y, dev.Hueco.X+1] := nhueco;
      Inc(dev.Hueco.X);
   end;
   Desliza := dev;
end;

function Estima(e : Estado) : Word;
var
   i, j, X, Y : Byte;
   sum : Word;
begin
   sum := 0;
   for i := 1 to fils do begin
      for j := 1 to cols do begin
         if e.Tablero[i, j] <> nhueco then begin
            Y := (e.Tablero[i, j] - 1) div cols + 1;
            X := (e.Tablero[i, j] - 1) mod cols + 1;
            Inc(sum, Abs(j - X) + Abs(i - Y));
         end;
      end;
   end;
   Estima := sum;
end;

function Resuelto(e : Estado) : Boolean;
begin
   Resuelto := (Estima(e) = 0);
end;

procedure MuestraListaMovs(l : ListaMovs);
var
   i : Word;
begin
   WriteLn('La longitud es ', l.Long);
   for i := 1 to l.Long do begin
      if l.Lista[i] = NORTE then Write('b ') else
      if l.Lista[i] = SUR   then Write('a ') else
      if l.Lista[i] = ESTE  then Write('i ') else
      if l.Lista[i] = OESTE then Write('d ');
   end;
end;

function Resuelve(e : Estado; profund : Word) : Boolean;
var
   dir : Direccion;
   Sig : Estado;
   t : char;
begin
   if profund + Estima(e) <= MaxProfund then begin
      if Resuelto(e) then begin
         MuestraListaMovs(Solucion);
         Resuelve := True;
         Exit;
      end else begin
         for dir := NORTE to ESTE do begin
            Sig := Desliza(e, dir);
            Solucion.Long := profund + 1;
            Solucion.Lista[profund + 1] := dir;
            if not Sig.Ninguno and Resuelve(Sig, profund + 1) then begin
               Resuelve := True;
               Exit;
            end;
         end;
      end;
   end;
   Resuelve := False;
end;


var
   EstadoInicial : Estado;

const
   ei : array[1..nhueco] of Byte = (8,6,7,2,5,4,3,9,1);

begin
   PonEstado(EstadoInicial, ei);
   MuestraEstado(EstadoInicial);
   Solucion.Long := 0;
   MaxProfund := Estima(EstadoInicial);
   WriteLn('Limite inferior: ', MaxProfund);
   Resuelve(EstadoInicial, 0);
   while not Resuelve(EstadoInicial, 0) do begin
      Inc(MaxProfund, 2);
      WriteLn(MaxProfund);
   end;
end.