Draw number spirals

Question

I like to draw a spiral of numbers in a grid format (clockwise) of size $n^2$.

So when I pass in $n=2$, it will generate a grid of size $n^2=2^2=4$.

When $n=3$, it will draw a spiral up to 9:

When $n=4$, we have 16:

Answer 1

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]]]

Using the above recursive definition:

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

---

Ulam spiral:

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

---

Answer 2

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]

• We can change {a -> {0, 1}, b -> {1, 0}} to {a -> {1, 0}, b -> {0, 1}} to get counterclockwise.

• Another way maybe PathGraph with GraphLayout -> "DiscreteSpiralEmbedding" and Transpose the matrix.

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]}

• Or NestGraph. https://mathematica.stackexchange.com/a/110796/72111

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]}

Answer 3

A more concise version:

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

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

$\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)$

Answer 4

We can define the spiral matrices recursively, by observing when n is odd we add a column to the left of the n-1 matrix, and a row on top, and when n is even we add a column to the right, and a row on the bottom:

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}]

I'm guessing there's a much cleaner way to do this however.

---

Add-on

This is the same thing, but I define the new columns and rows in separate functions to hopefully make it a little easier to stare at. We can also start at sp[0] by defining it to be the empty matrix:

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]}]
    ]
   ]

---

Another add-on

I just found @user34757 's answer here regarding Ulam spirals. We can use their ulamSpiral to create our needed spiral by reversing it, and taking the inner rows/columns if n is even:

(*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]]
   ]

Answer 5

You can also easily do it using my LatticePointsArrangement function from the Wolfram Function Repository:

pts=ResourceFunction["LatticePointsArrangement"]["CCWSpiralEast",25]
Graphics[{FaceForm[],EdgeForm[Black],MapIndexed[{Rectangle[#1-0.5,#1+0.5],Text[#2[[1]],#1]}&,pts]}]

Giving:

There are 160 different arrangements available in this function.