The maximum is Nest[2 # &, 0, n] (compare page 906 ), achieved for initial conditions of the form Nest[#[ ℯ ]&, ℯ , n] . … For all initial conditions this depth seems at first to increase linearly, then to decrease in a nested way according to FoldList[Plus, 0, Flatten[Table[ {1, 1, Table[-1, {IntegerExponent[i, 2] + 1}]}, {i, m}]]] This quantity alternates between value 1 at position 2 j and value j at position 2 j - j + 1 . … For initial conditions of size n , this occurs after at most Sum[Nest[2 # &, 0, i] - 1, {i, n}] + 1 steps.

All generalized additive rules ultimately yield nested patterns. Starting with a list of the initial conditions for s steps, the configurations for the next s steps are given by Append[Rest[list], Map[Mod[Apply[Plus, Flatten[c #]], 2]&, Transpose[ Table[RotateLeft[list, {0, i}], {i, -r, r}], {3, 2, 1}]]] where r = (Length[First[c]] - 1)/2 .

An initial condition consisting of n white cells with one black cell in the middle can then be obtained with the function (see below for comments on this and other Mathematica functions) CenterList[n_Integer] := ReplacePart[Table[0, {n}], 1, Ceiling[n/2]] For cellular automata of the kind discussed in this chapter, the rule can also be represented by a list. Thus, for example, rule 30 on page 27 corresponds to the list {0, 0, 0, 1, 1, 1, 1, 0} . … In general, the list for a particular rule can be obtained with the function ElementaryRule[num_Integer] := IntegerDigits[num, 2, 8] Given a rule together with a list representing the state a of a cellular automaton at a particular step, the following simple function gives the state at the next step: CAStep[rule_List, a_List] := rule 〚 8 - (RotateLeft[a] + 2 (a + 2 RotateRight[a])) 〛 A list of states corresponding to evolution for t steps can then be obtained with CAEvolveList[rule_, init_List, t_Integer] := NestList[CAStep[rule, #]&, init, t] Graphics of this evolution can be generated using CAGraphics[history_List] := Graphics[ Raster[1 - Reverse[history]], AspectRatio  Automatic] And having set up the definitions above, the Mathematica input Show[CAGraphics[CAEvolveList[ ElementaryRule[30], CenterList[103], 50]]] will generate the image: The description just given should be adequate for most cellular automaton simulations.

LFSR cryptanalysis Given a sequence obtained from a length n LFSR (see page 975 ) Nest[Mod[Append[#, Take[#, -n] . vec], 2] &, list, t] the vector of taps vec can be deduced from LinearSolve[Table[Take[seq, {i, i + n - 1}], {i, n}], Take[seq, {n + 1, 2n}], Modulus  2] (An iterative algorithm in n taking about n 2 rather than n 3 steps was given by Elwyn Berlekamp and James Massey in 1968.)

For equations of the form ∂ tt u[t, x]  ∂ xx u[t, x] + f[u[t, x]] one can set up a simple finite difference method by taking f in the form of pure function and creating from it a kernel with space step dx and time step dt : PDEKernel[f_, {dx_, dt_}] := Compile[{a,b,c,d}, Evaluate[(2 b - d) + ((a + c - 2 b)/dx 2 + f[b]) dt 2 ]] Iteration for n steps is then performed by PDEEvolveList[ker_, {u0_, u1_}, n_] := Map[First, NestList[PDEStep[ker, #]&, {u0, u1}, n]] PDEStep[ker_, {u1_, u2_}] := {u2, Apply[ker, Transpose[ {RotateLeft[u2], u2, RotateRight[u2], u1}], {1}]} With this approach an approximation to the top example on page 165 can be obtained from PDEEvolveList[PDEKernel[ (1 - # 2 )(1 + #)&, {.1, .05}], Transpose[ Table[{1, 1} N[Exp[-x 2 ]], {x, -20, 20, .1}]], 400] For both this example and the middle one the results converge rapidly as dx decreases.

Nonlinear feedback shift registers Linear feedback shift registers of the kind discussed on page 974 can be generalized to allow any function f (note the slight analogy with cyclic tag systems): NLFSRStep[f_, taps_, list_] := Append[Rest[list], f[list 〚 taps 〛 ]] With the choice f=IntegerDigits[s, 2, 8] 〚 8 - # . {4, 2, 1} 〛 & and taps = {1, 2, 3} this is essentially a rule s elementary cellular automaton. With a list of length n , Nest[NLFSRStep[f, taps, #] &, list, n] gives one step in the evolution of the cellular automaton in a register of width n , with a certain kind of spiral boundary condition.

Then the rules for the language consisting of balanced runs of parentheses (see page 939 ) can be written as {s[e]  s[e, e], s[e]  s["(", e, ")"], s[e]  s["(",")"]} Different expressions in the language can be obtained by applying different sequences of these rules, say using (this gives so-called leftmost derivations) Fold[# /. rules 〚 #2 〛 &, s[e], list] Given an expression, one can then use the following to find a list of rules that will generate it—if this exists: Parse[rules_, expr_] := Catch[Block[{t = {}}, NestWhile[ ReplaceList[#, MapIndexed[ReverseRule, rules]] &, {{expr, {}}}, (# /. … = {}) &];]] ReverseRule[a_  b_, {i_}] := {___, {s[x___, b, y___], {u___}}, ___}  {s[x, a, y], {i, u}} /; FreeQ[s[x], s[a]] In general, there will in principle be more than one such list, and to pick the appropriate list in a practical situation one normally takes the rules of the language to apply with a certain precedence—which is how, for example, x + y z comes to be interpreted in Mathematica as Plus[x, Times[y, z]] rather than Times[Plus[x, y], z] .

The evolution of the arithmetic system is given by ASEvolveList[{n_, rules_}, init_, t_] := NestList[(Mod[#, n] /. rules)[#] &, init, t] Given a value m obtained in the evolution of the arithmetic system, the state of the register machine to which it corresponds is {Mod[m, p] + 1, Map[Last, FactorInteger[ Product[Prime[i], {i, nr}] Quotient[m, p]]] - 1} Note that it is possible to have each successive step involve only multiplication, with no addition, at the cost of using considerably larger numbers overall.

The longest tautology at step t is Nest[(# ⊼ #) ⊼ (# ⊼ p t ) & , p ⊼ (p ⊼ p), t - 1] whose LeafCount grows like 3 t . … Pages 818 and 1175 discuss the sequence of all Nand theorems listed in order of increasing complexity.

More colors [in additive cellular automata] The pictures below show generalizations of rule 90 to k possible colors using the rule CAStep[k_Integer, a_List] := Mod[RotateLeft[a] + RotateRight[a], k] or equivalently Mod[ListCorrelate[{1, 0, 1}, a, 2], k] . … Mod[Binomial[t, n], k] is given for prime k by With[{d = Ceiling[Log[k, Max[t, n] + 1]]}, Mod[Apply[Times, Apply[Binomial, Transpose[ {IntegerDigits[t, k, d] , IntegerDigits[n, k, d] }], {1}]], k]] The patterns obtained for any k are nested.