{$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,P-,Q-,R-,S+,T-,V+,X+,Y+}
{$M 16384,0,655360}
{Programed by FR, Tu 20/06/2006}
{Solución aplicando búsqueda en anchura, utilizando una cola dinámica}
program caballo;
const i : array[1..8] of shortint = (-2,-2,-1, 1,-1,1, 2,2); {avance por las i}
j : array[1..8] of shortint = (-1, 1,-2,-2, 2,2,-1,1); { "" "" "" j}
MaxN = 100;
type tpos = record {posicion}
i,j : byte;
end;
tdato = record
p : tpos;
n : integer;
end;
type ptrTNode = ^TNode; {puntero al nodo}
TNode = record {nodo de la cola}
dato : tdato;
sig : ptrTNode; {puntero al siguiente nodo}
end;
var fe,fs : text;
m,n,p,q : byte; {dimensiones del tablero}
origen,destino,postemp,posact : tpos; {posiciones del caballo}
w {way} : array[1..MaxN,1..MaxN] of tpos;
t {tablero - V or N} : array[1..MaxN,1..MaxN] of char;
first,last,aux : ptrTNode; {punteros para implementar la cola}
procedure inifiles;
begin
assign(fe,'CAB.DAT');reset(fe);
assign(fs,'CAB.RES');rewrite(fs);
end;
procedure closedfiles;
begin
close(fe);
close(fs)
end;
procedure readdata;
var ch : char;
begin
readln(fe,n,m);
readln(fe,origen.i,origen.j);
readln(fe,destino.i,destino.j);
for p:=1 to m do begin
for q:=1 to n-1 do
read(fe,t[p,q],ch);
readln(fe,t[p,n]);
end;
if (t[destino.i,destino.j] = 'N') then begin
write(fs,'INSATISFACTIBLE');
closedfiles;
halt;
end;
end; { readdata }
procedure EscribeSolucion(l : integer);
var h : integer;
begin
{escribiendo el camino}
for h:=1 to l do begin
writeln(fs,origen.i,' ',origen.j);
origen:=w[origen.i,origen.j]{proxima casilla}
end;
end; { EscribeSolucion }
procedure IniCola;
begin
first:=nil;
last:=nil;
end;
procedure MeteEnLaCola(di,dj : byte; l : integer);
begin
{Siempre que se inserta se crea un nuevo nodo que será el último}
new(aux);
aux^.dato.p.i:=di;
aux^.dato.p.j:=dj;
aux^.dato.n:=l;
aux^.sig:=nil;
{Actualizar los punteros}
if last = nil then begin
{Este es el primer nodo insertado}
first:=aux;
last:=aux
end
else
begin
{Este NO es el primer nodo insertado}
last^.sig:=aux;{El que estaba de ultimo apunta a este nuevo}
last:=aux; {Ahora se actualiza el ultimo al recien insertado}
end;
end; { MeteEnLaCola }
procedure SacaDeLaCola(var posact : tpos; var l : integer);
begin
{Siempre se saca de la parte delantera de la cola. Actualizar los punteros}
posact.i:=first^.dato.p.i;
posact.j:=first^.dato.p.j;
l:=first^.dato.n;
aux:=first; {Salva el puntero al primero para DISPOSE}
first:=aux^.sig; {Ahora el primero es el segundo elemento}
dispose(aux); {Libera la memoria utilizada por el primer nodo}
if first = nil then
last := nil {Si no quedan nodos ambos punteros son NIL}
end; { SacaDeLaCola }
function EsteVaciaLaCola : boolean;
begin
if (first = nil) and (last = nil) then EsteVaciaLaCola:=true
else EsteVaciaLaCola:=false
end; { EstaVaciaLaCola }
procedure sol;
var k : byte;
l : integer;
begin
IniCola;
MeteEnLaCola(destino.i,destino.j,1);
while not EsteVaciaLaCola do begin
SacaDeLaCola(posact,l);
if (posact.i = origen.i) and (posact.j = origen.j) then begin
{ya se completo el camino}
EscribeSolucion(l);
exit;
end
else {ver los 8 posibles saltos}
for k:=1 to 8 do begin
postemp.i:=posact.i+i[k];
postemp.j:=posact.j+j[k];
if (postemp.i<=m) and (postemp.i>=1) and
(postemp.j<=n) and (postemp.j>=1) and
(w[postemp.i,postemp.j].i=0) and
(t[postemp.i,postemp.j] = 'V') then
{Si esta dentro de las dimensiones del tab y no se ha visitado}
{antes y es válida}
begin
w[postemp.i,postemp.j]:=posact;{guarda el camino para
llegar hasta aquí}
MeteEnLaCola(postemp.i,postemp.j,l+1);
end;
end; { for k }
end; { while }
{No hay camino}
write(fs,'INSATISFACTIBLE');
end; { sol }
begin { program }
inifiles;
readdata;
{fillchar(t,sizeof(t),0);}
sol;
closedfiles;
end. |