Cod sursa(job #1538974)

Utilizator TheMastermindThe Mastermind TheMastermind Data 30 noiembrie 2015 03:21:06
Problema Barbar Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.92 kb
{$H+}
USES math;
CONST
   tfi = 'barbar.in';
   tfo = 'barbar.out';
   d   : array[1..4] of longint = (-1,0,1,0);
   c   : array[1..4] of longint = (0,-1,0,1);
VAR
   n,m,l,r,x1,y1,x2,y2,cnt:longint;
   q1,q2:array[1..1000000] of longint;
   dd,a,free:array[1..1000,1..1000] of longint;
   str:string;
PROCEDURE nhap;
   Var
      i,j:longint;
   Begin
      readln(n,m);
      cnt:=1;
      l:=1; r:=0;
      For i:=1 to n do
         begin
            readln(str);
            For j:=1 to m do
               begin
                  If str[j]='O' then
                     begin
                        x1:=i;
                        y1:=j;
                     end;
                  If str[j]='I' then
                     begin
                        x2:=i;
                        y2:=j;
                     end;
                  If str[j]='D' then
                     begin
                        inc(r);
                        q1[r]:=i;
                        q2[r]:=j;
                        dd[i,j]:=0;
                        free[i,j]:=1;
                        a[i,j]:=1;
                     end;
                  If str[j]='*' then a[i,j]:=1;
               end;
         end;
   End;
PROCEDURE bfs;
   Var
      x,y,i,u,v:longint;
   Begin
      While l<=r do
         begin
            x:=q1[l]; y:=q2[l]; inc(l);
            For i:=1 to 4 do
               begin
                  u:=x+d[i];
                  v:=y+c[i];
                  If (u>0) and (u<=n) and (v>0) and (v<=m) then
                  If (a[u,v]=0) and (free[u,v]=0) then
                     begin
                        inc(r); q1[r]:=u; q2[r]:=v;
                        dd[u,v]:=dd[x,y]+1;
                        free[u,v]:=1;
                     end;
               end;
         end;
   End;
FUNCTION dfs(x,y,t:longint):boolean;
   Var
      i,u,v:longint;
   Begin
      If (x=x2) and (y=y2) then exit(true);
      free[x,y]:=cnt;
      For i:=1 to 4 do
         begin
            u:=x+d[i];
            v:=y+c[i];
            If (u>0) and (u<=n) and (v>0) and (v<=m) then
            If (a[u,v]=0) and (free[u,v]<>cnt) and (dd[u,v]>=t) then
            If dfs(u,v,t) then exit(true);
         end;
      exit(false);
   End;
FUNCTION check(mid:longint):boolean;
   Begin
      inc(cnt);
      If dfs(x1,y1,mid) then exit(true) else exit(false);
   End;
PROCEDURe xuly;
   Var
      l,r,mid,kq:longint;
   Begin
      l:=1;
      r:=dd[x1,y1];
      kq:=-1;
      While l<=r do
         begin
            mid:=(l+r) div 2;
            If check(mid) then
               begin
                  kq:=mid;
                  l:=mid+1;
               end
            else r:=mid-1;
         end;
      write(kq);
   End;
BEGIN
   assign(input,tfi); assign(output,tfo);
   reset(input); rewrite(output);
      nhap;
      bfs;
      xuly;
   close(input); close(output);
END.