Ackermann functions A convenient example is f[1, n_] := n; f[m_, 1] := f[m - 1, 2] f[m_, n_] := f[m - 1, f[m, n - 1] + 1] The original function constructed by Wilhelm Ackermann around 1926 is essentially f[1, x_, y_] := x + y; f[m_, x_, y_] := Nest[f[m - 1, x, #] &, x, y - 1] or f[m_, x_, y_]:= Nest[Function[z, Nest[#, x, z - 1]] &, x + # &, m - 1][y] For successive m (following the so-called Grzegorczyk hierarchy) this is x + y , x y , x y , Nest[x # &, 1, y] , .... f[4, x, y] can also be written Array[x &, y, 1, Power] and is sometimes called tetration and denoted x ↑ ↑ y .

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} ).

(a_  s_)  (rtab 〚 i k + a + 1 〛  k 2r (s - 1) + 1 + Mod[i k + a, k 2r ]), {i, 0, k 2r - 1}]&, net], 1] where here elementary rule 126 is specified for example by {2, 1, Reverse[IntegerDigits[126, 2, 8]]} . Starting from the set of all possible sequences, as given by AllNet[k_:2] := {Thread[(Range[k] - 1)  1]} this then yields for rule 126 the network {{0  1, 1  2}, {1  3, 1  4}, {1  1, 1  2}, {1  3, 0  4}} It is always possible to find a minimal network that represents a set of sequences. … The result from MinNet for rule 126 is {{1  3}, {0  2, 1  1}, {0  2,1  3}} .

 [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, z 〚 1, 1 〛 ] || !  [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}]]} /.

Then, for example, the rule for the Turing machine shown on page 78 can be given as {{1, 0}  {3, 1, -1}, {1, 1}  {2, 0, 1}, {2, 0}  {1, 1, 1}, {2, 1}  {3, 1, 1}, {3, 0}  {2, 1, 1}, {3, 1}  {1, 0, -1}} where the left-hand side in each case gives the state of the head and the value of the cell under the head, and the right-hand side consists of a triple giving the new state of the head, the new value of the cell under the head and the displacement of the head. With a rule given in this form, a single step in the evolution of the Turing machine can be implemented with the function TMStep[rule_List, {s_, a_List, n_}] /; (1 ≤ n ≤ Length[a]) := Apply[{#1, ReplacePart[a, #2, n], n + #3}&, Replace[{s, a 〚 n 〛 }, rule]] The evolution for many steps can then be obtained using TMEvolveList[rule_, init_List, t_Integer] := NestList[TMStep[rule, #]&, init, t] An alternative approach is to represent the complete state of the Turing machine by MapAt[{s, #}&, list, n] , and then to use TMStep[rule_, c_] := Replace[c, {a___, x_, h_List, y_, b___}  Apply[{{a, x, #2, {#1, y}, b}, {a, {#1, x}, #2, y, b}} 〚 #3 〛 &, h /. rule]] The result of t steps of evolution from a blank tape can also be obtained from (see also page 1143 ) s = 1; a[_] = 0; n = 0; Do[{s, a[n], d} = {s, a[n]} /. rule; n += d, {t}]

The rule for this system is {{1, 1}  {{{{}, {1, 1}}, {2}}, 2}, {1, 2}  {{{2, 2}, {{}, {2, 2}}}, 2}, {2, 1}  {{{}, {2, 2}}, 2}, {2, 2}  {{{1, 2} ,{{1}, {2}}}, 1}, {2, 3}  {{{{1, 2}, {1}}, {{2}, {2, 1}}}, 2}, {2, 4}  {{{2, 2}, {{2, 1}, {}}}, 1}}

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

In case (c), the following gives a list of the numbers of nodes generated up to step t : FoldList[Plus, 1, Join[{1, 4, 12, 10, -20, 6, 4}, Map[d, IntegerDigits[Range[4, t - 5], 2]]]] d[{___, 1}] = 1 d[{1, p : 0 .., 0}] := -Apply[Plus, 4 Range[Length[{p}]] - 1] + 6 d[{__, 1, p : 0 .., 0}] := d[{1, p, 0}] - 7 d[{___, p : 1 .., q : 0 ..., 1, 0}] := 4 Length[{p}] + 3 Length[{q}] + 2 d[{___, p : 1 .., 1, 0}] := 4 Length[{p}] + 2

Doubling rules [cellular automata] Rule (a) is {{0, 2, _}  5, {5, 3, _}  5, {5, _, _}  1, {_, 5, _}  1, {_, 2, _}  3, {_, 3, 2}  2, {_, 1, 2}  4, {_, 4, _}  3, {4, 3, _}  4, {4, 0, _}  2, {_, x_, _}  x} and takes 2n 2 + n steps to yield Table[1, {2n}] given input Append[Table[1, {n - 1}], 2] . Rule (b) is {{_, 2, _}  3, {_, 1, 2}  2, {3, 0, _}  1, {3, _, _}  3, {_, 3, _}  1, {_, x_, _}  x} and takes 3n steps. Rule (c) is k = 3 , r = 1 rule 5407067979 and takes 3n - 1 steps.

Every point in the pattern must correspond to some list of left and right branchings, represented by 0's and 1's respectively; in terms of this list the position of the point is given by Fold[1 + {c, Conjugate[c]} 〚 1 + #2 〛 #1&, 1, Reverse[list]] . … The bottom boundary of the region lies along Re[c] = -1/2 ; the extremal point on the edge of the gap in this case corresponds to {0, 0, 1, 0, 1, 0, 1, …} where the last two elements repeat forever. The rest of the boundary consists of a sequence of algebraic curves, with almost imperceptible changes in slope in between; the first corresponds to {0, 0, 0, 1, 0, 1, 0, 1, …} , while subsequent ones correspond to {0, 1, 1, 1, 0, 1, 0, 1, 0, 1, 0, 1, …} , {0, 1, 1, 1, 1, 0, 1, 0, 1, 0, 1, 0, 1, …} , etc.