Search NKS | Online
1 - 10 of 93 for NestList
Sierpiński pattern
Other ways to generate step n of the pattern shown here in various orientations include:
• Mod[Array[Binomial, {2, 2} n , 0], 2]
(see pages 611 and 870 )
• 1 - Sign[Array[BitAnd, {2, 2} n , 0]]
(see pages 608 and 871 )
• NestList[Mod[RotateLeft[#] + #, 2] &, PadLeft[{1}, 2 n ], 2 n - 1]
(see page 870 )
• NestList[Mod[ListConvolve[{1, 1}, #, -1], 2] &, PadLeft[{1}, 2 n ], 2 n - 1]
(see page 870 )
• IntegerDigits[NestList[BitXor[2#, #] &, 1, 2 n - 1], 2, 2 n ]
(see page 906 )
• NestList[Mod[Rest[FoldList[Plus, 0, #]], 2] &, Table[1, {2 n }], 2 n - 1]
(see page 1034 )
• Table[PadRight[ Mod[CoefficientList[(1 + x) t - 1 , x], 2], 2 n - 1], {t, 2 n }]
(see pages 870 and 951 )
• Reverse[Mod[CoefficientList[Series[1/(1 - (1 + x)y), {x, 0, 2 n - 1}, {y, 0, 2 n - 1}], {x, y}], 2]]
(see page 1091 )
• Nest[Apply[Join, MapThread[ Join, {{#, #}, {0 #, #}}, 2]] &, {{1}}, n]
(compare page 1073 )
The positions of black squares can be found from:
• Nest[Flatten[2# /. {x_, y_} {{x, y}, {x + 1, y}, {x, y + 1}}, 1] &, {{0, 0}}, n]
• Transpose[{Re[#], Im[#]}] &[ Flatten[Nest[{2 #, 2 # + 1, 2 # + } &, {0}, n]]]
(compare page 1005 )
• Position[Map[Split, NestList[Sort[Flatten[{#, # + 1}]] &, {0}, 2 n - 1]], _?(OddQ[Length[#]] &), {2}]
(see page 358 )
• Flatten[Table[Map[{t, #} &, Fold[Flatten[{#1, #1 + #2}] &, 0, Flatten[2^(Position[ Reverse[IntegerDigits[t, 2]], 1] - 1)]]], {t, 2 n - 1}], 1]
(see page 870 )
• Map[Map[FromDigits[#, 2] &, Transpose[Partition[#, 2]]] &, Position[Nest[{{#, #}, {#}} &, 1, n], 1] - 1]
(see page 509 )
A formatting hack giving the same visual pattern is
DisplayForm[Nest[SubsuperscriptBox[#, #, #] &, "1", n]]
And with this representation, the evolution for t steps is given by
SSEvolveList[rule_, init_List, t_Integer] := NestList[Flatten[# /. rule]&, init, t]
where in the first example on page 82 , the initial condition is {1} .
… In this case, the evolution can be obtained using
SSEvolveList[rule_, init_String, t_Integer] := NestList[StringReplace[#, rule]&, init, t]
For a neighbor-dependent substitution system such as the first one on page 85 the rule can be given as
{{1, 1} {0, 1}, {1, 0} {1, 0}, {0, 1} {0}, {0, 0} {0, 1}}
And with this representation, the evolution for t steps is given by
SS2EvolveList[rule_, init_List, t_Integer] := NestList[Flatten[Partition[#, 2, 1] /. rule]&, init, t]
where the initial condition for the first example on page 85 is {0, 1, 1, 0} .
Implementation [of cyclic tag systems]
With the rules for the cyclic tag system on page 95 given as {{1, 1}, {1, 0}} , the evolution can be obtained from
CTEvolveList[rules_, init_, t_] := Map[Last, NestList[CTStep, {rules, init}, t]]
CTStep[{{r_, s___}, {0, a___}}] := {{s, r}, {a}}
CTStep[{{r_, s___}, {1, a___}}] := {{s, r}, Join[{a}, r]}
CTStep[{u_, {}}] := {u, {}}
The leading elements on many more than t successive steps can be obtained directly from
CTList[rules_, init_, t_] := Flatten[Map[Last, NestList[CTListStep, {rules, init}, t]]]
CTListStep[{rules_, list_}] := {RotateLeft[rules, Length[list]],Flatten[rules 〚 Mod[Flatten[Position[list, 1]], Length[rules], 1] 〛 ]}
Implementation of digit sequences
A whole number n can be converted to a sequence of digits in base k using IntegerDigits[n,k] or (see also page 1094 )
Reverse[Mod[NestWhileList[Floor[#/k] &, n, # ≥ k &], k]]
and from a sequence of digits using FromDigits[list,k] or
Fold[k #1 + #2 &, 0, list]
For a number x between 0 and 1, the first m digits in its digit sequence in base k are given by RealDigits[x, k, m] or
Floor[k NestList[Mod[k #, 1]&, x, m - 1]]
and from these digits one can reconstruct an approximation to the number using FromDigits[{list, 0}, k] or
Fold[#1/k + #2 &, 0, Reverse[list]]/k
One way to do this is by using the Gödel number Product[Prime[i]^list 〚 i 〛 , {i, Length[list]}] . … Given p = Array[Prime, Length[list], PrimePi[Max[list]] + 1] or any list of integers that are all relatively prime and above Max[list] (the integers in list are assumed positive)
CRT[list_, p_] := With[{m = Apply[Times, p]}, Mod[Apply[Plus, MapThread[#1 (m/#2)^EulerPhi[#2] &, {list, p}]], m]]
yields a number x such that Mod[x, p] list . Based on this
LE[list_] := Module[{n = Length[list], i = Max[MapIndexed[ #1 - #2 &, PrimePi[list]]] + 1}, CRT[PadRight[ list, n + i], Join[Array[Prime[i + #] &, n], Array[Prime, i]]]]
will yield a number x that can be decoded into a list of length n using essentially the so-called Gödel β function
Mod[x, Prime[Rest[NestList[NestWhile[# + 1 &, # + 1, Mod[x, Prime[#]] 0 &] &, 0, n]]]]
Given only an output list NestList[Mod[a #, m]&, x, n] parameters {a, m} that generate the list can be found for sufficiently large n from
With[{ α = Apply[(#2 . Rest[list]/#1) &, Apply[ ExtendedGCD, Drop[list, -1]]]}, {Mod[ α , #], #} &[ Fold[GCD[#1, If[#1 0, #2, Mod[#2, #1]]] &, 0, ListCorrelate[{ α , -1}, list]]]]
With slightly more effort both x and {a, m} can be found just from First[IntegerDigits[list, 2, p]] .
Nested radicals
Given a list of integers acting like digits one can consider representing numbers in the form Fold[Sqrt[#1 + #2]&, 0, Reverse[list]] . … (Note that Nest[Sqrt[# + 2] &, 0, n] 2 Cos[ π /2 n + 1 ] .) … For any number x the first n digits are given by
Ceiling[NestList[(2 - Mod[-#, 1]) 2 &, x 2 , n - 1] - 2]
Even rational numbers such as 3/2 do not yield simple digit sequences.
The tetrahedron network from page 476 is for example given in this representation by
{1 {2, 3, 4}, 2 {1, 3, 4}, 3 {1, 2, 4}, 4 {1, 2, 3}}
The list of nodes reached by following up to n connections from node i are then given by
NodeLists[g_, i_, n_] := NestList[Union[Flatten[# /. g]] &, {i}, n]
The network distance corresponding to the length of the shortest path between two nodes is given by
Distance[g_, {i_, j_}] := Length[NestWhileList[ Union[Flatten[# /. g]] &, {i}, !
Second-order cellular automata
Second-order elementary rules can be implemented using
CA2EvolveList[rule_List, {a_List, b_List}, t_Integer] := Map[First, NestList[CA2Step[rule, #]&, {a, b}, t]]
CA2Step[rule_List, {a_, b_}] := {b, Mod[a + rule 〚 8 - (RotateLeft[b] + 2 (b + 2 RotateRight[b])) 〛 , 2]}
where rule is obtained from the rule number using IntegerDigits[n, 2, 8] .
The combination Drop[list, -1] + 2 Drop[list, 1] of the result from CA2EvolveList corresponds to evolution according to a first-order k = 4 , r = 1 rule.
[Turing] machine 596440
For any list of initial colors init , it turns out that successive rows in the first t steps of the compressed evolution pattern turn out to be given by
NestList[Join[{0}, Mod[1 + Rest[FoldList[Plus, 0, #]], 2], {{0}, {1, 1, 0}} 〚 Mod[Apply[Plus, #], 2] + 1] 〛 &, init, t]
Inside the right-hand part of this pattern the cell values can then be obtained from an upside-down version of the rule 60 additive cellular automaton, and starting from a sequence of 1 's the picture below shows that a typical rule 60 nested pattern can be produced, at least in a limited region.
The presence of glitches on the right-hand edge of the whole pattern means, however, that overall there is nothing as simple as nested behavior—making it conceivable that (possibly with analogies to tag systems) behavior complex enough to support universality can occur.