[franzkz]

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

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

Код:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100

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;