[franzkz]

Квадрат разбит на 4k равновеликих квадратных клеток. Квадрат перегибается поочередно относительно вертикальной (правая половина подкладывается под левую) и горизонтальной (нижняя половина подкладывается под верхнюю) оси симметрии до тех пор, пока все клетки не будут расположены друг под другом. Требуется занумеровать клетки исходного квадрата таким образом, чтобы в результате выполнения операций перегиба номера клеток, расположенных друг под другом, образовали числовую последовательность 1,2,3,...,4k, начиная с верхней клетки

Реализую через двусвязный список на массиве... если я правильно понял что такое двусвязный список. Вот что получилось и никак не могу понять почему выходит за пределы

Код:

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Button1: TButton;
    Edit1: TEdit;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

type
 input = record
 last1,last2,next1,next2,new : word;
end;

var
  Form1: TForm1;
  k,i,j,i1,i2,j1,j2,nj1,nj2,n,n1,cn,half : word;
  m : array of array of input;
implementation

{$R *.dfm}


Procedure concat(a,b,c,d : word);
var i1,i2,j1,j2,nj1,nj2 : word;
  begin
   i1:=a; i2:=b;

   while (m[i1,i2].next1<>n) and (m[i1,i2].next2<>n) do
      begin
      i1:=m[i1,i2].next1; i2:=m[i1,i2].next2;
      end;
   j1:=c; j2:=d;

   while (m[j1,j2].next1<>n) and (m[j1,j2].next2<>n) do
      begin
      j1:=m[j1,j2].next1;
      j2:=m[j1,j2].next2;
      end;

   while j1<>0 do
     begin
      nj2:=m[j1,j2].last2; nj1:=m[j1,j2].last1;
      m[i1,i2].next1:=j1; m[i1,i2].next2:=j2;
      m[j1,j2].last1:=i1; m[j1,j2].last2:=i2;
      i1:=j1; i2:=j2; j1:=nj1; j2:=nj2;
     end;
   m[i1,i2].next1:=n; m[i1,i2].next2:=n;
  end;



procedure TForm1.Button1Click(Sender: TObject);
begin

   k:=StrToInt(Edit1.Text);
   n1:=Round(Power(4,k)); {Определение числа клеток в матрице}
   n:=Round(Sqrt(n1)); {Определение числа клеток в одной строке или столбце}
   SetLength(m,n,n);

   for i:=0 to n-1 do
   for j:=0 to n-1 do
     begin
      m[i,j].last1:=0;
      m[i,j].next1:=n;
      m[i,j].last2:=0;
      m[i,j].next2:=n;
      m[i,j].new:=0;
     end;
   cn:=n;

   while cn>1 do {сгибание матрицы}
     begin
      half:=cn div 2;
      for i:=0 to half-1 do {сгиб по вертикали}
      for j:=0 to cn-1 do concat(j,i,j,cn-1-i);

      for i:=0 to half-1 do {сгиб по горизонтали}
      for j:=0 to half-1 do concat(i,j,cn-1-i,j);
      cn:=half;
     end;

   j1:=0;j2:=0;
   for i:=0 to n1-1 do {Назначение клеткам новые номера}
     begin
      m[j1,j2].new:=i;
      nj1:=m[j1,j2].next1; nj2:=m[j1,j2].next2;
      j1:=nj1; j2:=nj2;
     end;

     for i:=0 to n-1 do {Вывод результатов}
      begin
       for j:=1 to n do Label1.Caption:=Label1.Caption+ IntToStr(m[i,j].new);
       Label1.Caption:=Label1.Caption+#13;
      end;
end;
end;