Cod sursa(job #72135)

Utilizator FoaiaFoaia de Hartie Foaia Data 12 iulie 2007 21:42:51
Problema Barbar Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 3.32 kb
var a,b:array[1..3000,1..3000] of longint;
    f1,f2:text;
    i,j,max,i1,i2,n,m,h,pas,sf:longint;
    ok:boolean;
    vi,vj:array[1..5000000] of longint;
    c:char;

procedure vecinib(x,y:longint);
begin
        if b[x,y]=-2 then h:=1;
        if b[x,y]>pas then
        begin
                b[x,y]:=pas+1;
                a[x,y]:=-1;
        end;
end;

procedure vecini(x,y:longint);
begin
        if a[x,y]=max then
        begin
                inc(sf);
                a[x,y]:=a[vi[i],vj[i]]+1;
                vi[sf]:=x;
                vj[sf]:=y;
        end;
end;

begin
        assign(f1,'barbar.in');
        reset(f1);
        assign(f2,'barbar.out');
        rewrite(f2);
        readln(f1,n,m);
        max:=maxlongint;;
        for i:=1 to n do
        begin
                for j:=1 to m do
                begin
                        read(f1,c);
                        if c='.' then
                        begin
                                a[i,j]:=max;
                                b[i,j]:=max;
                        end;
                        if c='*' then
                        begin
                                a[i,j]:=-1;
                                b[i,j]:=-1;
                        end;
                        if c='D' then
                        begin
                                a[i,j]:=-1;
                                b[i,j]:=0;
                        end;
                        if c='I' then
                        begin
                                a[i,j]:=0;
                                b[i,j]:=-2;
                                vi[1]:=i;
                                vj[1]:=j;
                        end;
                        if c='O' then
                        begin
                                a[i,j]:=max;
                                b[i,j]:=-2;
                                i1:=i;
                                i2:=j;
                        end;
                end;
                readln(f1);
        end;
        ok:=true;
        while (ok=true)and(h=0) do
        begin
                ok:=false;
                for i:=1 to n do
                        for j:=1 to m do
                        begin
                                if a[i,j]>0 then a[i,j]:=max;
                                if b[i,j]=pas then
                                begin
                                        vecinib(i-1,j);
                                        vecinib(i+1,j);
                                        vecinib(i,j-1);
                                        vecinib(i,j+1);
                                end;
                        end;
                i:=0;
                sf:=1;
                inc(pas);
                while i<sf do
                begin
                        inc(i);
                        vecini(vi[i]-1,vj[i]);
                        vecini(vi[i]+1,vj[i]);
                        vecini(vi[i],vj[i]-1);
                        vecini(vi[i],vj[i]+1);
                        if a[i1,i2]<max then
                        begin
                                ok:=true;
                                break;
                        end;
                end;
        end;
        writeln(f2,pas-1);
        close(f1);
        close(f2);
end.