Search NKS | Online
1 - 10 of 46 for FoldList
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
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]] . … Repeats of a digit block b give numbers that solve Fold[(#1 2 - #2) &, x, b] x . … 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.
Implementation of generalized mobile automata
The state of a generalized mobile automaton at a particular step can be specified by {list, nlist} , where list gives the values of the cells, and nlist is a list of the positions of active cells. The rule can be given by specifying a list of cases such as {0, 0, 0} {1, {1, -1}} , where in each case the second sublist specifies the new relative positions of active cells. With this setup successive steps in the evolution of the system can be obtained from
GMAStep[rules_, {list_, nlist_}] := Module[{a, na}, {a, na} = Transpose[Map[Replace[Take[list, {# - 1, # + 1}], rules]&, nlist]]; {Fold[ReplacePart[#, Last[#2], First[#2]]&, list, Transpose[{nlist, a}]], Union[Flatten[nlist + na]]}]
But given t steps in this sequence as a list of 0's and 1's, the following function will reconstruct the rightmost t digits in the starting value of n :
IntegerDigits[First[Fold[{Mod[If[OddQ[#2], 2 First[#1] - 1, 2 First[#1] PowerMod[5, -1, Last[#1]]], Last[#1]], 2 Last[#1]} &, {0, 2}, Reverse[list]]], 2, Length[list]]
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]]
Given a sequence of length n , an approximation to h can be reconstructed using
Max[MapIndexed[#1/First[#2] &, FoldList[Plus, First[list], Rest[list]]]]
The fractional part of the result obtained is always an element of the Farey sequence
Union[Flatten[Table[a/b, {b, n}, {a, 0, b}]]]
(See also pages 892 , 932 and 1084 .)
In case (c), the following gives a list of the numbers of nodes generated up to step t :
FoldList[Plus, 1, Join[{1, 4, 12, 10, -20, 6, 4}, Map[d, IntegerDigits[Range[4, t - 5], 2]]]]
d[{___, 1}] = 1
d[{1, p : 0 .., 0}] := -Apply[Plus, 4 Range[Length[{p}]] - 1] + 6
d[{__, 1, p : 0 .., 0}] := d[{1, p, 0}] - 7
d[{___, p : 1 .., q : 0 ..., 1, 0}] := 4 Length[{p}] + 3 Length[{q}] + 2
d[{___, p : 1 .., 1, 0}] := 4 Length[{p}] + 2
Paperfolding sequences
The sequence of up and down creases in a strip of paper that is successively folded in half is given by a substitution system; after t steps the sequence turns out to be NestList[Join[#, {0}, Reverse[1 - #]] &, {0}, t] .
[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.