Cod sursa(job #743538)

Utilizator Buzu_Tudor_RoCont vechi Buzu_Tudor_Ro Data 4 mai 2012 20:43:10
Problema Rj Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.97 kb
Program P1;
type matrice=array[-2..101,-2..101] of integer;
var fi,fo : text;
    i,n,j,m : longint;
    a,b : matrice; c:char;
    l01,l02,c01,c02 : integer;

Procedure tipar;
var i,j,tmin,f,g : integer;
begin
    tmin:=32767;
    for i:=n downto 1 do
       for j:=m downto 1 do
          if (a[i,j]>0) and (a[i,j]=b[i,j]) and (a[i,j]<tmin) then begin
                                                                   tmin:=a[i,j];
                                                                   f:=i;
                                                                   g:=j;
                                                                   end;
    write(fo,tmin-1,' ',f,' ',g);
end;

Procedure undanumerica(var a:matrice; l0,c0,p,q:integer);
var u:longint;
begin
        u:=1;

        While a[p,q]=0 do begin
                          for i:=1 to n do
                                  for j:=1 to m do
                                                   if a[i,j]=u then begin
                                                                    if a[i-1,j]=0 then a[i-1,j]:=u+1;{Nord}
                                                                    if a[i+1,j]=0 then a[i+1,j]:=u+1;{Sud}
                                                                    if a[i,j-1]=0 then a[i,j-1]:=u+1;{Est}
                                                                    if a[i,j+1]=0 then a[i,j+1]:=u+1;{Vest}
                                                                    end;
                          u:=u+1;
                          end;
end;

begin
    assign(fi,'rj.in'); reset(fi); readln(fi,n,m);
    assign(fo,'rj.out'); rewrite(fo);

    for i:=1 to n do
       begin
       for j:=1 to n do begin
                        read(fi,c);
                        if c='X' then begin
                                      a[i,j]:=-1;
                                      b[i,j]:=-1;
                                      end
                                 else if c='R' then begin
                                                    a[i,j]:=1;
                                                    l01:=i;
                                                    c01:=j;
                                                    end
                                               else
                                               if c='J' then begin
                                                             b[i,j]:=1;
                                                             l02:=i;
                                                             c02:=j;
                                                             end;
                                      end;
                     readln(fi);
       end;

    for i:=0 to m+1 do begin a[0,i]:=-1; a[n+1,i]:=-1; end;
    for i:=0 to n+1 do begin a[i,0]:=-1; a[i,m+1]:=-1; end;

    undanumerica(a,l01,c01,l02,c02);
    undanumerica(b,l02,c02,l01,c01);

    tipar;

    close(fi); close(fo);
end.