All pastes #897778 Raw Edit

Stuff

public text v1 · immutable
·published 2008-02-09 20:52 UTC
rendered paste body
{$M 65520,0,655360}

program alee;
type sor = array[1..4] of -1..1;
     mutat = ^elem;
     elem = record
              x,y:Byte;
              d:Word;
              kov:mutat;
             end;
const dx : sor = (1,0,-1,0);
      dy : sor = (0,1,0,-1);
var
 g:Text;
 map:Array[1..178,1..178] of Integer;
 i,j,nrFa,xk1,yk1,xk2,yk2,n:Integer;
 queue,t,pnt:mutat;
 elm:elem;

 procedure Read_data;
 var f:Text;
 i,x,y:Integer;
 begin
  Assign(f,'alee.in');
  Reset(f);
  ReadLn(f,n,nrFa);
  for i:=1 to nrFa do
   begin
    Read(f,x,y);
    map[x,y]:=-1;
   end;
  ReadLn(f,xk1,yk1,xk2,yk2);
  Close(f);
 end;

 procedure initMap;
 var i,j:Integer;
 begin
  for i:=1 to n do
   begin
    for j:=1 to n do
     begin
      if map[i,j]=0 then map[i,j]:=-2;
     end;
   end;
  map[xk1,yk1]:=0;
 end;

 procedure beszur(var e:mutat;x,y:Byte;d:Word);
 var p,uj:mutat;
 begin
  new(uj);
  uj^.x:=x;
  uj^.y:=y;
  uj^.d:=d;
  uj^.kov:=nil;
  if e=nil then e:=uj
   else
    begin
     p:=e;
     while p^.kov<>nil do p:=p^.kov;
     p^.kov:=uj;
    end;
 end;

 procedure torol(var e:mutat);
 var p:mutat;
 begin
  p:=e;
  if e=nil then WriteLn('Ures')
   else
    begin
     e:=e^.kov;
     dispose(p);
    end;
 end;



 procedure GenerateLeeNumbers;{ez felelos a matrix megtolteseert}
 var i,lepes:Integer;
     eszama,k:Integer;
     x,y:elem;
 begin
  beszur(queue,xk1,yk1,0);
  eszama:=1;

  While (eszama>0) and (map[xk2,yk2]=-2) do
   begin
    x:=queue^;
    torol(queue);
    Dec(eszama);

    for k:=1 to 4 do
     begin
      y.x:=x.x+dx[k];
      y.y:=x.y+dy[k];
      if map[y.x,y.y]=-2 then
       begin
        y.d:=x.d+1;
        map[y.x,y.y]:=y.d;
        beszur(queue,y.x,y.y,y.d);
        Inc(eszama);
       end;
     end;

   end;

 end;

 procedure WriteRoute;
 var ln,m:Integer;
 i,j,k:Integer;
 begin
  i:=xk2;
  j:=yk2;
 repeat
  if i+1<=n then
   if map[i+1,j] = map[i,j]-1 then
    begin
     WriteLn(i,' ',j);
     Inc(i);
    end;
  if i-1>=1 then
   if map[i-1,j] = map[i,j]-1 then
    begin
     WriteLn(i,' ',j);
     Dec(i);
    end;
  if j-1>=1 then
   if map[i,j-1] = map[i,j]-1 then
    begin
     WriteLn(i,' ',j);
     Dec(j);
    end;
  if j+1<=n then
   if map[i,j+1] = map[i,j]-1 then
    begin
     WriteLn(i,' ',j);
     Inc(j);
    end;
 until (i=xk1) and (j=yk1);

 end;

begin
 Assign(g,'alee.out');
 ReWrite(g);
 Read_data;
 {WriteLn;
  for i:=1 to n do
   begin
    for j:=1 to n do Write(map[i,j],' ');
    WriteLn;
   end;}
 queue:=nil;
 InitMap;
 GenerateLeeNumbers;
 {
 Writeln;
  for i:=1 to n do
   begin
    for j:=1 to n do Write(map[i,j],' ');
    WriteLn;
   end; }
{ WriteRoute;}
 WriteLn(g,map[xk2,yk2]+1);
 Close(g);
 t:=queue;

 while t^.kov<>nil do
  begin
   pnt:=t;
   t:=t^.kov;
   dispose(pnt);
  end;
 dispose(t);
{ReadLn;}
end.