Cod sursa(job #1538966)

Utilizator TheMastermindThe Mastermind TheMastermind Data 30 noiembrie 2015 03:10:07
Problema Barbar Scor 90
Compilator fpc Status done
Runda Arhiva de probleme Marime 4.38 kb
{$H+}
CONST
    tfi='barbar.in';
    tfo='barbar.out';
    dd : array[1..4] of longint = (0,-1,0,1);
    cc : array[1..4] of longint = (1,0,-1,0);
VAR
    r,c,nh,pop1,pop2,x1,x2,y1,y2 : longint;
    st : string;
    a : array[1..1000,1..1000] of longint;
    h,h1 : array[1..1000000] of longint;
    pos,d : array[1..1000,1..1000] of longint;
    free : array[1..1000,1..1000] of boolean;
    fre,fr : array[1..1000,1..1000] of longint;
procedure nhap;
    var i,j : longint;
    begin
        readln(r,c);
        for i:=1 to r do
          begin
            readln(st);
            for j:=1 to c do
              if st[j] = 'D' then a[i,j]:=1
              else if st[j] = '*' then a[i,j]:=2
              else if st[j] = 'I' then
                begin
                  a[i,j]:=3;
                  x1:=i; y1:=j;
                end
              else if st[j] = 'O' then
                begin
                  a[i,j]:=4;
                  x2:=i; y2:=j;
                end;
          end;
    end;
procedure doicho(var x,y:longint);
    var tg:longint;
    begin
        tg:=x;
        x:=y;
        y:=tg;
    end;
procedure upheap(i:longint);
    begin
        if (i = 1) or  (d[h[i],h1[i]] >= d[h[i div 2],h1[i div 2]]) then exit;
        doicho(h[i],h[i div 2]);
        doicho(h1[i],h1[i div 2]);
        doicho(pos[h[i],h1[i]],pos[h[i div 2],h1[i div 2]]);
        upheap(i div 2);
    end;
procedure downheap(i:longint);
    var j:longint;
    begin
        j:=i*2;
        if (j>nh) then exit;
        if (j <nh) and (d[h[j],h1[j]] > d[h[j+1],h1[j + 1]]) then inc(j);
        if d[h[i],h1[i]] > d[h[j],h1[j]] then
           begin
              doicho(h[i],h[j]);
              doicho(h1[i],h1[j]);
              doicho(pos[h[i],h1[i]],pos[h[j],h1[j]]);
              downheap(j);
           end;
    end;
procedure push(x,y:longint);
    begin
        inc(nh);
        h[nh]:=x; h1[nh]:=y;
        pos[x,y]:=nh;
        upheap(nh);
    end;
procedure pop;
    begin
        pop1:=h[1];
        pop2:=h1[1];
        h[1]:=h[nh];
        h1[1]:=h1[nh];
        pos[h[1],h1[1]]:=1;
        dec(nh);
        downheap(1);
    end;
procedure xuly;
    var j,u,v,i,ii,jj:longint;
    begin
        nh:=0;
        for i:=1 to r do
          for j:=1 to c do
            begin
              d[i,j]:=10000000;
              free[i,j]:=true;
            end;
        for i:=1 to r do
          for j:=1 to c do
            if a[i,j]=1 then
              begin
                d[i,j]:=0;
                push(i,j);
              end;
        repeat
          pop;
          u:=pop1;
          v:=pop2;
          free[u,v]:=false;
          for i:=1 to 4 do
            begin
              ii:=u + dd[i]; jj:=v + cc[i];
              if (ii >=1) and (ii <= r) and (jj >=1) and (jj <= c) then
                if (a[ii,jj] <> 1) and (a[ii,jj] <> 2) then
                  if (free[ii,jj]) and (d[ii,jj] > d[u,v] + 1) then
                    begin
                      d[ii,jj]:=d[u,v] + 1;
                      if pos[ii,jj] = 0 then push(ii,jj) else upheap(pos[ii,jj]);
                    end;
            end;
        until nh =0;
    end;
procedure dfs(u,v,mid : longint);
    var i,ii,jj : longint;
    begin
        if d[u,v] < mid then exit;
        fre[u,v]:=mid;
        if (u = x2) and (v = y2) then exit;
        for i:=1 to 4 do
          begin
            ii:=u + dd[i]; jj:=v + cc[i];
            if (ii >=1) and (ii <= r) and (jj >=1) and (jj <= c) then
              if (d[ii,jj] >= mid) and (a[ii,jj] <> 2) and (a[ii,jj] <> 1) then
                if (fre[ii,jj] <> mid) then dfs(ii,jj,mid);
          end;
    end;
function check(mid : longint) : boolean;
    begin
        dfs(x1,y1,mid);
        if fre[x2,y2] = mid then exit(true)
        else exit(false);
    end;
procedure main;
    var ll,rr,mid,kq : longint;
    begin
        ll:=1; rr:=d[x1,y1]; kq:=-1;
        while ll <= rr do
          begin
            mid:=(ll+rr) div 2;
            if check(mid) then
              begin
                kq:=mid;
                ll:=mid + 1;
              end
            else rr:=mid -1;
          end;
        writeln(kq);
    end;
BEGIN
    assign(input,tfi); reset(input);
    assign(output,tfo); rewrite(output);
        nhap;
        xuly;
        main;
    close(input); close(output);
END.