Cod sursa(job #219159)

Utilizator antoanelaAntoanela Siminiuc antoanela Data 5 noiembrie 2008 21:13:22
Problema Barbar Scor 70
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.97 kb
var f,g:text;
    a:array[0..1010,0..1010]of char;
    b,c:array[0..1010,0..1010]of longint;
    vl,vc:array[0..1000000]of byte;
    v1:array[1..4]of shortint=(0,0,-1,1);
    v2:array[1..4]of shortint=(-1,1,0,0);
    n,m,i,j,li,ci,lf,cf,h,x,y:longint;

function verif(p,i:longint):boolean;
begin
  verif:=false;
  if (a[vl[p]+v1[i],vc[p]+v2[i]]='.')or (a[vl[p]+v1[i],vc[p]+v2[i]]='O')
    or (a[vl[p]+v1[i],vc[p]+v2[i]]='D')then
    verif:=true;
end;

function verif2(p,i:longint):boolean;
begin
  verif2:=false;
  if (a[vl[p]+v1[i],vc[p]+v2[i]]='.')or (a[vl[p]+v1[i],vc[p]+v2[i]]='O')
    or (a[vl[p]+v1[i],vc[p]+v2[i]]='I')then
    verif2:=true;
end;

procedure bf;
var p,i:longint;
begin
p:=1;
while (p<=h)do
  begin
    for i:=1 to 4 do
      if (vl[p]+v1[i]>0)and(vl[p]+v1[i]<=n)and(vc[p]+v2[i]>0)and(vc[p]+v2[i]<=m)
      and verif2(p,i) and(b[vl[p]+v1[i],vc[p]+v2[i]]=0)then
        begin
          inc(h);
          vl[h]:=vl[p]+v1[i];
          vc[h]:=vc[p]+v2[i];
          b[vl[h],vc[h]]:=b[vl[p],vc[p]]+1;
        end;
    inc(p);
  end;
end;

function try(x:longint):boolean;
var h,p,i:longint;
begin
  h:=1;
  p:=1;
  vl[1]:=li;
  vc[1]:=ci;
  for i:=1 to n do
    for j:=1 to m do c[i,j]:=0;
  try:=false;
  if (b[li,ci]>=x)then
    begin
  while (p<=h)do
    begin
      if (vl[p]=lf)and(vc[p]=cf)then
        begin
          try:=true;
          break;
        end;
      for i:=1 to 4 do
        if (vl[p]+v1[i]>0)and(vl[p]+v1[i]<=n)and(vc[p]+v2[i]>0)and(vc[p]+v2[i]<=m)
        and verif(p,i) and(b[vl[p]+v1[i],vc[p]+v2[i]]>=x)and(c[vl[p]+v1[i],vc[p]+v2[i]]=0)then
          begin
            inc(h);
            vl[h]:=vl[p]+v1[i];
            vc[h]:=vc[p]+v2[i];
            c[vl[h],vc[h]]:=1;
          end;
      inc(p);
    end;
    end;
end;


function search(a,b:longint):longint;
var r,k,o:longint;
begin
  r:=-1;
  while (a<=b)do
    begin
      inc(o);
      if (o=10)then break;
      k:=(a+b)div 2;
      if try(k)then
        begin
          r:=k;
          a:=k+1;
        end else b:=k-1;
    end;
  search:=r;
end;

begin
assign(f,'barbar.in');
assign(g,'barbar.out');
reset(f);
rewrite(g);
readln(f,n,m);
for i:=1 to n do
  begin
    for j:=1 to m do
      begin
        read(f,a[i,j]);
        if (a[i,j]='D')then
          begin
            inc(h);
            vl[h]:=i;
            vc[h]:=j;
          end else
        if (a[i,j]='I')then
          begin
            li:=i;
            ci:=j;
          end else
        if (a[i,j]='O')then
          begin
            lf:=i;
            cf:=j;
          end;
      end;
    readln(f);
  end;
bf;
{for i:=1 to n do
  begin
    for j:=1 to m do write(g,b[i,j],' ');
    writeln(g);
  end;}
x:=maxlongint;
for i:=1 to n do
  for j:=1 to m do
    if (a[i,j]<>'*')then
      begin
        if (x>b[i,j])then x:=b[i,j];
        if (y<b[i,j])then y:=b[i,j];
      end;
write(g,search(0,y));
close(f);
close(g);
end.