Cod sursa(job #249378)

Utilizator belgun_adrianBelgun Dimitri Adrian belgun_adrian Data 28 ianuarie 2009 11:18:03
Problema Barbar Scor 70
Compilator fpc Status done
Runda Arhiva de probleme Marime 3.55 kb
{// Arhiva de probleme - Barbar}

type
        adresa         = ^nod;
        nod            = record i,j : integer; adr : adresa; end;

const
        di      : array [1..4] of integer = (1,0,-1,0);
        dj      : array [1..4] of integer = (0,1,0,-1);
        dim     = 1000;

var
        r,c,i,j,iStr,jStr,iFin,jFin,k,ii,jj,lo,hi,mi,sol,p,u : integer;
        f       : text;
        ch      : char;
        a       : array [1..dim, 1..dim] of integer;
        uz      : array [1..dim, 1..dim] of byte;
        cd      : array [1..dim*dim*2] of record i, j: integer; end;
        d,t,pt  : adresa;


{
// mai trebuie implementata trecerea
// trimisa doar sa vad daca intra in memorie si timp
}
function  trece (dMin : integer):boolean;
var
        i, j, k : integer;
begin
for i :=1 to r do
    for j :=1 to c do
        uz [i, j] := 0;

p       := 1;
u       := 1;

cd[p].i := iStr;
cd[p].j := jStr;

while (p <= u) do
      begin

      i := cd[p].i;
      j := cd[p].j;

      for k := 1 to 4 do
          begin

          ii := i + di[k];
          jj := j + dj[k];

          if (ii < 1) or (jj < 1) or (ii > r) or (jj > c) then continue;

          if (uz [ii, jj] = 1) then continue;

          if (a[ii, jj] >= dMin) then
              begin
              uz[ii,jj] :=1;
              inc     (u);
              cd[u].i := ii;
              cd[u].j := jj;
              end;

          end;

      inc (p);
      end;

if (uz [iFin, jFin] = 1) then
   trece   := true
else
   trece   := false;
end;


begin
assign  (f, 'barbar.in');
reset   (f);
readln  (f, r, c);
for i := 1 to r do
    begin
    for j := 1 to c do
        begin
        a[i,j]  := maxint;
        read    (f, ch);
        case ch of
                '*': a[i, j] := -1;
                'D': begin
                     new (t);
                     t^.i := i; t^.j := j; t^.adr := d;
                     d := t;
                     end;
                'I': begin iStr := i; jStr := j; end;
                'O': begin iFin := i; jFin := j; end;

        end;
        end;
    readln      (f);
    end;
close   (f);

{
//calculam in matricea a distanta catre cel mai apropiat dragon;
}
t := d;
while (t<>nil) do
      begin
      i := t^.i;
      j := t^.j;
      a [i,j]   := 0;

      p     := 1;
      u     := 1;
      cd[p].i  := i;
      cd[p].j  := j;

      while (p <= u) do
        begin
        i := cd[p].i;
        j := cd[p].j;
        for k := 1 to 4 do
            begin
            ii := i + di[k];
            jj := j + dj[k];
            if (ii < 1) or (jj < 1) or (ii > r) or (jj > c) then continue;
            if (a[ii, jj] > a[i,j ] + 1) then
                begin
                a[ii, jj] := a[i, j] + 1;
                inc     (u);
                cd[u].i := ii;
                cd[u].j := jj;
                end;
            end;
        inc (p);
        end;

      pt := t;
      t  := t^.adr;
      dispose  (pt);
      end;
{
//  cautare binara pe intervalul [0, min(a[iStr,jStr], a[iFin, jFin])]
//  cautand daca poate trece pe acolo;
}
lo      := 0;
if (a[iStr, jStr] < a[iFin, jFin]) then
   hi   := a[iStr, jStr]
else
   hi   := a[iFin, jFin];


sol := hi;
while (lo<=hi) do
      begin
      mi := lo + (hi-lo) shr 1;

      if (trece(mi) = true) then
          begin
          lo := mi + 1;
          sol:= mi;
          end
      else
          hi := mi - 1;
      end;

assign  (f, 'barbar.out');
rewrite (f);
writeln (f, sol);
close   (f);
end.