Difference tables and polynomials A common mathematical approach to analyzing sequences is to form a difference table by repeatedly evaluating d[list_] := Drop[list, 1] - Drop[list, -1] . If the elements of list correspond to values of a polynomial of degree n at successive integers, then Nest[d, list, n + 1] will contain only zeros.

An initial condition consisting of n white cells with one black cell in the middle can then be obtained with the function (see below for comments on this and other Mathematica functions) CenterList[n_Integer] := ReplacePart[Table[0, {n}], 1, Ceiling[n/2]] For cellular automata of the kind discussed in this chapter, the rule can also be represented by a list. Thus, for example, rule 30 on page 27 corresponds to the list {0, 0, 0, 1, 1, 1, 1, 0} . … 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.

Implementation [of Turing machines] The state of a Turing machine at a particular step can be represented by the triple {s, list, n} , where s gives the state of the head, list gives the values of the cells, and n specifies the position of the head (the cell under the head thus has value list 〚 n 〛 ). … With a rule given in this form, a single step in the evolution of the Turing machine can be implemented with the function TMStep[rule_List, {s_, a_List, n_}] /; (1 ≤ n ≤ Length[a]) := Apply[{#1, ReplacePart[a, #2, n], n + #3}&, Replace[{s, a 〚 n 〛 }, rule]] The evolution for many steps can then be obtained using TMEvolveList[rule_, init_List, t_Integer] := NestList[TMStep[rule, #]&, init, t] An alternative approach is to represent the complete state of the Turing machine by MapAt[{s, #}&, list, n] , and then to use TMStep[rule_, c_] := Replace[c, {a___, x_, h_List, y_, b___}  Apply[{{a, x, #2, {#1, y}, b}, {a, {#1, x}, #2, y, b}} 〚 #3 〛 &, h /. rule]] The result of t steps of evolution from a blank tape can also be obtained from (see also page 1143 ) s = 1; a[_] = 0; n = 0; Do[{s, a[n], d} = {s, a[n]} /. rule; n += d, {t}]

Multiway tag systems As an extension of ordinary multiway systems one can generalize tag systems from page 93 to allow a list of strings at each step. Representing the strings by lists, one can write rules in the form {{1, 1, s___}  {s, 1, 0}, {1, s___}  {s, 1, 0, 1}} so that the evolution is given by MWTSEvolve[rule_, list_, t_] := Nest[Flatten[Map[ReplaceList[#, rule] &, #], 1] &, list, t]

Generalizations [of cyclic tag systems] The implementation above immediately allows cyclic tag systems which cycle through a list of more than two blocks. … Cyclic tag systems which allow any value for each element can be obtained by adding the rule CTStep[{{r_, s___}, {n_, a___}}] := {{s, r}, Flatten[{a, Table[r, {n}]}]} The leading elements in this case can be obtained using CTListStep[{rules_, list_}] := {RotateLeft[rules, Length[list]], With[{n = Length[rules]}, Flatten[Apply[Table[#1, {#2}] &, Map[Transpose[ {rules, #}] &, Partition[list, n, n, 1, 0]], {2}]]]}

Each step in its evolution can be implemented using LifeStep[a_List] := MapThread[If[(#1  1 && #2  4) || #2  3, 1, 0]&, {a, Sum[RotateLeft[a, {i, j}], {i, -1, 1}, {j, -1, 1}]}, 2] A more efficient implementation can be obtained by operating not on a complete array of black and white cells but rather just on a list of positions of black cells. With this setup, each step then corresponds to LifeStep[list_] := With[{p=Flatten[Array[List, {3, 3}, -1], 1]}, With[{u = Split[Sort[Flatten[Outer[Plus, list, p, 1], 1]]]}, Union[Cases[u, {x_, _, _}  x], Intersection[Cases[u, {x_, _, _, _}  x], list]]]] (A still more efficient implementation is based on finding runs of length 3 and 4 in Sort[u] .)

Implementation [of network cellular automata] Given a network represented as a list in which element i is {a, i , b } , where a is the node reached by the above connection from node i , and b is the node reached by the below connection, each step corresponds to NetCAStep[{rule_, net_}, list_] := Map[Replace[#, rule] &, list 〚 net 〛 ]

Generating causal networks If every element generated in the evolution of a generalized substitution system is assigned a unique number, then events can be represented for example by {4, 5}  {11, 12, 13} —and from a list of such events a causal network can be built up using With[{u = Map[First, list]}, MapIndexed[Function[ {e, i}, First[i]  Map[(If[# === {}, ∞ , # 〚 1, 1 〛 ] &)[ Position[u, #]]) &, Last[e]]], list]]

Digit count sequences Starting say with {1} repeatedly replace list by Join[list, IntegerDigits[Apply[Plus, list], 2]] The resulting sequences grow in length roughly like n Log[n] .

Implementation of general cellular automata With k colors and r neighbors on each side, a single step in the evolution of a general cellular automaton is given by CAStep[CARule[rule_List, k_, r_], a_List] := rule 〚 -1 - ListConvolve[k^Range[0, 2r], a, r + 1] 〛 where rule is obtained from a rule number num by IntegerDigits[num, k, k 2r + 1 ] .