# 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. :^) – Mr.Wizard Jun 11 '13 at 13:12
• @Mr.Wizard You are too late for the game :) – mmjang Jun 11 '13 at 13:14

## 11 Answers

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) – J. M.'s torpor 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. – mmjang 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.) – Mr.Wizard 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. – Michael E2 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. – chyanog 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}] – J. M.'s torpor 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[]? – J. M.'s torpor 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…… – xzczd 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.) – J. M.'s torpor 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. – J. M.'s torpor Jun 10 '13 at 17:11
• This code can be simplifyed with Min. – chyanog Jun 11 '13 at 6:13
• @chyanog, yes, I could have used Min[] and Max[] to compress to a single interval... – J. M.'s torpor 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]