Простой способ заполнить эту матрицу?

Question

Я хотел бы заполнить матрицу n * n (n нечетно) следующим образом:

_   _   _   23  22  21  20
_   _   24  10  9   8   37
_   25  11  3   2   19  36
26  12  4   1   7   18  35
27  13  5   6   17  34  _
28  14  15  16  33  _   _
29  30  31  32  _   _   _

Какой простой способ сделать это, используя Mathematica ?

Answer 1

С помощью этой вспомогательной функции:

Clear[makeSteps];
makeSteps[0] = {};
makeSteps[m_Integer?Positive] :=
  Most@Flatten[
    Table[#, {m}] & /@ {{-1, 0}, {-1, 1}, {0, 1}, {1, 0}, {1, -1}, {0, -1}}, 1];

Мы можем построить матрицу как

constructMatrix[n_Integer?OddQ] :=
  Module[{cycles, positions},
    cycles = (n+1)/2;
    positions = 
       Flatten[FoldList[Plus, cycles + {#, -#}, makeSteps[#]] & /@ 
           Range[0, cycles - 1], 1];
    SparseArray[Reverse[positions, {2}] -> Range[Length[positions]]]];

Чтобы получить матрицу, которую вы описали, используйте

constructMatrix[7] // MatrixForm

.Идея, стоящая за этим, состоит в том, чтобы исследовать шаблон, которому следуют позиции последовательных чисел 1 ..Вы можете видеть, что они образуют циклы.Нулевой цикл тривиален - содержит число 1 в позиции {0,0} (если мы посчитаем позиции от центра).Следующий цикл формируется путем взятия первого числа (2) в позиции {1,-1} и добавления к нему одного за другим следующих шагов: {0, -1}, {-1, 0}, {-1, 1}, {0, 1}, {1, 0} (когда мы движемся вокруг центра).Второй цикл аналогичен, но мы должны начать с {2,-2}, повторить каждый из предыдущих шагов дважды и добавить шестой шаг (идти вверх), повторяемый только один раз: {0, -1}.Третий цикл аналогичен: начните с {3,-3}, повторите все шаги 3 раза, кроме {0,-1}, который повторяется только дважды.Вспомогательная функция makeSteps автоматизирует процесс.В основной функции мы должны собрать все позиции вместе, а затем добавить к ним {cycles, cycles}, поскольку они были отсчитаны от центра, который имеет позицию {cycles,cycles}.Наконец, мы строим SparseArray из этих позиций.

Answer 2

Я не знаю синтаксис Mathematica, но, думаю, вы могли бы использовать алгоритм, подобный следующему:

start in the middle of the matrix
enter a 1 into the middle
go up-right (y-1 / x+1)
set integer iter=1
set integer num=2
while cursor is in matrix repeat:
   enter num in current field 
   increase num by 1
   repeat iter times:
       go left (x-1 / y)
       enter num in current field 
       increase num by 1
   repeat iter times:
       go down-left (x-1 / y+1)
       enter num in current field 
       increase num by 1
   repeat iter times:
       go down (x / y+1)
       enter num in current field 
       increase num by 1
   repeat iter times:
       go right (x+1 / y)
       enter num in current field 
       increase num by 1
   repeat iter times:
       go up-right (x+1 / y-1)
       enter num in current field 
       increase num by 1
   repeat iter-1 times:
       go up (x / y-1)
       enter num in current field 
       increase num by 1
   go up-up-right (y-2 / x+1)
   increase iter by 1

Вы также можете довольно легко преобразовать этот алгоритм в функциональную версию или в хвостовую рекурсию.

Что ж, вам придется проверить цикл while, если вы тоже не выходите за пределы. Если n нечетно, вы можете просто подсчитать num, пока:

m = floor(n/2)
num <= n*n - (m+m*m)

Я почти уверен, что есть более простой алгоритм, но он наиболее интуитивен для меня.

Answer 3

Первая версия:

i = 10;
a = b = c = Array[0 &, {2 (2 i + 1), 2 (2 i + 1)}];
f[n_] := 3*n*(n + 1) + 1;
k = f[i - 2];
p[i_Integer] :=
  ToRules@Reduce[
    -x + y < i - 1 && -x + y > -i + 1 &&
     (2 i + 1 - x)^2 + (2 i + 1 - y)^2 <= 2 i i - 2 &&
     3 i - 1 > x > i + 1 &&
     3 i - 1 > y > i + 1, {x, y}, Integers];

((a[[Sequence @@ #]] = 1) & /@ ({x, y} /. {p[i]}));
((a[[Sequence @@ (# + {2, 2})]] = 0) & /@ ({x, y} /. {p[i - 1]}));

(b[[Sequence @@ #]] = k--)&/@((# + 2 i {1, 1}) &/@ (SortBy[(# - 2 i {1, 1}) &/@ 
       Position[a, 1], 
      N@(Mod[-10^-9 - Pi/4 + ArcTan[Sequence @@ #], 2  Pi]) &]));
c = Table[b[[2 (2 i + 1) - j, k]], {j, 2 (2 i + 1) - 1}, 
                                   {k, 2 (2 i + 1) - 1}];
MatrixPlot[c]

Редактировать

Лучше:

genMat[m_] := Module[{f, k, k1, i, n, a = {{1}}},
  f[n_] := 3*n*(n + 1) + 1;
  For[n = 1, n <= m, n++,
   a = ArrayPad[a, 1];
   k1 = (f[n - 1] + (k = f[n]) + 2)/2 - 1;
   For[i = 2, i <= n + 1, i++,  a[[i, 2n + 1]] = k--; a[[2-i+2 n, 1]] = k1--];
   For[i = n + 2, i <= 2 n + 1, i++, a[[i, 3n+2-i]] = k--; a[[-i,i-n]] = k1--];
   For[i = n, i >= 1, i--, a[[2n+1, i]] = k--;a[[1, -i + 2 n + 2]] = k1--];
   ];
  Return@MatrixForm[a];
  ]

genMat[5]

Answer 4

Магические числа на диагонали, начинающиеся с 1 и повышающиеся вправо, могут быть получены из

f[n_] := 2 Sum[2 m - 1, {m, 1, n}] + UnitStep[n - 3] Sum[2 m, {m, 1, n - 2}]

In  := f@Range@5
Out := {2, 8, 20, 38, 62}

. При этом должно быть легко установить SparseArray.Я немного поиграюсь с этим и посмотрю, как это тяжело.

Answer 5

Частичное решение с использованием обработки изображений:

Image /@ (Differences@(ImageData /@ 
     NestList[
      Fold[ImageAdd, 
        p = #, (HitMissTransform[p, #, Padding -> 0] & /@
          {{{1}, {-1}},
           {{-1}, {-1}, {1}},
           {{1, -1, -1}},
           {{-1, -1, 1}},
           {{-1, -1, -1, -1}, {-1, -1, -1, -1}, {1, 1, -1, -1}}, 
           {{-1, -1, -1,  1}, {-1, -1, -1, -1}, {-1, -1, -1, -1}}})] &, img, 4]))