Cod sursa(job #1537442)

Utilizator hungntnktpHungntnktp hungntnktp Data 27 noiembrie 2015 11:49:42
Problema Barbar Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 3.95 kb
const
    tfi='barbar.in';
    tfo='barbar.out';
    dd:array[1..4] of longint=(-1,0,0,1);
    cc:array[1..4] of longint=(0,-1,1,0);
var
    a,b,free:array[0..1010,0..1010] of boolean;
    sttx,stty,finx,finy,m,n,fro,ba,res:longint;

    numdr:longint;
    drx,dry,queue1,queue2:array[0..1000000]of longint;
    d:array[0..1010,0..1010]of longint;
    l,r,mid:longint;
procedure inp;
    var
        i,j:longint;
        c:char;
    begin
        readln(m,n);
        for i:= 1 to m do
            for j:= 1 to n do a[i,j]:=true;
        for i:= 1 to m do
            begin
                for j:= 1 to n do
                    begin
                        read(c);
                        if c='I' then
                            begin
                                sttx:=i;stty:=j;
                            end
                        else if c='O' then
                            begin
                                finx:=i;finy:=j;
                            end
                        else if c='*' then  a[i,j]:=false
                        else if c='D' then
                            begin
                                inc(numdr);
                                drx[numdr]:=i;
                                dry[numdr]:=j;
                            end;
                    end;
                readln;
            end;
    end;
procedure push(x,y:longint);
    begin
        inc(ba);
        queue1[ba]:=x;
        queue2[ba]:=y;
        free[x,y]:=true;
    end;
procedure spread;
    var
        ii,jj,i,k,u,v,j:longint;
    begin
        for i:= 1 to m do
            for j:= 1 to n do b[i,j]:=a[i,j];
        fro:=1;ba:=0;
        for i:= 1 to m do
            for j:= 1 to n do free[i,j]:=false;

        for i:= 1 to numdr do
            begin
                ii:=drx[i];jj:=dry[i];
                d[ii,jj]:=0;
                push(ii,jj);
            end;
        while fro<=ba do
            begin
                u:=queue1[fro];v:=queue2[fro];inc(fro);
                for k:= 1 to 4 do
                    begin
                        ii:=u+dd[k];jj:=v+cc[k];
                        if b[ii,jj] then
                            if not free[ii,jj] then
                                begin
                                    d[ii,jj]:=d[u,v]+1;
                                    push(ii,jj);
                                end;
                    end;
            end;
    end;
function bfs(mid:longint):boolean;
    var
        i,j,ii,jj,k,u,v:longint;
    begin
        fro:=1;ba:=0;
        for i:= 1 to m do
            for j:= 1 to n do free[i,j]:=false;
        if d[sttx,stty]>=mid then
        push(sttx,stty);
        while fro<=ba do
            begin
                u:=queue1[fro];v:=queue2[fro];inc(fro);
                for k:= 1 to 4 do
                    begin
                        ii:=u+dd[k];jj:=v+cc[k];
                        if b[ii,jj] then
                            if not free[ii,jj] then
                              if d[ii,jj]>=mid then
                                begin
                                    push(ii,jj);
                                    if (ii=finx) and (jj=finy) then exit(true);
                                end;
                    end;
            end;
        exit(false);
    end;
function check(mid:longint):boolean;
    begin
        exit(bfs(mid));
    end;
procedure process;
    begin
        spread;
        res:=-1;
        l:=1;r:=m+n-2;
        while l<=r do
            begin
                mid:=(l+r) div 2;
                if check(mid) then
                    begin
                        res:=mid;
                        l:=mid+1;
                    end
                else r:=mid-1;
            end;
        writeln(res);
    end;
begin
    assign(input,tfi);reset(input);
    assign(output,tfo);rewrite(output);
    inp;
    process;
    close(input);close(output);
end.