Search NKS | Online
11 - 20 of 46 for FoldList
![](/common/images/search/spacer.gif)
Random walks
In one dimension, a random walk with t steps of length 1 starting at position 0 can be generated from
NestList[(# + (-1)^Random[Integer])&, 0, t]
or equivalently
FoldList[Plus, 0, Table[(-1)^Random[Integer], {t}]]
A generalization to d dimensions is then
FoldList[Plus, Table[0, {d}], Table[RotateLeft[PadLeft[ {(-1)^Random[Integer]}, d], Random[Integer, d - 1]], {t}]]
A fundamental property of random walks is that after t steps the root mean square displacement from the starting position is proportional to √ t . … As mentioned on page 1082 , the frequency spectrum Abs[Fourier[list]] 2 for a 1D random walk goes like 1/ ω 2 .
… To make a random walk on a lattice with k directions in two dimensions, one can set up
e = Table[{Cos[2 π s/k], Sin[2 π s/k]}, {s, 0, k - 1}]
then use
FoldList[Plus, {0, 0}, Table[e 〚 Random[Integer, {1, k}] 〛 , {t}]]
It turns out that on any regular lattice, in any number of dimensions, the average behavior of a random walk is always isotropic.
Higher-dimensional generalizations [of substitution systems]
The state of a d -dimensional substitution system can be represented by a nested list of depth d . The evolution of the system for t steps can be obtained from
SSEvolve[rule_, init_, t_, d_Integer] := Nest[FlattenArray[# /. rule, d] &, init, t]
FlattenArray[list_, d_] := Fold[Function[{a, n}, Map[MapThread[Join, #, n] &, a, -{d + 2}]], list, Reverse[Range[d] - 1]]
The analog in 3D of the 2D rule on page 187 is
{1 Array[If[LessEqual[##], 0, 1] &, {2, 2, 2}], 0 Array[0 &, {2, 2, 2}]}
Note that in d dimensions, each black cell must be replaced by at least d + 1 black cells at each step in order to obtain an object that is not restricted to a dimension d - 1 hyperplane.
Runs of digits [in numbers]
One can consider any base 2 digit sequence as consisting of successive runs of 0's and 1's, constructed from the list of run lengths by
Fold[Join[#1, Table[1 - Last[#1], {#2}]] &, {0}, list]
This representation is related to so-called surreal numbers (though with the first few digits different).
The quantity FoldList[Plus, 0, Table[MoebiusMu[i], {i, n}]] behaves very much like a random walk.
Applying FoldList[Plus, 0, 2list - 1] to the whole sequence yields the pattern shown below.
… This is similar to picture (c) on page 131 , and is a digit-by-digit version of
FoldList[Plus, 0, Table[Apply[Plus, 2 Rest[IntegerDigits[i, 2]] - 1], {i, n}]]
Note that although the picture above has a nested structure, the original concatenation sequences are not nested, and so cannot be generated by substitution systems.
.}] = 0
g[{1, s__}] := 1 + g[IntegerDigits[FromDigits[{s}, 2] + 1, 2]]
The list of elements in the sequence up to value m is given by
Flatten[Table[Table[n, {IntegerExponent[n, 2] + 1}], {n, m}]]
The differences between the first 2 (2 k -1) of these elements is
Nest[Replace[#, {x___} {x, 1, x, 0}]&, {}, k]
The largest n for which f[n] m is given by 2m + 1 - DigitCount[m, 2, 1] or IntegerExponent[(2m)!… Hump m in the picture of sequence (c) shown is given by
FoldList[Plus, 0, Flatten[Nest[Delete[NestList[Rest, #, Length[#] - 1], 2]&, Append[Table[1, {m}], 0], m]] - 1/2]
The first 2 m elements in the sequence can also be generated in terms of reordered base 2 digit sequences by
FoldList[Plus, 1, Map[Last[Last[#]]&, Sort[Table[{Length[#], Apply[Plus, #], 1 - #}& [ IntegerDigits[i, 2]], {i, 2 m }]]]]
Note that the positive and negative fluctuations in sequence (f) are not completely random: although the probability for individual fluctuations in each direction seems to be the same, the probability for two positive fluctuations in a row is smaller than for two negative fluctuations in a row.
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"} .
The basic idea is to encode the list of values of all the registers in the multiregister machine in the single number given by
RMEncode[list_] := Product[Prime[j]^list 〚 j 〛 , {j, Length[list]}]
and then to have this number be the value at appropriate steps of the first register in the 2-register machine. The program in the multiregister machine can be converted to a program for the 2-register machine according to
RMToRM2[prog_] := Module[{segs, adrs}, segs = MapIndexed[seg, prog]; adrs = FoldList[Plus, 1, Map[Length, segs]]; MapIndexed[#1 /. {ds[r_, s_] d[r, adrs 〚 s 〛 ], dr[r_, j_] d[r, j + First[#2]]} &, Flatten[segs]]]
seg[i[r_], {a_}] := With[{p = Prime[r]}, Flatten[{Table[i[2], {p}], dr[1, -p], i[1], dr[2, -1], Table[dr[1, 1], {p + 1}]}]]
seg[d[r_, n_], {a_}] := With[{p = Prime[r]}, Flatten[{i[2], dr[ 1, 5], i[1], dr[2, -1], dr[1, 1], ds[1, n], Table[{If[m p - 1, ds[1, a], dr[1, 3p + 2 - m]], Table[i[1], {p}], dr[2, -p], Table[dr[1, 1], {2p - m - 1}], ds[1, a + 1]}, {m, p - 1}]}]]
The initial conditions for the 2-register machine are given by {1, {RMEncode[list], 0}} and the results corresponding to each step in the evolution of the multiregister machine appear whenever register 2 in the 2-register machine is incremented from 0.
Given a list of blocks such as {{1, 1}, {0}} each element of Flatten[list] can be thought of as a state in a finite automaton or a Markov process (see page 1084 ). The transitions between these states have probabilities given by m[Map[Length, list]] where
m[s_] := With[{q = FoldList[Plus, 0, s]}, ReplacePart[ RotateRight[IdentityMatrix[Last[q]], {0, 1}], 1/Length[s], Flatten[Outer[List, Rest[q], Drop[q, -1] + 1], 1]]]
The average spectrum of sequences generated according to these probabilities can be obtained by computing the correlation function for elements a distance r apart
ξ [list_, r_] := With[{w = (# - Apply[Plus, #]/Length[#] &)[ Flatten[list]]}, w . MatrixPower[ m[Map[Length, list]], r] . w/Length[w]]
then forming Sum[ ξ [Abs[r]] Cos[2 π r ω ], {r, -n/2, n/2}] and taking the limit n ∞ .
The first m rules (which yield far more than m elements of the original sequence) are obtained for any h that is not a rational number from the continued fraction form (see page 914 ) of h by
Map[(({0 Join[#, {1}], 1 Join[#, {1, 0}]} &)[Table[0, {# - 1}]]) &, Reverse[Rest[ContinuedFraction[h, m]]]]
Given these rules, the original sequence is given by
Floor[h] + Fold[Flatten[#1 /. #2] &, {0}, rules]
If h is the solution to a quadratic equation, then the continued fraction form is repetitive, and so there are a limited number of different substitution rules. … (The presence of nested structure is particularly evident in FoldList[Plus, 0, Table[Mod[h n, 1] - 1/2, {n, max}]] .)
![](/common/images/search/spacer.gif)