Cod sursa(job #141007)

Utilizator Pepelea_FlaviuFlaviu Pepelea Pepelea_Flaviu Data 22 februarie 2008 17:19:54
Problema Barbar Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 3.01 kb
{BARBAR  -  100 pct     ATENTIE LA BORDURI :))}
type coord=record
      x,y:integer;
    end;
type pelem=^elem;
     elem=record
       info:coord;
       next:pelem;
     end;
const dx:array[1..4]of integer=(0,0,1,-1);
      dy:array[1..4]of integer=(1,-1,0,0);
const nmax=1100001;
var fi,fo:text;
    R,C,i,j,iu,ju,xi,yi,xf,yf,k,max:integer;
    first,last:pelem;
    a:array[0..1011,0..1011]of char;
    o,oo:array[0..1011,0..1011]of integer;
    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:integer):boolean;
var i,j,k:integer;
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:integer):integer;
var mij,rez,ct:integer;
begin
  rez:=-1; ct:=0;
  while st<=dr do
    begin
      mij:=(st+dr) shr 1; inc(ct);
      if verif(mij,ct) then
        begin
          rez:=mij; st:=mij+1; 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);
            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,C+1]:='*'; end;
  for i:=0 to C+1 do
    begin
      a[0,i]:='*'; a[0,R+1]:='*'; end;
  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.