Cod sursa(job #294400)

Utilizator ioalexno1Alexandru Bunget ioalexno1 Data 2 aprilie 2009 15:13:54
Problema Rj Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.77 kb
program alex;
const b:array[1..8]of -1..1=(-1,-1,0,1,1,1,0,-1);
      d:array[1..8]of -1..1=(0,1,1,1,0,-1,-1,-1);
var a:array[1..101,1..101]of longint;
    f:text;
    q:string;
    e:boolean;
    m,n,i,j,x,y,l,c,k,h,w,min:longint;
begin
assign(f,'1-rj.in');reset(f);
readln(f,m,n);
for i:=1 to m do
    begin
    readln(f,q);
    j:=0;
    for h:=1 to length(q) do
        case q[h] of
        ' ':begin
            j:=j+1;
            a[i,j]:=-1;
            end;
        'X':begin
            j:=j+1;
            a[i,j]:=-2;
            end;
        'R':begin
            j:=j+1;
            x:=i;
            y:=j;
            end;
        'J':begin
            j:=j+1;
            l:=i;
            c:=j;
            end;
        end;
        if length(q)<n then for h:=length(q)+1 to n do
                                begin
                                j:=j+1;
                                a[i,j]:=-1;
                                end;
        end;
close(f);
a[x,y]:=1;
k:=1;
repeat
e:=false;
for i:=1 to m do
    for j:=1 to n do
        if a[i,j]=k then begin
                         for h:=1 to 8 do
                             if a[i+b[h],j+d[h]]=-1 then begin
                                                         a[i+b[h],j+d[h]]:=k+1;
                                                         e:=true;
                                                         end;
                          end;
k:=k+1;
until(e=false);
a[x,y]:=0;
a[l,c]:=1;
min:=999999999;
l:=5000000;
c:=5000000;
k:=1;
repeat
e:=false;
for i:=1 to m do
    for j:=1 to n do
        if a[i,j]=k then begin
                         for h:=1 to 8 do
                             if(a[i+b[h],j+d[h]]=-1)or(k+1<a[i+b[h],j+d[h]])then begin
                                                         a[i+b[h],j+d[h]]:=k+1;
                                                         e:=true;
                                                         end
                                                  else if k+1=a[i+b[h],j+d[h]] then begin
        if k+1<min then begin
                        min:=k+1;
                        l:=i+b[h];
                        c:=j+d[h];
                        end
                   else if k+1=min then if i+b[h]<l then begin
                                                    l:=i+b[h];
                                                    c:=j+d[h];
                                                    end
                                               else if i+b[h]=l then if j+d[h]<c then c:=j+d[h];
                                                                                    end;
                          end;
k:=k+1;
until(e=false);
assign(f,'rj.out');rewrite(f);
writeln(f,min,' ',l,' ',c);
close(f);
end.