Cod sursa(job #1537434)

Utilizator hungntnktpHungntnktp hungntnktp Data 27 noiembrie 2015 11:40:01
Problema Barbar Scor 80
Compilator fpc Status done
Runda Arhiva de probleme Marime 3.78 kb
uses math;
const
        tfi     =       'barbar.in';
        tfo     =       'barbar.out';
        vc      =       10000000;
        dk   :   array[1..4] of longint =(-1,0,1,0);
        ck   :   array[1..4] of longint =(0,1,0,-1);
        maxn    =       1000;
var
        a,d,free : array[1..maxn,1..maxn] of longint;
        xd,yd,qx,qy : array[1..1000000] of longint;
        n,m,res,xi,yi,xo,yo,numd,f,r,u,v : longint;
        fi,fo : text;
procedure mo;
begin
        assign(fi,tfi); reset(fi);
        assign(fo,tfo); rewrite(fo);
end;
procedure dong;
begin
        close(fi);
        close(fo);
end;
procedure nhap;
var i,j:longint;
ch:char;
begin
        readln(fi,n,m);
        for i:=1 to n do
          begin
             for j:=1 to m do
              begin
                   read(fi,ch);
                   if ch='*' then a[i,j]:=1
                   else if ch='I' then
                    begin
                        xI:=i;
                        yI:=j;
                    end
                   else if ch='O' then
                    begin
                        xO:=i;
                        yO:=j;
                    end
                   else if ch='D' then
                    begin
                        inc(numd);
                        xD[numd]:=i;
                        yD[numd]:=j;
                    end;
              end;
             readln(fi);
          end;
end;
function dd(x,y,u,v:longint):longint;
begin
        dd:=abs(x-u) + abs(y-v);
end;
procedure push(x,y:longint);
begin
        inc(r);
        qx[r]:=x;
        qy[r]:=y;
end;
procedure pop;
begin
        u:=qx[f];
        v:=qy[f];
        inc(f);
end;
procedure init;
var i,j,k:longint;
begin
        for i:=1 to n do
         for j:=1 to n do
          d[i,j]:=vc;
        f:=1; r:=0;
        for i:=1 to numd do
         begin
              push(xD[i],yD[i]);
              d[xD[i],yD[i]]:=0;
         end;
        while f<=r do
         begin
               pop;
               for k:=1 to 4 do
                begin
                     i:=u+dk[k];
                     j:=v+ck[k];
                     if (i>=1) and (i<=n) and (j>=1) and (j<=m) then
                      begin
                           if (a[i,j]=0) and (d[i,j] > d[u,v] + 1) then
                            begin
                                 d[i,j]:=d[u,v]+1;
                                 push(i,j);
                            end;
                      end;
                end;
         end;
end;
function check(l:longint):boolean;
var i,j,k:longint;
begin
        f:=1; r:=0;
        fillchar(free,sizeof(free),0);
        push(xI,yI);
        free[xI,yI]:=1;
        while f<=r do
         begin
              pop;
              if (u=xO) and (v=yO) then exit(true);
              for k:=1 to 4 do
               begin
                    i:=u+dk[k];
                    j:=v+ck[k];
                    if (i>=1) and (i<=n) and (j>=1) and (j<=n) then
                     if (a[i,j]=0) and (d[i,j] >= l) then
                      if free[i,j]=0 then
                       begin
                            free[i,j]:=1;
                            push(i,j);
                       end;
               end;
         end;
        exit(false);
end;
procedure lam;
var l,r,mid:longint;
begin
        res:=0;
        l:=1;
        r:=vc;
        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;
        if res=0 then writeln(fo,-1) else writeln(fo,res);
end;
begin
        mo;
        nhap;
        init;
        lam;
        dong;
end.