Cod sursa(job #592291)

Utilizator vendettaSalajan Razvan vendetta Data 27 mai 2011 17:55:18
Problema Barbar Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 3.67 kb
const f = 'barbar.in'; g = 'barbar.out';
const dx : array[0..3] of shortint=(-1,0,1,0);
const dy : array[0..3] of shortint=(0,1,0,-1);

type elem = record
        x, y : longint;
end;

var
    drum : array[0..1000000] of elem;
    a, x : array[0..1001,0..1001] of longint;
    xp, xs, yp, ys, r, c, i, j : longint;
    ch : char;
    dr : longint;
    ince, sf: elem;

function check( x, y : longint ) : boolean;
    begin
        //if (x >= xp) and (x <= xs ) and (y >= yp) and (y <= ys) then check := true
        if (x >= 1) and (x <= r ) and (y >= 1) and (y <= c) then check := true
        else check := false;
    end;

procedure lee;
    var
        st, k, ii, jj : longint;
    begin
        st := 1;
        a[drum[st].x,drum[st].y] := 0;
        while (st <= dr ) do begin
            //a[drum[st].x,drum[st].y] := 0;
            for k := 0 to 3 do begin
                ii := drum[st].x + dx[k];
                jj := drum[st].y + dy[k];
                if (check(ii,jj)) and (a[ii,jj] = -2) then begin
                    inc( dr );
                    drum[dr].x := ii;
                    drum[dr].y := jj;
                    a[ii,jj] := a[drum[st].x,drum[st].y] + 1;
                end;
            end;
            inc( st );
        end;

    end;

function posibil( d : longint ) : boolean;
    var
        st, k, ii, jj : longint;

    begin
        posibil := false;
        fillchar( x, sizeof(x), 0 );
        st := 1; dr := 1;
        drum[st] := ince;
        x[drum[st].x,drum[st].y] := 1;

        while (st <= dr) do begin
            for k := 0 to 3 do begin
                ii := drum[st].x + dx[k];
                jj := drum[st].y + dy[k];
                if ( check( ii, jj ) ) and (a[ii,jj] >= d) and (x[ii,jj] = 0) then begin
                    inc( dr );
                    drum[dr].x := ii;
                    drum[dr].y := jj;
                    x[ii,jj] := 1;
                end;
            end;
            inc( st );
        end;
    if x[sf.x,sf.y] = 1 then posibil:= true;

    end;

function solve( ls, ld : longint ) : longint;
    var
        st, dr, mij, sol : longint;
    begin
        st := ls; dr := ld;
        while ( st <= dr ) do begin
            mij := ( st + dr ) div 2;
            if posibil( mij ) then begin
                st := mij + 1;
                sol := mij;
            end
            else dr := mij - 1;
        end;
        if sol>0 then solve := sol else solve := -1;
    end;

begin
    assign( input,f ); reset( input );
    assign( output,g ); rewrite( output );
    readln(r, c );
    for i := 1 to r do begin
        for j := 1 to c do begin
            //if j = c then readln( ch ) else read( ch );
            read( ch );
            if ch = 'D' then begin
                inc( dr );
                drum[dr].x := i; drum[dr].y := j;
                a[i,j] := 0;
            end;
            {
            if (ch = 'I') or (ch = 'O') then begin
                inc( dr );
                drum[dr].x := i; drum[dr].y := j;
            end;

            }
            if (ch = 'I') then begin a[i,j] := -2; ince.x := i; ince.y := j; end;
            if (ch = 'O') then begin a[i,j] := -2; sf.x := i; sf.y := j; end;

            if (ch = '*') then a[i,j] := -1;
            if (ch = '.') then a[i,j] := -2;
        end;
        readln;
    end;
    {
    for i := 1 to r do begin
        for j := 1 to c do write(a[i,j],' ');
        writeln;
    end;
    writeln;
    }
    lee;
    {
    for i := 1 to r do begin
        for j := 1 to c do write(a[i,j],' ');
        writeln;
    end;
    }
    writeln(solve(-1,a[ince.x,ince.y]));
end.