Cod sursa(job #1537430)

Utilizator hungntnktpHungntnktp hungntnktp Data 27 noiembrie 2015 11:38:24
Problema Barbar Scor 80
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.59 kb
{$inine on}
uses math;
const
 tfi='barbar.in';
 tfo='barbar.out';
 ha:array[1..4] of longint=(0,-1,0,1);
 co:array[1..4] of longint=(1,0,-1,0);
 oo=1000000000;

var
 fi,fo:Text;
 n,m,f,r,xi,yi,xo,yo,ok,res,dem:longint;
 a,d,free:array[0..1001,0..1001] of longint;
 qx,qy:array[0..1000001] of longint;

procedure push(x,y:longint);
 begin
     inc(r);
     qx[r]:=x;
     qy[r]:=y;
 end;

procedure pop(var x,y:longint);
 begin
     x:=qx[f];
     y:=qy[f];
     inc(f);
 end;

procedure nhap;
 var i,j,u,v,ii,jj:longint;ch:char;
 begin
     read(fi,m,n);res:=-1;
     f:=1;
     r:=0;
     for i:=1 to m do
     begin
      for j:=1 to n do
       begin
           read(fi,ch);
           d[i,j]:=oo;
           if ch='D' then
            begin
                d[i,j]:=0;
                push(i,j);
                a[i,j]:=1;
            end
           else if ch='*' then a[i,j]:=2
           else if ch='I' then
            begin
               xi:=i;
               yi:=j;
            end
           else if ch='O' then
            begin
                xo:=i;
                yo:=j;
            end;
       end;
      readln(fi);
     end;
     while f<=r do
      begin
          pop(u,v);
          for i:=1 to 4 do
           begin
               ii:=u+ha[i];
               jj:=v+co[i];
               if (ii>0) and (jj>0) and (ii<=m) and (jj<=n) then
                 if d[ii,jj]=oo then
                  if a[i,j]<>2 then
                  begin
                     d[ii,jj]:=d[u,v]+1;
                     push(ii,jj);
                  end;
           end;
      end;
 end;

procedure dfs(i,j,x:longint);
 var k,ii,jj:longint;
 begin
     if (i=xo) and (j=yo) then ok:=1;
     if ok=1 then exit;
     free[i,j]:=dem;
     for k:=1 to 4 do
      begin
          ii:=i+ha[k];
          jj:=j+co[k];
          if (ii>0) and (jj>0) and (ii<=m) and (jj<=n) then
           if (a[ii,jj]=0) and (free[ii,jj]<dem) and (d[ii,jj]>=x) then
            dfs(ii,jj,x);
      end;
 end;

function check(x:longint):boolean;
 begin
     ok:=0;inc(dem);
     dfs(xi,yi,x);
     exit(ok=1);
 end;

procedure process;
 var l,r,mid:longint;
 begin
     l:=1;
     r:=m+n-2;
     while l<=r do
      begin
          mid:=(l+r) div 2;
          if check(mid) then
           begin
               res:=mid;
               l:=mid+1;
           end
          else r:=mid-1;
      end;
     write(fo,res);
 end;

BEGIN
    assign(fi,tfi);reset(fi);
    assign(fo,tfo);rewrite(fo);
     nhap;
     process;
    close(fi);close(fo);
END.