Cod sursa(job #212808)

Utilizator antoanelaAntoanela Siminiuc antoanela Data 6 octombrie 2008 22:07:06
Problema Barbar Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.6 kb
var f,g:Text;
    ls,cs:array[0..100000000]of integer;
    a:array[0..1000,0..1000]of char;
    v,d:array[0..1000,0..1000]of longint;
    v1:array[1..4]of shortint=(0,0,-1,1);
    v2:array[1..4]of shortint=(-1,1,0,0);
    r,h,i,j,le,ce,lb,cb,m:longint;

procedure bfs1;
var p,l,c:longint;
begin
  p:=1;
  while (p<=h)do
    begin
      for i:=1 to 4 do
        begin
          l:=ls[p]+v1[i];
          c:=cs[p]+v2[i];
          if (l>0)and(l<=r)and(c>0)and(c<=m)and(a[l,c]<>'*')and(a[l,c]<>'D')and(v[l,c]=0)then
            begin
              inc(h);
              ls[h]:=l;
              cs[h]:=c;
              v[l,c]:=v[ls[p],cs[p]]+1;
            end;
        end;
      inc(p);
    end;
end;

function min(a,b:longint):longint;
begin
  min:=a;
  if (b<a)then min:=b;
end;

function max(a,b:longint):longint;
begin
  max:=a;
  if (b>a)then max:=b;
end;

procedure bfs2;
var p,l,c,k:longint;
begin
  h:=0;
  for i:=1 to 4 do
    begin
      l:=lb+v1[i];
      c:=cb+v2[i];
      if (l>0)and(l<=r)and(c>0)and(c<=m)then
        begin
          inc(h);
          ls[h]:=l;
          cs[h]:=c;
          d[l,c]:=v[lb,cb];
        end;
    end;
  p:=1;
  while (p<=h)do
    begin
      for i:=1 to 4 do
        begin
          l:=ls[p]+v1[i];
          c:=cs[p]+v2[i];
          if (l>0)and(l<=r)and(c>0)and(c<=m)and(a[l,c]<>'*')and(a[l,c]<>'D')then
            begin
              k:=min(v[ls[p],cs[p]],d[ls[p],cs[p]]);
              if (d[l,c]<k)then
                begin
                  inc(h);
                  ls[h]:=l;
                  cs[h]:=c;
                  d[l,c]:=k;
                end;
            end;
        end;
      inc(p);
    end;
end;


begin
assign(f,'barbar.in');
assign(g,'barbar.out');
reset(f);
rewrite(g);
readln(f,r,m);
for i:=1 to r do
  begin
    for j:=1 to m do
      begin
        read(f,a[i,j]);
        if (a[i,j]='D')then
          begin
            inc(h);
            ls[h]:=i;
            cs[h]:=j;
          end else
        if (a[i,j]='*')then v[i,j]:=-1 else
        if (a[i,j]='I')then
          begin
            lb:=i;
             cb:=j;
          end else
        if (a[i,j]='0')then
          begin
            le:=i;
            ce:=j;
           end;
      end;
    readln(f);
  end;
bfs1;
{for i:=1 to r do
  begin
    for j:=1 to m do write(G,v[i,j], ' ');
    writeln(g);
  end;
writeln(g);}
bfs2;
{for i:=1 to r do
  begin
    for j:=1 to m do write(G,d[i,j], ' ');
    writeln(g);
  end;}
if (d[le,ce]=0)then write(G,-1)else write(g,d[le,ce]);
close(f);
close(g);
end.