2014 dxdy logo

Научный форум dxdy

Математика, Физика, Computer Science, Machine Learning, LaTeX, Механика и Техника, Химия,
Биология и Медицина, Экономика и Финансовая Математика, Гуманитарные науки




Начать новую тему Ответить на тему
 
 Спиральная матрица в Mathematica
Сообщение29.11.2010, 13:33 


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

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

 Профиль  
                  
 
 Re: Спиральная матрица в Mathematica
Сообщение30.11.2010, 00:33 
Аватара пользователя


15/01/06
200
Как-нибудь так:
Код:
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]
  ]

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

 Профиль  
                  
 
 Re: Спиральная матрица в Mathematica
Сообщение30.11.2010, 15:19 


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

 Профиль  
                  
 
 Re: Спиральная матрица в Mathematica
Сообщение30.11.2010, 15:57 
Аватара пользователя


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

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

 Профиль  
                  
 
 Re: Спиральная матрица в Mathematica
Сообщение30.11.2010, 17:06 


07/03/10
59
А если вот так попробовать:
Код:
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}]

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

 Профиль  
                  
 
 Re: Спиральная матрица в Mathematica
Сообщение30.11.2010, 19:11 
Заслуженный участник
Аватара пользователя


07/01/10
2015
По-моему, легче не циклом, а сделать функцию $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 лучше.

 Профиль  
                  
 
 Re: Спиральная матрица в Mathematica
Сообщение30.11.2010, 20:53 
Аватара пользователя


15/01/06
200
Буду оборонять свой вариант :mrgreen:

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

 Профиль  
                  
 
 Re: Спиральная матрица в Mathematica
Сообщение30.11.2010, 20:56 
Заслуженный участник
Аватара пользователя


07/01/10
2015
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

 Профиль  
                  
 
 Re: Спиральная матрица в Mathematica
Сообщение30.11.2010, 21:24 
Аватара пользователя


15/01/06
200
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] попробуйте

 Профиль  
                  
 
 Re: Спиральная матрица в Mathematica
Сообщение01.12.2010, 00:53 


07/03/10
59
Leierkastenmann в сообщении #382140 писал(а):
У вас Casaubon формула не работает для нечетных n. А вариан caxapа у меня что-то совсем не работает ($RecursionLimit::reclim: Recursion depth of 256 exceeded.)

Вставте
Код:
$RecursionLimit = Infinity

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

(Оффтоп)

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

 Профиль  
                  
 
 Re: Спиральная матрица в Mathematica
Сообщение01.12.2010, 09:10 
Аватара пользователя


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

Casaubon в сообщении #382244 писал(а):
Вставте
Код:
$RecursionLimit = Infinity


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

 Профиль  
                  
 
 Re: Спиральная матрица в Mathematica
Сообщение01.12.2010, 20:17 
Аватара пользователя


15/01/06
200
Вот вариант попроще и поуниверсальней, работает для любых матриц и для произвольной функции заполнения.
Код:
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


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

 Профиль  
                  
 
 Re: Спиральная матрица в Mathematica
Сообщение02.12.2010, 10:02 


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

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

 Профиль  
                  
Показать сообщения за:  Поле сортировки  
Начать новую тему Ответить на тему  [ Сообщений: 13 ] 

Модераторы: Karan, Toucan, PAV, maxal, Супермодераторы



Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей


Вы не можете начинать темы
Вы не можете отвечать на сообщения
Вы не можете редактировать свои сообщения
Вы не можете удалять свои сообщения
Вы не можете добавлять вложения

Найти:
Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group