14
$\begingroup$

Well, this is how the array looks like:

enter image description here

I came up with this code:

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

Any better ideas?

Improve this question
$\endgroup$
2
  • $\begingroup$ Fun question. Too bad every method I can think of is already posted. :^) $\endgroup$ – Mr.Wizard Jun 11 '13 at 13:12
  • $\begingroup$ @Mr.Wizard You are too late for the game :) $\endgroup$ – mmjang Jun 11 '13 at 13:14

11 Answers 11

Active Oldest Votes
16
$\begingroup$

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.

Improve this answer
$\endgroup$
4
  • 2
    $\begingroup$ Someday, I'll try to find time to learn more about cellular automata... (+1) $\endgroup$ – J. M.'s ennui♦ Jun 11 '13 at 3:13
  • $\begingroup$ 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. $\endgroup$ – mmjang Jun 11 '13 at 4:08
  • 2
    $\begingroup$ @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.) $\endgroup$ – Mr.Wizard Jun 11 '13 at 14:55
  • $\begingroup$ @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. $\endgroup$ – Michael E2 Jun 11 '13 at 15:49
11
$\begingroup$

Here's a recursive approach:

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

To apply it and display

f[8] //. 1 -> "*" // MatrixForm

enter image description here

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.

Improve this answer
$\endgroup$
1
  • 3
    $\begingroup$ Iteration version: Nest[ArrayPad[#, 1, Boole@EvenQ@First@#] &, {{1}}, 7] //. 1 -> "*" // Grid. $\endgroup$ – chyanog Jun 10 '13 at 17:15
9
$\begingroup$

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

distance matrix

Now simply use rule-based replacement

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

to get the desired result.

result

Improve this answer
$\endgroup$
8
$\begingroup$

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[10] // MatrixForm

enter image description here

Improve this answer
$\endgroup$
7
$\begingroup$ 
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[6] //
 Grid[#\[Transpose], Frame -> All] &

examples

You can of course replace EvenQ with OddQ to "reverse" the order.

Improve this answer
$\endgroup$
7
$\begingroup$

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[10]
Improve this answer
$\endgroup$
1
  • 1
    $\begingroup$ 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}] $\endgroup$ – J. M.'s ennui♦ Jun 11 '13 at 12:41
5
$\begingroup$

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:

enter image description here

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

enter image description here

Improve this answer
$\endgroup$
2
  • 1
    $\begingroup$ Why not use Do[] instead of For[]? $\endgroup$ – J. M.'s ennui♦ Jun 11 '13 at 5:39
  • $\begingroup$ @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…… $\endgroup$ – xzczd Jun 11 '13 at 5:49
5
$\begingroup$

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}]]
Improve this answer
$\endgroup$
7
  • 1
    $\begingroup$ (At the very least, the sparse array takes up less memory than the corresponding full array.) $\endgroup$ – J. M.'s ennui♦ Jun 10 '13 at 16:41
  • $\begingroup$ 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 $\endgroup$ – ssch Jun 10 '13 at 17:07
  • $\begingroup$ 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. $\endgroup$ – J. M.'s ennui♦ Jun 10 '13 at 17:11
  • $\begingroup$ This code can be simplifyed with Min. $\endgroup$ – chyanog Jun 11 '13 at 6:13
  • $\begingroup$ @chyanog, yes, I could have used Min[] and Max[] to compress to a single interval... $\endgroup$ – J. M.'s ennui♦ Jun 11 '13 at 6:15
4
$\begingroup$

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

Improve this answer
$\endgroup$
3
$\begingroup$

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[5] // Grid

enter image description here

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[500]  // Timing // First
mat2[500] // Timing // First

0.437

0.234

Improve this answer
$\endgroup$
1
$\begingroup$ 
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]
Improve this answer
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.