Probably the simplest is a statement shown to be unprovable in Peano arithmetic by Laurence Kirby and Jeff Paris in 1982: that certain sequences g[n] defined by Reuben Goodstein in 1944 are of limited length for all n , where g[n_] := Map[First, NestWhileList[ {f[#] - 1, Last[#] + 1} &, {n, 3}, First[#] > 0 &]] f[{0, _}] = 0; f[{n_, k_}] := Apply[Plus, MapIndexed[#1 k^f[{#2 〚 1 〛 - 1, k}] &, Reverse[IntegerDigits[n, k - 1]]]] As in the pictures below, g[1] is {1, 0} , g[2] is {2, 2, 1, 0} and g[3] is {3, 3, 3, 2, 1, 0} . g[4] increases quadratically for a long time, with only element 3 × 2 402653211 - 2 finally being 0. … But while it is known that in Peano arithmetic κ = ε 0 , quite how to describe the value of κ for, say, set theory remains unknown.

Pointer-based encoding One can encode a list of data d by generating pointers to the longest and most recent copies of each subsequence of length at least b using PEncode[d_, b_ : 4] := Module[{i, a, u, v}, i = 2; a = {First[d]}; While[i ≤ Length[d], {u, v} = Last[Sort[Table[{MatchLength[d, i, j], j}, {j, i - 1}]]]; If[u ≥ b, AppendTo[a, p[i - v, u]]; i += u, AppendTo[a, d 〚 i 〛 ]; i++]]; a] MatchLength[d_, i_, j_] := With[{m = Length[d] - i}, Catch[ Do[If[d 〚 i + k 〛 =!… The encoded version of a purely nested sequence grows like Log[n] 2 .

General recursive functions, however, also allow μ [f_] = NestWhile[# + 1 &, 0, Function[n, f[n, ##] ≠ 0]]& which can perform unbounded searches. … Note that functions of the form Nest[r[c[s, z], #] &, c[s, s], n] are given in terms of the original Ackermann function in the note above by f[n + 1, 2, # + 1] - 1 & . … It is inevitable that the function shown must eventually grow faster than any primitive recursive function (at x = 356 its value is 63190, while at x = 1464 it is 1073844).

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

As suggested by the pictures in the main text, spectra such as (b) and (d) in the limit consist purely of discrete Dirac delta function peaks, while spectra such as (a) and (c) also contain essentially continuous parts. … 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] .

The pattern corresponding to each point is the limit of Nest[Flatten[1 + {c #, Conjugate[c] #}]&, {1}, n] when n  ∞ . … 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.

(For Xor , there are 2 possible σ , while for Or there are 3.) … But in all cases the general results for associative rules on page 956 show that the patterns obtained must be at most nested.

In the context of the 2D Ising model this phenomenon is associated with the fact that those configurations of a large array of spins that have high total energy are overwhelmingly likely to have near zero overall magnetization, while those that have low total energy are overwhelmingly likely to have nonzero overall magnetization. … One marginally more complicated case effectively involving 13 neighbors is IsingEvolve[list_, t_Integer] := First[Nest[IsingStep, {list, Mask[list]}, t]] IsingStep[{a_, mask_}] := {MapThread[ If[#2  2 && #3  1, 1 - #1, #1]&, {a, ListConvolve[ {{0, 1, 0}, {1, 0, 1}, {0, 1, 0}}, a, 2], mask}, 2], 1 - mask} where Mask[list_] := Array[Mod[#1 + #2, 2]&, Dimensions[list]] is set up so that alternating checkerboards of cells are updated on successive steps. … And what one sees at least roughly is that right around the phase transition there are patches of black and white of all sizes, forming an approximately nested random pattern.

(An example is NestList[Mod[2 #, 1]&, N[ π /4, 40], 200] ; Map[Precision, list] gives the number of significant digits of each element in the list.) … Pictures (a) and (c) below show simulations of the shift map on a typical computer, while pictures (b) and (d) show corresponding simulations on a pocket calculator.

Ironically enough, while cellular automata are good for many things, they turn out to be rather unsuitable for modelling either self-gravitating gases or neural networks. … And second, that in cases like rule 90 simple initial conditions led to nested or fractal patterns.