Cod sursa(job #764483)

Utilizator ctlin04UAIC.VlasCatalin ctlin04 Data 5 iulie 2012 13:19:30
Problema Barbar Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 3.21 kb
Program barbar;
 type tip=record
        x,y:longint;
        end;
      tp1=array [1..1000000] of tip;
var a,b,viz:array [0..1005,0..1005] of longint;
    c,d:tp1;
    aux:array [1..1005] of char;
    i,j,n,m,s,f,x1,y1,xf,yf,mid,num:longint;
    b1:array [1..1 shl 17] of char;
    ok,ok1,ok2:boolean;
    fi,fo:text;
procedure solve(var c1,c2:tp1);
 var nr,x,y:longint;
begin
 nr:=0;
   for i:=1 to num do begin
    x:=c1[i].x; y:=c1[i].y;
    if (a[x,y-1]=-1) and (b[x,y-1]=0) then begin b[x,y-1]:=b[x,y]+1; inc(nr); c2[nr].x:=x; c2[nr].y:=y-1; ok:=true; end;
    if (a[x,y+1]=-1) and (b[x,y+1]=0) then begin b[x,y+1]:=b[x,y]+1; inc(nr); c2[nr].x:=x; c2[nr].y:=y+1; ok:=true; end;
    if (a[x-1,y]=-1) and (b[x-1,y]=0) then begin b[x-1,y]:=b[x,y]+1; inc(nr); c2[nr].x:=x-1; c2[nr].y:=y; ok:=true; end;
    if (a[x+1,y]=-1) and (b[x+1,y]=0) then begin b[x+1,y]:=b[x,y]+1; inc(nr); c2[nr].x:=x+1; c2[nr].y:=y; ok:=true; end;
   end;
 num:=nr;
end;
procedure solve2(var c1,c2:tp1);
 var nr,x,y:longint;
begin
 nr:=0;
   for i:=1 to num do begin
    x:=c1[i].x; y:=c1[i].y;
    if (viz[x,y-1]=0) and (b[x,y-1]>=mid) then begin viz[x,y-1]:=1; inc(nr); c2[nr].x:=x; c2[nr].y:=y-1; ok2:=true; end;
    if (viz[x,y+1]=0) and (b[x,y+1]>=mid) then begin viz[x,y+1]:=1; inc(nr); c2[nr].x:=x; c2[nr].y:=y+1; ok2:=true; end;
    if (viz[x-1,y]=0) and (b[x-1,y]>=mid) then begin viz[x-1,y]:=1; inc(nr); c2[nr].x:=x-1; c2[nr].y:=y; ok2:=true; end;
    if (viz[x+1,y]=0) and (b[x+1,y]>=mid) then begin viz[x+1,y]:=1; inc(nr); c2[nr].x:=x+1; c2[nr].y:=y; ok2:=true; end;
   end;
 num:=nr;
end;
procedure exista(x,y:longint);
 begin
 {viz[x,y]:=1;
  if (x=xf) and (y=yf) then ok1:=true
   else begin
        if (b[x-1,y]>=mid) and (ok1=false) and (viz[x-1,y]=0) then exista(x-1,y);
        if (b[x+1,y]>=mid) and (ok1=false) and (viz[x+1,y]=0) then exista(x+1,y);
        if (b[x,y-1]>=mid) and (ok1=false) and (viz[x,y-1]=0) then exista(x,y-1);
        if (b[x,y+1]>=mid) and (ok1=false) and (viz[x,y+1]=0) then exista(x,y+1);
        end;
 viz[x,y]:=0;}
  num:=1; ok2:=true; c[1].x:=x1; c[1].y:=y1;
   while ok2 do begin
                solve2(c,d);
                if ok2 then solve2(d,c);
               end;
  if viz[xf,yf]=1 then ok1:=true;
   fillchar(viz,sizeof(viz),0);
 end;
begin
 assign(fi,'barbar.in');
  assign(fo,'barbar.out');
 settextbuf(fi,b1);
 reset(fi); rewrite(fo); readln(fi,n,m);
  for i:=1 to n do begin
   readln(fi,aux);
    for j:=1 to m do
      if aux[j]='.' then a[i,j]:=-1
       else if aux[j]='*' then a[i,j]:=-2
        else if aux[j]='D' then begin a[i,j]:=-1; b[i,j]:=1; inc(num); c[num].x:=i; c[num].y:=j; end
         else if aux[j]='I' then begin a[i,j]:=-1; x1:=i; y1:=j; end
          else begin xf:=i; yf:=j; a[i,j]:=-1; end;
                      end;
  ok:=true;
  while ok do begin
               ok:=false;
               solve(c,d);
              if ok then solve(d,c);
              end;
  if b[x1,y1]>b[xf,yf] then f:=b[xf,yf] else f:=b[x1,y1];
   s:=1;
  while s<=f do begin
   mid:=(s+f) div 2; ok1:=false; exista(x1,y1);
    if ok1 then begin ok:=true; s:=mid+1; end else f:=mid-1;
                 end;
  if ok then write(fo,f-1) else write(fo,'-1');
 close(fo);
end.