3D network The 3D network (c) can be laid out in space using Array[x[8 {##}] &, {n, n, n}] where x[m:{_, _, _}] := {x 1 [m], x 1 [m + 4], x 2 [m + {4, 2, 0}], x 2 [m + {0, 6, 4}]} x 1 [m:{_, _, _}] := Line[Map[# + m &, {{1, 0, 0}, {1, 1, 1}, {0, 2, 1}, {1, 1, 1}, {3, 1, 3}, {3, 0, 4}, {3, 1, 3}, {4, 2, 3}}]] x 2 [{i_, j_, k_}] := x 1 [{-i - 4, -j - 2, k}] /.

Multicolor Turing machines [from 2-color TMs] Given rules in the form on page 888 for a Turing machine with s states and k colors the following yields an equivalent Turing machine with With[{c = Ceiling[Log[2, k]]}, (3 2 c + 2c - 7) s] states (always less than 6.03 k s ) and 2 colors: TMToTM2[rule_, s_, k_] := # /. MapIndexed[ #1  First[#2] &, Union[Map[# 〚 1, 1 〛 &, #]]] &[ With[{b = Ceiling[Log[2, k]] - 1}, Flatten[Table[ {Table[{Table[{{m, i, n, d}, c}  {{m, Mod[i, 2 n - 1 ], n - 1, d}, Quotient[i, 2 n - 1 ], 1}, {n, 2, b}, {i, 0, 2 n - 1}], Table[{ {m, i, 1, d}, c}  {{m, -1, 1, d}, i, d}, {i, 0, 1}], Table[ {{m, -1, n, d}, c}  {{m, -1, n + 1, d}, c, d}, {n, b - 1}], {{m, -1, b, d}, c}  {{0, 0, m}, c, d}}, {d, -1, 1, 2}], Table[{{i, n, m}, c}  {{ i + 2 n c, n + 1, m}, c, -1}, {n, 0, b - 1}, {i, 0, 2 n - 1}], With[{r = 2 b }, Table[ If[i + r c ≥ k, {}, Cases[rule, ({m, i + r c}  {x_, y_, z_})  {{i, b, m}, c}  {{x, Mod[y, r], b, z}, Quotient[y, r], 1})]], {i, 0, r - 1}]]}, {m, s}, {c, 0, 1}]]]] Some of these states are usually unnecessary, and in the main text such states have been pruned. Given an initial condition {i, list, n} the initial condition for the 2-color Turing machine is With[{b = Ceiling[Log[2, k]]}, {i, Flatten[IntegerDigits[list, 2, b]], b n}]

Symbolic systems [emulating cellular automata] Given the rules for an elementary cellular automaton in the form used on page 867 (with {0, 0, 0}  0 ), the following will construct a symbolic system which emulates it: Flatten[{Array[(p[x_][#1][#2][#3]  p[x[{##} /. rules]][#2][#3]) &, {2, 2, 2}, 0] /. {0  p, 1  q}, {r[x_]  p[r[p][p]][x], p[x_][p][p][r]  x[p][p][r]}}] The initial condition for the symbolic system is given by Fold[#1[#2] &, r[p][p], init /. {0  p, 1  q}][p][p][r] Step t in the cellular automaton corresponds to step t (t + Length[init] + 3) in the symbolic system.

The pattern after n steps is then given by Nest[Flatten[f[#]] &, {0}, n] , where for the rule on page 189 f[z_] = 1/2 (1 -  ) {z + 1/2, z - 1/2} ( f[z_] = (1 -  ){z + 1, z} gives a transformed version). For the rule on page 190 , f[z_] = 1/2 (1 -  ) {  z + 1/2, z - 1/2} . For rules (a), (b) and (c) (Koch curve) on page 191 the forms of f[z_] are respectively: (0.296 - 0.57  ) z - 0.067  - {1.04, 0.237} N[1/40 {17 ( √ 3 -  ) z, -24 + 14 z}] N[(1/2 (1/ √ 3 - 1)(  + {1, -1}) -  - (1 + {  , -  }/ √ 3 ) z)/2]

Thus for example {(0 | 1) ...} corresponds to all possible sequences of 0 's and 1 's, while {1, 1, (1) ..., 0, (0) ...} ... corresponds to the sequences that can occur after 2 steps in rule 126 and {(0) ..., 1, {0, (0) ..., 1, 1} | {1, (1) ..., 0}} ... to those that can occur after 2 steps in rule 110 (see page 279 ).

(Note that Nest[Sqrt[# + 2] &, 0, n]  2 Cos[ π /2 n + 1 ] .) … It appears that digits 0, 1, 2 are sufficient to represent uniquely all numbers between 1 and 2. … For random x , digits 0, 1, 2 appear to occur with limiting frequencies Sqrt[2 + d] - Sqrt[1 + d] .

But in practice the most accurate measurements show phenomena such as 1/f noise, presumably as a result of features of the detector and perhaps of electromagnetic fields associated with decay products.

For class 1 and 2 cellular automata, there are typically only a limited number of possible sequences of any length allowed. … Class 1 has h x = 0 and h t = 0 . Class 2 has h x ≠ 0 but h t = 0 .

This specification gives a list of three blocks {b 1 , b 2 , b 3 } and the final initial conditions consist of an infinite repetition of b 1 blocks, followed by b 2 , followed by an infinite repetition of b 3 blocks. … CTToR110[rules_ /; Select[rules, Mod[Length[#], 6] ≠ 0 &]  {}, init_] := Module[{g1, g2, g3, nr = 0, x1, y1, sp}, g1 = Flatten[ Map[If[#1 === {}, {{{2}}}, {{{1, 3, 5 - First[#1]}}, Table[ {4, 5 - # 〚 n 〛 }, {n, 2, Length[#]}]}] &, rules] /. a_Integer  Map[({d[# 〚 1 〛 , # 〚 2 〛 ], s[# 〚 3 〛 ]}) &, Partition[c[a], 3]], 4]; g2 = g1 = MapThread[If[#1 === #2 === {d[22, 11], s3}, {d[ 20, 8], s3}, #1] &, {g1, RotateRight[g1, 6]}]; While[Mod[ Apply[Plus, Map[# 〚 1, 2 〛 &, g2, 30] ≠ 0, nr++; g2 = Join[ g2, g1]]; y1 = g2 〚 1, 1, 2 〛 - 11; If[y1 < 0, y1 += 30]; Cases[ Last[g2] 〚 2 〛 , s[d[x_, y1], _, _, a_]  (x1 = x + Length[a])]; g3 = Fold[sadd, {d[x1, y1], {}}, g2]; sp = Ceiling[5 Length[ g3 〚 2 〛 ]/(28 nr) + 2]; {Join[Fold[sadd, {d[17, 1], {}}, Flatten[Table[{{d[sp 28 + 6, 1], s[5]}, {d[398, 1], s[5]}, { d[342, 1], s[5]}, {d[370, 1], s[5]}}, {3}], 1]] 〚 2 〛 , bg[ 4, 11]], Flatten[Join[Table[bgi, {sp 2 + 1 + 24 Length[init]}], init /. {0  init0, 1  init1}, bg[1, 9], bg[6, 60 - g2 〚 1, 1, 1 〛 + g3 〚 1, 1 〛 + If[g2 〚 1, 1, 2 〛 < g3 〚 1, 2 〛 , 8, 0]]]], g3 〚 2 〛 }] s[1] = struct[{3, 0, 1, 10, 4, 8}, 2]; s[2] = struct[{3, 0, 1, 1, 619, 15}, 2]; s[3] = struct[{3, 0, 1, 10, 4956, 18}, 2]; s[4] = struct[{0, 0, 9, 10, 4, 8}]; s[5] = struct[{5, 0, 9, 14, 1, 1}]; {c[1], c[2]} = Map[Join[{22, 11, 3, 39, 3, 1}, #] &, {{63, 12, 2, 48, 5, 4, 29, 26, 4, 43, 26, 4, 23, 3, 4, 47, 4, 4}, {87, 6, 2, 32, 2, 4, 13, 23, 4, 27, 16, 4}}]; {c[3], c[4], c[5]} = Map[Join[#, {4, 17, 22, 4, 39, 27, 4, 47, 4, 4}] &, {{17, 22, 4, 23, 24, 4, 31, 29}, {17, 22, 4, 47, 18, 4, 15, 19}, {41, 16, 4, 47, 18, 4, 15, 19}}] {init0, init1} = Map[IntegerDigits[216 (# + 432 10 49 ), 2] &, {246005560154658471735510051750569922628065067661, 1043746165489466852897089830441756550889834709645}] bgi = IntegerDigits[9976, 2] bg[s_, n_] := Array[bgi 〚 1 + Mod[# - 1, 14] 〛 &, n, s] ev[s[d[x_, y_], pl_, pr_, b_]] := Module[{r, pl1, pr1}, r = Sign[BitAnd[2^ListConvolve[{1, 2, 4}, Join[bg[pl - 2, 2], b, bg[pr, 2]]], 110]]; pl1 = (Position[r - bg[pl + 3, Length[r]], 1 | -1] /. {}  {{Length[r]}}) 〚 1, 1 〛 ; pr1 = Max[pl1, (Position[r - bg[pr + 5 - Length[r], Length[r]], 1 | -1] /. {}  {{1}}) 〚 -1, 1 〛 ]; s[d[x + pl1 - 2, y + 1], pl1 + Mod[pl + 2, 14], 1 + Mod[pr + 4, 14] + pr1 - Length[r], Take[r, {pl1, pr1}]]] struct[{x_, y_, pl_, pr_, b_, bl_}, p_Integer : 1] := Module[ {gr = s[d[x, y], pl, pr, IntegerDigits[b, 2, bl]], p2 = p + 1}, Drop[NestWhile[Append[#, ev[Last[#]]] &, {gr}, If[Rest[Last[#]] === Rest[gr], p2--]; p2 > 0 &], -1]] sadd[{d[x_, y_], b_}, {d[dx_, dy_], st_}] := Module[{x1 = dx - x, y1 = dy - y, b2, x2, y2}, While[y1 > 0, {x1, y1} += If[Length[st]  30, {8, -30}, {-2, -3}]]; b2 = First[Cases[st, s[d[x3_, -y1], pl_, _, sb_]  Join[bg[pl - x1 - x3, x1 + x3], x2 = x3 + Length[sb]; y2 = -y1; sb]]]; {d[x2, y2], Join[b, b2]}] CTToR110[{{}}, {1}] yields blocks of lengths {7204, 1873, 7088} . But even CTToR110[{{0, 0, 0, 0, 0, 0}, {}, {1, 1, 1, 1, 1, 1}, {}}, {1}] already yields blocks of lengths {105736, 34717, 95404} .

In enumerating recursive functions it is convenient to use symbolic definitions for composition and primitive recursion c[g_, h___] = Apply[g, Through[{h}[##]]] & r[g_, h_] = If[#1  0, g[##2], h[#0[#1 - 1, ##2], #1 - 1, ##2]] & where the more efficient unwound form is r[g_,h_] = Fold[Function[{u, v}, h[u, v, ##2]], g[##2], Range[0, #1 - 1]] & And in terms of these, for example, plus = r[p[1], s] . … From its definition, the function can be written as Fold[Fold[2^Ceiling[Log[2, Ceiling[(#1 + 2)/(#2 + 2)]]] (#2 + 2) - 2 - #1 &, #2, Range[#1]] &, 0, Range[#]]& Its first zeros are at {4, 126, 813, 966, 1166, 1177, 1666, 1897} . … Among functions with simple explicit definitions, essentially the only examples known fundamentally to be not primitive recursive are ones closely related to the Ackermann function.