Cod sursa(job #140937)

Utilizator time_testertime tester time_tester Data 22 februarie 2008 14:29:20
Problema Barbar Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 3.43 kb
program barbar;
type coord=record
      x,y:longint;
    end;
type pelem=^elem;
     elem=record
       info:coord;
       next:pelem;
     end;
type vector=array[1..4]of longint;
const dx:vector=(0,0,1,-1);
      dy:vector=(1,-1,0,0);
const nmax=1100001;
var fi,fo:text;
    R,C,i,j,iu,ju,xi,yi,xf,yf,k,max:longint;
    first,last:pelem;
    a:array[0..1011,0..1011]of char;
    oo:array[0..1011,0..1011]of longint;
    o:array[0..1011,0..1011]of longint;
    pc,pu:coord;
    ss:ansistring;
procedure qout(var vl:coord);
var p:pelem;
begin
  p:=first;
  vl:=first^.info;
  first:=first^.next;
  dispose(p);
end;
procedure qin(vl:coord);
var p:pelem;
begin
  new(p);
  p^.info:=vl;
  p^.next:=nil
  if first=nil then
    begin
      first:=p;
      last:=first;
    end
  else
    begin
      last^.next:=p;
      last:=p;
    end;
end;
function verif(m,ct:longint):boolean;
var i,j,k:longint;
begin
  if o[xi,yi]<m then
    begin
      verif:=false;
      exit;
    end;
  pc.x:=xi; pc.y:=yi;
  qin(pc);
  oo[xi,yi]:=ct;
  while first<>nil do
    begin
      qout(pc); i:=pc.x; j:=pc.y;
      for k:=1 to 4 do
        begin
          iu:=i+dx[k]; ju:=j+dy[k];
          if (oo[iu,ju]<ct)and(o[iu,ju]>=m)and(a[iu,ju]='.') then
            begin
              oo[iu,ju]:=ct;
              pu.x:=iu; pu.y:=ju; qin(pu);
            end;
        end;
    end;
  if oo[xf,yf]<>ct then verif:=false
                   else verif:=true;
end;
function binary_search(st,dr:longint):longint;
var mij,rez,ct:longint;
begin
  rez:=-1; ct:=0;
  while st<=dr do
    begin
      mij:=(st+dr) shr 1;
      ct:=ct+1;
      if verif(mij,ct) then
        begin
          rez:=mij;
          st:=mij+1;
          ct:=ct+1;
          if verif(mij+1,ct)=false then
            begin
              binary_search:=rez;
              exit;
            end;
        end
      else
        dr:=mij-1;
    end;
  binary_search:=rez;
end;
begin
  assign(fi,'barbar.in'); reset(fi);
  assign(fo,'barbar.out'); rewrite(fo);
  readln(fi,R,C);
  for i:=1 to R do
    begin
      readln(fi,ss);
      for j:=1 to length(ss) do
        begin
          o[i,j]:=nmax;
          if ss[j]='I' then
            begin
              xi:=i;
              yi:=j;
              a[i,j]:='.';
            end;
          if ss[j]='O' then
            begin
              xf:=i;
              yf:=j;
              a[i,j]:='.';
            end;
          if ss[j]='D' then
            begin
              o[i,j]:=0;
              pc.x:=i; pc.y:=j;
              qin(pc);
              a[i,j]:='.'
            end;
          if ss[j]='*' then
            a[i,j]:='*';
          if ss[j]='.' then a[i,j]:='.';
        end;
    end;
  for i:=0 to R+1 do
    begin
      a[i,0]:='*'; a[i,R+1]:='*';
      oo[i,0]:=nmax; oo[i,R+1]:=nmax; end;
  for i:=0 to C+1 do
    begin
      a[0,i]:='*'; a[0,C+1]:='*';
      oo[0,i]:=nmax; oo[0,C+1]:=nmax; end;
  max:=0;
  while first<>nil do
    begin
      qout(pc); i:=pc.x; j:=pc.y;
      for k:=1 to 4 do
        begin
          iu:=i+dx[k]; ju:=j+dy[k];
          if (a[iu,ju]='.')and(o[iu,ju]>o[i,j]+1) then
            begin
              o[iu,ju]:=o[i,j]+1;
              if o[iu,ju]>max then max:=o[iu,ju];
              pu.x:=iu; pu.y:=ju; qin(pu);
            end;
        end;
    end;
  writeln(fo,binary_search(0,max));
  close(fi);
  close(fo);
end.