The same is true for higher-dimensional generalizations such as so-called Anosov maps {x, y}  Mod[m . … The continued fraction map x  Mod[1/x, 1] discussed on page 914 becomes repetitive whenever its initial condition is a solution to a quadratic equation. For a map x  f[x] where f[x] is a polynomial such as a x (1 - x) the real initial conditions that yield period p are given by Select[x /.

Implementation [of TM cellular automaton] Given a non-deterministic Turing machine with rules in the form above, the rules for a cellular automaton which emulates it can be obtained from NDTMToCA[tm_] := Flatten[{{_, h, _}  h, {s, _c, _}  e, {s, _, _}  s, {_, s, c[i_]}  s[i], {_, s, x_}  x, {a[_, _], _s, _}  s, {_, a[x_, y_], s[i_]}  a[x, y, i], {x_, _s, _}  x, {_, _, s[i_]}  s[i], Map[Table[With[{b = (# 〚 Min[Length[#], z] 〛 &)[ {x, #} /. tm]}, If[Last[b]  -1, {{a[_], a[x, #, z], e}  h, {a[ _], a[x, #, z], s}  a[x, #, z], {a[_], a[x, #, z], _}  a[b 〚 2 〛 ], {a[x, #, z], a[w_], _}  a[b 〚 1 〛 , w], {_, a[w_], a[x, #, z]}  a[w]}, {{a[_], a[x, #, z], _}  a[b 〚 2 〛 ], {a[x, #, z], a[w_], _}  a[w], {_, a[w_], a[x, #, z]}  a[b 〚 1 〛 , w]}]], {x, Max[Map[# 〚 1, 1 〛 &, tm]]}, {z, Max[Map[Length[# 〚 2 〛 ] &, tm]]}] &, Union[Map[# 〚 1, 2 〛 &, tm]]], {_, x_, _}  x}]

Directional reversibility [in cellular automata] Even if successive time steps in the evolution of a cellular automaton do not correspond to an injective map, it is still possible to get an injective map by looking at successive lines at some angle in the spacetime evolution of the system.

For the 9-neighbor rules introduced on page 177 CAStep[rule_, a_] := Map[rule 〚 18 - # 〛 &, ListConvolve[{{2, 2, 2}, {2, 1, 2}, {2, 2, 2}}, a, 2], {2}] where rule is given by IntegerDigits[code, 2, 18] . In d dimensions with k colors, 5-neighbor rules generalize to (2d + 1) -neighbor rules, with CAStep[{rule_, d_}, a_] := Map[rule 〚 -1 - # 〛 &, a + k AxesTotal[a, d], {d}] AxesTotal[a_, d_] := Apply[Plus, Map[RotateLeft[a, #] + RotateRight[a, #]&, IdentityMatrix[d]]] with rule given by IntegerDigits[code, k, k(2d(k - 1) + 1)] . 9-neighbor rules generalize to 3 d -neighbor rules, with CAStep[{rule_, d_}, a_] := Map[rule 〚 -1 - # 〛 &, a + k FullTotal[a, d], {d}] FullTotal[a_, d_] := Array[RotateLeft[a, {##}] &, Table[3, {d}], -1, Plus] - a with rule given by IntegerDigits[code, k, k((3 d - 1)(k - 1) + 1)] . In 3 dimensions, the positions of black cells can conveniently be displayed using Graphics3D[Map[Cuboid[-Reverse[#]] &, Position[a, 1]]]

Iterated maps For maps of the form x  a x (1 - x) discussed on page 920 the attractor for small a is a fixed point, then a period 2 limit cycle, then period 4, 8, 16, etc.

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} //. MapIndexed[ {{r___}, Flatten[{#1, s___}]}  {{r,#2 〚 1 〛 },{s}} &, c]] Note that the encoded data can consist of any sequence of 0's and 1's.

Each collection of such functions can be obtained from lists of vectors representing 1D Walsh functions by using Outer[Outer[Times, ##] &, b, b, 1, 1] , or equivalently Map[Transpose, Map[# b &, b, {2}]] . … 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.

If the rules for a one-element-dependence tag system are given in the form {2, {{0, 1}, {0, 1, 1}}} (compare page 1114 ), the initial conditions for the Turing machine are TagToMTM[{2, rule_}, init_] := With[{b = FoldList[Plus, 1, Map[Length, rule] + 1]}, Drop[Flatten[{Reverse[Flatten[{1, Map[{Map[ {1, 0, Table[0, {b 〚 # + 1 〛 }]} &, #], 1} &, rule], 1}]], 0, 0, Map[{Table[2, {b 〚 # + 1 〛 }], 3} &, init]}], -1]] surrounded by 0 's, with the head on the leftmost 2 , in state 1 .

The rules for the multiway system can then be given for example as {"AAB"  "BB", "BA"  "ABB"} The evolution of the system is given by the functions MWStep[rule_List, slist_List] := Union[Flatten[ Map[Function[s, Map[MWStep1[#, s] &, rule]], slist]]] MWStep1[p_String  q_String, s_String] := Map[StringReplacePart[s, q, #] &, StringPosition[s, p]] MWEvolveList[rule_, init_List, t_Integer] := NestList[MWStep[rule, #] &, init, t] An alternative approach uses lists instead of strings, and in effect works by tracing the internal steps that Mathematica goes through in trying out possible matchings. With the rule from above written as {{x___, 0, 0, 1, y___}  {x, 1, 1, y}, {x___, 1, 0, y___}  {x, 0, 1, 1, y}} MWStep can be rewritten as MWStep[rule_List, slist_List] := Union[Flatten[Map[ReplaceList[#, rule] &, slist], 1]] The case shown on page 206 is {"AB"  "", "ABA"  "ABBAB", "ABABBB"  "AAAAABA"} starting with {"ABABAB"} .

Fractal dimensions [of additive cellular automata] The total number of nonzero cells in the first t rows of the pattern generated by the evolution of an additive cellular automaton with k colors and weights w (see page 952 ) from a single initial 1 can be found using g[w_, k_, t_] := Apply[Plus, Sign[NestList[Mod[ ListCorrelate[w, #, {-1, 1}, 0], k] &, {1}, t - 1]], {0, 1}] The fractal dimension of this pattern is then given by the large m limit of Log[k,g[w, k,k m + 1 ]/g[w, k, k m ]] When k is prime it turns out that this can be computed as d[w_, k_:2] := Log[k,Max[Abs[Eigenvalues[With[ {s = Length[w] - 1}, Map[Function[u, Map[Count[u, #] &, #1]], Map[Flatten[Map[Partition[Take[#, k + s - 1], s, 1] &, NestList[Mod[ListConvolve[w, #], k] &, #, k - 1]], 1] &, Map[Flatten[Map[{Table[0, {k - 1}], #} &, Append[#, 0]]] &, #]]] &[Array[IntegerDigits[#, k, s] &, k s - 1]]]]]]] For rule 90 one gets d[{1, 0, 1}] = Log[2, 3] ≃ 1.58 .