Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

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?

share|improve this question
    
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 :) –  mm.Jang Jun 11 '13 at 13:14
add comment

10 Answers 10

up vote 13 down vote accepted

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.

share|improve this answer
2  
Someday, I'll try to find time to learn more about cellular automata... (+1) –  J. M. 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. –  mm.Jang Jun 11 '13 at 4:08
2  
@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
add comment

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

share|improve this answer
add comment

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

share|improve this answer
add comment

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}]]
share|improve this answer
1  
(At the very least, the sparse array takes up less memory than the corresponding full array.) –  J. M. 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. Jun 10 '13 at 17:11
    
This code can be simplifyed with Min. –  chyaong Jun 11 '13 at 6:13
    
@chyanog, yes, I could have used Min[] and Max[] to compress to a single interval... –  J. M. Jun 11 '13 at 6:15
show 2 more comments

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]
share|improve this answer
1  
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. Jun 11 '13 at 12:41
add comment

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

share|improve this answer
add comment

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

share|improve this answer
1  
Why not use Do[] instead of For[]? –  J. M. Jun 11 '13 at 5:39
    
@0x4A4D 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
add comment

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.

share|improve this answer
3  
Iteration version: Nest[ArrayPad[#, 1, Boole@EvenQ@First@#] &, {{1}}, 7] //. 1 -> "*" // Grid. –  chyaong Jun 10 '13 at 17:15
add comment
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.

share|improve this answer
add comment

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

share|improve this answer
add comment

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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