Cod sursa(job #825520)
Utilizator | Data | 29 noiembrie 2012 09:55:00 | |
---|---|---|---|
Problema | Barbar | Scor | 80 |
Compilator | fpc | Status | done |
Runda | Arhiva de probleme | Marime | 4.23 kb |
{$H+}
Const
tfi = 'barbar.in';
tfo = 'barbar.out';
nmax = 1001;
d : array [1..4] of longint = (1,-1,0,0);
c : array [1..4] of longint = (0,0,1,-1);
Type
arr1 = array [0..nmax] of string;
arr2 = array [0..nmax,0..nmax] of boolean;
arr3 = array [0..nmax*nmax] of longint;
arr4 = array [0..nmax,0..nmax] of longint;
Var
fi,fo : text;
m,n,f,r,res : longint;
s : arr1;
dd : arr2;
qx,qy : arr3;
kc,g : arr4;
sx,sy,ex,ey : longint;
Procedure mo;
Begin
assign(fi,tfi);reset(fi);
assign(fo,tfo);rewrite(fo);
End;
Procedure dong;
begin
close(fi);
close(fo);
End;
procedure nhap;
Var
i,j : longint;
Begin
readln(fi,m,n);
For i:=1 to m do readln(fi,s[i]);
End;
Procedure push(x,y:longint);
Begin
inc(r);
qx[r]:=x;
qy[r]:=y;
End;
Procedure pop(var x,y:longint);
Begin
x:=qx[f];
y:=qy[f];
inc(f);
End;
Procedure init;
Var
i,j : longint;
Begin
f:=1;
r:=0;
For i:=1 to m do
For j:=1 to n do
Begin
If s[i,j]='I' then
Begin
sx:=i;
sy:=j;
End;
If s[i,j]='O' then
Begin
ex:=i;
ey:=j;
End;
dd[i,j]:=true;
If s[i,j]='D' then
Begin
push(i,j);
dd[i,j]:=false;
End;
End;
End;
Procedure bfs;
var
i,j,x,y,u,v : longint;
begin
While f<=r do
begin
pop(u,v);
For i:=1 to 4 do
Begin
x:=u+d[i];
y:=v+c[i];
if (x>=1) and (y>=1) and (x<=m) and (y<=n) and (dd[x,y]) then
Begin
kc[x,y]:=kc[u,v]+1;
dd[x,y]:=false;
push(x,y);
End;
End;
End;
End;
Function check(mid:longint):boolean;
Var
i,j,u,v,x,y : longint;
Begin
f:=1;
r:=0;
For i:=1 to m do
For j:=1 to n do
begin
dd[i,j]:=true;
g[i,j]:=0;
End;
push(sx,sy);
dd[sx,sy]:=false;
While f<=r do
Begin
pop(u,v);
For i:=1 to 4 do
Begin
x:=u+d[i];
y:=v+c[i];
If (x>=1) and (y>=1) and (x<=m) and (y<=n) then
begin
If (s[x,y]<>'*') and (dd[x,y]) and (kc[x,y]>=mid) then
begin
g[x,y]:=g[u,v]+1;
dd[x,y]:=false;
push(x,y);
End;
End;
End;
End;
If g[ex,ey]<>0 then exit(true)
else exit(false);
End;
Procedure inkq;
Var
l,r,mid : longint;
begin
l:=0;
r:=m+n;
res :=-1;
While l<=r do
begin
mid:=(l+r) shr 1;
If check(mid) then
Begin
res:=mid;
l:=mid+1;
End
else r:=mid-1;
End;
writeln(fo,res);
End;
BEGIN
mo;
nhap;
init;
bfs;
inkq;
dong;
END.