And with this assumption, n should increase by a factor of 5/2 half the time, and decrease by a factor close to 1/2 the rest of the time—so that after t steps it should be multiplied by an overall factor of about ( √ 5 /2) t .

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

Such doubts will in the end only be put to rest by the explicit construction of a discrete fundamental theory along the lines I discuss in Chapter 9 .

Fibonacci[n] can be obtained in many ways: • (GoldenRatio n - (-GoldenRatio) -n )/ √ 5 • Round[GoldenRatio n / √ 5 ] • 2 1 - n Coefficient[(1 + √ 5 ) n , √ 5 ] • MatrixPower[{{1, 1}, {1, 0}}, n - 1] 〚 1, 1 〛 • Numerator[NestList[1/(1 + #)&, 1, n]] • Coefficient[Series[1/(1 - t - t 2 ), {t, 0, n}], t n - 1 ] • Sum[Binomial[n - i - 1, i], {i, 0, (n - 1)/2}] • 2 n - 2 - Count[IntegerDigits[Range[0, 2 n - 2 ], 2], {___, 1, 1, ___}] A fast method for evaluating Fibonacci[n] is First[Fold[f, {1, 0, -1}, Rest[IntegerDigits[n, 2]]]] f[{a_, b_, s_}, 0] = {a (a + 2b), s + a (2a - b), 1} f[{a_, b_, s_}, 1] = {-s + (a + b) (a + 2b), a (a + 2b), -1} Fibonacci numbers appear to have first arisen in perhaps 200 BC in work by Pingala on enumerating possible patterns of poetry formed from syllables of two lengths.

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.

= {}, 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.

And in general if h is associative the result Nest[h[r, #]&, s, t] of t steps of evolution can be rewritten for example using the repeated squaring method as h[Fold[If[#2  0, h[#1, #1], h[r, h[#1, #1]]] &, r, Rest[IntegerDigits[t, 2]]], s] which requires only about Log[t] rather than t applications of h .

Here are examples of how some of the basic Mathematica constructs used in the notes in this book work: • Iteration Nest[f, x, 3] ⟶ f[f[f[x]]] NestList[f, x, 3] ⟶ {x, f[x], f[f[x]], f[f[f[x]]]} Fold[f, x, {1, 2}] ⟶ f[f[x, 1], 2] FoldList[f, x, {1, 2}] ⟶ {x, f[x, 1], f[f[x, 1], 2]} • Functional operations Function[x, x + k][a] ⟶ a + k (# + k&)[a] ⟶ a + k (r[#1] + s[#2]&)[a, b] ⟶ r[a] + s[b] Map[f, {a, b, c}] ⟶ {f[a], f[b], f[c]} Apply[f, {a, b, c}] ⟶ f[a, b, c] Select[{1, 2, 3, 4, 5}, EvenQ] ⟶ {2, 4} MapIndexed[f, {a, b, c}] ⟶ {f[a, {1}], f[b, {2}], f[c, {3}]} • List manipulation {a, b, c, d} 〚 3 〛 ⟶ c {a, b, c, d} 〚 {2, 4, 3, 2} 〛 ⟶ {b, d, c, b} Take[{a, b, c, d, e}, 2] ⟶ {a, b} Drop[{a, b, c, d, e}, -2] ⟶ {a, b, c} Rest[{a, b, c, d}] ⟶ {b, c, d} ReplacePart[{a, b, c, d}, x, 3] ⟶ {a, b, x, d} Length[{a, b, c}] ⟶ 3 Range[5] ⟶ {1, 2, 3, 4, 5} Table[f[i], {i, 4}] ⟶ {f[1], f[2], f[3], f[4]} Table[f[i, j], {i, 2}, {j, 3}] ⟶ {{f[1, 1], f[1, 2], f[1, 3]}, {f[2, 1], f[2, 2], f[2, 3]}} Array[f, {2, 2}] ⟶ {{f[1, 1], f[1, 2]}, {f[2, 1], f[2, 2]}} Flatten[{{a, b}, {c}, {d, e}}] ⟶ {a, b, c, d, e} Flatten[{{a, {b, c}}, {{d}, e}}, 1] ⟶ {a, {b, c}, {d}, e} Partition[{a, b, c, d}, 2, 1] ⟶ {{a, b}, {b, c}, {c, d}} Split[{a, a, a, b, b, a, a}] ⟶ {{a, a, a}, {b, b}, {a, a}} ListConvolve[{a, b}, {1, 2, 3, 4, 5}] ⟶ {2a + b, 3a + 2b, 4a + 3b, 5a + 4b} Position[{a, b, c, a, a}, a] ⟶ {{1}, {4}, {5}} RotateLeft[{a, b, c, d, e}, 2] ⟶ {c, d, e, a, b} Join[{a, b, c}, {d, b}] ⟶ {a, b, c, d, b} Union[{a, a, c, b, b}] ⟶ {a, b, c} • Transformation rules {a, b, c, d} /. b  p ⟶ {a, p, c, d} {f[a], f[b], f[c]} /. f[a]  p ⟶ {p, f[b], f[c]} {f[a], f[b], f[c]} /. f[x_]  p[x] ⟶ {p[a], p[b], p[c]} {f[1], f[b], f[2]} /. f[x_Integer]  p[x] ⟶ {p[1], f[b], p[2]} {f[1, 2], f[3], f[4, 5]} /. f[x_, y_]  x + y ⟶ {3, f[3], 9} {f[1], g[2], f[2], g[3]} /. f[1] | g[_]  p ⟶ {p, p, f[2], p} • Numerical functions Quotient[207, 10] ⟶ 20 Mod[207, 10] ⟶ 7 Floor[1.45] ⟶ 1 Ceiling[1.45] ⟶ 2 IntegerDigits[13, 2] ⟶ {1, 1, 0, 1} IntegerDigits[13, 2, 6] ⟶ {0, 0, 1, 1, 0, 1} DigitCount[13, 2, 1] ⟶ 3 FromDigits[{1, 1, 0, 1}, 2] ⟶ 13 The Mathematica programs in these notes are formatted in Mathematica StandardForm .

Similarly, assuming as in the rest of this note that all variables are non-negative, b  a + c + 1 has solutions that are exactly those integers that satisfy a < b , with c having some allowed value.