Search NKS | Online
191 - 200 of 310 for Nest
![](/common/images/search/spacer.gif)
The picture below shows an example—with ultimately fairly simple nested behavior.
In case (c) the behavior is slightly more complicated, but if the pattern is viewed in the appropriate way then it turns out to have the same nested form as the third neighbor-independent substitution system shown on page 83 .
Conway considered fraction systems based on rules of the form
FSEvolveList[fracs_, init_, t_] := NestList[First[Select[fracs #, IntegerQ, 1]] &, init, t]
With the choice
fracs = {17/91, 78/85, 19/51, 23/38, 29/33, 77/29, 95/ 23, 77/19, 1/17, 11/13, 13/11, 15/14, 15/2, 55/1}
starting at 2 the result for Log[2, list] is as shown below, where Rest[Log[2, Select[list, IntegerQ[Log[2, #]] &]]] gives exactly the primes.
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.
The system thus in the end produces patterns that are purely nested, though formed from rather complicated elements.
The nested structure is like the progression of base 2 digit sequences shown on page 117 .
Solve[Nest[f, x, p] x, x], Im[#] 0 &]
For x a x (1 - x) the results usually cannot be expressed in terms of explicit radicals beyond period 2.
Substitution systems in which all replacements are done that are found to fit in a left-to-right scan can be implemented as follows
GSSEvolveList[rule_, s_, n_] := NestList[GSSStep[rule, #] &, s, n]
GSSStep[rule_, s_] := g[rule, s, f[StringPosition[s, Map[First, rule]]]]
f[{ }] = { }; f[s_] := Fold[If[Last[Last[#1]] ≥ First[#2], #1, Append[#1, #2]]&, {First[s]}, Rest[s]]
g[rule_, s_, { }] := s; g[rule_, s_, pos_] := StringReplacePart[ s, Map[StringTake[s, #] &, pos] /. rule, pos]
with rules given as {"ABA" "BAAB", "BBBB" "AA"} .
Fractal dimensions [of additive cellular automata]
The total number of nonzero cells in the first t rows of the pattern generated by the evolution of an additive cellular automaton with k colors and weights w (see page 952 ) from a single initial 1 can be found using
g[w_, k_, t_] := Apply[Plus, Sign[NestList[Mod[ ListCorrelate[w, #, {-1, 1}, 0], k] &, {1}, t - 1]], {0, 1}]
The fractal dimension of this pattern is then given by the large m limit of
Log[k,g[w, k,k m + 1 ]/g[w, k, k m ]]
When k is prime it turns out that this can be computed as
d[w_, k_:2] := Log[k,Max[Abs[Eigenvalues[With[ {s = Length[w] - 1}, Map[Function[u, Map[Count[u, #] &, #1]], Map[Flatten[Map[Partition[Take[#, k + s - 1], s, 1] &, NestList[Mod[ListConvolve[w, #], k] &, #, k - 1]], 1] &, Map[Flatten[Map[{Table[0, {k - 1}], #} &, Append[#, 0]]] &, #]]] &[Array[IntegerDigits[#, k, s] &, k s - 1]]]]]]]
For rule 90 one gets d[{1, 0, 1}] = Log[2, 3] ≃ 1.58 .
The typical way this is done is to say that a function f n corresponds to an integer n if f n [a][b] yields Nest[a, b, n] (see note below ).
![](/common/images/search/spacer.gif)