Cod sursa(job #825507)

Utilizator hungntnktpHungntnktp hungntnktp Data 29 noiembrie 2012 09:47:37
Problema Barbar Scor 90
Compilator fpc Status done
Runda Arhiva de probleme Marime 4.08 kb
{$H+}
USES
        math;
CONST
        tfi     =       'barbar.in';
        tfo     =       'barbar.out';
        h1      :       array[1..4] of longint=(0,0,1,-1);
        h2      :       array[1..4] of longint=(1,-1,0,0);
VAR

        fo,fi   :       text;

        a       :       array[1..1001,1..1001] of longint;
        l1,l2   :       array[1..1000000] of longint;
        ts      :       array[1..1000,1..1000] of longint;
        res,n,m,dem,sx,sy,ex,ey,tg     :       longint;
        free,fr    :       array[1..1001,1..1001] of boolean;
        ok:longint;
        st:string;
        q1,q2   :       array[1..1000000] of longint;
        l,r:longint;

procedure push(x,y:longint);
  begin
        Inc(r);
        q1[r]:=x;
        q2[r]:=y;
  end;
procedure pop(var x,y:longint);
  begin
         x:=q1[l];
         y:=q2[l];
         Inc(l);
  end;
procedure nhap;
  var i,j:longint;  c:Char;
  begin
        assign(fi,tfi);reset(fi);assign(fo,tfo);rewrite(fo);
          readln(fi,n,m);
          l:=1;r:=0;
          for i:= 1 to n do
            begin
                 readln(fi,st);
                 for j:=1 to m do
                   begin
                         fr[i,j]:=true;
                         if st[j]='.' then a[i,j]:=0
                         else if st[j]='I' then
                           begin
                                 sx:=i;
                                 sy:=j;
                           end
                         else if st[j]='O' then
                           begin
                                 ex:=i;
                                 ey:=j;
                           end
                         else if st[j]='*' then a[i,j]:=1
                         else
                           begin
                                a[i,j]:=2;
                                push(i,j);
                                fr[i,j]:=false
                           end;
                   end;
            end;
  end;

procedure ktao;
  var i,u,v,x,y:longint;
  begin
         While l<=r do
           begin
                pop(x,y);
                for i:=1 to 4 do
                  begin
                        u:=h1[i]+x;
                        v:=h2[i]+y;
                        if (u>=1) and (v>=1) and (u<=n) and (v<=m) and (fr[u,v]) then
                          begin
                                ts[u,v]:=ts[x,y]+1;
                                fr[u,v]:=false;
                                push(u,v);
                          end;
                  end;
           end;
  end;
procedure Go(x,y,k:longint);
  var i,j,u,v:longint;
  begin
         if (x=ex) and (y=ey) then
           begin
               tg:=1;
               exit;
           end;
         if tg=1 then exit;
         if tg=0 then
           begin
                 for i:=1 to 4 do
                   begin
                        u:=x+h1[i];
                        v:=y+h2[i];
                        if (u>=1) and (u<=n) and (v<=m) and (v>=1) then
                         if (a[u,v]<>1) and (free[u,v]) and (ts[u,v]>=k) then
                           begin
                                 free[u,v]:=false;
                                 Go(u,v,k);
                           end;
                   end;
           end;


  end;
function Check(x:longint):boolean;
  var i,j:longint;
  begin
         tg:=0;
         fillchar(free,sizeof(free),true);
         free[sx,sy]:=false;
         if ts[sx,sy]<x then exit(false);
         Go(sx,sy,x);
         if tg=0 then exit(false);
         exit(true);
  end;
procedure xl;
  var l,r,mid:longint;
  begin
         l:=0;
         r:=n+m;
         res:=-1;
         while l<=r do
           begin
                mid:=(l+r) shr 1;
                if Check(mid) then
                  begin
                        res:=mid;
                        l:=mid+1;
                  end
                else r:=mid-1;
           end;
        write(fo,res);
  end;
BEGIN
      nhap;
      ktao;
      xl;
      close(fo);
      close(Fi);
END.