Arithmetic systems [emulating register machines] Given the program for a register machine with nr registers in the form on page 896 , an arithmetic system which emulates it can be obtained from RMToAS[prog_, nr_] := With[{p = Length[prog], g = Product[Prime[j], {j, nr}]}, {p g, Sort[Flatten[MapIndexed[ With[{n = First[#2] - 1}, #1 /. … The evolution of the arithmetic system is given by ASEvolveList[{n_, rules_}, init_, t_] := NestList[(Mod[#, n] /. rules)[#] &, init, t] Given a value m obtained in the evolution of the arithmetic system, the state of the register machine to which it corresponds is {Mod[m, p] + 1, Map[Last, FactorInteger[ Product[Prime[i], {i, nr}] Quotient[m, p]]] - 1} Note that it is possible to have each successive step involve only multiplication, with no addition, at the cost of using considerably larger numbers overall.

TMToRM[rules_] := Module[{segs, adrs}, segs = Map[TMCompile, rules] ; adrs = Thread[Map[First, rules]  Drop[FoldList[Plus, 1, Map[Length, segs]], -1]]; MapIndexed[(# /.

= {} Given a set of sequences of values represented by a particular network, the set obtained after one step of cellular automaton evolution is given by NetCAStep[{k_, r_, rtab_}, net_] := Flatten[ Map[Table[# /. … = {}, AllNet[k], q = ISets[b = Map[Table[ Position[d, NetStep[net, #, a]] 〚 1, 1 〛 , {a, 0, k - 1}]&, d]]; DeleteCases[MapIndexed[#2 〚 2 〛 - 1  #1 &, Rest[ Map[Position[q, #] 〚 1, 1 〛 &, Transpose[Map[Part[#, Map[ First, q]]&, Transpose[b]]], {2}]] - 1, {2}], _  0, {2}]]] DSets[net_, k_:2] := FixedPoint[Union[Flatten[Map[Table[NetStep[net, #, a], {a, 0, k - 1}]&, #], 1]]&, {Range[Length[net]]}] ISets[list_] := FixedPoint[Function[g, Flatten[Map[ Map[Last, Split[Sort[Part[Transpose[{Map[Position[g, #] 〚 1, 1 〛 &, list, {2}], Range[Length[list]]}], #]], First[#1]  First[#2]&], {2}]&, g], 1]], {{1}, Range[2, Length[list]]}] If net has q nodes, then in general MinNet[net] can have as many as 2 q -1 nodes. … To obtain such trimmed networks one can apply the function TrimNet[net_] := With[{m = Apply[Intersection, Map[FixedPoint[ Union[#, Flatten[Map[Last, net 〚 # 〛 , {2}]]]&, #]&, Map[List, Range[Length[net]]]]]}, net 〚 m 〛 /.

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.

 [i, j, m], {i, 0, t - 1}, {j, Max[1, n - i], n + i}, {k, 0, ktot - 1}, {m, k + 1, ktot - 1}],  [0, s], Cases[MapIndexed[  [Abs[n - First[#2]], First[#2], #1]&, a],  [x_, _, _] /; x < t], Table[  [Abs[n - i], i, 0], {i, Length[a] + 1, n + t - 1}], Table[!  [i, j, k] || If[EvenQ[n + i - j],  [i, j], False] ||  [i + 1, j, k], {i, 0, t - 2}, {j, Max[1, n - i], n + i}, {k, 0, ktot - 1}], Table[Map[Function[ z, Outer[! …  [i, j, z 〚 1, 2 〛 ] || ## &, Apply[Sequence, Map[If[i < t - 1, {  [i + 1, # 〚 1 〛 ],  [ i + 1, j - # 〚 3 〛 ],  [i + 1, j, # 〚 2 〛 ]}, {  [i + 1, j - # 〚 3 〛 ]}]&, z 〚 2 〛 ]]]], rules], {i, 0, t - 1}, {j, n + i, Max[1, n - i], -2}], Apply[Or, Table[  [i, 0], {i, n, t, 2}]]} /.

Register machines [from cellular automata] Given the program for a register machine in the form used on page 896 , the rules for a cellular automaton that emulates it can be obtained from g[i[1], p_, m_] := {{_, p, _}  p + 1, {_, 0, p}  m + 2, {_, _, p}  m + 3} g[i[2], p_, m_] := {{_, p, _}  p + 1, {p, 0, _}  m + 5, {p, _, _}  m + 6} g[d[1, q_], p_, m_] := {{m + 2 | m + 3, p, _}  q, {m + 1, p, _}  p, {0, p, _}  p + 1, {_, m + 2 | m + 3, p}  m + 1} g[d[2, q_], p_, m_] := {{_, p, m + 5 | m + 6}  q, {_, p, m + 4}  p, {_, p, 0}  p + 1, {p, m + 5 | m + 6, _}  m + 4} RMToCA[prog_] := With[{m = Length[prog]}, Flatten[ {MapIndexed[g[#1, First[#2], m] &, prog], {{0, 0 | m + 1, m + 3}  m + 2, {0, m + 1, _}  0, {0, 0, m + 1}  0, {_, _, x : (m + 1 | m + 3)}  x, {_, m + 1 | m + 3, _}  m + 2, {m + 6, 0 | m + 4, 0}  m + 5, {_, m + 4, 0}  0, {m + 4, 0, 0}  0, {x : (m + 4 | m + 6), _, _}  x, {_, m + 4 | m + 6, _}  m + 5, {_, x_ , _}  x}}]] If m is the length of the register machine program, then the resulting cellular automaton has m + 7 possible colors for each cell.

The number of sequences s n of length n that can actually occur is given by Apply[Plus, Flatten[MatrixPower[m, n]]] where the adjacency matrix m is given by MapAt[(1 + #) &, Table[0, {Length[net]}, {Length[net]}], Flatten[MapIndexed[{First[#2], Last[#1]} &, net, {2}], 1]] For rule 32, for example, s n turns out to be Fibonacci[n + 3] , so that for large n it is approximately GoldenRatio n .

In the 1980s, particularly following discoveries in iterated maps and quasicrystals, studies of such spectra were made in the context of number theory and dynamical systems theory. … With k colors each giving a string of the same length s the recurrence relation is Thread[Map[ ϕ [#][t + 1, ω ] &, Range[k] - 1]  Apply[Plus, MapIndexed[Exp[  ω (Last[#2] - 1) s t ] ϕ [#1][t, ω ] &, Range[k] - 1 /. rules, {-1}], {1}]/ √ s ] Some specific properties of the examples shown include: (a) (Thue–Morse sequence) The spectrum is essentially Nest[Range[2 Length[#]] Join[#, Reverse[#]] &, {1}, t] .

Sequential substitution systems [from cellular automata] Given a sequential substitution system with rules in the form used on page 893 , the rules for a cellular automaton which emulates it can be obtained from SSSToCA[rules_] := Flatten[{{v[_, _, _], u, _}  u, {_, v[rn_, x_, _], u}  r[rn + 1, x], {_, v[_, x_, _], _}  x, MapIndexed[ With[{r n = #2 〚 1 〛 , rs = #1 〚 1 〛 , rr = #1 〚 2 〛 }, {If[Length[rs]  1, {u, r[rn, First[rs]], _}  q[0, rr], {u, r[rn, First[rs]], _}  v[rn, First[rs], Take[rs, 1]]], {u, r[rn, x_], _}  v[rn, x, {}], {v[rn, _, Drop[rs, -1]], Last[rs], _}  q[Length[rs] - 1, rr], Table[{v[rn, _, Flatten[{___, Take[rs, i - 1]}]], rs 〚 i 〛 , _}  v[ rn, rs 〚 i 〛 , Take[rs, i]], {i, Length[rs] - 1, 1, -1}], {v[rn, _, _], y_, _}  v[rn, y, {}]}] & , rules /. s  List], {_, q[0, {x__, _}], _}  q[0, {x}], {_, q[0, {x_}], _}  r[1, x], {_, q[0, {}], x_}  r[1, x], {_, q[_, {___, x_}], _}  x, {_, q[_, {}], x_}  x, {_, x_, q[0, _]}  x, {_, _, q[n_, {}]}  q[n - 1, {}], {_, _, q[n_, {x___, _}]}  q[n - 1, {x}], {q[_, {}], _, _}  w, {q[0, {__, x_}], p[y_, _], _}  p[x, y], {q[0, {__, x_}], y_, _}  p[x, y], {p[_, x_], p[y_, _], _}  p[x, y], {p[_, x_], u, _}  x, {p[_, x_], y_, _}  p[x, y], {_, p[x_, _], _}  x, {w, u, _}  u, {w, x_, _}  w, {_, w, x_}  x, {_, r[rn_, x_], _}  x, {_, u, r[_, _]}  u, {_, x_, r[rn_, _]}  r[rn, x], {_, x_, _}  x}] The initial condition is obtained by applying the rule s[x_, y__]  {r[1, x], y} and then padding with u 's.

Then the rules for the language consisting of balanced runs of parentheses (see page 939 ) can be written as {s[e]  s[e, e], s[e]  s["(", e, ")"], s[e]  s["(",")"]} Different expressions in the language can be obtained by applying different sequences of these rules, say using (this gives so-called leftmost derivations) Fold[# /. rules 〚 #2 〛 &, s[e], list] Given an expression, one can then use the following to find a list of rules that will generate it—if this exists: Parse[rules_, expr_] := Catch[Block[{t = {}}, NestWhile[ ReplaceList[#, MapIndexed[ReverseRule, rules]] &, {{expr, {}}}, (# /.