Difference tables and polynomials A common mathematical approach to analyzing sequences is to form a difference table by repeatedly evaluating d[list_] := Drop[list, 1] - Drop[list, -1] . If the elements of list correspond to values of a polynomial of degree n at successive integers, then Nest[d, list, n + 1] will contain only zeros.

Particularly dramatic are the concatenation systems discussed on page 913 , as well as successive rows in nested patterns such as Flatten[IntegerDigits[NestList[BitXor[#, 2 #] &, 1, 500], 2]] and sequences based on numbers such as Flatten[Table[If[GCD[i, j]  0, 1, 0], {i, 1000}, {j, i}]] (see page 613 ).

Non-deterministic Turing machines Generalizing rules from page 888 by making each right-hand side a list of possible outcomes, the list of configurations that can be reached after t steps is given by NTMEvolve[rule_, inits_, t_Integer] := Nest[ Union[Flatten[Map[NTMStep[rule, #]&, #], 1]]&, inits, t] NTMStep[rule_List, {s_, a_, n_}] /; 1 ≤ n ≤ Length[a] := Apply[{#1, ReplacePart[a, #2, n], n + #3}&, Replace[{s, a 〚 n 〛 }, rule], {1}]

Paperfolding sequences The sequence of up and down creases in a strip of paper that is successively folded in half is given by a substitution system; after t steps the sequence turns out to be NestList[Join[#, {0}, Reverse[1 - #]] &, {0}, t] .

Implementation [of tag systems] With the rules for case (a) on page 94 given for example by {2, {{0, 0}  {1, 1}, {1, 0}  {}, {0, 1}  {1, 0}, {1, 1}  {0, 0, 0}}} the evolution of a tag system can be obtained from TSEvolveList[{n_, rule_}, init_, t_] := NestList[If[Length[#] < n, {}, Join[Drop[#, n], Take[#, n] /. rule]]&, init, t] An alternative implementation is based on applying to the list at each step rules such as {{0, 0, s___}  {s, 1, 1}, {1, 0, s___}  {s}, {0, 1, s___}  {s, 1, 0}, {1, 1, s___}  {s, 0, 0, 0}} There are a total of ((k r + 1 - 1)/(k - 1)) k n possible rules if blocks up to length r can be added at each step and k colors are allowed.

Surprisingly enough, this simple procedure, which can be represented by the function s[list_] := Flatten[ Transpose[Reverse[Partition[list, Length[list]/2]]]] with or without the Reverse , is able to produce orderings which at least in some respects seem quite random. But by doing Nest[s, Range[52], 26] one ends up with a simple reversal of the original deck, as in the pictures below.

Comments on Mathematica functions CenterList works by first creating a list of n 0's, then replacing the middle 0 by a 1. … CAEvolveList applies CAStep t times. … In general NestList[s[r, #]&, i, 2] ⟶ {i, s[r, i], s[r, s[r, i]]} , etc.

Multiway systems based on numbers One can consider for example the rule n  {n + 1, 2 n} implemented by NestList[Union[Flatten[{# + 1, 2 #}]] &, {0}, t] In this case there are Fibonacci[t + 2] distinct numbers obtained at step t . In general, rules based on simple arithmetic operations yield only simple nested structures.

Nested lists One can think of structures that annihilate in pairs as being like parentheses or other delimiters that come in pairs, as in the picture below. A string of balanced parentheses is analogous to a nested Mathematica list such as {{{}, {{}}}, {}} . The Mathematica expression tree for this list then has a structure analogous to the nested pattern in the picture.

Implementation [of 2D substitution systems] With the rule on page 187 given for example by {1  {{1, 0}, {1, 1}}, 0  {{0, 0}, {0, 0}}} the result of t steps in the evolution of a 2D substitution system from a initial condition such as {{1}} is given by SS2DEvolve[rule_, init_, t_] := Nest[Flatten2D[# /. rule] &, init, t] Flatten2D[list_] := Apply[Join, Map[MapThread[Join, #] &, list]]