Recursive subdivision [encoding] In one dimension, encoding can be done using Subdivide[a_] := Flatten[ If[Length[a]  2, a, If[Apply[SameQ, a], {1,First[a]}, {0, Map[Subdivide, Partition[a, Length[a]/2]]}]]] In n dimensions, it can be done using Subdivide[a_, n_] := With[{s = Table[1, {n}]}, Flatten[ If[Dimensions[a]  2s, a, If[Apply[SameQ, Flatten[a]], {1, First[Flatten[a]]}, {0, Map[Subdivide[#, n] &, Partition[a, 1/2Length[a] s], {n}]}]]]]

Sequence equations Another way to set up 1D systems based on constraints is by having equations like Flatten[{x, 1, x, 0, y}] === Flatten[{0, y, 0, y, x}] , where each variable stands for a list.

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] 〛 ]}

Implementation [of 2D substitution systems] With the rule on page 187 given for example by {1  {{1, 0}, {1, 1}}, 0  {{0, 0}, {0, 0}}} the result of t steps in the evolution of a 2D substitution system from a initial condition such as {{1}} is given by SS2DEvolve[rule_, init_, t_] := Nest[Flatten2D[# /. rule] &, init, t] Flatten2D[list_] := Apply[Join, Map[MapThread[Join, #] &, list]]

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# /. {x_, y_}  {{x, y}, {x + 1, y}, {x, y + 1}}, 1] &, {{0, 0}}, n] • Transpose[{Re[#], Im[#]}] &[ Flatten[Nest[{2 #, 2 # + 1, 2 # +  } &, {0}, n]]] (compare page 1005 ) • Position[Map[Split, NestList[Sort[Flatten[{#, # + 1}]] &, {0}, 2 n - 1]], _?(OddQ[Length[#]] &), {2}] (see page 358 ) • Flatten[Table[Map[{t, #} &, Fold[Flatten[{#1, #1 + #2}] &, 0, Flatten[2^(Position[ Reverse[IntegerDigits[t, 2]], 1] - 1)]]], {t, 2 n - 1}], 1] (see page 870 ) • Map[Map[FromDigits[#, 2] &, Transpose[Partition[#, 2]]] &, Position[Nest[{{#, #}, {#}} &, 1, n], 1] - 1] (see page 509 ) A formatting hack giving the same visual pattern is DisplayForm[Nest[SubsuperscriptBox[#, #, #] &, "1", n]]

Particularly dramatic are the concatenation systems discussed on page 913 , as well as successive rows in nested patterns such as Flatten[IntegerDigits[NestList[BitXor[#, 2 #] &, 1, 500], 2]] and sequences based on numbers such as Flatten[Table[If[GCD[i, j]  0, 1, 0], {i, 1000}, {j, i}]] (see page 613 ).

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}]]]}

Sequence equations One can ask whether by replacing variables by sequences one can satisfy so-called word or string equations such as Flatten[{x, 0, x, 0, y}]  Flatten[{y, x, 0, y, 1, 0, 1, 0, 0}] (with shortest solution x = {1, 0, 1, 0, 0, 1, 0, 1, 0, 0, 1, 0, 1, 0} , y = {1, 0, 1, 0, 0, 1, 0, 1, 0, 0} ).

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}, !

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. … Transforms of 2D data are equivalent to 1D transforms of flattened data.