Cod sursa(job #57930)

Utilizator gurneySachelarie Bogdan gurney Data 3 mai 2007 18:43:05
Problema Car Scor 40
Compilator fpc Status done
Runda Arhiva de probleme Marime 3.71 kb
program car;
const
  fin='car.in';
  fout='car.out';
  nmax=600;
  inf=maxlongint shr 1;
  di:array[0..7] of longint=(1,1,0,-1,-1,-1,0,1);
  dj:array[0..7] of longint=(0,1,1,1,0,-1,-1,-1);
type
  list=^elem;
  elem=record
      x:longint;
      urm:list;
    end;
var
  d:array[0..nmax+1,0..nmax+1] of longint;
  lst:array[0..2] of list;
  ult:array[0..2] of list;
  p:array[0..2] of list;
  q,aux:list;
  dir,i,j,k,m,n,x,y,xi,yi,xf,yf:longint;

function code(i,j,dir:longint):longint;
  begin
    code:=(i shl 9)+j+(dir shl 18);
  end;

function pi(x:longint):longint;
  begin
    pi:=(x shr 9) and 511;
  end;

function pj(x:longint):longint;
  begin
    pj:=x and 511;
  end;

function pd(x:longint):longint;
  begin
    pd:=x shr 18;
  end;

procedure insert(x:longint;l:longint);
  var
    aux:list;
  begin
    new(aux);aux^.x:=x;
    if p[l]<>nil then
      begin
        ult[l]^.urm:=aux;
        aux^.urm:=nil;
        ult[l]:=aux;
      end
    else
      begin
        new(lst[l]);new(ult[l]);
        new(p[l]);
        lst[l]:=aux;ult[l]:=aux;
        lst[l]^.urm:=nil;ult[l]^.urm:=nil;
        aux^.urm:=nil;
        p[l]:=aux;
      end;
  end;

procedure expand(x:longint;l:longint);
  var
    i,j,dir,xx,dd:longint;
  begin
    i:=pi(x);j:=pj(x);dir:=pd(x);
    if l=0 then
      begin
        if d[i,j]+l<d[i+di[dir],j+dj[dir]] then
          begin
            d[i+di[dir],j+dj[dir]]:=d[i,j]+l;
            insert(code(i+di[dir],j+dj[dir],dir),(y+l)mod 3);
          end;
      end
    else if l=1 then
      begin
        dd:=(dir+1)and 7;
        if d[i,j]+l<d[i+di[dd],j+dj[dd]] then
          begin
            d[i+di[dd],j+dj[dd]]:=d[i,j]+l;
            insert(code(i+di[dd],j+dj[dd],dd),(y+l)mod 3);
          end;
        dd:=(dir+7)and 7;
        if d[i,j]+l<d[i+di[dd],j+dj[dd]] then
          begin
            d[i+di[dd],j+dj[dd]]:=d[i,j]+l;
            insert(code(i+di[dd],j+dj[dd],dd),(y+l)mod 3);
          end;
      end
    else if l=2 then
      begin
        dd:=(dir+2)and 7;
        if d[i,j]+l<d[i+di[dd],j+dj[dd]] then
          begin
            d[i+di[dd],j+dj[dd]]:=d[i,j]+l;
            insert(code(i+di[dd],j+dj[dd],dd),(y+l)mod 3);
          end;
        dd:=(dir+6)and 7;
        if d[i,j]+l<d[i+di[dd],j+dj[dd]] then
          begin
            d[i+di[dd],j+dj[dd]]:=d[i,j]+l;
            insert(code(i+di[dd],j+dj[dd],dd),(y+l)mod 3);
          end;
      end;
  end;

begin
  assign(input,fin);
    reset(input);
    readln(n,m);
    readln(xi,yi,xf,yf);
    for i:=1 to n do
      begin
        for j:=1 to m do
          begin
            read(x);
            if x=1 then
              d[i,j]:=-1
            else
              d[i,j]:=inf;
          end;
      end;
    //border
    for i:=0 to m+1 do
      begin
        d[0,i]:=-1;
        d[n+1,i]:=-1;
      end;
    for i:=0 to n+1 do
      begin
        d[i,0]:=-1;
        d[i,m+1]:=-1;
      end;

  close(input);
  assign(output,fout);
    rewrite(output);
    for dir:=0 to 7 do
      begin
        if d[xi+di[dir],yi+dj[dir]]<>-1 then
          begin
            insert(code(xi+di[dir],yi+dj[dir],dir),0);
            d[xi+di[dir],yi+dj[dir]]:=0;
          end;
      end;
    k:=0;
    while (p[1]<>nil) or ((p[2]<>nil) or (p[0]<>nil)) do
      begin
        y:=k mod 3;
        while p[k mod 3]<>nil do
          begin
            for dir:=0 to 2 do
              expand(p[y]^.x,dir);
            p[y]:=p[y]^.urm;
          end;
        lst[y]:=nil;ult[y]:=nil;p[y]:=nil;
        inc(k);
      end;
    if (d[xf,yf]=-1)or(d[xf,yf]=inf) then
      writeln(-1)
    else
      writeln(d[xf,yf]);
  close(output);
end.