And with this representation, the evolution for t steps is given by SSEvolveList[rule_, init_List, t_Integer] := NestList[Flatten[# /. rule]&, init, t] where in the first example on page 82 , the initial condition is {1} . … In this case, the evolution can be obtained using SSEvolveList[rule_, init_String, t_Integer] := NestList[StringReplace[#, rule]&, init, t] For a neighbor-dependent substitution system such as the first one on page 85 the rule can be given as {{1, 1}  {0, 1}, {1, 0}  {1, 0}, {0, 1}  {0}, {0, 0}  {0, 1}} And with this representation, the evolution for t steps is given by SS2EvolveList[rule_, init_List, t_Integer] := NestList[Flatten[Partition[#, 2, 1] /. rule]&, init, t] where the initial condition for the first example on page 85 is {0, 1, 1, 0} .

Higher-dimensional generalizations [of substitution systems] The state of a d -dimensional substitution system can be represented by a nested list of depth d . The evolution of the system for t steps can be obtained from SSEvolve[rule_, init_, t_, d_Integer] := Nest[FlattenArray[# /. rule, d] &, init, t] FlattenArray[list_, d_] := Fold[Function[{a, n}, Map[MapThread[Join, #, n] &, a, -{d + 2}]], list, Reverse[Range[d] - 1]] The analog in 3D of the 2D rule on page 187 is {1  Array[If[LessEqual[##], 0, 1] &, {2, 2, 2}], 0  Array[0 &, {2, 2, 2}]} Note that in d dimensions, each black cell must be replaced by at least d + 1 black cells at each step in order to obtain an object that is not restricted to a dimension d - 1 hyperplane.

Implementation [of 2D Turing machines] With rules represented as a list of elements of the form {s, a}  {sp, ap, {dx, dy}} ( s is the state of the head and a the color of the cell under the head) each step in the evolution of a 2D Turing machine is given by TM2DStep[rule_, {s_, tape_, r : {x_, y_}}] := Apply[{#1, ReplacePart[tape, #2, {r}], r + #3} &, {s, tape 〚 x, y 〛 } /. rule]

Huffman coding From a list p of probabilities for blocks, the list of codewords can be generated using Map[Drop[Last[#], -1] &, Sort[ Flatten[MapIndexed[Rule, FixedPoint[Replace[Sort[#], {{p0_, i0_}, {p1_, i1_}, pi___}  {{p0 + p1, {i0, i1}}, pi}] & , MapIndexed[List, p]] 〚 1, 2 〛 , {-1}]]]] -1 Given the list of codewords c , the sequence of blocks that occur in encoded data d can be uniquely reconstructed using First[{{}, d} //.

Comments on Mathematica functions CenterList works by first creating a list of n 0's, then replacing the middle 0 by a 1. … CAEvolveList applies CAStep t times. … In general NestList[s[r, #]&, i, 2] ⟶ {i, s[r, i], s[r, s[r, i]]} , etc.

Iterated run-length encoding Starting say with {1} consider repeatedly replacing list by (see page 1070 ) Flatten[Map[{Length[#], First[#]} &, Split[list]]] The resulting sequences contain only the numbers 1, 2 and 3, but otherwise at first appear fairly random.

Substitution systems in which all replacements are done that are found to fit in a left-to-right scan can be implemented as follows GSSEvolveList[rule_, s_, n_] := NestList[GSSStep[rule, #] &, s, n] GSSStep[rule_, s_] := g[rule, s, f[StringPosition[s, Map[First, rule]]]] f[{ }] = { }; f[s_] := Fold[If[Last[Last[#1]] ≥ First[#2], #1, Append[#1, #2]]&, {First[s]}, Rest[s]] g[rule_, s_, { }] := s; g[rule_, s_, pos_] := StringReplacePart[ s, Map[StringTake[s, #] &, pos] /. rule, pos] with rules given as {"ABA"  "BAAB", "BBBB"  "AA"} .

And with this setup, t steps of evolution can be found with SSSEvolveList[rule_, init_s, t_Integer] := NestList[(# /. rule)&, init, t] Note that as an alternative to having s be Flat , one can explicitly set up rules based on patterns such as s[x___, 1, 0, y___]  s[x, 0, 1, 0, y] . And by using rules such as s[x___, 1, 0, y___]  {s[x, 0, 1, 0, y], Length[s[x]]} one can keep track of the positions at which substitutions are made. ( StringReplace replaces all occurrences of a given substring, not just the first one, so cannot be used directly as an alternative to having a flat function.)

For 1D elementary rules the list is {{-1}, {0}, {1}} , while for 2D 5-neighbor rules it is {{-1, 0}, {0, -1}, {0, 0}, {0, 1}, {1, 0}} . … One can specify a neighborhood configuration by giving in the same order as the offset list the color of each cell in the neighborhood. … A single step in evolution of a general cellular automaton with state a and rule number num is then given by Map[IntegerDigits[num, k, k^Length[os]] 〚 -1 - # 〛 &, Apply[Plus, MapIndexed[k^(Length[os] - First[#2]) RotateLeft[a, #1] &, os]], {-1}] or equivalently by Map[IntegerDigits[num, k, k^Length[os]] 〚 -# - 1 〛 &, ListCorrelate[Fold[ReplacePart[k #1, 1, #2 + r + 1] &, Array[0 &, Table[2r + 1, {d}]], os], a, r + 1], {d}]

With this setup, a network consisting of just one node is {{1, 1}} and a 1D array of n nodes can be obtained with CyclicNet[n_] := RotateRight[ Table[Mod[{i - 1, i + 1}, n] + 1, {i, n}]] With above connections represented as 1 and the below connections as 2 , the node reached by following a succession s of connections from node i is given by Follow[list_, i_, s_List] := Fold[list 〚 #1 〛 〚 #2 〛 &, i, s] The total number of distinct nodes reached by following all possible succession of connections up to length d is given by NeighborNumbers[list_, i_Integer, d_Integer] := Map[Length, NestList[Union[Flatten[list 〚 # 〛 ]] &, Union[list 〚 i 〛 ], d - 1]] For each such list the rules for the network system then specify how the connections from node i should be rerouted. The rule {2, 3}  {{2, 1}, {1}} specifies that when NeighborNumbers gives {2, 3} for a node i , the connections from that node should become {Follow[list, i, {2, 1}], Follow[list, i, {1}]} . … With rules set up in this way, each step in the evolution of a network system is given by NetEvolveStep[{depth_Integer, rule_List}, list_List] := Block[ {new = {}}, Join[Table[Map[NetEvolveStep1[#, list, i] &, Replace[NeighborNumbers[list, i, depth], rule]], {i, Length[list]}], new]] NetEvolveStep1[s : {___Integer}, list_, i_] := Follow[list, i, s] NetEvolveStep1[{s1 : {___Integer}, s2 : {___Integer}}, list_, i_] := Length[list] + Length[ AppendTo[new, {Follow[list, i, s1], Follow[list, i, s2]}]] The set of nodes that can be reached from node i is given by ConnectedNodes[list_, i_] := FixedPoint[Union[Flatten[{#, list 〚 # 〛 }]] &, {i}] and disconnected nodes can be removed using RenumberNodes[list_, seq_] := Map[Position[seq, #] 〚 1, 1 〛 &, list 〚 seq 〛 , {2}] The sequence of networks obtained on successive steps by applying the rules and then removing all nodes not connected to node number 1 is given by NetEvolveList[rule_, init_, t_Integer] := NestList[(RenumberNodes[#, ConnectedNodes[#, 1]] &)[ NetEvolveStep[rule, #]] &, init, t] Note that the nodes in each network are not necessarily numbered in the order that they appear on successive lines in the pictures in the main text.