Cod sursa(job #922871)

Utilizator patrascu_eugen96Patrascu Eugen patrascu_eugen96 Data 22 martie 2013 18:11:27
Problema Rj Scor 50
Compilator fpc Status done
Runda Arhiva de probleme Marime 6.02 kb
program romeo_julietaX2004;
type matrice=array[0..102,0..102] of integer;
     mat=array[0..102,0..102] of char;
var a,b:matrice;
    c:mat;
    i,j,n,m,t,x,y,o,v:integer;
    min:longint;
    ok:boolean;
    f,g:text;
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 read(f,c[i,j]); readln(f); end;
for i:=1 to n do
for j:=1 to m do begin
                 if c[i,j]=' ' then begin
                                    a[i,j]:=0;
                                    b[i,j]:=0;
                                    end
                 else if c[i,j]='X' then begin
                                         a[i,j]:=1;
                                         b[i,j]:=1;
                                         end
                 else if c[i,j]='R' then begin
                                         a[i,j]:=-1;
                                         b[i,j]:=0;
                                         end
                 else if c[i,j]='J' then begin
                                         a[i,j]:=0;
                                         b[i,j]:=-1;
                                         end;
                 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 j:=0 to m+1 do begin a[0,j]:=1; a[n+1,j]:=1; b[0,j]:=1; b[n+1,j]:=1; end;
ok:=true;
while ok do begin
            ok:=false;
            for i:=1 to n do
            for j:=1 to m do
            if a[i,j]<0 then begin
                             if a[i-1,j]=0 then begin
                                                a[i-1,j]:=a[i,j]-1;
                                                ok:=true;
                                                end;
                             if a[i+1,j]=0 then begin
                                                a[i+1,j]:=a[i,j]-1;
                                                ok:=true;
                                                end;
                             if a[i,j-1]=0 then begin
                                                a[i,j-1]:=a[i,j]-1;
                                                ok:=true;
                                                end;
                             if a[i,j+1]=0 then begin
                                                a[i,j+1]:=a[i,j]-1;
                                                ok:=true;
                                                end;
                             if a[i-1,j-1]=0 then begin
                                                  a[i-1,j-1]:=a[i,j]-1;
                                                  ok:=true;
                                                  end;
                             if a[i-1,j+1]=0 then begin
                                                  a[i-1,j+1]:=a[i,j]-1;
                                                  ok:=true;
                                                  end;
                             if a[i+1,j-1]=0 then begin
                                                  a[i+1,j-1]:=a[i,j]-1;
                                                  ok:=true;
                                                  end;
                             if a[i+1,j+1]=0 then begin
                                                  a[i+1,j+1]:=a[i,j]-1;
                                                  ok:=true;
                                                  end;
                             end;
            end;
ok:=true;
while ok do begin
            ok:=false;
            for i:=1 to n do
            for j:=1 to m do
            if b[i,j]<0 then begin
                             if b[i-1,j]=0 then begin
                                                b[i-1,j]:=b[i,j]-1;
                                                ok:=true;
                                                end;
                             if b[i+1,j]=0 then begin
                                                b[i+1,j]:=b[i,j]-1;
                                                ok:=true;
                                                end;
                             if b[i,j-1]=0 then begin
                                                b[i,j-1]:=b[i,j]-1;
                                                ok:=true;
                                                end;
                             if b[i,j+1]=0 then begin
                                                b[i,j+1]:=b[i,j]-1;
                                                ok:=true;
                                                end;
                             if b[i-1,j-1]=0 then begin
                                                  b[i-1,j-1]:=b[i,j]-1;
                                                  ok:=true;
                                                  end;
                             if b[i-1,j+1]=0 then begin
                                                  b[i-1,j+1]:=b[i,j]-1;
                                                  ok:=true;
                                                  end;
                             if b[i+1,j-1]=0 then begin
                                                  b[i+1,j-1]:=b[i,j]-1;
                                                  ok:=true;
                                                  end;
                             if b[i+1,j+1]=0 then begin
                                                  b[i+1,j+1]:=b[i,j]-1;
                                                  ok:=true;
                                                  end;
                             end;
            end;
min:=-10000;
for i:=1 to n do
for j:=1 to m do if a[i,j]<>1 then
     if a[i,j]=b[i,j] then if (a[i,j]>min)and(a[i,j]<>0) then begin
                                              min:=a[i,j];
                                              o:=i;
                                              v:=j;
                                              end;
write(g,-min,' ',o,' ',v);
{for i:=1 to n do begin
for j:=1 to m do write(g,a[i,j],' '); writeln(g); end;}
close(f);close(g);
end.