1
$\begingroup$

I have been creating 2D cellular automaton functions in Mathematica and I would like the output to be a graphical representation of the array at each time step. I know I can do this with ListAnimate:

pics = ArrayPlot[#, ColorFunction -> "Rainbow", 
     ColorRules -> {713 -> Brown, 0 -> White, 1 -> Black, 2 -> Blue, 
       3 -> Purple, 4 -> Green, 100 -> Gray, 101 -> Yellow, 
       102 -> Orange, 103 -> Red, 104 -> Pink}, Mesh -> True, 
     ImageSize -> {900, 600}] & /@ 
   CellularAutomaton[rule, init, duration];
ListAnimate[pics, AnimationRunning -> False]

The issue is I have random seeds I want to be able to manipulate within the graphic. So I have also used the Manipulate function:

Manipulate[SeedRandom[sr]; 
 ArrayPlot[CellularAutomaton[rule, init, step][[step]], 
  ColorFunction -> "Rainbow", 
  ColorRules -> {713 -> Brown, 0 -> White, 1 -> Black, 2 -> Blue, 
    3 -> Purple, 4 -> Green, 100 -> Gray, 101 -> Yellow, 
    102 -> Orange, 103 -> Red, 104 -> Pink}, Mesh -> True, 
  ImageSize -> {900, 600}],
 {{step, 1, "step"}, 1, 50, 1, Appearance -> "Labeled"},
 {{sr, 100, "random seed"}, 1, 200, 1, Appearance -> "Labeled"},
 SynchronousUpdating -> True,
 SaveDefinitions -> True] 

The issue with the way I am using Manipulate right now is that it runs through the whole cellular automaton function starting from the initial board every time you increase the step. This makes it extremely hard to run my function on large arrays on my personal computer because it gets increasingly slower as the number of steps increases.

TL;DR - How do you either 1) include a manipulatable random seed in ListAnimate or 2) adjust the Manipulate function to not rerun the whole cellular automaton function from the beginning every time or 3) is there another function I can use to output my graphic?

(*RULES*)
SeedRandom[];
rule = {Function[{p, p23, p32, p42, p43, p53, p24, p34, p35, p44}, 
      (*If touching antibiotic*)

      If[p < 100 && (p43 == 100 || p34 == 100 || p23 == 100 || 
          p32 == 100),
       If[RandomReal[] > prob1 (p), 100, 101],
       (*If not all the way stacked*)
       If[Mod[p, 100] < 4,
        (*down*) 
        If[(p23 - p) == 1 , 
         If[ p < 100 && RandomReal[] < prob1 (p23), 101, p + 1],
         (*right*)

         If[(Mod[p32, 100] > Mod[p, 100] && 
            Mod[p42, 100] > Mod[p, 100] && (p32 - p) == 1), 
          If[ p < 100 && RandomReal[] < prob1 (p32), 101, p + 1], 
          (*up*)

          If[(Mod[p43, 100] > Mod[p, 100] && 
             Mod[p44, 100] > Mod[p, 100] && 
             Mod[p53, 100] > Mod[p, 100] && (p43 - p) == 1), 
           If[p < 100 && RandomReal[] < prob1 (p43), 101, p + 1], 
           (*left with probability when antibiotic present*)

             If[(Mod[p34, 100] > Mod[p, 100] && 
              Mod[p24, 100] > Mod[p, 100] && 
              Mod[p, 35100] > Mod[p, 100] && 
              Mod[p44, 100] > Mod[p, 100] && (p34 - p) == 1), 
            If[p < 100 && RandomReal[] < prob1 (p34), 101, p + 1],
            (*stacking if those surrounding are unable to be \
populated*)

            If[(Mod[p, 100] == Mod[p32, 100] || 
                p32 == WALLSTATE) && (Mod[p, 100] == Mod[p34, 100] || 
                p34 == WALLSTATE) && (Mod[p, 100] == Mod[p43, 100] || 
                p43 == WALLSTATE) && (Mod[p, 100] == 
                 Mod[p23, 100] ||  p23 == WALLSTATE) && 
              Mod[p, 100] != 0, p + 1,
             If[Mod[p, 100] >= 1, p, p]]]]]], p]]][#[[3, 3]], #[[2, 
      3]], #[[3, 2]], #[[4, 2]], #[[4, 3]], #[[5, 3]], #[[2, 4]], #[[
      3, 4]], #[[3, 5]], #[[4, 4]]] &, {}, {2, 2}};

(*INITIAL BOARD*)

f[x_, y_] :=
  If[x <= 2 || x > xdim - 2, WALLSTATE,
   If[y <= 2 || y > ydim - 2, WALLSTATE,
    If[RandomReal[] < .1, 100, 1]]];
init = Array[f, {xdim , ydim}];
$\endgroup$
  • 2
    $\begingroup$ Can you include the values of rule, init, and any other variables needed to run your code? $\endgroup$ – MarcoB Jun 6 '18 at 18:04
  • $\begingroup$ Welcome to Mathematica.SE. As Marco already pointed out, in its current form, your question is hard to answer without having all definitions of your specific example. If you would include code, that can directly be copied and tested, chances are much better that someone can help you with your problem. $\endgroup$ – halirutan Jun 8 '18 at 0:40
  • $\begingroup$ (INITIAL BOARD) f[x_, y_] := If[x <= 2 || x > xdim - 2, WALLSTATE, If[y <= 2 || y > ydim - 2, WALLSTATE, If[RandomReal[] < .1, 100, 1]]]; init = Array[f, {xdim , ydim}]; $\endgroup$ – Emma Kuntz Jun 8 '18 at 14:18

Your Answer

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

Browse other questions tagged or ask your own question.