Nombre Password [ Regístrate ]

El salto del caballo (OIE 5 - 2001) - Código en Pascal
{$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.


© (2001-2008) ALGORITMIA.NET - Política de privacidad