Easy way to populate this matrix?

Question

I would like to populate the matrix n * n (n, odd) as follows:

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

What is an easy way to do this with Mathematica?

Answer 1

With this helper function:

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

We can build the matrix as

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

To get the matrix you describe, use

 constructMatrix[7] // MatrixForm 

The idea is to explore the pattern according to which the positions of consecutive numbers 1 follow. You can see that they form cycles. The zero cycle is trivial - it contains the number 1 in the position {0,0} (if we count the positions from the center). The next cycle is formed by taking the first number (2) at the position {1,-1} and adding the following steps one after another: {0, -1}, {-1, 0}, {-1, 1}, {0, 1}, {1, 0} (as you move in the center). The second cycle is similar, but we must start with {2,-2} , repeat each of the previous steps twice and add the sixth step (up), repeating only once: {0, -1} . The third cycle is similar: start with {3,-3} , repeat all steps 3 times, except for {0,-1} , which is repeated only twice. The helper function makeSteps automates the process. In the main function, then we need to collect all the positions together, and then add {cycles, cycles} , since they were calculated from the center, which has the position {cycles,cycles} . Finally, we build SparseArray from these positions.

Answer 2

I don't know the Mathematica syntax, but I think you could use an algorithm like this:

 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 

You can also easily convert this algorithm to a functional version or to tail recursion.

Well, you will need to check the while loop if you are also not out of bounds. If n is odd, you can just count the number until:

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

I am sure there is a simpler algorithm, but the most intuitive one for me.

Answer 3

Magic numbers on the diagonal, starting from 1 and rising to the right, can be obtained from

 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} 

With this, it is easy to install a SparseArray . I will play a little with him and see how difficult it is.

Answer 4

First version:

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

Edit

It's better:

 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,in]] = 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 5

Partial solution using image processing:

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