1
$\begingroup$

I want to produce the following ArrayPlot programmatically:

enter image description here

To produce the leftmost grid, I tried this:

GridBox[{
   {ArrayPlot[{{0, 1, 0}}]},
   {ArrayPlot[{{1, 1, 1}}]}, 
   {ArrayPlot[{{0, 0, 0}}]}}, 
  GridBoxDividers -> {"Rows" -> {{True}}, 
    "Columns" -> {{True}}}] // DisplayForm

I'm unsure if this can be tailored to look like I want, or if I should pursue another solution.

edit: the general formula for the plots is an ellementary cellular automaton that inverts its output if the state of its cell is 1 (black) in t-1 (the upper square). The CellularAutomaton function can serve as guide.

Improve this question
$\endgroup$
3
  • $\begingroup$ Is the ordering important? Is there a formula that generates which boxes are filled? $\endgroup$
    – march
    Aug 10, 2015 at 20:04
  • $\begingroup$ Your code is complicated. Try this: ArrayPlot[{{0, 1, 0}, {1, 1, 1}, {0, 1, 0}}]. Now just hand-code the 3x3 matrices for each of these, map ArrayPlot and wrap in Row and you should be pretty close to done (except for some minor tweaks). This will be far easier and faster than trying to come up with a clever algorithmic/programmatic way to generate those images. $\endgroup$
    – rm -rf ♦
    Aug 10, 2015 at 20:11
  • 1
    $\begingroup$ Can you post the code for the specific automaton? $\endgroup$
    – march
    Aug 10, 2015 at 20:25

2 Answers 2

Reset to default
5
$\begingroup$

If you generate a list of 9-element lists of 0's and 1's using CellularAutomaton, then you can do the following:

GraphicsRow[
  Framed[
    ArrayPlot[
      #
      , Frame -> False
      , Axes -> False
    ]
  ] & /@ list
]

For instance, if

list = CellularAutomaton[30, {0, 1, 0, 1, 1, 1, 0, 1, 0}, 5];

then the code above generates

enter image description here

You can add the proper gridlines by adding

Epilog -> {
  Line[{{1, 0}, {1, 3}, {2, 3}, {2, 0}, {1, 0}}]
  , Line[{{0, 1}, {3, 1}, {3, 2}, {0, 2}, {0, 1}}]
 }

for your particular version. In addition, you can format each plot the same as you see fit by modifying the Options sent to ArrayPlot.

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

Borrowing from @march's answer (and non-CelluarAutomaton)...

pos = Subsets[{2, 4, 5, 6, 8}] /. x_Integer :> {x};
list = (Partition[#, 3] & /@ (ReplacePart[ConstantArray[0, 9], 1, #] & /@ pos));

GraphicsRow[
 Framed[ArrayPlot[#, Frame -> False, Axes -> False, 
  Epilog -> {Line[{{1, 0}, {1, 3}, {2, 3}, {2, 0}, {1, 0}}], 
   Line[{{0, 1}, {3, 1}, {3, 2}, {0, 2}, {0, 1}}]}]] & /@ list, 
  ImageSize -> 1500]

enter image description here

Improve this answer
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

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