General rules [for multidimensional cellular automata] One can specify the neighborhood for any rule in any dimension by giving a list of the offsets for the cells used to update a given cell. 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.

Surprisingly enough, this simple procedure, which can be represented by the function s[list_] := Flatten[ Transpose[Reverse[Partition[list, Length[list]/2]]]] with or without the Reverse , is able to produce orderings which at least in some respects seem quite random.

The basic idea is to encode the list of values of all the registers in the multiregister machine in the single number given by RMEncode[list_] := Product[Prime[j]^list 〚 j 〛 , {j, Length[list]}] and then to have this number be the value at appropriate steps of the first register in the 2-register machine. The program in the multiregister machine can be converted to a program for the 2-register machine according to RMToRM2[prog_] := Module[{segs, adrs}, segs = MapIndexed[seg, prog]; adrs = FoldList[Plus, 1, Map[Length, segs]]; MapIndexed[#1 /. {ds[r_, s_]  d[r, adrs 〚 s 〛 ], dr[r_, j_]  d[r, j + First[#2]]} &, Flatten[segs]]] seg[i[r_], {a_}] := With[{p = Prime[r]}, Flatten[{Table[i[2], {p}], dr[1, -p], i[1], dr[2, -1], Table[dr[1, 1], {p + 1}]}]] seg[d[r_, n_], {a_}] := With[{p = Prime[r]}, Flatten[{i[2], dr[ 1, 5], i[1], dr[2, -1], dr[1, 1], ds[1, n], Table[{If[m  p - 1, ds[1, a], dr[1, 3p + 2 - m]], Table[i[1], {p}], dr[2, -p], Table[dr[1, 1], {2p - m - 1}], ds[1, a + 1]}, {m, p - 1}]}]] The initial conditions for the 2-register machine are given by {1, {RMEncode[list], 0}} and the results corresponding to each step in the evolution of the multiregister machine appear whenever register 2 in the 2-register machine is incremented from 0.

Blocks in such sequences obtained from Partition[list, n, 1] must all be distinct since they correspond to successive complete states of the shift register. … The regularity of PN sequences is revealed by looking at the autocorrelation RotateLeft[(-1) list , m] . (-1) list . This quantity is -1 for all nonzero m for PN sequences (so that all but the first component in Abs[Fourier[(-1) list ]] 2 are equal), but has mean 0 for truly random sequences.

The sequence {1, 2, 2, 1, 1, 2, …} defined by the property list  Map[Length, Split[list]] was suggested as a mathematical puzzle by William Kolakoski in 1965 and is equivalent to Join[{1, 2}, Map[First, CTEvolveList[{{1}, {2}}, {2}, t]]] It is known that this sequence does not repeat, contains no more than two identical consecutive blocks, and has at least very close to equal numbers of 1's and 2's.

The tetrahedron network from page 476 is for example given in this representation by {1  {2, 3, 4}, 2  {1, 3, 4}, 3  {1, 2, 4}, 4  {1, 2, 3}} The list of nodes reached by following up to n connections from node i are then given by NodeLists[g_, i_, n_] := NestList[Union[Flatten[# /. g]] &, {i}, n] The network distance corresponding to the length of the shortest path between two nodes is given by Distance[g_, {i_, j_}] := Length[NestWhileList[ Union[Flatten[# /. g]] &, {i}, !

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} //.

Starting with a list of nodes, the nodes reached by following arcs with value a for one step are given by NetStep[net_, i_, a_] := Union[ReplaceList[a, Flatten[net 〚 i 〛 ]]] A list of values then corresponds to a path in the network starting from any node if Fold[NetStep[net, #1, #2]&, Range[Length[net]], list] =!… = {}, AllNet[k], q = ISets[b = Map[Table[ Position[d, NetStep[net, #, a]] 〚 1, 1 〛 , {a, 0, k - 1}]&, d]]; DeleteCases[MapIndexed[#2 〚 2 〛 - 1  #1 &, Rest[ Map[Position[q, #] 〚 1, 1 〛 &, Transpose[Map[Part[#, Map[ First, q]]&, Transpose[b]]], {2}]] - 1, {2}], _  0, {2}]]] DSets[net_, k_:2] := FixedPoint[Union[Flatten[Map[Table[NetStep[net, #, a], {a, 0, k - 1}]&, #], 1]]&, {Range[Length[net]]}] ISets[list_] := FixedPoint[Function[g, Flatten[Map[ Map[Last, Split[Sort[Part[Transpose[{Map[Position[g, #] 〚 1, 1 〛 &, list, {2}], Range[Length[list]]}], #]], First[#1]  First[#2]&], {2}]&, g], 1]], {{1}, Range[2, Length[list]]}] If net has q nodes, then in general MinNet[net] can have as many as 2 q -1 nodes. … To obtain such trimmed networks one can apply the function TrimNet[net_] := With[{m = Apply[Intersection, Map[FixedPoint[ Union[#, Flatten[Map[Last, net 〚 # 〛 , {2}]]]&, #]&, Map[List, Range[Length[net]]]]]}, net 〚 m 〛 /.

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 tag systems] With the rules for case (a) on page 94 given for example by {2, {{0, 0}  {1, 1}, {1, 0}  {}, {0, 1}  {1, 0}, {1, 1}  {0, 0, 0}}} the evolution of a tag system can be obtained from TSEvolveList[{n_, rule_}, init_, t_] := NestList[If[Length[#] < n, {}, Join[Drop[#, n], Take[#, n] /. rule]]&, init, t] An alternative implementation is based on applying to the list at each step rules such as {{0, 0, s___}  {s, 1, 1}, {1, 0, s___}  {s}, {0, 1, s___}  {s, 1, 0}, {1, 1, s___}  {s, 0, 0, 0}} There are a total of ((k r + 1 - 1)/(k - 1)) k n possible rules if blocks up to length r can be added at each step and k colors are allowed.