Cod sursa(job #357024)

Utilizator ionutz32Ilie Ionut ionutz32 Data 17 octombrie 2009 19:28:01
Problema Barbar Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 4.81 kb
type ref=^nod;
nod=record
    x,y:word;
    adr:ref;
    end;
var a,s:array[1..1000,1..1000] of longint;
v,u,sf,u2:ref;
m,n,i,j,a1,b,mid,ix,iy,ox,oy:longint;
c:char;
f,g:text;
k:boolean;
begin
assign(f,'barbar.in');
assign(g,'barbar.out');
reset(f);rewrite(g);
readln(f,m,n);
for i:=1 to m do
    begin
    for j:=1 to n do
        begin
        read(f,c);
        case c of
             '.':a[i,j]:=1000001;
             '*':a[i,j]:=-1;
             'D':if v=nil then
                    begin
                    new(v);
                    v^.x:=i;
                    v^.y:=j;
                    v^.adr:=nil;
                    sf:=v;
                    end
                 else
                     begin
                     new(u);
                     u^.x:=i;
                     u^.y:=j;
                     u^.adr:=nil;
                     sf^.adr:=u;
                     sf:=u;
                     end;
             'I':begin
                 a[i,j]:=1000001;
                 ix:=i;
                 iy:=j;
                 end;
             'O':begin
                 a[i,j]:=1000001;
                 ox:=i;
                 oy:=j;
                 end;
             end;
        s[i,j]:=1000001;
        end;
    readln(f);
    end;
u:=v;
while u<>nil do
      begin
      if (u^.x>1) and (a[u^.x-1,u^.y]=1000001) then
         begin
         a[u^.x-1,u^.y]:=a[u^.x,u^.y]+1;
         new(u2);
         u2^.x:=u^.x-1;
         u2^.y:=u^.y;
         u2^.adr:=nil;
         sf^.adr:=u2;
         sf:=u2;
         end;
      if (u^.y>1) and (a[u^.x,u^.y-1]=1000001) then
         begin
         a[u^.x,u^.y-1]:=a[u^.x,u^.y]+1;
         new(u2);
         u2^.x:=u^.x;
         u2^.y:=u^.y-1;
         u2^.adr:=nil;
         sf^.adr:=u2;
         sf:=u2;
         end;
      if (u^.y<n) and (a[u^.x,u^.y+1]=1000001) then
         begin
         a[u^.x,u^.y+1]:=a[u^.x,u^.y]+1;
         new(u2);
         u2^.x:=u^.x;
         u2^.y:=u^.y+1;
         u2^.adr:=nil;
         sf^.adr:=u2;
         sf:=u2;
         end;
      if (u^.x<m) and (a[u^.x+1,u^.y]=1000001) then
         begin
         a[u^.x+1,u^.y]:=a[u^.x,u^.y]+1;
         new(u2);
         u2^.x:=u^.x+1;
         u2^.y:=u^.y;
         u2^.adr:=nil;
         sf^.adr:=u2;
         sf:=u2;
         end;
      v:=u;
      u:=u^.adr;
      dispose(v);
      end;
if a[ix,iy]<a[ox,oy] then
   b:=a[ix,iy]
else
    b:=a[ox,oy];
while a1<=b do
      begin
      mid:=a1+(b-a1) shr 1;
      s[ix,iy]:=mid;
      v:=nil;u:=nil;u2:=nil;sf:=nil;
      new(v);
      v^.x:=ix;
      v^.y:=iy;
      v^.adr:=nil;
      sf:=v;
      u:=v;
      k:=false;
      while u<>nil do
            begin
            if (u^.x>1) and (a[u^.x-1,u^.y]>=mid) and (s[u^.x-1,u^.y]<>mid) then
               begin
               s[u^.x-1,u^.y]:=mid;
               new(u2);
               u2^.x:=u^.x-1;
               u2^.y:=u^.y;
               u2^.adr:=nil;
               sf^.adr:=u2;
               sf:=u2;
               if (sf^.x=ox) and (sf^.y=oy) then
                  begin
                  k:=true;
                  break;
                  end;
               end;
            if (u^.y>1) and (a[u^.x,u^.y-1]>=mid) and (s[u^.x,u^.y-1]<>mid) then
               begin
               s[u^.x,u^.y-1]:=mid;
               new(u2);
               u2^.x:=u^.x;
               u2^.y:=u^.y-1;
               u2^.adr:=nil;
               sf^.adr:=u2;
               sf:=u2;
               if (sf^.x=ox) and (sf^.y=oy) then
                  begin
                  k:=true;
                  break;
                  end;
               end;
            if (u^.y<n) and (a[u^.x,u^.y+1]>=mid) and (s[u^.x,u^.y+1]<>mid) then
               begin
               s[u^.x,u^.y+1]:=mid;
               new(u2);
               u2^.x:=u^.x;
               u2^.y:=u^.y+1;
               u2^.adr:=nil;
               sf^.adr:=u2;
               sf:=u2;
               if (sf^.x=ox) and (sf^.y=oy) then
                  begin
                  k:=true;
                  break;
                  end;
               end;
            if (u^.x<m) and (a[u^.x+1,u^.y]>=mid) and (s[u^.x+1,u^.y]<>mid) then
               begin
               s[u^.x+1,u^.y]:=mid;
               new(u2);
               u2^.x:=u^.x+1;
               u2^.y:=u^.y;
               u2^.adr:=nil;
               sf^.adr:=u2;
               sf:=u2;
               if (sf^.x=ox) and (sf^.y=oy) then
                  begin
                  k:=true;
                  break;
                  end;
               end;
            v:=u;
            u:=u^.adr;
            dispose(v);
            end;
      if k=true then
         a1:=mid+1
      else
          b:=mid-1;
      end;
write(g,b);
close(f);close(g);
end.