Cod sursa(job #583689)

Utilizator ion_calimanUAIC Ion Caliman ion_caliman Data 21 aprilie 2011 20:03:26
Problema Car Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 6.53 kb
var     a,d:array[0..501,0..501]of longint;
        b:array[0..501,0..501]of string;
        poz,poz2:array[1..2,1..1000]of integer;
        n,m,i,j,xx,yy,xf,yf,np,np2,x,y,pr:longint;
        bo:boolean;
        f,g:text;

procedure init;
begin
  for i:=0 to n+1 do
    begin
      a[i,0]:=1;
      a[0,i]:=1;
      a[i,n+1]:=1;
      a[n+1,i]:=1;
    end;
  np2:=0;
  if a[xx+1,yy]=0 then
    begin
      inc(np2);
      poz[1,np2]:=xx+1;
      poz[2,np2]:=yy;
      b[xx+1,yy]:='E';
    end;
  if a[xx+1,yy+1]=0 then
    begin
      inc(np2);
      poz[1,np2]:=xx+1;
      poz[2,np2]:=yy+1;
      b[xx+1,yy+1]:='SE';
    end;
  if a[xx,yy+1]=0 then
    begin
      inc(np2);
      poz[1,np2]:=xx;
      poz[2,np2]:=yy+1;
      b[xx,yy+1]:='S';
    end;
  if a[xx-1,yy+1]=0 then
    begin
      inc(np2);
      poz[1,np2]:=xx-1;
      poz[2,np2]:=yy+1;
      b[xx-1,yy+1]:='SW';
    end;
  if a[xx-1,yy]=0 then
    begin
      inc(np2);
      poz[1,np2]:=xx-1;
      poz[2,np2]:=yy;
      b[xx-1,yy]:='W';
    end;
  if a[xx-1,yy-1]=0 then
    begin
      inc(np2);
      poz[1,np2]:=xx-1;
      poz[2,np2]:=yy-1;
      b[xx-1,yy-1]:='NW';
    end;
  if a[xx,yy-1]=0 then
    begin
      inc(np2);
      poz[1,np2]:=xx;
      poz[2,np2]:=yy-1;
      b[xx,yy-1]:='N';
    end;
  if a[xx+1,yy-1]=0 then
    begin
      inc(np2);
      poz[1,np2]:=xx+1;
      poz[2,np2]:=yy-1;
      b[xx+1,yy-1]:='NE';
    end;

end;

function pret(x,y,xx,yy:longint):longint;
var     s,r:string;
begin
  s:=b[x,y];
  if (xx=x+1)and(yy=y) then r:='E' else
  if (xx=x+1)and(yy=y+1) then r:='SE' else
  if (xx=x)and(yy=y+1) then r:='S' else
  if (xx=x-1)and(yy=y+1) then r:='SW' else
  if (xx=x-1)and(yy=y) then r:='W' else
  if (xx=x-1)and(yy=y-1) then r:='NW' else
  if (xx=x)and(yy=y-1) then r:='N' else
  if (xx=x+1)and(yy=y-1) then r:='NE';

  if s=r then pret:=0 else
  if ((s='E')and((r='SE')or(r='NE')))or
     ((s='W')and((r='SW')or(r='NW')))or
     ((s='S')and((r='SE')or(r='SW')))or
     ((s='N')and((r='NE')or(r='NW')))or
     ((s='SE')and((r='E')or(r='S')))or
     ((s='SW')and((r='S')or(r='W')))or
     ((s='NW')and((r='W')or(r='N')))or
     ((s='NE')and((r='N')or(r='E')))then pret:=1 else
  if (((s='E')or(s='W'))and((r='S')or(r='N')))or
     (((s='S')or(s='N'))and((r='E')or(r='W')))or
     (((s='SE')or(s='NW'))and((r='SW')or(r='NE')))or
     (((s='SW')or(s='NE'))and((r='SE')or(r='NW')))then pret:=2 else
  if ((s='E')and((r='SW')or(r='NW')))or
     ((s='W')and((r='SE')or(r='NE')))or
     ((s='S')and((r='NE')or(r='NW')))or
     ((s='N')and((r='SE')or(r='SW')))or
     ((s='SE')and((r='W')or(r='N')))or
     ((s='SW')and((r='N')or(r='E')))or
     ((s='NW')and((r='S')or(r='E')))or
     ((s='NE')and((r='S')or(r='W')))then pret:=3 else pret:=4;
end;

begin
  assign(f,'car.in');
  assign(g,'car.out');
  reset(f);
  rewrite(g);
  readln(f,n,m);
  readln(f,yy,xx,yf,xf);
  for i:=1 to n do
   for j:=1 to m do
    read(f,a[j,i]);
  init;
  poz2:=poz;
  bo:=true;
  while bo do
    begin
      bo:=false;
      poz:=poz2;
      np:=np2;
      np2:=0;
      for i:=1 to np do
        begin
          x:=poz[1,i]; y:=poz[2,i];

          if (a[x+1,y]=0) then
            begin
            pr:=pret(x,y,x+1,y);
            if  (b[x,y]<>'W')and((d[x+1,y]=0)or(d[x+1,y]>d[x,y]+pr)) then
            begin
              bo:=true;
              d[x+1,y]:=d[x,y]+pr;
              inc(np2);
              poz2[1,np2]:=x+1;
              poz2[2,np2]:=y;
              b[x+1,y]:='E'
            end;
            end;

          if (a[x+1,y+1]=0) then
            begin
            pr:=pret(x,y,x+1,y+1);
            if  (b[x,y]<>'NW')and  ((d[x+1,y+1]=0)or(d[x+1,y+1]>d[x,y]+pr)) then
            begin
              bo:=true;
              d[x+1,y+1]:=d[x,y]+pr;
              inc(np2);
              poz2[1,np2]:=x+1;
              poz2[2,np2]:=y+1;
              b[x+1,y+1]:='SE'
            end;
            end;

          if (a[x,y+1]=0) then
            begin
            pr:=pret(x,y,x,y+1);
            if  (b[x,y]<>'N')and  ((d[x,y+1]=0)or(d[x,y+1]>d[x,y]+pr)) then
            begin
              bo:=true;
              d[x,y+1]:=d[x,y]+pr;
              inc(np2);
              poz2[1,np2]:=x;
              poz2[2,np2]:=y+1;
              b[x,y+1]:='S'
            end;
            end;

          if (a[x-1,y+1]=0) then
            begin
            pr:=pret(x,y,x-1,y+1);
            if  (b[x,y]<>'NE')and  ((d[x-1,y+1]=0)or(d[x-1,y+1]>d[x,y]+pr)) then
            begin
              bo:=true;
              d[x-1,y+1]:=d[x,y]+pr;
              inc(np2);
              poz2[1,np2]:=x-1;
              poz2[2,np2]:=y+1;
              b[x-1,y+1]:='SW'
            end;
            end;

          if (a[x-1,y]=0) then
            begin
            pr:=pret(x,y,x-1,y);
            if  (b[x,y]<>'E')and  ((d[x-1,y]=0)or(d[x-1,y]>d[x,y]+pr)) then
            begin
              bo:=true;
              d[x-1,y]:=d[x,y]+pr;
              inc(np2);
              poz2[1,np2]:=x-1;
              poz2[2,np2]:=y;
              b[x-1,y]:='W'
            end;
            end;

          if (a[x-1,y-1]=0) then
            begin
            pr:=pret(x,y,x-1,y-1);
            if  (b[x,y]<>'SE')and  ((d[x-1,y-1]=0)or(d[x-1,y-1]>d[x,y]+pr)) then
            begin
              bo:=true;
              d[x-1,y-1]:=d[x,y]+pr;
              inc(np2);
              poz2[1,np2]:=x-1;
              poz2[2,np2]:=y-1;
              b[x-1,y-1]:='NW'
            end;
            end;

          if (a[x,y-1]=0)then
            begin
            pr:=pret(x,y,x,y-1);
            if  (b[x,y]<>'S')and  ((d[x,y-1]=0)or(d[x,y-1]>d[x,y]+pr)) then
            begin
              bo:=true;
              d[x,y-1]:=d[x,y]+pr;
              inc(np2);
              poz2[1,np2]:=x;
              poz2[2,np2]:=y-1;
              b[x,y+1]:='N'
            end;
            end;

          if (a[x+1,y-1]=0)then
            begin
            pr:=pret(x,y,x+1,y-1);
            if  (b[x,y]<>'SW')and  ((d[x+1,y-1]=0)or(d[x+1,y-1]>d[x,y]+pr)) then
            begin
              bo:=true;
              d[x+1,y-1]:=d[x,y]+pr;
              inc(np2);
              poz2[1,np2]:=x+1;
              poz2[2,np2]:=y-1;
              b[x+1,y-1]:='NE'
            end;
            end;
        end;
    end;
 { for i:=1 to n do
    begin
  for j:=1 to m do
    write(d[j,i],' ');
    writeln;
    end;
    readln;  }
  writeln(g,d[xf,yf]);
  close(g);
end.