\begingroup

我喜欢以网格格式（顺时针）绘制数字螺旋，大小为n2n2n^2。

所以当我传进来n = 2n=2n=2，它将生成一个大小为n2=22= 4n2=22=4n^2=2^2=4。

什么时候n = 3n=3n=3，它将绘制一个螺旋，最多 9 个：

什么时候n = 4n=4n=4，我们有 16 个：

\endgroup


最佳答案
4

\begingroup

Clear[g]
g[0] = {};
g[x_] := g[x] = 
  With[{mo = Mod[x, 2] + 1}, {Append, Prepend}[[mo]][
    MapIndexed[{Append, 
         Prepend}[[mo]][#, #2[[1]] + (x - 
          1)^2 + (-2 #2[[1]] + x) (mo - 1)] &, 
     g[x - 1]], ({Reverse, Identity}[[mo]])@
     Range[(x - 1)^2 + x, x^2]]]

使用上述递归定义：

Grid[#, Frame -> All] & /@ g /@ Range[7]

：

p = 10;
PathGraph[Range[p^2], 
 VertexCoordinates -> (First@Position[Transpose@g[p], #]*{1, -1} & /@ 
    Range[p^2]), VertexLabels -> (x_?PrimeQ) -> x]

\endgroup

4

  • \begingroup
    嗨@azerbajdzan 随着 n 变大，正方形将无法容纳：例如：Grid[#, Frame -> All] & /@ Table[g[n], {n, 800, 800}] 有没有办法只绘制最后 2 个外壳？或者只绘制外层？
    \endgroup


    – 


  • \begingroup
    @Steve237 我认为800它太大了，无法很好地显示所有数字的全长。
    \endgroup


    – 


  • \begingroup
    你好@azerbajdzan：我不想显示它…我只想将它列为 LIST 集 {…,…,…,} 外层。
    \endgroup


    – 

  • 1
    \begingroup
    @Steve237 您可以像这样替换内部数字：g[n] /. x_ /; x <= (n - 2)^2 -> Nothing
    \endgroup


    – 

\begingroup

Clear[n, coords, m];
n = 8;
coords = 
  Threaded@{Ceiling[n/2], Ceiling[n/2]} + 
   FoldList[Plus, {0, 0}, 
    Flatten[Riffle[Table[ConstantArray[(-1)^(k + 1) a, k], {k, 1, n}],
        Table[ConstantArray[(-1)^(k + 1) b, k], {k, 1, 
         n}]]] /. {a -> {0, 1}, b -> {1, 0}}];
m = SparseArray[Thread[coords[[1 ;; n^2]] -> Range[1, n^2]]];
Grid[m, Frame -> All]

  • 我们可以改为{a -> {0, 1}, b -> {1, 0}}逆时针方向 {a -> {1, 0}, b -> {0, 1}}。
  • 另一种方法可能是PathGraph使用GraphLayout -> "DiscreteSpiralEmbedding"和Transpose矩阵。
Clear[n, k, coords, m, g];
n = 8;
k = n^2;
g = PathGraph[Range[k], GraphLayout -> "DiscreteSpiralEmbedding", 
   VertexLabels -> Automatic];
coords = (VertexCoordinates /. 
      AbsoluteOptions[g, VertexCoordinates]) + 1 // Rationalize;
m = SparseArray[Thread[coords[[1 ;; k]] -> Range[1, k]]];
{g, Grid[Transpose@m, Frame -> All]}

  • 或者NestGraph. 
Clear[n, k, coords, m, g];
n = 8;
k = n^2;
g = NestGraph[# + 1 &, 0, k - 1, 
   GraphLayout -> "DiscreteSpiralEmbedding", 
   VertexLabels -> Automatic];
coords = (VertexCoordinates /. 
       AbsoluteOptions[g, VertexCoordinates]) + 1 // Rationalize // 
   Reverse;
m = SparseArray[Thread[coords[[1 ;; k]] -> Range[1, k]]];
{g, Grid[Transpose@m, Frame -> All]}

\endgroup

\begingroup

更简洁的版本：

n=5;
pts=ReIm@FoldList[Plus,0,I^-Floor[Sqrt[4Range[n^2-1]-3]-1]];
Graphics[{Line@pts,Point@pts}] 


MatrixForm[mat=Partition[Ordering[Cross/@pts],n]]

⎛⎝⎜⎜⎜⎜⎜⎜2120191817227651623814152492314二十五101112十三⎞⎠⎟⎟⎟⎟⎟⎟（21222324二十五20789101961211185431217161514十三）\left(
\begin{array}{ccccc}
21 & 22 & 23 & 24 & 25 \\
20 & 7 & 8 & 9 & 10 \\
19 & 6 & 1 & 2 & 11 \\
18 & 5 & 4 & 3 & 12 \\
17 & 16 & 15 & 14 & 13 \\
\end{array}
\right)

\endgroup

2

  • \begingroup
    非常好+1:)
    \endgroup


    – 

  • \begingroup
    太棒了，@chyanog——简洁明了！有没有办法在线条图上显示数字。
    \endgroup


    – 

\begingroup

我们可以递归地定义螺旋矩阵，通过观察当n为奇数时，我们在矩阵左侧添加一列n-1，在顶部添加一行；当n为偶数时，我们在矩阵右侧添加一列，在底部添加一行：

sp[2] = {{1, 2}, {4, 3}};

sp[n_] := sp[n] =
  Module[{joinLeftCol, joinRightCol},
   If[OddQ[n],
    joinLeftCol = 
     Join[{Reverse@Range[(n - 1)^2 + 1, (n - 1)^2 + (n - 1)]}, 
       Transpose@sp[n - 1]] // Transpose;
     Join[{Range[ ((n - 1)^2 + n), n^2]}, joinLeftCol]
    ,
    joinRightCol = 
     Join[Transpose@
        sp[n - 1], {Range[(n - 1)^2 + 1, (n - 1)^2 + (n - 1)]}] // 
      Transpose;
    Join[joinRightCol, {Reverse@Range[ ((n - 1)^2 + n), n^2]}]
    ]
   ]

Table[sp[i] // Grid[#, Frame -> All] &, {i, 2, 5}]

不过我猜有一种更干净的方法可以做到这一点。

添加在

这是同样的事情，但我在单独的函数中定义了新的列和行，希望可以让它更容易看。我们也可以sp[0]从将其定义为空矩阵开始：

newCol[n_] := 
 Module[{col}, col = Range[(n - 1)^2 + 1, (n - 1)^2 + (n - 1)];
  If[OddQ[n], Reverse@col, col]]

newRow[n_] := Module[{row}, row = Range[((n - 1)^2 + n), n^2];
  If[OddQ[n], row, Reverse@row]]

sp[0] = {{}};

sp[n_] := sp[n] = Module[{joinCol},
   If[OddQ[n],
    joinCol = Transpose@Join[{newCol[n]}, Transpose@sp[n - 1]];
    Join[{newRow[n]}, joinCol]
    ,
    
    joinCol = Transpose@Join[Transpose@sp[n - 1], {newCol[n]}];
    Join[joinCol, {newRow[n]}]
    ]
   ]

另一个附加组件

找到了@user34757关于乌兰姆螺旋的回答。我们可以使用它们ulamSpiral来创建我们所需的螺旋，方法是将其反转，并取内部行/列（如果n是偶数）：

(*from https://mathematica.stackexchange.com/a/96784/72953*)
ulamSpiral[n_] := 
 Permute[Range[n^2], 
   Accumulate@
    Take[Join[{n^2 + 1}/2, 
      Flatten@Table[(-1)^j i, {j, n}, {i, {-1, n}}, {j}]], n^2]]~
  Partition~n

sp[n_] := 
 If[OddQ[n], 
  Reverse@ulamSpiral[n], 
  (Reverse@ulamSpiral[n + 1])[[2 ;; All, 2 ;; All]]
   ]

\endgroup