# How can I generate a nested array like this one?

Well, this is how the array looks like: I came up with this code:

n = 10;
Nest[ArrayPad[#, 1, 1 - #[[1, 1]]] &, {{1}}, n] /. {1 -> "*"}


Any better ideas?

• Fun question. Too bad every method I can think of is already posted. :^) Jun 11 '13 at 13:12
• @Mr.Wizard You are too late for the game :) Jun 11 '13 at 13:14

Via CellularAutomaton:

ruleFn[{{_, _, _}, {_, 0, _}, {_, _, _}}, step_] := 1;
ruleFn[{{_, _, _}, {_, 1, _}, {_, _, _}}?(MemberQ[#, 0, 2] &), step_] := 0;
ruleFn[{{1, 1, 1}, {1, 1, 1}, {1, 1, 1}}, step_] := 1;

CellularAutomaton[{ruleFn, {}, {1, 1}}, {{{0}}, 1}, {{{9}}}] /. 1 -> "*" // Grid


Edit: For those who really like obfuscated CAs:

Grid[CellularAutomaton[
{6704108548762591141713703895184498446288891439307603869437298727894782281512658462491554691453382697921609151728673186802143641955019044568101339107753983,
2, {1, 1}}, {{{0}}, 1}, {{{9}}}] /. 1 -> "*"]


...or just like really large numbers.

• Someday, I'll try to find time to learn more about cellular automata... (+1) Jun 11 '13 at 3:13
• It's my favorite! And it will takes me some tough time to figure out how it works :) I accept this just due to my personal interest on CA, all the other answers are nice too. Jun 11 '13 at 4:08
• @mm.Jang this method is very slow, some ~340 times slower than my mat2. I know you didn't specify performance as your primary goal but this seems like a lot of code for a very slow function. (Sorry Michael; I'm usually a fan of your answers but this just seems impractical.) Jun 11 '13 at 14:55
• @Mr.Wizard No problem. The answer was meant for fun. Upvoted your comment because it's important for future visitors, who may have other criteria, such as efficiency, in searching for solutions. Jun 11 '13 at 15:49

Here's a recursive approach:

f = {{1}};
f[x_] := ArrayPad[f[x - 1], 1, Boole@OddQ@x];


To apply it and display

f //. 1 -> "*" // MatrixForm I learned this trick from rm -rf in this post which has a great explanation of a simple recursive function. This f[ ] works for both even and odd matrix sizes.

• Iteration version: Nest[ArrayPad[#, 1, Boole@EvenQ@First@#] &, {{1}}, 7] //. 1 -> "*" // Grid. Jun 10 '13 at 17:15

Update

Simpler way of generating a "concentric" matrix, without having to convert to an image to apply a distance transform:

    With[{size = 11},
Array[Max[#1, #2, size + 1 - #1, size + 1 - #2] &, {size, size}]
/. {_?OddQ -> "0", _?EvenQ -> "*"}]


End update

Here's a hare-brained implementation that uses DistanceTransform[]:

First create an image with a single background (value 0) pixel at the center, and remaining pixels all foreground (value 1):

img = Image[SparseArray[{6, 6} -> 0, {11, 11}, 1]]

Take the distance transform with the chessboard metric:

mat = Round@ImageData@DistanceTransform[img, DistanceFunction -> ChessboardDistance]

giving Now simply use rule-based replacement

mat /. {_?EvenQ -> "*", _?OddQ -> "0"} // MatrixForm

to get the desired result. I like Bill's recursive approach. Here's another version using ArrayPad and Fold:

nested[n_Integer] := Fold[ArrayPad[#, 1, (-1)^#2] &, {{1}}, Range[n]] /. {-1 -> 0, 1 -> "*"}
nested // MatrixForm Clear[nestmatrix]
nestmatrix[width_] := SparseArray[{{i_, j_} /;
EvenQ[Ceiling[Norm[{i, j} - (width + 1)/2, ∞]]] :>
"*"}, width {1, 1}, 0] // Normal

{#, Grid[
nestmatrix[#] /.
"*" -> Item["*", Background -> Lighter[Red, .7]],
ItemSize -> All,
Frame -> All,
FrameStyle -> GrayLevel[.8]]} & /@ Range //
Grid[#\[Transpose], Frame -> All] & You can of course replace EvenQ with OddQ to "reverse" the order.

The CellularAutomaton is very cool!

Another solution based on how * and 0 positions differ is given below:

f[n_] := Table[If[Mod[Max[Abs[i], Abs[j]], 2] == 0, "*", "0"],
{i, -n, n}, {j, -n, n}];

f

• Nicely done. Here's a SparseArray[] version: f[n_Integer] := SparseArray[{i_, j_} /; EvenQ[Max[Abs[i - n - 1], Abs[j - n - 1]]] :> "*", {2 n + 1, 2 n + 1}] Jun 11 '13 at 12:41

It's surprising that the following For loop approach is so fast (in fact it seems to be the fastest one until now! ):

(* n is the order of the matrix *)
n = 301;
mat = ConstantArray["*", {n, n}];
mid = (1 + n)/2;
mat[[mid, mid]] = 0;
For[i = 2, mid - i >= 1, i += 2,
mat[[mid - i, mid - i ;; mid + i]] = 0;
mat[[mid + i, mid - i ;; mid + i]] = 0;
mat[[mid - i + 1 ;; mid + i - 1, mid - i]] = 0;
mat[[mid - i + 1 ;; mid + i - 1, mid + i]] = 0]


Here's the snapshot for the test result: You may think that this code may be improved by changing the For loop into Do or Nest, but again, it's surprising that Do and Nest help little here, and I had a hard time in getting the boundary of the iterator. (I'm really bad at that! And thanks for the help of @chyanog ! )

n = 301;
mat = ConstantArray["*", {n, n}];
mid = (1 + n)/2;
mat[[mid, mid]] = 0;
Do[mat[[mid - i, mid - i ;; mid + i]] = 0;
mat[[mid + i, mid - i ;; mid + i]] = 0;
mat[[mid - i + 1 ;; mid + i - 1, mid - i]] = 0;
mat[[mid - i + 1 ;; mid + i - 1, mid + i]] = 0;, {i, 2, mid - 1, 2}]

n = 301;
mat = ConstantArray["*", {n, n}];
mid = (1 + n)/2;
mat[[mid, mid]] = 0;
i = 2;
Nest[(mat[[mid - i, mid - i ;; mid + i]] = 0;
mat[[mid + i, mid - i ;; mid + i]] = 0;
mat[[mid - i + 1 ;; mid + i - 1, mid - i]] = 0;
mat[[mid - i + 1 ;; mid + i - 1, mid + i]] = 0; i += 2;) &, , Floor[(mid - 1)/2]] • Why not use Do[] instead of For[]? Jun 11 '13 at 5:39
• @J. M. In fact this code is written with Nest at very first, but later I found that the speed will barely change even if I use Do or For…… Jun 11 '13 at 5:49

A bit complicated, but:

With[{n = 31},
SparseArray[{i_, j_} /;
(EvenQ[i] && (i <= j <= n - i + 1 || n - i + 1 <= j <= i)) ||
(EvenQ[j] && (j <= i <= n - j + 1 || n - j + 1 <= i <= j)) :> "*",
{n, n}]]


n must be odd, of course.

As noted in the comments by chyanog, one might want to use Min[]/Max[] for the second set of tests for each index. Here's an alternative:

With[{n = 31},
SparseArray[{i_, j_} /;
(EvenQ[i] && IntervalMemberQ[Interval[{i, n - i + 1}], j]) ||
(EvenQ[j] && IntervalMemberQ[Interval[{j, n - j + 1}], i]) :> "*",
{n, n}]]

• (At the very least, the sparse array takes up less memory than the corresponding full array.) Jun 10 '13 at 16:41
• I think the memory advantage will be marginal at best, it seems defining SparseArray with Condition causes it to test all possible positions and store {position} and value for all that match, in this case storing ~half the positions and a long list with only "*"s in it
– ssch
Jun 10 '13 at 17:07
• Well, according to ByteCount[mm]/ByteCount[Normal[mm]] (where mm is the sparse array), it only needs more or less 2/3 of the storage for the full array; I get similar savings for larger dimensions. Jun 10 '13 at 17:11
• This code can be simplifyed with Min. Jun 11 '13 at 6:13
• @chyanog, yes, I could have used Min[] and Max[] to compress to a single interval... Jun 11 '13 at 6:15

At the risk of flogging this equine quadruped post mortem, here's yet another:

Grid[
MorphologicalTransform[
SparseArray[{17, 17} -> 1, {33, 33}, 0],
{"Fill", "Clean", "Flip"},  17] /. 1 -> "*"]


using the strange options in MorphologicalTransform. Picture unnecessary...

I'm trying to do it differently but it's hard with so many good answers.

Hopefully this brings something unique:

mat[n_] := "*" Mod[1 - Array[Max@Abs@{##} &, 2n + {1,1}, -n], 2]

mat // Grid I thought using multiplication was clever but it appears replacement is faster when working with strings.

mat2[n_] := Mod[1 - Array[Max@Abs@{##} &, 2 n + {1, 1}, -n], 2] /. {1 -> "*"}

mat  // Timing // First
mat2 // Timing // First


0.437

0.234

p = {"*", 0};
n = 5;
Nest[ArrayPad[#, 1, First[p = p[[{2, 1}]]]] &, {{"*"}}, n] // TeXForm


$\left( \begin{array}{ccccccccccc} 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 \\ 0 & * & * & * & * & * & * & * & * & * & 0 \\ 0 & * & 0 & 0 & 0 & 0 & 0 & 0 & 0 & * & 0 \\ 0 & * & 0 & * & * & * & * & * & 0 & * & 0 \\ 0 & * & 0 & * & 0 & 0 & 0 & * & 0 & * & 0 \\ 0 & * & 0 & * & 0 & * & 0 & * & 0 & * & 0 \\ 0 & * & 0 & * & 0 & 0 & 0 & * & 0 & * & 0 \\ 0 & * & 0 & * & * & * & * & * & 0 & * & 0 \\ 0 & * & 0 & 0 & 0 & 0 & 0 & 0 & 0 & * & 0 \\ 0 & * & * & * & * & * & * & * & * & * & 0 \\ 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 \\ \end{array} \right)$

Also

Fold[ArrayPad[#, 1, p[[#2]]] &, {{"*"}}, Mod[Range @ n, 2, 1]]
Nest[ArrayPad[#, 1, #[[1, 1]] /. {0 -> "*", "*" -> 0}] &, {{"*"}}, n]