Cod sursa(job #200798)

Utilizator RobybrasovRobert Hangu Robybrasov Data 26 iulie 2008 15:34:00
Problema Rj Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.61 kb
const   vc:array[1..2,1..8] of -1..1=((-1,0,1,1,1,0,-1,-1),
                                      (-1,-1,-1,0,1,1,1,0));
type    coord=record lin,col:byte; end;
        adr=^coada;
        coada=record val:coord; urm:adr; end;
var     a:array[0..101,0..101] of byte;
        r,t:array[0..101,0..101] of integer;
        n,m,i,j,iu,ju,x1,y1,x2,y2,k:byte;
        min:integer;
        li,ls:adr;
        nr:coord;
        c:char;
        f:text;

procedure baga(x:coord);
var p:adr;
begin
  new(p);
  p^.val:=x;
  p^.urm:=nil;
  if li=nil then
    begin
      li:=p;
      ls:=li;
    end
  else
    begin
      ls^.urm:=p;
      ls:=p;
    end;
end;

procedure scoate(var x:coord);
var p:adr;
begin
  p:=li;
  x:=li^.val;
  li:=li^.urm;
  dispose(p);
end;

procedure romeo;
begin
  nr.lin:=x1; nr.col:=y1;
  baga(nr);
  while li<>nil do
    begin
      scoate(nr);
      i:=nr.lin; j:=nr.col;
      for k:=1 to 8 do
        begin
          iu:=i+vc[1,k]; ju:=j+vc[2,k];
          if (a[iu,ju]=0) and (r[i,j]+1<r[iu,ju]) then
            begin
              r[iu,ju]:=r[i,j]+1;
              nr.lin:=iu; nr.col:=ju;
              baga(nr);
            end;
        end;
    end;
end;

procedure julia;
begin
  nr.lin:=x2; nr.col:=y2;
  baga(nr);
  while li<>nil do
    begin
      scoate(nr);
      i:=nr.lin; j:=nr.col;
      for k:=1 to 8 do
        begin
          iu:=i+vc[1,k]; ju:=j+vc[2,k];
          if (a[iu,ju]=0) and (t[i,j]+1<t[iu,ju]) then
            begin
              t[iu,ju]:=t[i,j]+1;
              nr.lin:=iu; nr.col:=ju;
              baga(nr);
            end;
        end;
    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,c);
          case c of
            'X':a[i,j]:=1;
            'R':begin x1:=i; y1:=j; end;
            'J':begin x2:=i; y2:=j; end;
          end;
        end;
      readln(f);
    end;
  close(f);
  for i:=0 to n+1 do
    begin
      a[i,0]:=1; a[i,m+1]:=1;
    end;
  for i:=0 to m+1 do
    begin
      a[0,i]:=1; a[n+1,i]:=1;
    end;
  for i:=1 to n do
    for j:=1 to m do
      begin
        r[i,j]:=maxint;
        t[i,j]:=maxint;
      end;
  r[x1,y1]:=0; t[x2,y2]:=0;
  romeo;
  li:=nil; ls:=nil;
  julia;
  assign(f,'rj.out');
  rewrite(f);
  min:=maxint;
  for i:=1 to n do
    for j:=1 to m do
        if (r[i,j]=t[i,j]) and (t[i,j]<min) then
          begin
            min:=t[i,j];
            x1:=i; y1:=j;
          end;
  write(f,min+1,' ',x1,' ',y1);
  close(f);
end.