Skip to main content
1 of 5
C. E.
  • 71.2k
  • 6
  • 141
  • 269

###Background A while back someone told me about a homework problem he was working on. Since I hadn't been in that class I hadn't heard about cellular automatons... So when I was bored and wanted to try the homework problem I ended up implementing everything from scratch. A few weeks later I stumbled upon CellularAutomaton in Vitaliy Kaurov's post here. I hope that my solutions can help you somehow.

###The problem The homework problem is a fire that can spread in four directions (the Von Neumann neighborhood). Only trees can catch fire though. A typical fire looks like this:

forest

Any of the methods below can generate it. There appears to be a named collision between method 1 and 2, so you may need to restart the kernel before you can try the next.

###Method #1

(* Generate random forest *)
forest = RandomChoice[{1, 1, 0}, {150, 150}];

(* Set fire to a randomly chosen location *)
forest = ReplacePart[forest, RandomChoice[Position[forest, 1]] -> 3];

(* Kernel. Determines how the fire spreads. *)
ker = {{1, 0}, {0, 1}, {-1, 0}, {0, -1}};  (* Can be programmatically generated: Position[CrossMatrix[1],1]-2 *)

(* Find trees in danger *)
trees[forest_] := Position[forest, 1];
dangerZone[forest_] := Intersection[trees[forest], Flatten[ker + ConstantArray[#, Length[ker]] & /@ Position[forest, 3], 1]]

(* Simulates the fire *)
frames = FixedPointList[ReplacePart[#, {Position[#, 3] -> 2, dangerZone[#] -> 3}] &, forest];

(* Visualizes the fire *)
ListAnimate[ ArrayPlot[#, ColorRules -> {0 -> Brown, 1 -> Green, 2 -> Orange, 3 -> Yellow}] & /@ frames]

###Method #2

(* Generate random forest *)
forest = RandomChoice[{1, 1, 0}, {200, 200}];

(* Locate trees *)
trees = Position[forest, 1];

(* Set fire to a randomly chosen location *)
forest = ReplacePart[forest, RandomChoice[trees] -> 3];

(* Kernel. Determines how the fire spreads. *)
ker[p_] := Sequence[p + {1, 0}, p + {0, 1}, p + {-1, 0}, p + {0, -1}]; 

(* Find trees in danger *)
dangerZone[frontline_, forest_] := Intersection[trees, DeleteDuplicates[ker /@ frontline]]

(* The brain *)
setFire[frontline_, forest_] := Module[{dz = dangerZone[frontline, forest]},
  If[dz != {},
   trees = Complement[trees, dz];
   setFire[dz, ReplacePart[Sow@forest, {frontline -> 2, dz -> 3}]],
   Sow@forest
   ]
  ]

(* Simulate the fire *)
Block[{$RecursionLimit = 100000},
  {final, {frames}} = Reap@setFire[Position[forest, 3], forest]
  ];

(* Visualizes the fire *)
ListAnimate[ArrayPlot[#, ColorRules -> {0 -> Brown, 1 -> Green, 2 -> Orange, 3 -> Yellow}] & /@ frames]

###Method #3

(* Generate random forest *)
forest = ArrayPad[RandomChoice[{1, 1, 0}, {100, 100}], 1];

(* Set fire to a randomly chosen location *)
forest = ReplacePart[forest, RandomChoice[Position[forest, 1]] -> 2];

(* Simulate *)
adv[forest_] := CellularAutomaton[{
    {{_, Except[2], _}, {Except[2], x_, Except[2]}, {_, Except[2], _}} :> x,
    {{_, _, _}, {_, x_, _}, {_, _, _}} :> Switch[x, 1, 2, 2, 2, 0, 0]}, forest];
frames = FixedPointList[adv, forest];

(* Visualize the fire *)
ListAnimate[ArrayPlot[#, ColorRules -> {0 -> Brown, 1 -> Green, 2 -> Orange, 3 -> Yellow}] & /@ frames]

###Conclusions I hope that in these three different examples you can find something that might help you simulate your model. As for efficiency, a lot of the time is spent visualizing. The computation is much faster, and I tried to measure it, although I am unsure of my results because they seem very unlikely. Confirm them yourself! Remember that these times also seem faster than you anticipate because it takes time for the frontend to display the result, even in list form. For 200x200 pixel grid the methods take this much time:

Method 1: 1.513038 seconds

Method 2: 0.376987 seconds

Method 3: 20-25 seconds

I tried using the third argument of CellularAutomaton to generate only the end state, however it did not yield much improvement in time.

The conclusion is that it appears one can do simulations faster by writing one's own code for it. However CellularAutomaton is fast and somewhat easy to use. If you can think of a way to formulate your rules in the format required by CellularAutomaton, therefore, you could start with that and see if speed is a problem or not. In the other methods you are free to write program your rules however you want.

If you don't want to generate the entire simulation at once but just want to watch how it evolves in the beginning, you can save time by visualizing it using Dynamic like this:

Dynamic[ArrayPlot[forest = adv[forest], ColorRules -> {0 -> Brown, 1 -> Green, 2 -> Orange}]]

This might be useful if you are experimenting. Vitaliy uses it in the post I linked to.

If you have any questions please know that all I have ever done regarding CA is in this post. But if I can I will try to help you.

C. E.
  • 71.2k
  • 6
  • 141
  • 269