For k = 2 , there are 16 possible rules, and the most complicated pattern obtained is nested like the rule 90 elementary cellular automaton. … With rule given by IntegerDigits[num, k, k 2 ] a single step of evolution can be implemented as CAStep[{k_, rule_}, a_List] := rule 〚 k 2 - RotateLeft[a] - k a 〛

With more than two piles it was discovered in 1901 that one player can in general force the other to lose by arranging that after each of their moves Apply[BitXor, h]  0 , where h is the list of heights. For k > 1 this yields a nested pattern, analogous to those shown on page 871 . If one allows only specific numbers of objects to be taken at each step a nested pattern is again obtained.

We would not usually say, therefore, that either of the first two pictures at the top of the facing page seem random, since we can readily recognize highly regular repetitive and nested patterns in them. … The three pictures on the facing page can always be described by explicitly giving a list of the colors of each of the 6561 cells that they contain.

Other examples [of substitution systems] (a) (Period-doubling sequence) After t steps, there are a total of 2 t elements, and the sequence is given by Nest[MapAt[1 - # &, Join[#, #], -1]&, {0}, t] . … The Thue–Morse sequence discussed on page 890 can be obtained from it by applying 1 - Mod[Flatten[Partition[FoldList[Plus, 0, list], 1, 2]], 2] (b) The n th element is simply Mod[n, 2] .

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. … In addition: • GoldenRatio is the solution to x  1 + 1/x or x 2  x + 1 • The right-hand rectangle in is similar to the whole rectangle when the aspect ratio is GoldenRatio • Cos[ π /5]  Cos[36 ° ]  GoldenRatio/2 • The ratio of the length of the diagonal to the length of a side in a regular pentagon is GoldenRatio • The corners of an icosahedron are at coordinates Flatten[Array[NestList[RotateRight, {0, (-1) #1 GoldenRatio, (-1) #2 }, 3]&, {2, 2}], 2] • 1 + FixedPoint[N[1/(1 + #), k] &, 1] approximates GoldenRatio to k digits, as does FixedPoint[N[Sqrt[1 + #],k]&, 1] • A successive angle difference of GoldenRatio radians yields points maximally separated around a circle (see page 1006 ).

Sorting networks Any list can be sorted using Fold[PairSort, list, pairs] by doing a fixed sequence of comparisons of pairs PairSort[a_, p : {_, _}] := Block[{t = a}, t 〚 p 〛 = Sort[t 〚 p 〛 ]; t] (Different comparisons often do not interfere and so can be done in parallel.) … The first one on the bottom (with 63 comparisons) has a nested structure and uses the method invented by Kenneth Batcher in 1964: Flatten[Reverse[Flatten[With[{m = Ceiling[Log[2, n]] - 1}, Table[With[{d = If[i  m, 2 t , 2 i + 1 - 2 t ]}, Map[ {0, d} + # &, Select[Range[n - d], BitAnd[# - 1, 2 t ]  If[i  m, 0, 2 t ] &]]], {t, 0, m}, {i, t, m}]], 1]], 1] The second one on the bottom also uses 63 comparisons, while the last one is the smallest known for n = 16 : it uses 60 comparisons and was invented by Milton Green in 1969.

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 .

Starting in the 1960s it began to be realized that fast algorithms could be based on nested or recursive processes, and such algorithms became increasingly popular in the 1980s. … An example is the algorithm of Anatolii Karatsuba from 1961 for finding products of n -digit numbers (with n = 2 s ) by operating on their digits in the nested pattern of page 608 (see also page 1093 ) according to First[f[IntegerDigits[x, 2, n], IntegerDigits[y, 2, n], n/2]] f[x_, y_, n_] := If[n < 1, x y, g[Partition[x, n], Partition[y, n], n]] g[{x1_, x0_}, {y1_, y0_}, n_] := With[{z1 = f[x1, y1, n/2], z0 = f[x0, y0, n/2]}, z1 2 2n + (f[x0 + x1, y0 + y1, n/2] - z1 - z0)2 n + z0] Other examples include the fast Fourier transform (page 1074 ) and related algorithms for ListConvolve , the quicksort algorithm for Sort , and many algorithms in fields such as computational geometry.

(The presence of nested structure is particularly evident in FoldList[Plus, 0, Table[Mod[h n, 1] - 1/2, {n, max}]] .)

The magnetic energy of the system is taken to be e[s_] := -1/2 Apply[Plus, s ListConvolve[ {{0, 1, 0}, {1, 0, 1}, {0, 1, 0}}, s, 2], {0, 1}] so that each pair of adjacent spins contributes -1 when they are parallel and +1 when they are not. … 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.