Cod sursa(job #804917)

Utilizator tibi2012Galatanu Tiberiu tibi2012 Data 30 octombrie 2012 18:04:30
Problema Barbar Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 3.83 kb
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,f1,x1,y1,xf,yf,mid,num:longint;
    b1:array [1..1 shl 17] of char;
    ok,ok1,ok2:boolean;
    f,g: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
  num:=1;
  ok2:=true;
  c[1].x:=x1;
  c[1].y:=y1;
  while ok2 do
    begin
      ok2:=false;
      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(f,'barbar.in');
  assign(g,'barbar.out');
  settextbuf(f,b1);
  reset(f);
  rewrite(g);
  readln(f,n,m);
  for i:=1 to n do
    begin
      readln(f,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
    f1:=b[xf,yf]
  else
    f1:=b[x1,y1];
  s:=1;
  while s<=f1 do
    begin
      mid:=(s+f1) div 2;
      ok1:=false;
      exista(x1,y1);
      if ok1 then
        begin
          ok:=true;
          s:=mid+1;
        end
      else
        f1:=mid-1;
    end;
  if ok then
    write(g,f1-1)
  else
    write(g,'-1');
  close(f);
  close(g);
end.