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 . For rule 150 d[{1, 1, 1}] = Log[2, 1 + √ 5 ] ≃ 1.69 . … For the other rules on page 952 : d[{1, 1, 0, 1, 0}] = Log[2, Root[4 + 2 # - 2 # 2 - 3 # 3 + # 4 &, 2]] ≃ 1.72 d[{1, 1, 0, 1, 1}] = Log[2, Root[-4 + 4 # + # 2 - 4 # 3 + # 4 &, 2]] ≃ 1.80 Other cases include (see page 870 ): d[{1, 0, 1}, k] = 1 + Log[k, (k + 1)/2] d[{1, 1, 1}, 3] = Log[3, 6] ≃ 1.63 d[{1, 1, 1}, 5] = Log[5, 19] ≃ 1.83 d[{1, 1, 1}, 7] = Log[7, Root[-27136 + 23280 # - 7288 # 2 + 1008 # 3 - 59 # 4 + # 5 & , 1]] ≃ 1.85

States versus colors [in Turing machines] The total number of possible Turing machines depends on the product s k .

These numbers can also be obtained as the coefficients of x n in the series expansion of x ∂ x Log[ ζ [m, x]] , with the so-called zeta function, which is always a rational function of x , given by ζ [m_, x_] := 1/Det[IdentityMatrix[Length[m]] - m x] and corresponds to the product over all cycles of 1/(1 - x n ) .

Then, for example, the rule for the mobile automaton shown on page 71 can be given as {{1, 1, 1}  {0, 1}, {1, 1, 0}  {0, 1}, {1, 0, 1}  {1, -1}, {1, 0, 0}  {0, -1}, {0, 1, 1}  {0, -1}, {0, 1, 0}  {0, 1}, {0, 0, 1}  {1, 1}, {0, 0, 0}  {1, -1}} where the left-hand side in each case gives the value of the active cell and its left and right neighbors, while the right-hand side consists of a pair containing the new value of the active cell and the displacement of its position. … With a rule given in this form, each step in the evolution of the mobile automaton corresponds to the function MAStep[rule_, {list_List, n_Integer}] /; (1 < n < Length[list]) := Apply[{ReplacePart[list, #1, n], n + #2}&, Replace[Take[list, {n - 1, n + 1}], rule]] The complete evolution for many steps can then be obtained with MAEvolveList[rule_, init_List, t_Integer] := NestList[MAStep[rule, #]&, init, t] (The program will run more efficiently if Dispatch is applied to the rule before giving it as input.) For the mobile automaton on page 73 , the rule can be given as {{1, 1, 1}  {{0, 0, 0}, -1}, {1, 1, 0}  {{1, 0, 1}, -1}, {1, 0, 1}  {{1, 1, 1}, 1}, {1, 0, 0}  {{1, 0, 0}, 1}, {0, 1, 1}  {{0, 0, 0}, 1}, {0, 1, 0}  {{0, 1, 1}, -1}, {0, 0, 1}  {{1, 0, 1}, 1}, {0, 0, 0}  {{1, 1, 1}, 1}} and MAStep must be rewritten as MAStep[rule_, {list_List, n_Integer}] /; (1 < n < Length[list]) := Apply[{Join[Take[list, {1, n - 2}], #1, Take[list, {n + 2, -1}]], n + #2}&, Replace[Take[list, {n - 1, n + 1}], rule]]

This can be done for blocks up to length n in a 1D cellular automaton with k colors using ReversibleQ[rule_, k_, n_] := Catch[Do[ If[Length[Union[Table[CAStep[rule, IntegerDigits[i, k, m]], {i, 0, k m - 1}]]] ≠ k m , Throw[False]], {m, n}]; True] For k = 2 , r = 1 it turns out that it suffices to test only up to n = 4 (128 out of the 256 rules fail at n = 1 , 64 at n = 2 , 44 at n = 3 and 14 at n = 4 ); for k = 2 , r = 2 it suffices to test up to n = 15 , and for k = 3 , r = 1 , up to n = 9 . But although these results suggest that in general it should suffice to test only up to n = k 2 r , all that has so far been rigorously proved is that n = k 2 r (k 2 r -1) + 2 r + 1 (or n = 15 for k = 2 , r = 1 ) is sufficient. For 2D cellular automata an analogous procedure can in principle be used, though there is no upper limit on the size of blocks that need to be tested, and in fact the question of whether a particular rule is reversible is directly equivalent to the tiling problem discussed on page 213 (compare page 942 ), and is thus formally undecidable.

[Universal] register machines The results of page 100 suggest that with 2 registers and up to 8 instructions no universal register machines (URMs) exist. … An example with 8 registers and 41 instructions is: or {d[4, 40], i[5], d[3, 9], i[3], d[7, 4], d[5, 14], i[6], d[3, 3], i[7], d[6, 2], i[6], d[5, 11], d[6, 3], d[4, 35], d[6, 15], i[4], d[8, 16], d[5, 21], i[1], d[3, 1], d[5, 25], i[2], d[3, 1], i[6], d[5, 32], d[1, 28], d[3, 1], d[4, 28], i[4], d[6, 29], d[3, 1], d[5, 24], d[2, 28], d[3, 1], i[8], i[6], d[5, 36], i[6], d[3, 3], d[6, 40], d[4, 3]} Given any register machine, one first applies the function RMToRM2 from page 1114 , then takes the resulting program and initial condition and finds an initial condition for the URM using R2ToURM[prog_, init_] := Join[init, With[ {n = Length[prog]}, {1 + LE[Reverse[prog] /. {i[x_]  x, d[x_, y_]  4 + 2 n + x - 2y}], n + 1, 0, 0, 0, 0}]] For the first example on page 98 this gives {0, 0, 1471, 3, 0, 0, 0, 0} .

Then in 1970 Roger Banks managed to show that the 2-state 5-neighbor symmetric 2D rule 4005091440 was able to reproduce all the same logical elements. … When only one glider is present, a new spaceship emerges on the right as the output. … The pictures below show how 1D cellular automata can be implemented in the 4-color WireWorld cellular automaton of Brian Silverman from 1987, whose rules find the new value of a cell from its old value a and the number u of its 8 neighbors that are 1's according to a /. {0  0, 1  2, 2  3, 3  If[0 < u < 3, 1, 3]}

So for example the equation a 2 + b 2  0 has solutions that are exactly those integers that satisfy the relation a  0 ∧ b  0 . … From various number-theoretical results many relations can readily be encoded as integer equations: (a  0 ∨ b  0) ↔ a b  0 (a  0 ∧ b  0) ↔ a + b  0 a < b ↔ b  a + c + 1 a  Mod[b, c] ↔ (b  a + c d ∧ a < c) a  Quotient[b, c] ↔ (b  a c + d ∧ d < c) a  Binomial[b, c] ↔ With[{n = 2 b + 1}, (n + 1) b  n c (a + d n) + e ∧ e < n c ∧ a < n] a  b! … The simplest known way of doing this (see note below ) involves a degree 8 equation with 60 variables: a  b c ↔ α [d, 4 + b e, 1 + z] ∧ α [f, e, 1 + z] ∧ a  Quotient[d, f] ∧ α [g, 4 + b, 1 + z] ∧ e  16 g(1 + z) λ [a_, b_, c_] := Module[{x}, 2 a + x 1  c ∧ (Mod[b - a, c]  0 ∨ Mod[b + a, c]  0)] α [a_, b_, c_] := Module[{x}, x 1 2 - b x 1 x 2 + x 2 2  1 ∧ x 3 2 - b x 3 x 4 + x 4 2  1 ∧ 1 + x 4 + x 5  x 3 ∧ Mod[x 3 , x 1 2 ]  0 ∧ 2x 4 + x 7  b x 3 ∧ Mod[-b + x 8 , x 7 ]  0 ∧ Mod[-2 + x 8 , x 1 ]  0 ∧ x 8 - x 11  3 ∧ x 12 2 - x 8 x 12 x 13 + x 13 2  1 ∧ 1 + 2 a + x 14  x 1 ∧ λ [a, x 12 , x 7 ] ∧ λ [c, x 12 , x 1 ]] (This roughly uses the idea that solutions to Pell equations grow exponentially, so that for example x 2  2y 2 + 1 has solutions With[{u = 3 + 2 √ 2 }, (u n + u -n )/2] .)

Table[0, {n}] . … Starting with an ordinary base 2 digit sequence, one prepends a unary specification of its length, then a specification of that length specification, and so on: (Flatten[{Sign[-Range[1 - Length[#], 0]], #}] &)[ Map[Rest, IntegerDigits[Rest[Reverse[NestWhileList[ Floor[Log[2, #] &, n + 1, # > 1 &]]],2]]] (d) Binary-coded base 3. … Apply[Take, RealDigits[(N[#, N[Log[10, #] + 3]] &)[ n √ 5 /GoldenRatio 2 + 1/2], GoldenRatio]] The representations of all the first Fibonacci[n] - 1 numbers can be obtained from (the version in the main text has Rest[RotateLeft[Join[#, {0, 1}]]] & applied) Apply[Join, Map[Last, NestList[{# 〚 2 〛 ], Join[Map[Join[{1, 0}, Rest[#]] & , # 〚 2 〛 ], Map[Join[{1, 0}, #] &, # 〚 1 〛 ]]} &, {{}, {{1}}}, n-3]]]

For one step in rule 30, for example, this yields {{1, 0, 0}, {0, 1, 1}, {0, 1, 0}, {0, 0, 1}} , as shown on page 616 . … Given an original DNF list s , this can be done using PI[s, n] : PI[s_, n_] := Union[Flatten[ FixedPointList[f[Last[#], n] &, {{}, s}] 〚 All, 1 〛 , 1]] g[a_, b_] := With[{i = Position[Transpose[{a, b}], {0,1}]}, If[Length[i]  1 && Delete[a, i] === Delete[b, i], {ReplacePart[a, _, i]}, {}]] f[s_, n_] := With[ {w = Flatten[Apply[Outer[g, #1, #2, 1] &, Partition[Table[ Select[s, Count[#, 1]  i &], {i, 0, n}], 2, 1], {1}], 3]}, {Complement[s, w, SameTest  MatchQ], w}] The minimal DNF then consists of a collection of these prime implicants. Sometimes it is all of them, but increasingly often when n ≥ 3 it is only some.