Cod sursa(job #1537429)

Utilizator hungntnktpHungntnktp hungntnktp Data 27 noiembrie 2015 11:37:54
Problema Barbar Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.74 kb
program barbar;

const
  tfi = 'barbar.in';
  tfo = 'barbar.out';
  r : array [0..3] of longint = (0,1,0,-1);
  c : array [0..3] of longint = (1,0,-1,0);

var
  m,n,front,rear,time,sx,sy,res : longint;
  qx,qy : array [1..1000000] of longint;
  d,pass : array [1..1000,1..1000] of longint;
  s : array [1..1000,1..1000] of char;

procedure enter;
  var i,j : longint;
  begin
    assign(input,tfi);
    reset(input);
    readln(m,n);
    for i := 1 to m do
      begin
        for j := 1 to n do
          begin
            read(s[i,j]);
            if s[i,j] = 'I' then
              begin
                sx := i;
                sy := j;
              end;
          end;
        readln;
      end;
    close(input);
  end;

function inside(x,y : longint) : boolean;
  begin
    exit((1 <= x) and (x <= m) and (1 <= y) and (y <= n) and (s[x,y] <> '*'));
  end;

procedure push(x,y : longint);
  begin
    inc(rear);
    qx[rear] := x;
    qy[rear] := y;
  end;

procedure pop(var x,y : longint);
  begin
    x := qx[front];
    y := qy[front];
    inc(front);
  end;

procedure init;
  var x,y,u,v,i : longint;
  begin
    front := 1; rear := 0;
    for x := 1 to m do
      for y := 1 to n do
        if s[x,y] = 'D' then push(x,y)
        else d[x,y] := -1;
    while front <= rear do
      begin
        pop(x,y);
        for i := 0 to 3 do
          begin
            u := x + r[i];
            v := y + c[i];
            if inside(u,v) and (d[u,v] = -1) then
              begin
                d[u,v] := d[x,y] + 1;
                push(u,v);
              end;
          end;
      end;
  end;

function check(mid : longint) : boolean;
  var x,y,u,v,i : longint;
  begin
    inc(time);
    front := 1; rear := 0;
    push(sx,sy);
    pass[sx,sy] := time;
    while front <= rear do
      begin
        pop(x,y);
        for i := 0 to 3 do
          begin
            u := x + r[i];
            v := y + c[i];
            if inside(u,v) and (d[u,v] >= mid) and (pass[u,v] <> time) then
              begin
                if s[u,v] = 'O' then exit(true);
                push(u,v);
                pass[u,v] := time;
              end;
          end;
      end;
    exit(false);
  end;

procedure process;
  var l,r,mid : longint;
  begin
    res := -1;
    l := 1;
    r := d[sx,sy];
    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;
  end;

procedure print;
  begin
    assign(output,tfo);
    rewrite(output);
    write(res);
    close(output);
  end;

begin
  enter;
  init;
  process;
  print;
end.