Cod sursa(job #825528)

Utilizator hungntnktpHungntnktp hungntnktp Data 29 noiembrie 2012 10:00:26
Problema Barbar Scor 90
Compilator fpc Status done
Runda Arhiva de probleme Marime 3.09 kb
uses math;
const
        nmax    =       1010;
        dx      :       array[1..4] of longint = (1,0,-1,0);
        dy      :       array[1..4] of longint = (0,-1,0,1);
var
        n,m,mind,maxd,bdy,bdx,ktx,kty,fron,righ,top:longint;
        qx,qy,sx,sy:array[0..nmax*nmax] of longint;
        d:array[0..nmax,0..nmax] of longint;
        a:array[0..nmax,0..nmax] of char;
        free:Array[0..nmax,0..nmax] of boolean;
procedure push(u,v:longint);
begin
        inc(righ);qx[righ]:=u;qy[righ]:=v;
        free[u][v]:=false;
end;
procedure pop(var u,v:longint);
begin
        u:=qx[fron];v:=qy[fron];
        inc(fron);
end;
procedure progress;
var i,j,u,v,l,r,h,mid,res:longint;
check:boolean;
begin
        readln(n,m);
        for i:=1 to n do
         begin
           for j:=1 to m do
             begin
               read(a[i][j]);
               if a[i][j]='D' then
                 begin
                   inc(top);sx[top]:=i;sy[top]:=j;
                 end
               else if a[i][j]='I' then
                 begin
                  bdx:=i;bdy:=j;
                 end
               else if a[i][j]='O' then
                 begin
                   ktx:=i;kty:=j;
                 end;
             end;
           readln;
         end;
        fron:=1;righ:=0;
        for i:=1 to n do for j:=1 to m do free[i][j]:=true;
        for i:=1 to top do push(sx[i],sy[i]);
        mind:=maxlongint;
        maxd:=0;
        while fron<=righ do
          begin
            pop(u,v);
            mind:=min(mind,d[u][v]);
            maxd:=max(maxd,d[u][v]);
            for h:=1 to 4 do
              begin
                i:=u+dx[h];j:=v+dy[h];
                if free[i][j] and (a[i][j]<>'*') then
                  begin
                    d[i][j]:=d[u][v]+1;
                    push(i,j);
                  end;
              end;
          end;
        for i:=1 to n do for j:=1 to m do free[i][j]:=true;
        l:=mind;r:=maxd;
        while l<=r do
          begin
            mid:=(l+r)shr 1;
            if d[bdx,bdy]<mid  then
              begin
                r:=mid-1;
                continue;
              end;
            check:=false;
            fron:=1;righ:=0;
            push(bdx,bdy);
            while fron<=righ do
             begin
               pop(u,v);
               if (u=ktx)and(v=kty) then
                 begin
                   check:=true;
                   break;
                 end;
               for h:=1 to 4 do
                 begin
                   i:=u+dx[h];j:=v+dy[h];
                   if free[i][j] and (a[i][j]<>'*')and(d[i][j]>=mid) then push(i,j);
                 end;
             end;
            if check then
              begin
                res:=mid;l:=mid+1;
              end else r:=mid-1;
            for i:=1 to righ do free[qx[i],qy[i]]:=true;
          end;
        writeln(res);
end;
begin
        assign(input,'barbar.in');reset(input);
        assign(output,'barbar.out');rewrite(output);
          progress;
        close(input);
        close(output);
end.