Cod sursa(job #249367)

Utilizator belgun_adrianBelgun Dimitri Adrian belgun_adrian Data 28 ianuarie 2009 10:46:45
Problema Barbar Scor 40
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.72 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 : integer;
        f       : text;
        ch      : char;
        a, b    : array [1..dim, 1..dim] of integer;
        d,t,p,u,pt       : adresa;


{
// mai trebuie implementata trecerea
// trimisa doar sa vad daca intra in memorie si timp
}
function  trece (k : integer):boolean;
begin


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;

      new(p);
      p^.i  := i;
      p^.j  := j;
      u     := p;
      u^.adr:= nil;

      while (p <> nil) do
        begin
        i := p^.i;
        j := 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;
                new     (u^.adr);
                u       := u^.adr;
                u^.i    := ii;
                u^.j    := jj;
                end;
            end;
        pt := p;
        p  := p^.adr;
        dispose  (pt);
        end;

      t := t^.adr;
      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
          hi := mi - 1;
          sol:= mi;
          end
      else
          lo := mi + 1;
      end;

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