Cod sursa(job #5764)

Utilizator fogabFodor Gabor fogab Data 14 ianuarie 2007 20:48:10
Problema Car Scor 40
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.96 kb
const inf=2147483647;
      hy:array[1..8] of shortint=(0,1,1,1,0,-1,-1,-1);
      hx:array[1..8] of shortint=(-1,-1,0,1,1,1,0,-1);
var f:text;
    a:array[0..501,0..501] of byte;
    b:array[0..501,0..501,1..8] of int64;
    n,m,xs,ys,xf,yf:integer;
    i,j,l,gx,gy,gd,val:longint;
    r:array[0..2] of longint;
    k,c:int64;
    lx,ly,ld:array[0..2000000,0..2] of integer;
begin
assign(f,'car.in');
reset(f);
readln(f,n,m);
readln(f,xs,ys,xf,yf);
for i:=1 to n do
    for j:=1 to m do begin
                     read(f,a[i,j]);
                     for l:=1 to 8 do b[i,j,l]:=inf;
                     end;
close(f);
if ((xs=xf) and (ys=yf))
   and (a[xf,yf]<>-1) then begin
                              assign(f,'car.out');
                              rewrite(f);
                              writeln(f,0);
                              close(f);
                              halt;
                              end
else begin
if (a[xs,ys]=1) then a[xf,yf]:=1;
if n<m then for i:=0 to m+1 do begin
                             a[0,i]:=1;
                             a[n+1,i]:=1;
                             a[i,0]:=1;
                             a[i,m+1]:=1;
                             end
       else for i:=0 to n+1 do begin
                             a[0,i]:=1;
                             a[n+1,i]:=1;
                             a[i,0]:=1;
                             a[i,m+1]:=1;
                             end;
for i:=1 to 8 do begin
                 lx[i-1,0]:=xs;
                 ly[i-1,0]:=ys;
                 ld[i-1,0]:=i;
                 b[xs,ys,i]:=0;
                 end;
r[0]:=8;
l:=0;
repeat
i:=0;
while i<r[(l mod 3)] do begin
                        gx:=lx[i,l mod 3];
                        gy:=ly[i,l mod 3];
                        gd:=ld[i,l mod 3];
                        val:=b[gx,gy,gd];
                        for j:=1 to 8 do
                            if a[gx+hx[j],gy+hy[j]]=0 then begin
                            c:=abs(gd-j);
                            if c>4 then c:=8-c;
                            if c<=2 then
                               if val+c<b[gx+hx[j],gy+hy[j],j]
                                  then begin
                                        b[gx+hx[j],gy+hy[j],j]:=val+c;
                                        lx[r[(l+c) mod 3],(l+c) mod 3]:=gx+hx[j];
                                        ly[r[(l+c) mod 3],(l+c) mod 3]:=gy+hy[j];
                                        ld[r[(l+c) mod 3],(l+c) mod 3]:=j;
                                        inc(r[(l+c) mod 3]);
                                       end;
                            end;
                         inc(i);
                         end;
r[(l mod 3)]:=0;
inc(l);
until (r[0]=0) and (r[1]=0) and (r[2]=0);
k:=inf;
for i:=1 to 8 do
    if (b[xf,yf,i]<k) then k:=b[xf,yf,i];
assign(f,'car.out');
rewrite(f);
if k=inf then writeln(f,-1)
         else writeln(f,k);
close(f);
end;
end.