The matrices for size n = 2 s can be obtained from Nest[Apply[Join, f[{Map[Flatten[Map[{#, #} &, #]] &, #], Map[Flatten[Map[{#, -#} &, #]] &, g[#]]}]] &, {{1}},s] with (a) f = Identity , g = Reverse , (b) f = Transpose , g = Identity , and (c) f = g = Identity . … It exhibits a nested structure, and can be obtained as in the pictures below from the evolution of a 2D substitution system, or equivalently from a Kronecker product as in Nest[Flatten2D[Map[# {{1, 1}, {1, -1}} &, #, {2}]] &, {{1}}, s] with Flatten2D[a_] := Apply[Join, Apply[Join, Map[Transpose,a], {2}]] (c) is known as dyadic or Paley order.

One can also consider building up lists of non-identical elements, say by successively using Join .

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.

In case (c), the following gives a list of the numbers of nodes generated up to step t : FoldList[Plus, 1, Join[{1, 4, 12, 10, -20, 6, 4}, Map[d, IntegerDigits[Range[4, t - 5], 2]]]] d[{___, 1}] = 1 d[{1, p : 0 .., 0}] := -Apply[Plus, 4 Range[Length[{p}]] - 1] + 6 d[{__, 1, p : 0 .., 0}] := d[{1, p, 0}] - 7 d[{___, p : 1 .., q : 0 ..., 1, 0}] := 4 Length[{p}] + 3 Length[{q}] + 2 d[{___, p : 1 .., 1, 0}] := 4 Length[{p}] + 2

Cyclic tag systems [emulating tag systems] From a tag system which depends only on its first element, with rules given as in the note below, the following constructs a cyclic tag system emulating it: TS1ToCT[{n_, subs_}] := With[{k = Length[subs]}, Join[Map[v[Last[#], k] &, subs], Table[{}, {k(n - 1)}]]] u[i_, k_] := Table[If[j  i + 1, 1, 0], {j, k}] v[list_, k_] := Flatten[Map[u[#, k] &, list]] The initial condition for the tag system can be converted using v[list, k] .

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.

Implementation [of cyclic tag systems] With the rules for the cyclic tag system on page 95 given as {{1, 1}, {1, 0}} , the evolution can be obtained from CTEvolveList[rules_, init_, t_] := Map[Last, NestList[CTStep, {rules, init}, t]] CTStep[{{r_, s___}, {0, a___}}] := {{s, r}, {a}} CTStep[{{r_, s___}, {1, a___}}] := {{s, r}, Join[{a}, r]} CTStep[{u_, {}}] := {u, {}} The leading elements on many more than t successive steps can be obtained directly from CTList[rules_, init_, t_] := Flatten[Map[Last, NestList[CTListStep, {rules, init}, t]]] CTListStep[{rules_, list_}] := {RotateLeft[rules, Length[list]],Flatten[rules 〚 Mod[Flatten[Position[list, 1]], Length[rules], 1] 〛 ]}

In such a rule, given a list of how many neighbors around a given cell (out of s possible) make the cell turn black the outer totalistic code for the rule can be obtained from Apply[Plus, 2^Join[2 list, 2 Range[s + 1] - 1]]

Sierpiński pattern Other ways to generate step n of the pattern shown here in various orientations include: • Mod[Array[Binomial, {2, 2} n , 0], 2] (see pages 611 and 870 ) • 1 - Sign[Array[BitAnd, {2, 2} n , 0]] (see pages 608 and 871 ) • NestList[Mod[RotateLeft[#] + #, 2] &, PadLeft[{1}, 2 n ], 2 n - 1] (see page 870 ) • NestList[Mod[ListConvolve[{1, 1}, #, -1], 2] &, PadLeft[{1}, 2 n ], 2 n - 1] (see page 870 ) • IntegerDigits[NestList[BitXor[2#, #] &, 1, 2 n - 1], 2, 2 n ] (see page 906 ) • NestList[Mod[Rest[FoldList[Plus, 0, #]], 2] &, Table[1, {2 n }], 2 n - 1] (see page 1034 ) • Table[PadRight[ Mod[CoefficientList[(1 + x) t - 1 , x], 2], 2 n - 1], {t, 2 n }] (see pages 870 and 951 ) • Reverse[Mod[CoefficientList[Series[1/(1 - (1 + x)y), {x, 0, 2 n - 1}, {y, 0, 2 n - 1}], {x, y}], 2]] (see page 1091 ) • Nest[Apply[Join, MapThread[ Join, {{#, #}, {0 #, #}}, 2]] &, {{1}}, n] (compare page 1073 ) The positions of black squares can be found from: • Nest[Flatten[2# /.

[Turing] machine 596440 For any list of initial colors init , it turns out that successive rows in the first t steps of the compressed evolution pattern turn out to be given by NestList[Join[{0}, Mod[1 + Rest[FoldList[Plus, 0, #]], 2], {{0}, {1, 1, 0}} 〚 Mod[Apply[Plus, #], 2] + 1] 〛 &, init, t] Inside the right-hand part of this pattern the cell values can then be obtained from an upside-down version of the rule 60 additive cellular automaton, and starting from a sequence of 1 's the picture below shows that a typical rule 60 nested pattern can be produced, at least in a limited region.