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