Cod sursa(job #833931)

Utilizator tgistvanTorok Istvan tgistvan Data 13 decembrie 2012 14:00:31
Problema Barbar Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.89 kb
 type sark=record
           x,y:integer;
           end;

      mat=array[0..1000,0..1000]of integer;

      sor=array[0..1000] of sark;

 var a:mat;
     d:sor;
     c:char;
     n,m,i,j,bei,bej,kii,kij,k:integer;
     f,g:text;

 procedure jbfl(x,y:integer);
 var i,j:integer;
 begin
 if (x>0)and(y>0)and(x<=n)and(y<=m) then begin

 if(a[x,y-1]>0)and(a[x,y-1]>a[x,y]+1) then begin a[x,y-1]:=a[x,y]+1; jbfl(x,y-1); end;
 if(a[x,y+1]>0)and(a[x,y+1]>a[x,y]+1) then begin a[x,y+1]:=a[x,y]+1; jbfl(x,y+1); end;
 if(a[x-1,y]>0)and(a[x-1,y]>a[x,y]+1) then begin a[x-1,y]:=a[x,y]+1; jbfl(x-1,y); end;
 if(a[x+1,y]>0)and(a[x+1,y]>a[x,y]+1) then begin a[x+1,y]:=a[x,y]+1; jbfl(x+1,y); end;

 end;

 end;


 function minim(d:sor;k:integer):integer;
 var i,x,y:integer;
 begin

 minim:=maxint;

 for i:=1 to k do begin
 x:=d[i].x;
 y:=d[i].y;

 if (x>0)and(y>0)and(x<=n)and(y<=m) then begin
 if(a[x,y-1]<minim)and(a[x,y-1]>0) then minim:=a[x,y-1];
 if(a[x,y+1]<minim)and(a[x,y+1]>0)  then minim:=a[x,y+1];
 if(a[x-1,y]<minim)and(a[x-1,y]>0)  then minim:=a[x-1,y];
 if(a[x+1,y]<minim)and(a[x+1,y]>0)  then minim:=a[x+1,y];
 end;


 end;

 {inc(minim);}
 end;

 begin

 assign(f,'barbar.in'); reset(f);
 read(f,n,m);

 for i:=1 to n do
 for j:=1 to m do  a[i,j]:=maxint;



 k:=0;
 for i:=1 to n do begin readln(f);
     for j:=1 to m do begin
                      read(f,c);
                      if c='*' then a[i,j]:=-9
                      else
                      if c='D' then begin a[i,j]:=-2;
                                    inc(k);
                                    d[k].x:=i;
                                    d[k].y:=j;
                                    end
                      else
                      if c='O' then begin
                                    kii:=i;
                                    kij:=j;
                                    a[i,j]:=-1
                                    end
                      else if c='I' then  begin
                                          a[i,j]:=0;
                                          bei:=i;
                                          bej:=j;
                                          end;

                      end;
                  end;
 close(f);

 {
 for i:=0 to n do begin writeln;
 for j:=0 to m do write(a[i,j]:7);
 end;
 writeln;
 writeln('elvegzi es : ');

 writeln(bei,'   ',bej);    }

 jbfl(bei,bej);

 for i:=0 to n do begin
                  a[i,0]:=maxint;
                  a[i,m]:=maxint;
                  end;

 for j:=0 to n do begin
                  a[0,j]:=maxint;
                  a[m,j]:=maxint;
                  end;



{for i:=0 to n do begin writeln;
 for j:=0 to m do write(a[i,j]:7);
 end;
 writeln;      }
 for i:=1 to k do writeln(d[i].x,'   ',d[i].y);

 assign(g,'Barbar.out'); rewrite (g);
 write(minim(d,k));
 close(g);
 end.