Firing Squad Problem

Author

Eric W. Weisstein
April 15, 2004

This notebook downloaded from http://mathworld.wolfram.com/notebooks/CellularAutomata/FiringSquadProblem.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/FiringSquadProblem.html.

©2005 Wolfram Research, Inc. except for portions noted otherwise

Additional Authors

The material in this notebook appears in
Stephen Wolfram
A New Kind of Science
© 2002 Stephen Wolfram LLC
via Oyvind Tafjord
July 29, 2002

Code

Note: there is a bug in the code for width 3 so if you want to do that width, get rid of the test in MazStep.  Note that the graphic cheats a little, assigning same colors to states 2 and 6, but this is probably OK since color 6 always appear only at the boundaries.

MazRules={{1,1,1}->1,{1,1,2}->2,{1,1,3}->1,{1,1,4}->4,{1,1,5}->3,{1,2,2}->2,{1,2,3}->3,{1,2,5}->2,{1,3,1}->3,{1,3,2}->3,{1,3,3}->3,{1,3,5}->1,{1,3,6}->3,{1,4,1}->3,{1,4,2}->2,{1,4,3}->2,{1,4,5}->3,{1,4,6}->2,{1,5,1}->5,{1,5,2}->5,{1,5,3}->5,{1,5,4}->5,{1,5,5}->5,{1,5,6}->5,{2,1,3}->5,{2,1,4}->4,{2,1,5}->5,{2,1,6}->5,{2,2,1}->1,{2,2,2}->2,{2,2,3}->1,{2,2,4}->4,{2,2,5}->2,{2,3,1}->3,{2,3,2}->3,{2,3,3}->4,{2,3,5}->4,{2,3,6}->4,{2,4,4}->4,{2,4,5}->4,{2,5,1}->5,{2,5,2}->5,{2,5,3}->3,{2,5,4}->5,{2,5,5}->4,{2,5,6}->3,{3,1,2}->1,{3,1,3}->3,{3,1,4}->2,{3,1,5}->2,{3,2,1}->1,{3,2,3}->1,{3,2,5}->1,{3,3,1}->3,{3,3,2}->3,{3,3,3}->7,{3,3,5}->1,{3,3,6}->7,{3,4,2}->2,{3,4,3}->2,{3,5,1}->5,{3,5,2}->5,{3,5,3}->4,{3,5,4}->5,{3,5,5}->2,{4,1,1}->1,{4,1,2}->5,{4,1,4}->1,{4,1,5}->3,{4,2,1}->1,{4,2,3}->1,{4,2,5}->1,{4,2,6}->1,{4,3,1}->3,{4,3,2}->3,{4,3,5}->1,{4,4,1}->1,{4,4,2}->2,{4,4,3}->1,{4,4,4}->4,{4,4,5}->4,{4,5,1}->5,{4,5,2}->5,{4,5,3}->2,{4,5,4}->5,{4,5,5}->3,{4,5,6}->2,{5,1,1}->1,{5,1,2}->5,{5,1,3}->1,{5,1,4}->3,{5,2,1}->3,{5,2,2}->2,{5,2,3}->3,{5,2,4}->4,{5,2,5}->2,{5,3,1}->3,{5,3,2}->3,{5,3,4}->3,{5,4,1}->5,{5,4,2}->3,{5,4,4}->4,{5,5,1}->5,{5,5,2}->5,{5,5,3}->5,{5,5,5}->5,{5,5,6}->5,{6,3,1}->3,{6,3,2}->3,{6,3,3}->7,{6,3,5}->4,{6,4,2}->3,{3,1,6}->3,{3,2,6}->1,{3,4,6}->2,{3,5,6}->4,{1,2,6}->3};

MazStep[l_] := Flatten[{6, Partition[l, 3, 1] /. MazRules /.
     {a_, b_, c_} :> (If[ !MemberQ[{a, b, c}, 8], Print["No rule for ",
         {a, b, c}]]; 8), 6}]

MazInit[n_] := Flatten[{6, 3, Table[5, {n - 1}], 6}]

MazRun[n_] := NestList[MazStep, MazInit[n], 2*n - 2]

CellGraphics[ar_] := Graphics[Raster[1 - Reverse[ar]],
   AspectRatio -> Automatic]

MazGraphics[n_] := CellGraphics[MazRun[n] /. {1 -> 1, 2 -> 0.2, 3 -> 0.4,
     4 -> 0.6, 5 -> 0, 6 -> 0.2, 7 -> 0.5, 8 -> 0}]

Figure

Show[GraphicsArray[MazGraphics/@{10,25,50}]]