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
- 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.
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.
