Programación lúdica: ganador del reto del laberinto

Hace ya un par de semanas pusimos en el reto de la programación lúdica, la creación de un laberinto. Hubo una discreta participación, la cual quiero creer, se debió en parte a que el reto sonaba demasiado complejo y aunque no lo era tanto, requería quizás de más horas de las que muchos podrían haberse ocupado para resolverlo.

Se recibieron algunas participaciones que invalidé porque parecían copia de algún programa de Internet y ante mi petición de aclarar el asunto hubo incluso silencio. Y que conste, no estoy acusando a nadie, solamente que la idea de los retos es que los que participan los resuelvan porque ése es el chiste, amén de que en eso reside la diversión.

Finalmente, hubo tres finalistas. Uno usó Java (Salvador González), otro Javascript (Gabriel Martínez), con ayuda de JQuery y un tercero, escrito en Delphi. La decisión no fue fácil pero me parece que el ganador hizo la versión más manejable y visualmente más adecuada a la interfaz gráfica. El ganador es pues Guillermo Cañedo y este es su código (en Delphi):

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, Spin;

type
  TMurosSet = set of (arriba, abajo, derecha, izquierda);

  PCelda = ^TCelda;
  TCelda = record
      i, j, pos: Integer;
      visitado: Boolean;
      etiqueta: String;
      muros: TMurosSet;
      adyacentes: TList;
  end;

  PRef = ^TRef;
  TRef = record
      pos: Integer;
      muroComun: TMurosSet;
  end;

  TForm1 = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    Button1: TButton;
    Lienzo: TPaintBox;
    rens: TSpinEdit;
    cols: TSpinEdit;
    Label1: TLabel;
    Label2: TLabel;
    Button2: TButton;
    Label4: TLabel;
    procedure LienzoPaint(Sender: TObject);
    procedure rensChange(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormResize(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    dx, dy: Integer;
    Q: TList;
    solucion: TStringList;
    verSol: Boolean;
    procedure calcTamCeldas;
    function ObtieneListaDeNodos: TList;
    function obtieneNodo(i, j: Integer): PCelda;
    function obtieneNodosAdyacentes(i, j: Integer): TList;
    function refCelda(i, j: Integer): Integer;
    procedure DFS(nodo: PCelda);
    procedure DerribarMuro(A, B: PCelda);
    function obtieneNodosPorDondePuedePasar(nodo: PCelda): TStringList;
    function HayHabitacionesF: Boolean;
    function getMuroRandom(nodo: Pcelda): PCelda;
    function obtieneHabitacionF: PCelda;
    procedure etiquetar(nodo: pCelda; etq: String);
    function obtieneMuroQueIntercepta(A, B: PCelda): TMurosSet;
    function Regresa: PCelda;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}


procedure TForm1.LienzoPaint(Sender: TObject);
var
   i, j, rx, ry: integer;
   R: TRect;
   celda: PCelda;
begin
    R.Left := 0;
    R.Top := 0;
    R.Right := Lienzo.Width;
    R.Bottom := Lienzo.Height;
    Lienzo.Canvas.Brush.Color := clWhite;
    Lienzo.Canvas.Brush.Style := bsSolid;
    Lienzo.Canvas.FillRect(R);

    Lienzo.Canvas.Pen.Color := clBlack;
    Lienzo.Canvas.Pen.Width := 1; 
    if Q <> Nil then
      begin
          for i := 0 to (Q.Count - 1) do
               begin
                   celda := Q[i];

                   rx := celda^.j*dx;
                   ry := celda^.i*dy;
                   
                   if arriba in celda^.muros then
                       begin
                           Lienzo.Canvas.MoveTo(rx, ry);
                           Lienzo.Canvas.LineTo(rx + dx, ry);
                       end;
                       
                   if abajo in celda^.muros then
                       begin
                           Lienzo.Canvas.MoveTo(rx, ry + dy);
                           Lienzo.Canvas.LineTo(rx + dx, ry + dy);
                       end;

                   if derecha in celda^.muros then
                       begin
                           Lienzo.Canvas.MoveTo(rx + dx, ry);
                           Lienzo.Canvas.LineTo(rx + dx, ry + dy);
                       end;

                   if izquierda in celda^.muros then
                       begin
                           Lienzo.Canvas.MoveTo(rx, ry);
                           Lienzo.Canvas.LineTo(rx, ry + dy);
                       end;

               end;

           if (verSol) and (solucion.Count > 0) then
               begin
                   Lienzo.Canvas.Pen.Color := clRed;
                   Lienzo.Canvas.Brush.Style := bsClear;
                   Lienzo.Canvas.Pen.Width := round(dy/3); 
                   celda := Q[StrToInt(solucion[0])];
                   rx := celda^.j*dx;
                   ry := celda^.i*dy;
                   Lienzo.Canvas.MoveTo(round(rx), round(ry + dy/2));

                   for i := 0 to (solucion.Count - 1) do
                       begin
                           celda := Q[StrToInt(solucion[i])];
                           rx := celda^.j*dx;
                           ry := celda^.i*dy;
                           Lienzo.Canvas.LineTo(round(rx + dx/2), round(ry + dy/2));
                       end;
                       
                   Lienzo.Canvas.LineTo(round(rx + dx), round(ry + dy/2));

               end;
      end
    else
      begin

           for j := 0 to cols.Value do
               begin
                   Lienzo.Canvas.MoveTo(dx*j, 0);
                   Lienzo.Canvas.LineTo(dx*j, Lienzo.Height);
               end;

           for j := 0 to rens.Value do
               begin
                   Lienzo.Canvas.MoveTo(0, dy*j);
                   Lienzo.Canvas.LineTo(Lienzo.Width, dy*j);
               end;
            
      end;
end;

function TForm1.ObtieneListaDeNodos: TList;
var
   i, j: integer;
   P: PCelda;
begin
   Result := TList.Create;
   for i := 0 to rens.Value - 1 do
       for j := 0 to cols.Value - 1 do
           begin
              New(P);
              P^.i := i;
              P^.j := j;
              P^.visitado := false;
              P^.etiqueta := 'u';
              P^.muros := [arriba, abajo, derecha, izquierda];
              P^.pos := refCelda(i, j);
              P^.adyacentes := obtieneNodosAdyacentes(i, j);
              Result.Add(P);
           end;
end;


function TForm1.obtieneNodo(i, j: Integer): PCelda;
var
   k: integer;
   P: PCelda;
begin
   Result := nil;
   for k := 0 to (Q.Count - 1) do
       begin
           P := Q.Items[k];
           if (P^.i = i) and (P^.j = j) then
               begin
                   Result := P;
                   Exit;
               end;
       end;
end;


function TForm1.refCelda(i, j: Integer): Integer;
begin
  Result := i*cols.Value + j;
end;


function TForm1.obtieneNodosAdyacentes(i, j: Integer): TList;

    procedure Add(k: Integer; muro: TMurosSet);
    var
        P: PRef;
    begin
        New(P);
        P^.pos := k;
        P^.muroComun := muro;
        Result.Add(P);
    end;

begin

    Result := TList.Create;
    if i - 1 >= 0 then Add(refCelda(i - 1, j), [arriba]);
    if i + 1 <= rens.Value - 1 then Add(refCelda(i + 1, j), [abajo]);     if j - 1 >= 0 then Add(refCelda(i, j - 1), [izquierda]);
    if j + 1 <= cols.Value - 1 then Add(refCelda(i, j + 1), [derecha]);
end;

procedure LimpiaLista2(MyList: TList);
var
   i: Integer;
   ARecord: PRef;
begin
   if MyList <> Nil then
      begin
           for i := 0 to (MyList.Count - 1) do
               begin
                   ARecord := MyList.Items[i];
                   Dispose(ARecord);
               end;
           MyList.Free;
       end;
end;


procedure LimpiaLista(MyList: TList);
var
   i: Integer;
   ARecord: PCelda;
begin
   if MyList <> Nil then
      begin
           for i := 0 to (MyList.Count - 1) do
               begin
                   ARecord := MyList.Items[i];
                   LimpiaLista2(ARecord^.adyacentes);
                   Dispose(ARecord);
               end;
           MyList.Free;
       end;
end;

procedure TForm1.rensChange(Sender: TObject);
begin
   Button2.Enabled := false;
   verSol := false;
   LimpiaLista(Q);
   Q := nil;
   solucion.Clear;
   calcTamCeldas;
   FormResize(Sender);
   Lienzo.Refresh;
end;

procedure TForm1.calcTamCeldas;
begin
   // dx := Round(Lienzo.Width/cols.Value);
   // dy := Round(Lienzo.Height/rens.Value);
   dx := 12;
   dy := 12;
   Lienzo.Width := dx*cols.Value + 1;
   Lienzo.Height := dy*rens.Value + 1;
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
   solucion := TStringList.Create;
   calcTamCeldas;
end;

function TForm1.HayHabitacionesF: Boolean;
var
   i: Integer;
   P: PCelda;
begin
    Result := False;
    for i := 0 to (Q.Count - 1) do
        begin
            P := Q[i];
            if P^.etiqueta = 'F' then
                begin
                    Result := true;
                    Exit;
                end;
        end;
end;


function TForm1.obtieneHabitacionF: PCelda;
var
   i: Integer;
   P: PCelda;
   L : TStringList;
begin

   L := TStringList.Create;
   for i := 0 to (Q.Count - 1) do
       begin
           P := Q[i];
           if P^.etiqueta = 'F' then L.Add(IntToStr(i));
       end;
       
   if L.Count > 0 then
       Result := Q[StrToInt(L[Random(L.Count)])]
   else
       Result := nil;
   L.Free;
end;

function TForm1.getMuroRandom(nodo: Pcelda): PCelda;
var
   i: Integer;
   Ref: Pref;
   vecino: PCelda;
   L : TStringList;
begin
   L := TStringList.Create;
   for i := 0 to nodo^.adyacentes.Count - 1 do
       begin
           Ref := nodo^.adyacentes[i];
           vecino := Q[Ref^.pos];
           if vecino^.etiqueta = 'I' then L.Add(IntToStr(i));
       end;

   if L.Count > 0 then
       begin
           Ref := nodo^.adyacentes[StrToInt(L[Random(L.Count)])];
           Result := Q[Ref^.pos];
       end
   else
       Result := nil;
   
   L.Free;
end;

procedure TForm1.etiquetar(nodo: pCelda; etq: String);
var
   i: integer;
   Ref: PRef;
   hijo: PCelda;
begin
   for i := 0 to nodo^.adyacentes.Count - 1 do
       begin
           Ref := nodo^.adyacentes[i];
           hijo := Q[Ref^.pos];
           if hijo^.etiqueta <> 'I' then hijo^.etiqueta := etq;
       end;
end;


function TForm1.obtieneMuroQueIntercepta(A, B: PCelda): TMurosSet;
var
    i: Integer;
    Ref: PRef;
begin
    Result := [];
    for i := 0 to A^.adyacentes.Count - 1 do
        begin
            Ref := A^.adyacentes[i];
            if B^.pos = Ref^.pos then
                begin
                    Result := Ref^.muroComun;
                    Exit;
                end;
        end;
end;

procedure TForm1.DerribarMuro(A, B: PCelda);
begin
    A^.muros := A^.muros - obtieneMuroQueIntercepta(A, B);
    B^.muros := B^.muros - obtieneMuroQueIntercepta(B, A);
end;

function TForm1.obtieneNodosPorDondePuedePasar(nodo: PCelda): TStringList;
var
   i: Integer;
   Ref: PRef;
   adyacente: PCelda;
begin
   Result := TStringList.Create;
   for i := 0 to nodo^.adyacentes.Count - 1 do
       begin
           Ref := nodo^.adyacentes[i];
           adyacente := Q[Ref^.pos];
           if (not adyacente^.visitado) and (Ref^.muroComun * nodo^.muros = []) then Result.Add(IntTostr(Ref^.pos));
       end;
end;

function TForm1.Regresa: PCelda;
var
   L: TStringList;
begin
   L := TStringList.Create;
   Result := nil;
   while (solucion.Count > 0) and (L.Count = 0) do
       begin
           Result := Q[StrToInt(solucion[solucion.Count - 1])];
           L.Free;
           L := obtieneNodosPorDondePuedePasar(Result);
           solucion.Delete(solucion.Count - 1);
       end;

   L.Free;
end;


procedure TForm1.DFS(nodo: PCelda);
var
   celda: PCelda;
   Childs: TStringList;
begin
   nodo^.visitado := true;
   solucion.Add(IntToStr(nodo^.pos));
   Childs := obtieneNodosPorDondePuedePasar(nodo);
   if Childs.Count > 0 then
      begin
          celda := Q[StrToInt(Childs[Random(Childs.Count)])];
          DFS(celda);
      end;
   Childs.Free;
end;


procedure TForm1.Button1Click(Sender: TObject);
var
  vecino, I, F: PCelda;
  Ref: PRef;
  k: Integer;
  val: Boolean;
begin
    Button1.Enabled := false;
    Button2.Enabled := false;
    verSol := false;
    if verSol then Button2.Caption := 'Ocultar Solución' else Button2.Caption := 'Ver Solución';
    Randomize;
    LimpiaLista(Q);
    Q := ObtieneListaDeNodos;


    I := obtieneNodo(Random(rens.Value), Random(cols.Value));
    I^.etiqueta := 'I';
    for k := 0 to I^.adyacentes.Count - 1 do
        begin
            Ref := I^.adyacentes[k];
            vecino := Q[Ref^.pos];
            vecino^.etiqueta := 'F';
        end;

    repeat
        F := obtieneHabitacionF;
        I := getMuroRandom(F);
        DerribarMuro(I, F);
        F^.etiqueta := 'I';
        etiquetar(F, 'F');
    until not HayHabitacionesF;


    //// BUSCA LA SOLUCION ////
    solucion.Clear;
    I := obtieneNodo(Random(rens.Value), 0);
    I^.muros := I^.muros - [izquierda];

    repeat
        DFS(I);
        F := Q[StrToInt(solucion[solucion.Count - 1])];
        val := (F^.j = cols.Value - 1);
        if not val then I := Regresa;
    until val;
    
    F^.muros := F^.muros - [derecha];


    Lienzo.Refresh;
    Button1.Enabled := true;
    Button2.Enabled := solucion.Count > 0;
end;


procedure TForm1.FormDestroy(Sender: TObject);
begin
    solucion.Free;
    LimpiaLista(Q);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
    verSol := not verSol;
    Lienzo.Refresh;
    if verSol then Button2.Caption := 'Ocultar Solución' else Button2.Caption := 'Ver Solución';
end;

procedure TForm1.FormResize(Sender: TObject);
begin
    Lienzo.Left := Round((Panel2.ClientWidth - Lienzo.Width)/2);
    Lienzo.Top := Round((Panel2.ClientHeight - Lienzo.Height)/2);
end;

end.

Cabe indicar que Guillermo mandó versiones mejoradas de tanto en tanto, las cuales optimizaron la solución, lo cual fue lo que finalmente decidió que se le otorgara el primer lugar.

Guillermo Cañedo Ramírez, 44 años, estudió Ingeniería Eléctrica y una maestría en Sistemas Eléctricos de Potencia en el Instituto Tecnológico de Morelia. He aquí la descripción de lo que hizo:

«La estrategia que seguí», nos dice, «está basada en 2 algoritmos:»

Dependiendo del número de renglones y columnas que se quieran del laberinto, se define una matriz de m renglones y n columnas y se almacena toda la información en una lista dinámica con TList (disponible en Delphi) de apuntadores a una estructura de datos TCelda.

TMurosSet = set of (arriba, abajo, derecha, izquierda);

  PCelda = ^TCelda;
  TCelda = record
      i, j, pos: Integer;
      visitado: Boolean;
      etiqueta: String;   
      muros: TMurosSet;
      adyacentes: TList;
  end;

y la lista de habitaciones adyacentes apunta a una estructura de datos del tipo TRef.

  PRef = ^TRef;
  TRef = record
      pos: Integer;
      muroComun: TMurosSet;
  end;

Primero se etiquetan todas las celdas o habitaciones de la matriz con ‘u’

1) El Algoritmo de Prim’s para generar el laberinto, es como sigue:

a) Elegir una celda o habitación al azar y etiquetarla como I,
b) Etiquetar las habitaciones adyacentes de I con F
c) Obtener al azar una habitación etiquetada como F y derribar el muro que colinda con la habitación I,
d) Etiquetar F como I y
e) Etiquetar las adyacentes del nuevo I pero que no sean I como F
f) Repetir del c) al e) hasta que ya no haya mas habitaciones F

2) El Algoritmo de Búsqueda Primero en Profundidad con retroceso para hallar la solución:

a) Etiquetar todas las habitaciones del laberinto como no visitadas.
b) Elegir al azar una habitación de entrada de la primer columna y se establece como entrada del laberinto, eliminando su muro izquierdo
c) Establecer la habitación como nodo raíz y marcarla como visitada y guardar la posición del nodo en una lista que sera la solución.
d) Obtener las habitaciones adyacentes que no estén visitadas y que no tengan muro colindante para poder pasar.
e) Elegir al azar una de ellas y de manera recursiva repetir de c) a e) hasta que ya no haya habitaciones adyacentes sin visitar y sin muro o que la columna del nodo raíz sea igual al total de columnas del laberinto
f) si e) no se cumple entonces ir en sentido inverso con nuestra lista de la solución e ir eliminando el ultimo elemento hasta que haya un camino por donde pasar.
g) Al finalizar se marca el último nodo de la lista con la solución como salida del laberinto derribando el muro derecho.

Actualmente desarrolla aplicaciones educativas y juegos para tabletas y smartphones en forma independiente en Taos Games.

Felicitamos a Guillermo y vienen más retos, con más premios. Hemos estado trabajando con algunas empresas para que nos den apoyo, así que ahora, a redoblar esfuerzos porque los premios empezarán a ponerse más atractivos… Poco a poco, pero verán que empezarán a incrementarse.

A quien le interese el código de Guillermo y el de los otros dos concursantes, poueden escribirme a morsa@la-morsa.com y se los mandaré por si les interesa estudiarlo.

También te puede interesar

Comentarios