Спиральная матрица в Mathematica

[Alladin]

Здравствуйте! Как задать спиральную матрицу (10*10) с помощью средств Mathematica вроде циклов?

Пример такой матрицы размером 4*4
1 12 11 10
2 13 16 9
3 14 15 8
4 5 6 7

[Leierkastenmann]

Как-нибудь так:

SpiralMatrix[n_] := Module[
  {
   i = 0,
   j = 1,
   m = n,
   k = 1,
   smatrix = Array[0 &, {n, n}],
   l,
   s
   },
  While[m > 0,
   s = {m, m - 1, m - 1, m - 2};
   For[l = 1, l <= Count[s, _?(# > 0 &)],
    Do[
     {i = i + Sin[Pi/2*l];
      j = j + Cos[Pi*(l/2 - 1)];
      smatrix[[i, j]] = k;
      k++},
     {s[[l]]}
     ];
    l++
    ];
   m = Sqrt[m^2 - Max[4*(m - 1), 1]]
   ];
  Return[smatrix]
  ]

Это первое что в голову пришло, возможно есть и более изящные решения.

[Alladin]

Не хочет работать. И непонятно, причём тут синусы и косинусы.

[Leierkastenmann]

Что значит не хочет работать? Пишите хотя бы какие ошибки выдает.

Синусы и косинусы в данной задаче помогают делать повороты при обходе матрицы по спирали. У задачи на самом деле много реализаций можно придумать, можно те же самые повороты заранее предопределить и обойтись без синусов и косинусов.

[Casaubon]

А если вот так попробовать:

f[{i_, j_}, n_] := Module[{
   r = Round[ 1/2 + 1/2 Max[Abs[n + 1 - 2 #] & /@ {i, j}]]
   },
  4 r^2 + 2 - 4 r + (i + j - n - 2 r) Sign[j - i - 1/2]
 ]

MatrixForm@Table[f[{i, j}, 10], {i, 10}, {j, 10}]

Правда, числа стоят в обратном порядке, но это недолго и переделать, если надо.

[caxap]

По-моему, легче не циклом, а сделать функцию $a_n(i,j)$, возвращающую число, которое стоит на месте $(i,j)$ в матрице $n\times n$. Например (не самое лучшее решение, но простое):

(* Направление к элементу, к которому нужно перейти при рекурсии *)
dir[i_, j_, n_] := Piecewise[{
     {{1, 0}, j < i && j < n + 1 - i},
     {{-1, 0}, j > i - 1 && j > n + 1 - i},
     {{0, -1}, j < n + 2 - i && j > i - 1},
     {{0, 1}, True}}] // Append[#, n] &;

(* сама рекурсия *)
a[1, 1, n_] := 1; 
a[i_, j_, n_] := 1 + Apply[a, {i, j, n} + dir[i, j, n]];

spiral[n_] := Array[a[#1, #2, 0] &, {n, n}] // Transpose;

-- 30 ноя 2010, 19:14 --

У Casaubon лучше.

[Leierkastenmann]

Буду оборонять свой вариант

У вас Casaubon формула не работает для нечетных n. А вариан caxapа у меня что-то совсем не работает ($RecursionLimit::reclim: Recursion depth of 256 exceeded.)

[caxap]

Leierkastenmann в сообщении #382140 писал(а):

А вариан caxapа у меня что-то совсем не работает ($RecursionLimit::reclim: Recursion depth of 256 exceeded.)

Пардон, надо заменить "Apply[a, {i, j, n}" на "Apply[a, {i, j, 0}" и "Array[a[#1, #2, 0]" на "Array[a[#1, #2, n]" (я просто при наборе опечатался).

Я тоже писал специально для чётных $n$, но, как оказалось, с нечётными тоже работает.

(Пример)

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

In[11]:= spiral[9] //TableForm
Out[11]//TableForm= 1   32   31   30   29   28   27   26   25
                    2   33   56   55   54   53   52   51   24
                    3   34   57   72   71   70   69   50   23
                    4   35   58   73   80   79   68   49   22
                    5   36   59   74   81   78   67   48   21
                    6   37   60   75   76   77   66   47   20
                    7   38   61   62   63   64   65   46   19
                    8   39   40   41   42   43   44   45   18
                    9   10   11   12   13   14   15   16   17

[Leierkastenmann]

caxap в сообщении #382143 писал(а):

Leierkastenmann в сообщении #382140 писал(а):

А вариан caxapа у меня что-то совсем не работает ($RecursionLimit::reclim: Recursion depth of 256 exceeded.)

Пардон, надо заменить "Apply[a, {i, j, n}" на "Apply[a, {i, j, 0}" и "Array[a[#1, #2, 0]" на "Array[a[#1, #2, n]" (я просто при наборе опечатался).

Я тоже писал специально для чётных $n$, но, как оказалось, с нечётными тоже работает.

spiral[16] попробуйте

[Casaubon]

Leierkastenmann в сообщении #382140 писал(а):

У вас Casaubon формула не работает для нечетных n. А вариан caxapа у меня что-то совсем не работает ($RecursionLimit::reclim: Recursion depth of 256 exceeded.)

Вставте

$RecursionLimit = Infinity

перед всем этим делом.

(Оффтоп)

Всю жизнь считал 10 чётным числом. Leierkastenmann, готовы представить изящненький вариант для нечётных $n$, или, ещё лучше, для произвольных натуральных? У вас уж слишком громоздко. ;)

[Leierkastenmann]

Casaubon, я нигде и не отрицал, что 10 это четное число , но зачем же так сужать решение. К сожалению, автор не уточнил зачем ему спиральная матрица 10х10 и почему именно 10х10, но если вдруг ему задали решить такую задачу, то с вашими решениями нормальный преподаватель завалит его только так, потому что решение очень частное (как мы уже заметили оно не работает для нечетных, или например вас попросят заполнить матрицу по спирали не последовательными числами, а последовательными простыми числами). Мое конечно громоздкое и не очень изящное, может даже где-то надуманное, зато работает и легко модифицируется.

Casaubon в сообщении #382244 писал(а):

Вставте

$RecursionLimit = Infinity

Спасибо, но я лучше найду нормальное решение, чем буду допускать безумные рекурсии

[Leierkastenmann]

Вот вариант попроще и поуниверсальней, работает для любых матриц и для произвольной функции заполнения.

SetAttributes[SpiralMatrix, HoldAll];
SpiralMatrix[n1_, n2_, (f_)[n3_]] := Module[
  {
   i = 0,
   j = 1,
   k,
   l = 1,
   smatrix = Array[0 &, {n1, n2}],
   n = n1,
   m = n2,
   r = 1
   },
  While[Min[n, m] > 0,
   k = 1;
   While[k <= n + m - 1,
    If[k <= n,
     i = i + (-1)^(r + 1),
     j = j + (-1)^(r + 1)
     ];
    smatrix[[i, j]] = f[l];
    l++;
    k++
    ];
   n--;
   m--;
   r++
   ];
  Return[smatrix]
  ];
f[n_]:=n;
SpiralMatrix[5, 5, f[n]] // MatrixForm

Может теперь поупражняемся в трехмерных спиралях?

[Alladin]

Спасибо всем, кто отписался! Это задание не учебное. Просто хочу разобраться в Mathematica для дальнейших исследований.

Сейчас буду разбираться...