Nombre Password [ Regístrate ]

Campo minado II (OIE 4 - 2000) - Código en Pascal
{$B-,I-,S-,R-,Q-}
{Programed By FR, Tu 15/08/2006}
{Solución utilizando búsqueda en anchura}

program robgen; { campo minado II }

type tpos = record i,j : byte; end;

const mov : array[1..4,1..2] of shortint = ((-1,0),(0,+1),(+1,0),(0,-1));
      MaxN = 100;

var fe,fs   : text;
    m,n,i,j : byte;
    camp    : array[0..MaxN + 1,0..MaxN + 1] of 0..1;
    ant     : array[1..MaxN,1..MaxN] of tpos;
    ox,oy,
    dx,dy   : byte;
    ori     : char; { orientacion }

    cola    : array[1..10000] of tpos;
    f,l     : byte; {first, last}

procedure inifiles;
begin
    assign(fe,'robgen.dat');reset(fe);
    assign(fs,'robgen.res');rewrite(fs);
end;

procedure closedfiles;
begin
    close(fe);
    close(fs);
end;

procedure readdata;
var line : string[200];
    e    : integer;
begin
    readln(fe,line);
    val(copy(line,1,pos(',',line)-1),m,e);
    val(copy(line,pos(',',line)+1,length(line)),n,e);

    for m:=1 to m do begin
        readln(fe,line);
        while pos('0',line) > 0 do begin
           camp[m,pos('0',line) div 2 + 1] := 0;
           line[pos('0',line)]:='1';
        end;
    end;

    readln(fe,line); { origen }
    val(copy(line,1,pos(',',line)-1),ox,e);
    val(copy(line,pos(',',line)+1,length(line)),oy,e);

    readln(fe,line); { destino }
    val(copy(line,1,pos(',',line)-1),dx,e);
    val(copy(line,pos(',',line)+1,length(line)),dy,e);

    read(fe,ori);
end; { readdata }

procedure Prepara;
begin
    f:=1;
    l:=1;
    fillchar(cola,sizeof(cola),0);
    fillchar(ant,sizeof(ant),0);
    fillchar(camp,sizeof(camp),1);
end;

procedure EnColar(x,y : byte);
begin
    with cola[l] do begin
         i:=x;
         j:=y;
    end;
    inc(l);
end; {encolar}


procedure DeColar(var x,y : byte);
begin
    with cola[f] do begin
         x:=i;
         y:=j;
    end;
    inc(f)
end; {decolar}

procedure print;
var ii : byte;
begin
    while not ((i = dx) and (j = dy)) do begin
        Case ori of
           'N' : begin
                     if ant[i,j].i > i then begin
                        writeln(fs,'I');
                        writeln(fs,'I');
                        ori:='S'
                     end
                     else
                     if ant[i,j].j < j then begin
                        writeln(fs,'I');
                        ori:='O'
                     end
                     else
                     if ant[i,j].j > j then begin
                        writeln(fs,'D');
                        ori:='E';
                     end
                 end; {N}

           'S' : begin
                     if ant[i,j].i < i then begin
                        writeln(fs,'I');
                        writeln(fs,'I');
                        ori:='N'
                     end
                     else
                     if ant[i,j].j < j then begin
                        writeln(fs,'D');
                        ori:='O'
                     end
                     else
                     if ant[i,j].j > j then begin
                        writeln(fs,'I');
                        ori:='E';
                     end
                 end; {S}

           'E' : begin
                     if ant[i,j].j < j then begin
                        writeln(fs,'I');
                        writeln(fs,'I');
                        ori:='O'
                     end
                     else
                     if ant[i,j].i < i then begin
                        writeln(fs,'I');
                        ori:='N'
                     end
                     else
                     if ant[i,j].i > i then begin
                        writeln(fs,'D');
                        ori:='S'
                     end;
                 end; {E}

           'O' : begin
                     if ant[i,j].j > j then begin
                        writeln(fs,'I');
                        writeln(fs,'I');
                        ori:='E'
                     end
                     else
                     if ant[i,j].i < i then begin
                        writeln(fs,'D');
                        ori:='N'
                     end
                     else
                     if ant[i,j].i > i then begin
                        writeln(fs,'I');
                        ori:='S'
                     end;
                 end; {O}
        end; {case}

        writeln(fs,'A');
        ii:=i;
        i:=ant[i,j].i;
        j:=ant[ii,j].j;
    end;
end; {print}

{Breadth-first search, búsqueda en anchura}
procedure bfs;
var k,ii,jj : byte;
begin
    EnColar(dx,dy);
    camp[dx,dy]:=1;

    repeat
        DeColar(i,j);

        if (i = ox) and (j = oy) then begin
           print;
           exit
        end
        else
           for k:=1 to 4 do begin
               ii:=i+mov[k][1];
               jj:=j+mov[k][2];
               if camp[ii,jj] = 0 then begin
                  camp[ii,jj]:=1;
                  ant[ii,jj].i:=i;
                  ant[ii,jj].j:=j;
                  EnColar(ii,jj);
               end;
           end; {for k}
    until f = l;

    write(fs,'MISION IMPOSIBLE')
end; {bfs}

begin { program }
    inifiles;
    Prepara;
    readdata;
    bfs;
    closedfiles;
end.


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