Cod sursa(job #97026)

Utilizator GavrilaVladGavrila Vlad GavrilaVlad Data 4 noiembrie 2007 18:37:23
Problema Barbar Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 3.38 kb
const d1:array[1..4]of longint=(1,-1,0,0);
      d2:array[1..4]of longint=(0,0,1,-1);
var v,ba:array[1..1000000,1..2]of longint;
    m,q,z:array[0..1001,0..1001]of longint;
    n,i,o,p,j,k,c1,c2,x,y,a,b,w,d,r,l,f1:longint;
    s:string;
    c:char;
    f:text;
begin
   assign(f,'barbar.in');
   reset(f);
   readln(f,n,r);
   for i:=1 to n do
   begin
   for j:=1 to r do
   begin
   read(f,c);
   if c='.'then begin m[i,j]:=-1;
                      q[i,j]:=-1;
                end
           else
   if c='*'then begin m[i,j]:=-2;
                      q[i,j]:=-2;
                end
           else
   if c='D'then begin m[i,j]:=0;
                      q[i,j]:=0;
                      k:=k+1;
                      v[k,1]:=i;
                      v[k,2]:=j;
                end
           else
   if c='I'then begin m[i,j]:=-1;
                      q[i,j]:=0;
                      a:=i;
                      b:=j;
                      ba[1,1]:=i;
                      ba[1,2]:=j;
                end
           else
   if c='O'then begin m[i,j]:=-1;
                      q[i,j]:=-1;
                      w:=i;
                      d:=j;
                end;
   end;
   readln(f);
   c1:=1;
   end;
   close(f);
   z:=q;
   repeat
   c2:=k;
   for i:=c1 to k do
   for j:=1 to 4 do
   begin
   x:=v[i,1]+d1[j];
   y:=v[i,2]+d2[j];
   if(m[x,y]=-1)and(x>0)and(y>0)and(x<=n)and(y<=r)then begin m[x,y]:=m[v[i,1],v[i,2]]+1;
                                                           c2:=c2+1;
                                                           v[c2,1]:=x;
                                                           v[c2,2]:=y;
                                                     end;
   end;
   c1:=k+1;
   k:=c2;
   until c1>k;
   o:=0;
   q:=z;
   c1:=1;
   f1:=0;
   k:=1;
   repeat
   c2:=k;
   for i:=c1 to k do
   for j:=1 to 4 do
   begin
   x:=ba[i,1]+d1[j];
   y:=ba[i,2]+d2[j];
   if(q[x,y]=-1)and(x>0)and(y>0)and(x<=n)and(y<=r)then begin q[x,y]:=1;
                                                           c2:=c2+1;
                                                           ba[c2,1]:=x;
                                                           ba[c2,2]:=y;
                                                           if(x=w)and(y=d)then f1:=1;
                                                     end;
   end;
   c1:=k+1;
   k:=c2;
   until(c1>k)or(f1=1);
   p:=n*r;
   if(c1>k)then o:=-1;
   while(p-o>1)and(o>-1)do
   begin
   l:=(p+o-1)div 2+(o+p-1)mod 2;
   q:=z;
   c1:=1;
   f1:=0;
   k:=1;
   repeat
   c2:=k;
   for i:=c1 to k do
   for j:=1 to 4 do
   begin
   x:=ba[i,1]+d1[j];
   y:=ba[i,2]+d2[j];
   if(q[x,y]=-1)and(x>0)and(y>0)and(x<=n)and(y<=r)and(m[x,y]>=l)then begin q[x,y]:=1;
                                                           c2:=c2+1;
                                                           ba[c2,1]:=x;
                                                           ba[c2,2]:=y;
                                                           if(x=w)and(y=d)then f1:=1;
                                                     end;
   end;
   c1:=k+1;
   k:=c2;
   until(c1>k)or(f1=1);
   if f1=1 then o:=(o+p-1)div 2+(o+p-1)mod 2
                    else
   if c1>k then p:=(o+p-1)div 2+(o+p-1)mod 2;
   end;
   assign(f,'barbar.out');
   rewrite(f);
   writeln(f,l);
   close(f);
end.