Implementation of totalistic cellular automata To handle totalistic rules that involve k colors and nearest neighbors, one can add the definition CAStep[TotalisticCARule[rule_List, 1], a_List] := rule 〚 -1 - (RotateLeft[a] + a + RotateRight[a]) 〛 to what was given on page 867 . The following definition also handles the more general case of r neighbors: CAStep[TotalisticCARule[rule_List, r_Integer], a_List] := rule 〚 -1 - Sum[RotateLeft[a, i], {i, -r, r}] 〛 One can generate the representation of totalistic rules used by these functions from code numbers using ToTotalisticCARule[num_Integer, k_Integer, r_Integer] := TotalisticCARule[IntegerDigits[num, k, 1 + (k - 1)(2r + 1)], r]

(In Mathematica 4 and above PadLeft[{1}, n, 0, Floor[n/2]] can be used instead.) … RotateLeft[a] and RotateRight[a] make shifted versions of the original list of cell values a . … Note that by using RotateLeft and RotateRight one automatically gets cyclic boundary conditions.

Thus, for example, rule 30 can be given as {{1, 1, 1}  0, {1, 1, 0}  0, {1, 0, 1}  0, {1, 0, 0}  1, {0, 1, 1}  1, {0, 1, 0}  1, {0, 0, 1}  1, {0, 0, 0}  0} To use rules in this form, CAStep can be rewritten as CAStep[rule_, a_List] := Transpose[{RotateRight[a], a, RotateLeft[a]}] /. rule or CAStep[rule_, a_List] := Partition[a, 3, 1, 2] /. rule The rules that are given can now contain patterns, so that rule 90, for example, can be written as {{1, _, 1}  0, {1, _, 0}  1, {0, _, 1}  1, {0, _, 0}  0} But how can one set up a program that can handle rules in several different forms? … Then, for example, one can define CAStep[ElementaryCARule[rule_List], a_List] := rule 〚 8 - (RotateLeft[a] + 2 (a + 2 RotateRight[a])) 〛 CAStep[GeneralCARule[rule_, r_Integer:1], a_List] := Partition[a, 2r + 1, 1, r + 1] /. rule CAStep[FunctionCARule[f_, r_Integer:1], a_List] := Map[f, Partition[a, 2r + 1, 1, r + 1]] Note that the second two definitions have been generalized to allow rules that involve r neighbors on each side. In each case, the use of Partition could be replaced by Transpose[Table[RotateLeft[a, i], {i, -r, r}]] .

A simpler example is the rule Mod[RotateLeft[list] + RotateRight[list], 1] With a single nonzero initial cell with value 1/k the pattern produced is just Pascal's triangle modulo k .

Implementation [of 2D cellular automata] An n × n array of white squares with a single black square in the middle can be generated by PadLeft[{{1}}, {n, n}, 0, Floor[{n, n}/2]] For the 5-neighbor rules introduced on page 170 each step can be implemented by CAStep[rule_, a_] := Map[rule 〚 10 - # 〛 &, ListConvolve[{{0, 2, 0}, {2, 1, 2}, {0, 2, 0}}, a, 2], {2}] where rule is obtained from the code number by IntegerDigits[code, 2, 10] . … In d dimensions with k colors, 5-neighbor rules generalize to (2d + 1) -neighbor rules, with CAStep[{rule_, d_}, a_] := Map[rule 〚 -1 - # 〛 &, a + k AxesTotal[a, d], {d}] AxesTotal[a_, d_] := Apply[Plus, Map[RotateLeft[a, #] + RotateRight[a, #]&, IdentityMatrix[d]]] with rule given by IntegerDigits[code, k, k(2d(k - 1) + 1)] . 9-neighbor rules generalize to 3 d -neighbor rules, with CAStep[{rule_, d_}, a_] := Map[rule 〚 -1 - # 〛 &, a + k FullTotal[a, d], {d}] FullTotal[a_, d_] := Array[RotateLeft[a, {##}] &, Table[3, {d}], -1, Plus] - a with rule given by IntegerDigits[code, k, k((3 d - 1)(k - 1) + 1)] .

Second-order cellular automata Second-order elementary rules can be implemented using CA2EvolveList[rule_List, {a_List, b_List}, t_Integer] := Map[First, NestList[CA2Step[rule, #]&, {a, b}, t]] CA2Step[rule_List, {a_, b_}] := {b, Mod[a + rule 〚 8 - (RotateLeft[b] + 2 (b + 2 RotateRight[b])) 〛 , 2]} where rule is obtained from the rule number using IntegerDigits[n, 2, 8] .

Implementation [of patterning model] Given a 2D array of values a and a list of weights w , each step in the evolution of the system corresponds to WeightedStep[w_List, a_] := Map[If[# > 0, 1, 0]&, Sum[w 〚 1 + i 〛 Apply[Plus, Map[RotateLeft[a, #]&, Layer[i]]], {i, 0, Length[w] - 1}], {2}] Layer[n_] := Layer[n] = Select[Flatten[Table[{i, j}, {i, -n, n}, {j, -n, n}],1], MemberQ[#, n| - n]&]

This list can then be updated using CCAEvolveStep[f_, list_List] := Map[f, (RotateLeft[list] + list + RotateRight[list])/3] CCAEvolveList[f_, init_List, t_Integer] := NestList[CCAEvolveStep[f, #] &, init, t] where for the rule on page 157 f is FractionalPart[3#/2] & while for the rule on page 158 it is FractionalPart[# + 1/4] & .

3D class 4 [cellular automaton] rules With a cubic lattice of the type shown on page 183 , and with updating rules of the form LifeStep3D[{p_, q_, r_}, a_List] := MapThread[If[ #1  1 && p ≤ #2 ≤ q || #2  r, 1, 0]&, {a, Sum[RotateLeft[ a, {i, j, k}], {i, -1, 1}, {j, -1, 1}, {k, -1, 1}] - a}, 3] Carter Bays discovered between 1986 and 1990 the three examples {5, 7, 6} , {4, 5, 5} , and {5, 6, 5} .

In general, the list for a particular rule can be obtained with the function ElementaryRule[num_Integer] := IntegerDigits[num, 2, 8] Given a rule together with a list representing the state a of a cellular automaton at a particular step, the following simple function gives the state at the next step: CAStep[rule_List, a_List] := rule 〚 8 - (RotateLeft[a] + 2 (a + 2 RotateRight[a])) 〛 A list of states corresponding to evolution for t steps can then be obtained with CAEvolveList[rule_, init_List, t_Integer] := NestList[CAStep[rule, #]&, init, t] Graphics of this evolution can be generated using CAGraphics[history_List] := Graphics[ Raster[1 - Reverse[history]], AspectRatio  Automatic] And having set up the definitions above, the Mathematica input Show[CAGraphics[CAEvolveList[ ElementaryRule[30], CenterList[103], 50]]] will generate the image: The description just given should be adequate for most cellular automaton simulations. In some earlier versions of Mathematica a considerably faster version of the program can be created by using the definition CAStep = Compile[{{rule, _Integer, 1}, {a, _Integer, 1}}, rule 〚 8 - (RotateLeft[a] + 2 (a + 2 RotateRight[a])) 〛 ] In addition, in Mathematica 4 and above, one can use CAStep[rule_, a_]:=rule 〚 8 - ListConvolve[{1, 2, 4}, a, 2]]] 〛 or directly in terms of the rule number num Sign[BitAnd[2^ListConvolve[{1, 2, 4}, a, 2], num]] (In versions of Mathematica subsequent to the release of this book the built-in CellularAutomaton function can be used, as discussed on page 867 .) … But since the C program explicitly updates values sequentially from left to right, the left-hand neighbor of a particular cell will already have been given its new value when one tries to updates the cell itself.