Search NKS | Online
11 - 20 of 23 for NestWhileList
In the first 200 billion digits, the frequencies of 0 through 9 differ from 20 billion by
{30841, -85289, 136978, 69393, -78309, -82947, -118485, -32406, 291044, -130820}
An early approximation to π was
4 Sum[(-1) k /(2k + 1), {k, 0, m}]
30 digits were obtained with
2 Apply[Times, 2/Rest[NestList[Sqrt[2 + #]&, 0, m]]]
An efficient way to compute π to n digits of precision is
(# 〚 2 〛 2 /# 〚 3 〛 )& [NestWhile[Apply[Function[{a, b, c, d}, {(a + b)/2, Sqrt[a b], c - d (a - b) 2 , 2 d}], #]&, {1, 1/Sqrt[N[2, n]], 1/4, 1/4}, # 〚 2 〛 ≠ # 〚 2 〛 &]]
This requires about Log[2, n] steps, or a total of roughly n Log[n] 2 operations (see page 1134 ).
The rule on page 82 can then be given simply as
s[1, 0] s[0, 1, 0]
while the rule on page 85 becomes
{s[0, 1, 0] s[0, 0, 1], s[0] s[0, 1, 0]}
The Flat attribute of s makes these rules apply not only for example to the whole sequence s[1, 0, 1, 0] but also to any subsequence such as s[1, 0] . … And with this setup, t steps of evolution can be found with
SSSEvolveList[rule_, init_s, t_Integer] := NestList[(# /. rule)&, init, t]
Note that as an alternative to having s be Flat , one can explicitly set up rules based on patterns such as s[x___, 1, 0, y___] s[x, 0, 1, 0, y] .
Continued fractions
The first n terms in the continued fraction representation for a number x can be found from the built-in Mathematica function ContinuedFraction , or from
Floor[NestList[1/Mod[#, 1]&, x, n - 1]]
A rational approximation to the number x can be reconstructed from the continued fraction using FromContinuedFraction or by
Fold[(1/#1 + #2 )&, Last[list], Rest[Reverse[list]]]
The pictures below show the digit sequences of successive iterates obtained from NestList[1/Mod[#, 1]&, x, n] for several numbers x .
… Fairly large terms are sometimes seen quite early: in 5 1/3 term 19 is 3052, while in Root[10 + 8 # - # 3 &, 1] term 34 is 1,501,790. … For any irrational number this quantity cannot be less than 2, while for algebraic irrationals Klaus Roth showed in 1955 that it can only have finitely many peaks that reach above any specified level.
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.
Flatten[{1, 0, CTList[{{1, 0, 0, 1}, {0, 1, 1, 0}}, {0, 1}, t]}]
gives for example the Thue–Morse substitution system {1 {1, 0}, 0 {0, 1}} .
… In example (c), the elements are again correlated: the growth is by an average of ( √ 5 - 1)/2 ≃ 0.618 elements at each step, and the first elements on alternate steps form the same nested sequence as obtained from the substitution system {1 {1, 0}, 0 {1}} . … In example (e), the frequency of 1's is again about 3/4, but now {0, 0} occurs with frequency 0.05, {1, 1} occurs with frequency 0.55, while {0, 0, 0} and {0, 1, 0} cannot occur.
The sequence on step t can be obtained from Nest[Join[#, 1 - #] &, {1}, t - 1] . … The color of the element at position n is given by 2 - (Floor[(n + 1) GoldenRatio] - Floor[n GoldenRatio]) (see page 904 ), while the position of the k th white element is given by the so-called Beatty sequence Floor[k GoldenRatio] . … The resulting curve has a nested form, with envelope n^Log[3, 2] .
The pattern corresponding to each point is the limit of Nest[Flatten[1 + {c #, Conjugate[c] #}]&, {1}, n] when n ∞ . … Every point in the pattern must correspond to some list of left and right branchings, represented by 0's and 1's respectively; in terms of this list the position of the point is given by Fold[1 + {c, Conjugate[c]} 〚 1 + #2 〛 #1&, 1, Reverse[list]] . … The rest of the boundary consists of a sequence of algebraic curves, with almost imperceptible changes in slope in between; the first corresponds to {0, 0, 0, 1, 0, 1, 0, 1, …} , while subsequent ones correspond to {0, 1, 1, 1, 0, 1, 0, 1, 0, 1, 0, 1, …} , {0, 1, 1, 1, 1, 0, 1, 0, 1, 0, 1, 0, 1, …} , etc.
In the context of the 2D Ising model this phenomenon is associated with the fact that those configurations of a large array of spins that have high total energy are overwhelmingly likely to have near zero overall magnetization, while those that have low total energy are overwhelmingly likely to have nonzero overall magnetization. … 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.
As suggested by the pictures in the main text, spectra such as (b) and (d) in the limit consist purely of discrete Dirac delta function peaks, while spectra such as (a) and (c) also contain essentially continuous parts. … With k colors each giving a string of the same length s the recurrence relation is
Thread[Map[ ϕ [#][t + 1, ω ] &, Range[k] - 1] Apply[Plus, MapIndexed[Exp[ ω (Last[#2] - 1) s t ] ϕ [#1][t, ω ] &, Range[k] - 1 /. rules, {-1}], {1}]/ √ s ]
Some specific properties of the examples shown include:
(a) (Thue–Morse sequence) The spectrum is essentially Nest[Range[2 Length[#]] Join[#, Reverse[#]] &, {1}, t] . … (Z transform or generating function methods can be applied directly only for substitution systems with rules such as {1 list, 0 1 - list} .)
Pointer-based encoding
One can encode a list of data d by generating pointers to the longest and most recent copies of each subsequence of length at least b using
PEncode[d_, b_ : 4] := Module[{i, a, u, v}, i = 2; a = {First[d]}; While[i ≤ Length[d], {u, v} = Last[Sort[Table[{MatchLength[d, i, j], j}, {j, i - 1}]]]; If[u ≥ b, AppendTo[a, p[i - v, u]]; i += u, AppendTo[a, d 〚 i 〛 ]; i++]]; a]
MatchLength[d_, i_, j_] := With[{m = Length[d] - i}, Catch[ Do[If[d 〚 i + k 〛 =!… The encoded version of a purely nested sequence grows like Log[n] 2 .