Cod sursa(job #370392)

Utilizator arnold23Arnold Tempfli arnold23 Data 30 noiembrie 2009 23:16:30
Problema Rj Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.4 kb
const cx:array[1..8] of shortint =(0,0,1,-1,1,-1,1,-1);
      cy:array[1..8] of shortint =(-1,1,0,0,1,-1,-1,1);

type elem=record
          x,y,h:longint;
        end;

var rom,jul:array[1..101,1..101] of longint;
    v:array[1..101,1..101] of shortint;
    me:array[1..10000] of elem;
    f:text;
    ro,ju:elem;
    i,j,n,m,min,hx,hy:longint;
    a:char;

procedure bejarrom(lq:elem);
var  ux,uy,hany,l,c:longint;
begin
 l:=1;
 c:=1;
 me[1].x:=lq.x;
 me[1].y:=lq.y;
 me[1].h:=1;

 while l<=c do begin
   for i:=1 to 8 do begin
     ux:=me[l].x+cx[i];
     uy:=me[l].y+cy[i];
     if (ux in [1..n]) and (uy in [1..m]) then
      if (v[ux,uy]<>-1) and (rom[ux,uy]=0) then begin
        hany:=me[l].h+1;
        inc(c);
        me[c].x:=ux;
        me[c].y:=uy;
        me[c].h:=hany;
        rom[ux,uy]:=hany;
     end;
   end;
   inc(l);
 end;

end;

procedure bejarjul(lq:elem);
var  ux,uy,hany,l,c:longint;
begin
 l:=1;
 c:=1;
 me[1].x:=lq.x;
 me[1].y:=lq.y;
 me[1].h:=1;

 while l<=c do begin
   for i:=1 to 8 do begin
     ux:=me[l].x+cx[i];
     uy:=me[l].y+cy[i];
     if (ux in [1..n]) and (uy in [1..m]) then
      if (v[ux,uy]<>-1) and (jul[ux,uy]=0) then begin
        hany:=me[l].h+1;
        inc(c);
        me[c].x:=ux;
        me[c].y:=uy;
        me[c].h:=hany;
        jul[ux,uy]:=hany;
     end;
   end;
   inc(l);
 end;

end;


begin
 assign(f,'rj.in');
 reset(f);
 readln(f,n,m);
 for i:=1 to n do begin
   for j:=1 to m do begin
     read(f,a);
     if a='X' then v[i,j]:=-1
     else if a='R' then begin ro.x:=i; ro.y:=j; end
     else if a='J' then begin ju.x:=i; ju.y:=j; end
     else v[i,j]:=0;
   end;
   readln(f);
 end;
 close(f);

 {kiiras}
 { for i:=1 to n do begin for j:=1 to m do write(v[i,j],' '); writeln; end;  }

 bejarrom(ro);
 bejarjul(ju);

 min:=maxlongint;
 for i:=1 to n do
   for j:=1 to m do
     if rom[i,j]=jul[i,j] then
       if (rom[i,j]<min) and (rom[i,j]+jul[i,j]<>0) then begin
                              min:=rom[i,j];
                              hx:=i;
                              hy:=j;
                            end;

 assign(f,'rj.out');
 rewrite(f);
 write(f,min,' ',hx,' ',hy);
 close(f);

{probara

new(elso);
elso^.x:=ro.kx;
elso^.y:=ro.ky;
elso^.kov:=nil;
betesz(1,2,3);
while elso<>nil do begin
  write(elso^.x,' ',elso^.y,' ');
  elso:=elso^.kov;
end;
}

end.