Cod sursa(job #690292)

Utilizator alinutzVasiu Alin alinutz Data 25 februarie 2012 14:51:41
Problema Rj Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.36 kb
program info;
type vector=array[0..102,0..102]of integer;
const dx:array[1..8] of integer=(0,0,1,-1,-1,1,-1,1);
      dy:array[1..8] of integer=(-1,1,0,0,-1,1,1,-1);
var f,g:text;
    a,b:vector;
    m,n,i,j,rx,ry,jx,jy:integer;
    vrx,vry,vjx,vjy:array[1..100000] of longint;


procedure citire;
var x:char;
begin
  assign(f,'rj.in');  reset(f);
  assign(g,'rj.out');  rewrite(g);
  readln(f,n,m);
  for i:=1 to n do
   begin
     for j:=1 to m do
      begin
        read(f,x);
        if x='R' then
         begin
           rx:=i;
           ry:=j;
         end
        else
          if x='J' then
            begin
              jx:=i;
              jy:=j;
            end
           else
             if x='X' then
              begin
                a[i,j]:=-1;
                b[i,j]:=-1;
              end;
      end;
      readln(f);
   end;
   for i:=0 to n+1 do
      begin
        a[i,0]:=-1;
        a[i,m+1]:=-1;
        b[i,0]:=-1;
        b[i,m+1]:=-1;
      end;
      for i:=0 to m+1 do
         begin
           a[0,i]:=-1;
           a[n+1,i]:=-1;
           b[0,i]:=-1;
           b[n+1,i]:=-1;
         end;
    close(f);

end;

procedure lee;
var st,sf:longint;

begin
a[rx,ry]:=1;
vrx[1]:=rx;
vry[1]:=ry;
st:=0;
sf:=1;
while st<sf do
   begin
   inc(st);
   for i:=1 to 8 do
      if a[vrx[st]+dx[i],vry[st]+dy[i]]=0 then
        begin
         a[vrx[st]+dx[i],vry[st]+dy[i]]:=a[vrx[st],vry[st]]+1;
         inc(sf);
         vrx[sf]:=vrx[st]+dx[i];
         vry[sf]:=vry[st]+dy[i];
        end;
   end;
b[jx,jy]:=1;
vjx[1]:=jx;
vjy[1]:=jy;
st:=0;
sf:=1;
while st<sf do
   begin
   inc(st);
   for i:=1 to 8 do
      if b[vjx[st]+dx[i],vjy[st]+dy[i]]=0 then
        begin
         b[vjx[st]+dx[i],vjy[st]+dy[i]]:=b[vjx[st],vjy[st]]+1;
         inc(sf);
         vjx[sf]:=vjx[st]+dx[i];
         vjy[sf]:=vjy[st]+dy[i];
        end;
   end;
end;

procedure afisare;
var tmin:longint;
    xmin,ymin:integer;
begin
  tmin:=maxlongint;
  xmin:=-1;
  ymin:=-1;
  for i:=1 to n do
   for j:=1 to m do
    if a[i,j]=b[i,j] then
      if (a[i,j]<tmin)and(a[i,j]<>-1)and(a[i,j]<>0) then
       begin
         tmin:=a[i,j];
         xmin:=i;
         ymin:=j;
       end;
   writeln(g,tmin,' ',xmin,' ',ymin);
   close(g);
end;

begin
    citire;
    lee;
    afisare;

end.