# Search NKS | Online

1 - 10 of 23 for NestWhileList

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

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}, !

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]]]]

Implementation [of continuous cellular automata]
The state of a continuous cellular automaton at a particular step can be represented by a list of numbers, each lying between 0 and 1. This list can then be updated using
CCAEvolveStep[f_, list_List] := Map[f, (RotateLeft[list] + list + RotateRight[list])/3]
CCAEvolveList[f_, init_List, t_Integer] := NestList[CCAEvolveStep[f, #] &, init, t]
where for the rule on page 157 f is FractionalPart[3#/2] & while for the rule on page 158 it is FractionalPart[# + 1/4] & .
Note that in the definitions above, the elements of list can be either exact rational numbers, or approximate numbers obtained using N .

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. The element at position n in the first sequence discussed above can however be obtained in about Log[n] steps using
((IntegerDigits[#3 + Quotient[#1, #2], 2] 〚 Mod[#1, #2] + 1 〛 &)[n - (# - 2)2 # - 1 - 2, #, 2 # - 1 ]&)[NestWhile[# + 1&, 0, (# - 1)2 # + 1 < n &]]
where the result of the NestWhile can be expressed as
Ceiling[1 + ProductLog[1/2(n - 1)Log[2]]/Log[2]]
Following work by Maxim Rytin in the late 1990s about k n+1 digits of a concatenation sequence can be found fairly efficiently from
k/(k - 1) 2 - (k - 1) Sum[k (k s - 1) ((1 + s - s k)/(k - 1)) (1/((k - 1) (k s - 1) 2 ) - k/((k - 1) (k s + 1 - 1) 2 ) + 1/(k s + 1 - 1)), {s, n}]
Concatenation sequences can also be generated by joining together digits from other representations of numbers; the picture below shows results for the Gray code representation from page 901 .

If h is rational, the sequence is repetitive, while if h is a quadratic irrational, it is nested. 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 .)

Starting with an ordinary base 2 digit sequence, one prepends a unary specification of its length, then a specification of that length specification, and so on:
(Flatten[{Sign[-Range[1 - Length[#], 0]], #}] &)[ Map[Rest, IntegerDigits[Rest[Reverse[NestWhileList[ Floor[Log[2, #] &, n + 1, # > 1 &]]],2]]]
(d) Binary-coded base 3. … Apply[Take, RealDigits[(N[#, N[Log[10, #] + 3]] &)[ n √ 5 /GoldenRatio 2 + 1/2], GoldenRatio]]
The representations of all the first Fibonacci[n] - 1 numbers can be obtained from (the version in the main text has Rest[RotateLeft[Join[#, {0, 1}]]] & applied)
Apply[Join, Map[Last, NestList[{# 〚 2 〛 ], Join[Map[Join[{1, 0}, Rest[#]] & , # 〚 2 〛 ], Map[Join[{1, 0}, #] &, # 〚 1 〛 ]]} &, {{}, {{1}}}, n-3]]]

For rule 90 the combination c can be specified as {{1, 0, 1}} , while for rule 150R it can be specified as {{0, 1, 0}, {1, 1, 1}} . All generalized additive rules ultimately yield nested patterns. Starting with a list of the initial conditions for s steps, the configurations for the next s steps are given by
Append[Rest[list], Map[Mod[Apply[Plus, Flatten[c #]], 2]&, Transpose[ Table[RotateLeft[list, {0, i}], {i, -r, r}], {3, 2, 1}]]]
where r = (Length[First[c]] - 1)/2 .

Then, for example, the rule for the mobile automaton shown on page 71 can be given as
{{1, 1, 1} {0, 1}, {1, 1, 0} {0, 1}, {1, 0, 1} {1, -1}, {1, 0, 0} {0, -1}, {0, 1, 1} {0, -1}, {0, 1, 0} {0, 1}, {0, 0, 1} {1, 1}, {0, 0, 0} {1, -1}}
where the left-hand side in each case gives the value of the active cell and its left and right neighbors, while the right-hand side consists of a pair containing the new value of the active cell and the displacement of its position. … With a rule given in this form, each step in the evolution of the mobile automaton corresponds to the function
MAStep[rule_, {list_List, n_Integer}] /; (1 < n < Length[list]) := Apply[{ReplacePart[list, #1, n], n + #2}&, Replace[Take[list, {n - 1, n + 1}], rule]]
The complete evolution for many steps can then be obtained with
MAEvolveList[rule_, init_List, t_Integer] := NestList[MAStep[rule, #]&, init, t]
(The program will run more efficiently if Dispatch is applied to the rule before giving it as input.)
For the mobile automaton on page 73 , the rule can be given as
{{1, 1, 1} {{0, 0, 0}, -1}, {1, 1, 0} {{1, 0, 1}, -1}, {1, 0, 1} {{1, 1, 1}, 1}, {1, 0, 0} {{1, 0, 0}, 1}, {0, 1, 1} {{0, 0, 0}, 1}, {0, 1, 0} {{0, 1, 1}, -1}, {0, 0, 1} {{1, 0, 1}, 1}, {0, 0, 0} {{1, 1, 1}, 1}}
and MAStep must be rewritten as
MAStep[rule_, {list_List, n_Integer}] /; (1 < n < Length[list]) := Apply[{Join[Take[list, {1, n - 2}], #1, Take[list, {n + 2, -1}]], n + #2}&, Replace[Take[list, {n - 1, n + 1}], rule]]

Then the rules for the language consisting of balanced runs of parentheses (see page 939 ) can be written as
{s[e] s[e, e], s[e] s["(", e, ")"], s[e] s["(",")"]}
Different expressions in the language can be obtained by applying different sequences of these rules, say using (this gives so-called leftmost derivations)
Fold[# /. rules 〚 #2 〛 &, s[e], list]
Given an expression, one can then use the following to find a list of rules that will generate it—if this exists:
Parse[rules_, expr_] := Catch[Block[{t = {}}, NestWhile[ ReplaceList[#, MapIndexed[ReverseRule, rules]] &, {{expr, {}}}, (# /. … = {}) &];]]
ReverseRule[a_ b_, {i_}] := {___, {s[x___, b, y___], {u___}}, ___} {s[x, a, y], {i, u}} /; FreeQ[s[x], s[a]]
In general, there will in principle be more than one such list, and to pick the appropriate list in a practical situation one normally takes the rules of the language to apply with a certain precedence—which is how, for example, x + y z comes to be interpreted in Mathematica as Plus[x, Times[y, z]] rather than Times[Plus[x, y], z] .