Cod sursa(job #186474)

Utilizator AndreiDDiaconeasa Andrei AndreiD Data 28 aprilie 2008 00:11:51
Problema Rj Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 3.47 kb
const d1:array[1..8] of longint=(1,-1,0,0,1,-1,1,-1);
      d2:array[1..8] of longint=(0,0,-1,1,1,1,-1,-1);
var romeo,julieta:array[1..10000,1..2] of longint;
n,m,tmax,x,y,s,d:longint;
f:text;
a,b:array[0..100,0..100] of longint;
c:char;
{--------------------}
procedure citire;
begin
assign(f,'rj.in');reset(f);
readln(f,n,m);
end;
{---------------------}
procedure init;
var i,j:integer;
begin
for i:=1 to n do begin
    for j:=1 to m do begin
        read(f,c);
        if c=' ' then begin
                      a[i,j]:=-1;
                      b[i,j]:=-1;
                      end
                 else if c='X' then begin
                                    a[i,j]:=-2;
                                    b[i,j]:=-2;
                                    end
                               else if c='R' then begin
                                                  a[i,j]:=0;
                                                  romeo[1,1]:=i;
                                                  romeo[1,2]:=j;
                                                  end
                                             else if c='J' then begin
                                                                b[i,j]:=0;
                                                                julieta[1,1]:=i;
                                                                julieta[1,2]:=j;
                                                                end;
         end;
         readln(f);
         end;
close(f);
end;
{---------------------}
procedure rezolvare;
var i,q,w,t,j:integer;
begin
q:=1;
w:=1;
repeat
t:=q;
for i:=w to q do
for j:=1 to 8 do begin
x:=romeo[i,1]+d1[j];
y:=romeo[i,2]+d2[j];
if (a[x,y]=-1) and (x>0) and (y>0) and (x<=n) and (y<=m) then begin
                                                             a[x,y]:=a[romeo[i,1],romeo[i,2]]+1;
                                                             inc(t);
                                                             romeo[t,1]:=x;
                                                             romeo[t,2]:=y;
                                                             end;
end;
w:=q+1;
q:=t;
until w>q;
q:=1;
w:=1;
repeat
t:=q;
for i:=w to q do
for j:=1 to 8 do begin
x:=julieta[i,1]+d1[j];
y:=julieta[i,2]+d2[j];
if (b[x,y]=-1) and (x>0) and (y>0) and (x<=n) and (y<=m) then begin
                                                             b[x,y]:=b[julieta[i,1],julieta[i,2]]+1;
                                                             inc(t);
                                                             julieta[t,1]:=x;
                                                             julieta[t,2]:=y;
                                                             end;
end;
w:=q+1;
q:=t;
until w>q;
end;
{-------------------}
procedure final;
var i,j:integer;
begin
tmax:=maxlongint;
x:=0;
y:=0;
for i:=1 to n do
    for j:=1 to m do
        if (a[i,j]=b[i,j]) and (a[i,j]>0) and (a[i,j]<tmax) then begin
                                                                 tmax:=a[i,j];
                                                                 x:=i;
                                                                 y:=j;
                                                                 end;
end;
{--------------------}
procedure afisare;
begin
assign(f,'rj.out');rewrite(f);
write(f,tmax+1,' ',x,' ',y);
close(f);
end;
begin
citire;
init;
rezolvare;
final;
afisare;
end.