Cod sursa(job #370395)

Utilizator arnold23Arnold Tempfli arnold23 Data 30 noiembrie 2009 23:49:13
Problema Rj Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.27 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,t:longint;
    a:char;
    ok:boolean;

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 begin
      if jul[ux,uy]=1 then min:=(me[l].h+1) shr 1;
      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;
   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 begin
      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;
   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;  }

 jul[ju.x,ju.y]:=1;
 bejarrom(ro);
 jul[ju.x,ju.y]:=0;
 bejarjul(ju);

 i:=1;
 ok:=true;
 while (i<=n) and ok do begin
    j:=1;
    while (j<=m) and (ok) do begin
       if (rom[i,j]=jul[i,j]) and (rom[i,j]=min) then ok:=false;
       inc(j);
    end;
    inc(i);
 end;

 assign(f,'rj.out');
 rewrite(f);
 write(f,min,' ',i-1,' ',j-1);
 close(f);


end.