Cod sursa(job #1550502)

Utilizator baolaptrinhbaolaptrinh baolaptrinh Data 13 decembrie 2015 19:56:07
Problema Barbar Scor 50
Compilator fpc Status done
Runda Arhiva de probleme Marime 4.19 kb
uses math;
const
     fi='barbar.in';
     fo='barbar.out';
     oo=trunc(1e9);
     maxn=1000;
     uu:array[1..4] of longint=(0,-1,0,1);
     vv:array[1..4] of longint=(-1,0,1,0);

type
     toado=record
          x,y:longint;
     end;
     data=record
          xx,yy:longint;
     end;

var
     R,C:longint;
     a:array[1..1000,1..1000] of char;

     vt:array[1..1000*1000] of toado;  slD:longint;

     D:array[1..maxn,1..maxn] of longint;
     ok:array[1..maxn,1..maxn] of longint;

     cur,leng:longint;
     q:array[1..1000*1000] of data;
     stx,sty,fnx,fny:longint;
     minleng:longint;

procedure Docdl;
var
     i,j:Longint;
begin
     readln(R,C);
     slD:=0;
     for i:=1 to R do
          begin
               for j:=1 to C do
                    begin
                         read(a[i,j]);
                         if a[i,j]='D' then
                              begin
                                   inc(slD);
                                   vt[slD].x:=i;
                                   vt[slD].y:=j;
                              end;
                         if a[i,j]='I' then
                              begin
                                   stx:=i;
                                   sty:=j;
                              end;
                         if a[i,j]='O' then
                              begin
                                   fnx:=i;
                                   fny:=j;
                              end;
                    end;
               readln;
          end;
end;

function check(x,y:longint):boolean;
begin
     if (x<1) or (y<1) or(x>R) or (y>C) or (a[x,y]='#') or (a[x,y]='D') or (ok[x,y]<>0) then exit(false);
     exit(true);
end;

procedure BFS(x,y:Longint);
var
     i:longint;
     u:data;
     x1,y1:longint;
begin
     cur:=1;
     Leng:=1;
     q[1].xx:=x;
     q[1].yy:=y;
     repeat
          u:=q[cur];
          for i:=1 to 4 do
               begin
                    x1:=u.xx+uu[i];
                    y1:=u.yy+vv[i];
                    if check(x1,y1) then
                         begin
                              ok[x1,y1]:=ok[u.xx,u.yy]+1;
                              inc(leng);
                              q[leng].xx:=x1;
                              q[leng].yy:=y1;
                         end;
               end;
          inc(cur);
     until cur>leng;
end;

procedure Chuanbi;
var
     i,j,j2:longint;
begin
     for i:=1 to R do
     for j:=1 to C do
          D[i,j]:=oo;
     for i:=1 to slD do
          begin
               for j:=1 to R do
               for j2:=1 to C do
                    ok[j,j2]:=0;
               BFS(vt[i].x,vt[i].y);
               for j:=1 to R do
               for j2:=1 to C do
                    D[j,j2]:=min(D[j,j2],ok[j,j2]);
          end;
end;

procedure Visit(x,y:longint);
var
     i:longint;
     x1,y1:longint;
begin
     for i:=1 to 4 do
          begin
               x1:=x+uu[i];
               y1:=y+vv[i];
               if check(x1,y1) then
                    begin
                         if D[x1,y1] >= minleng then
                              begin
                                   ok[x1,y1]:=ok[x,y]+1;
                                   VIsit(x1,y1);
                              end;
                    end;
          end;
end;

function ktr(k:longint):boolean;
var
     i,j:longint;
begin
     for i:=1 to R do
     for j:=1 to C do
          ok[i,j]:=0;
     minleng:=k;
     Visit(stx,sty);
     if ok[fnx,fny]<>0 then exit(true);
     exit(false);
end;

procedure Xuli;
var
     i,j:longint;
     Dau,Cuoi,mid,res:longint;
begin
     Chuanbi;
     Dau:=1; Cuoi:=maxn*maxn;
     while Dau<=Cuoi do
          begin
               mid:=(Dau+Cuoi) div 2;
               if ktr(mid) then
                    begin
                         res:=mid;
                         Dau:=mid+1;
                    end
               else
                    Cuoi:=mid-1;
          end;
     writeln(res);
end;

BEGIN
 assign(input,fi); reset(input);
 assign(output,fo); rewrite(output);
  docdl;
  xuli;
 close(input); close(output);
END.