Cod sursa(job #277365)

Utilizator cheery_g1rlHaller Emanuela cheery_g1rl Data 11 martie 2009 17:49:38
Problema Rj Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.64 kb
var a:array[0..101,0..101] of char;
    r,j:array[1..100,1..100] of integer;
    min,n,m,i,k,xr,xj,yr,yj:integer;
    s:string;
procedure apelr(x,y,d:integer);
   begin
     if (a[x,y]<>'X')and(r[x,y]>d) then
        begin
          r[x,y]:=d;
          apelr(x,y-1,d+1);
          apelr(x,y+1,d+1);
          apelr(x-1,y-1,d+1);
          apelr(x-1,y,d+1);
          apelr(x-1,y+1,d+1);
          apelr(x+1,y-1,d+1);
          apelr(x+1,y,d+1);
          apelr(x+1,y+1,d+1);
        end;
   end;
procedure apelj(x,y,d:integer);
   begin
     if (a[x,y]<>'X')and(j[x,y]>d) then
        begin
          j[x,y]:=d;
          apelj(x,y-1,d+1);
          apelj(x,y+1,d+1);
          apelj(x-1,y-1,d+1);
          apelj(x-1,y,d+1);
          apelj(x-1,y+1,d+1);
          apelj(x+1,y-1,d+1);
          apelj(x+1,y,d+1);
          apelj(x+1,y+1,d+1);
        end;
   end;

begin
assign(input,'rj.in'); reset(input);
assign(output,'rj.out'); rewrite(output);
readln(n,m);
for i:=1 to n do
  begin
    readln(s);
  for k:=1 to m do
      begin
        a[i,k]:=s[k];
        r[i,k]:=n*m+1; j[i,k]:=n*m+1;
        if a[i,k]='R' then begin xr:=i; yr:=k; end
          else if a[i,k]='J' then begin xj:=i; yj:=k; end;
      end;
  end;
for i:=0 to n+1 do
  begin
    a[i,0]:='X'; a[i,m+1]:='X';
  end;
for i:=0 to m+1 do
  begin
    a[0,i]:='X'; a[n+1,i]:='X';
  end;

apelr(xr,yr,1);
apelj(xj,yj,1);

min:=n*m+1;
for i:=1 to n do
  for k:=1 to m do
     if (r[i,k]=j[i,k])and(r[i,k]<min) then
       begin
         min:=r[i,k]; xr:=i; yr:=k;
       end;

writeln(min,' ',xr,' ',yr);
close(input); close(output);

end.