Search NKS | Online
11 - 20 of 21 for DigitCount
![](/common/images/search/spacer.gif)
(a) (Successive digits sequence) The sequence produced is repetitive, with the element at position n being black for n odd and white for n even. … The complete pattern formed by looking at all the steps together has the same structure as the arrangement of base 2 digits in successive numbers shown on page 117 .
(b) (Thue–Morse sequence) The color s[n] of the element at position n is given by 1 - Mod[DigitCount[n - 1, 2, 1], 2] .
The configuration of the tape on each side of the head in the Turing machine evolution can be obtained from the tag system evolution using
Cases[history, x : {a[_], ___} Apply[{#1, Reverse[#2]} &, Map[ Drop[IntegerDigits[Count[x, #], 2], -1] &, {_b, _d}]]]
Fibonacci[n] can be obtained in many ways:
• (GoldenRatio n - (-GoldenRatio) -n )/ √ 5
• Round[GoldenRatio n / √ 5 ]
• 2 1 - n Coefficient[(1 + √ 5 ) n , √ 5 ]
• MatrixPower[{{1, 1}, {1, 0}}, n - 1] 〚 1, 1 〛
• Numerator[NestList[1/(1 + #)&, 1, n]]
• Coefficient[Series[1/(1 - t - t 2 ), {t, 0, n}], t n - 1 ]
• Sum[Binomial[n - i - 1, i], {i, 0, (n - 1)/2}]
• 2 n - 2 - Count[IntegerDigits[Range[0, 2 n - 2 ], 2], {___, 1, 1, ___}]
A fast method for evaluating Fibonacci[n] is
First[Fold[f, {1, 0, -1}, Rest[IntegerDigits[n, 2]]]]
f[{a_, b_, s_}, 0] = {a (a + 2b), s + a (2a - b), 1}
f[{a_, b_, s_}, 1] = {-s + (a + b) (a + 2b), a (a + 2b), -1}
Fibonacci numbers appear to have first arisen in perhaps 200 BC in work by Pingala on enumerating possible patterns of poetry formed from syllables of two lengths. … In addition:
• GoldenRatio is the solution to x 1 + 1/x or x 2 x + 1
• The right-hand rectangle in is similar to the whole rectangle when the aspect ratio is GoldenRatio
• Cos[ π /5] Cos[36 ° ] GoldenRatio/2
• The ratio of the length of the diagonal to the length of a side in a regular pentagon is GoldenRatio
• The corners of an icosahedron are at coordinates
Flatten[Array[NestList[RotateRight, {0, (-1) #1 GoldenRatio, (-1) #2 }, 3]&, {2, 2}], 2]
• 1 + FixedPoint[N[1/(1 + #), k] &, 1] approximates GoldenRatio to k digits, as does FixedPoint[N[Sqrt[1 + #],k]&, 1]
• A successive angle difference of GoldenRatio radians yields points maximally separated around a circle (see page 1006 ).
Fractal dimensions [of additive cellular automata]
The total number of nonzero cells in the first t rows of the pattern generated by the evolution of an additive cellular automaton with k colors and weights w (see page 952 ) from a single initial 1 can be found using
g[w_, k_, t_] := Apply[Plus, Sign[NestList[Mod[ ListCorrelate[w, #, {-1, 1}, 0], k] &, {1}, t - 1]], {0, 1}]
The fractal dimension of this pattern is then given by the large m limit of
Log[k,g[w, k,k m + 1 ]/g[w, k, k m ]]
When k is prime it turns out that this can be computed as
d[w_, k_:2] := Log[k,Max[Abs[Eigenvalues[With[ {s = Length[w] - 1}, Map[Function[u, Map[Count[u, #] &, #1]], Map[Flatten[Map[Partition[Take[#, k + s - 1], s, 1] &, NestList[Mod[ListConvolve[w, #], k] &, #, k - 1]], 1] &, Map[Flatten[Map[{Table[0, {k - 1}], #} &, Append[#, 0]]] &, #]]] &[Array[IntegerDigits[#, k, s] &, k s - 1]]]]]]]
For rule 90 one gets d[{1, 0, 1}] = Log[2, 3] ≃ 1.58 .
Here are examples of how some of the basic Mathematica constructs used in the notes in this book work:
• Iteration
Nest[f, x, 3] ⟶ f[f[f[x]]]
NestList[f, x, 3] ⟶ {x, f[x], f[f[x]], f[f[f[x]]]}
Fold[f, x, {1, 2}] ⟶ f[f[x, 1], 2]
FoldList[f, x, {1, 2}] ⟶ {x, f[x, 1], f[f[x, 1], 2]}
• Functional operations
Function[x, x + k][a] ⟶ a + k
(# + k&)[a] ⟶ a + k
(r[#1] + s[#2]&)[a, b] ⟶ r[a] + s[b]
Map[f, {a, b, c}] ⟶ {f[a], f[b], f[c]}
Apply[f, {a, b, c}] ⟶ f[a, b, c]
Select[{1, 2, 3, 4, 5}, EvenQ] ⟶ {2, 4}
MapIndexed[f, {a, b, c}] ⟶ {f[a, {1}], f[b, {2}], f[c, {3}]}
• List manipulation
{a, b, c, d} 〚 3 〛 ⟶ c
{a, b, c, d} 〚 {2, 4, 3, 2} 〛 ⟶ {b, d, c, b}
Take[{a, b, c, d, e}, 2] ⟶ {a, b}
Drop[{a, b, c, d, e}, -2] ⟶ {a, b, c}
Rest[{a, b, c, d}] ⟶ {b, c, d}
ReplacePart[{a, b, c, d}, x, 3] ⟶ {a, b, x, d}
Length[{a, b, c}] ⟶ 3
Range[5] ⟶ {1, 2, 3, 4, 5}
Table[f[i], {i, 4}] ⟶ {f[1], f[2], f[3], f[4]}
Table[f[i, j], {i, 2}, {j, 3}] ⟶ {{f[1, 1], f[1, 2], f[1, 3]}, {f[2, 1], f[2, 2], f[2, 3]}}
Array[f, {2, 2}] ⟶ {{f[1, 1], f[1, 2]}, {f[2, 1], f[2, 2]}}
Flatten[{{a, b}, {c}, {d, e}}] ⟶ {a, b, c, d, e}
Flatten[{{a, {b, c}}, {{d}, e}}, 1] ⟶ {a, {b, c}, {d}, e}
Partition[{a, b, c, d}, 2, 1] ⟶ {{a, b}, {b, c}, {c, d}}
Split[{a, a, a, b, b, a, a}] ⟶ {{a, a, a}, {b, b}, {a, a}}
ListConvolve[{a, b}, {1, 2, 3, 4, 5}] ⟶ {2a + b, 3a + 2b, 4a + 3b, 5a + 4b}
Position[{a, b, c, a, a}, a] ⟶ {{1}, {4}, {5}}
RotateLeft[{a, b, c, d, e}, 2] ⟶ {c, d, e, a, b}
Join[{a, b, c}, {d, b}] ⟶ {a, b, c, d, b}
Union[{a, a, c, b, b}] ⟶ {a, b, c}
• Transformation rules
{a, b, c, d} /. b p ⟶ {a, p, c, d}
{f[a], f[b], f[c]} /. f[a] p ⟶ {p, f[b], f[c]}
{f[a], f[b], f[c]} /. f[x_] p[x] ⟶ {p[a], p[b], p[c]}
{f[1], f[b], f[2]} /. f[x_Integer] p[x] ⟶ {p[1], f[b], p[2]}
{f[1, 2], f[3], f[4, 5]} /. f[x_, y_] x + y ⟶ {3, f[3], 9}
{f[1], g[2], f[2], g[3]} /. f[1] | g[_] p ⟶ {p, p, f[2], p}
• Numerical functions
Quotient[207, 10] ⟶ 20
Mod[207, 10] ⟶ 7
Floor[1.45] ⟶ 1
Ceiling[1.45] ⟶ 2
IntegerDigits[13, 2] ⟶ {1, 1, 0, 1}
IntegerDigits[13, 2, 6] ⟶ {0, 0, 1, 1, 0, 1}
DigitCount[13, 2, 1] ⟶ 3
FromDigits[{1, 1, 0, 1}, 2] ⟶ 13
The Mathematica programs in these notes are formatted in Mathematica StandardForm .
The series has an accumulation of poles on the circle Abs[a] 2 1 ; the coefficient of x m turns out to have denominator
2^(m - DigitCount[m, 2, 1]) Apply[Times, Table[Cyclotomic[s, a]^Floor[(m - 1)/s], {s, m - 1}]]
For other iterated maps general formulas also seem rare.
By about 100 AD Hero had described an odometer-like device that could be driven automatically and could effectively count in digital form. … But much more widely known were the machines built in the 1640s by Blaise Pascal for doing addition on numbers with five or so digits and in the 1670s by Gottfried Leibniz for doing multiplication, division and square roots.
With two colors of elements additional conditions can be constructed involving counting elements of each color, or various blocks of elements.
The undecidability of PCP can be seen to follow from the undecidability of the halting problem through the fact that the question of whether a tag system of the kind on page 93 with initial sequence s ever reaches a halting state (where none of its rules apply) is equivalent to the question of whether there is a way to satisfy the PCP constraint
TSToPCP[{n_, rule_}, s_] := Map[Flatten[IntegerDigits[#, 2, 2]] &, Module[{f}, f[u_] := Flatten[Map[{1, #} &, 3u]]; Join[Map[{f[Last[#]], RotateLeft[f[First[#]]]} &, rule], {{f[s], {1}}}, Flatten[ Table[{{1, 2}, Append[RotateLeft[f[IntegerDigits[j, 2, i]]], 2]}, {i, 0, n - 1}, {j, 0, 2 i - 1}], 1]]], {2}]
Any PCP constraint can also immediately be related to the evolution of a multiway tag system of the kind discussed in the note below.
Given an integer a for which IntegerDigits[a, 2] gives the cell values for a cellular automaton, a single step of evolution according say to rule 30 is given by
BitXor[a, 2 BitOr[a, 2a]]
where (see page 871 )
BitXor[x, y] BitOr[x, y] - BitAnd[x, y]
and a is assumed to be padded with 0's at each end. … From this representation of Power the universal equation can be converted to a purely polynomial equation with 2154 variables—which when expanded has 1683150 terms, total degree 16 (average per term 6.8), maximum coefficient 17827424 and LeafCount 16540206.
Ever since the 1930s there have been questions about just what should count as an observation. … For certainly in the standard formalism, quantum probability amplitudes are taken to be continuous quantities in which an arbitrary number of digits can be specified.
![](/common/images/search/spacer.gif)