Cod sursa(job #136800)

Utilizator TudorutzuMusoiu Tudor Tudorutzu Data 15 februarie 2008 23:36:32
Problema Rj Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 3.56 kb
const d1:array[1..8]of shortint=(-1,-1,0,1,1,1,0,-1);
      d2:array[1..8]of shortint=(0,1,1,1,0,-1,-1,-1);
var f,g:text;
    i,n,m,min,lin,k,col,x,y,xt,yt,xr,xj,yr,yj,j,u,p:longint;
    c,d:array[1..100000] of integer;
    ro,ju:array[-1..100,-1..100] of integer;
    z: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,z);
               if z='X' then
               begin
                    ro[i,j]:=-1;
                    ju[i,j]:=-1;
               end
               else
               begin
                    if z='R' then
                    begin
                         ro[i,j]:=1;
                         xr:=i; yr:=j;
                    end;
                    if z='J' then
                    begin
                         ju[i,j]:=1;
                         xj:=i; yj:=j;
                    end;
               end;
          end;
          readln(f);
     end;
     for i:=-1 to 100 do
          for j:=-1 to 100 do
          begin
               if (i<1)or(i>n) then
               begin
                    ro[i,j]:=-1;
                    ju[i,j]:=-1;
               end;
          end;
     p:=1; u:=1;
     for i:=-1 TO 100    do
          for j:=-1 to 100 do
          begin
               if (i<1)or(i>n) then
               begin
                    ro[j,i]:=-1;
                    ju[j,i]:=-1;
               end;
          end;
     c[1]:=xr; d[1]:=yr;
     while (p<=u) do
     begin
          x:=c[p];
          y:=d[p];
          for k:=1 to 8 do
          begin
               xt:=x+d1[k];
               yt:=y+d2[k];
               if ro[xt,yt]=0 then
               begin
                    ro[xt,yt]:=1+ro[x,y];
                    inc(u);
                    c[u]:=xt;
                    d[u]:=yt;
               end;
          end;
          inc(p);
     end;
     for i:=1 to u do
     begin
          c[i]:=0; d[i]:=0;
     end;
     u:=1; p:=1;
     c[1]:=xj; d[1]:=yj;
     while (p<=u) do
     begin
          x:=c[p];
          y:=d[p];
          for i:=1 to 8 do
          begin
               xt:=x+d1[i];
               yt:=y+d2[i];
               if ju[xt,yt]=0 then
               begin
                    ju[xt,yt]:=ju[x,y]+1;
                    inc(u);
                    c[u]:=xt;
                    d[u]:=yt;
               end;
          end;
          inc(p);
     end;
     min:=maxlongint;
     for i:=1 to n do
          for j:=1 to m do
               if ro[i,j]>0 then
                    if ro[i,j]=ju[i,j] then
                         if min>ro[i,j] then
                         begin
                              min:=ro[i,j];
                              col:=j;
                              lin:=i;
                         end
                         else if min=ro[i,j] then
                                   if lin>i then
                                   begin
                                        col:=j;
                                        lin:=i;
                                   end
                                   else if lin=i then
                                             if col>j then
                                             begin
                                                  col:=j;
                                                  lin:=i;
                                             end;
     writeln(g,min,' ',lin,' ',col);
     close(g);
end.