Search NKS | Online
91 - 98 of 98 for Flatten
![](/common/images/search/spacer.gif)
With the state of a 2-color tag system encoded as an integer according to FromDigits[Reverse[list] + 1, 3] the following takes the rule for any such tag system (in the first form from page 894 ) and yields a primitive recursive function that emulates a single step in its evolution:
TSToPR[{n_, rule_}] := Fold[Apply[c, Flatten[{#1, Array[p, #
2], c[r[z, c[r[p[1], s], c[r[z, p[2]], c[r[z, r[c[s, z], c[r[c[s,
c[s, z]], z], p[2]]]], p[2]]], p[1]]], p[#2]]}]] & , c[c[r[p[1],
s], p[1], c[r[p[1], r[z, c[s, c[s, s]]]], c[c[r[z, c[r[p[1], s],
c[r[z, c[s, z]], c[r[p[1], r[z, c[r[p[1], s], c[r[z, p[2]], c[
r[z, r[c[s, z], c[r[c[s, c[s, z]], z], p[2]]]], p[2]]], p[1]]]],
p[2], p[3]]], p[1]]], p[1], p[1]], p[1]], p[2]]], p[n + 1],
MapIndexed[c[r[z, c[r[p[1], p[4]], p[2], p[3], p[4]]], c[r[z,
r[c[s, z], c[r[c[s, c[s, z]], z], p[2]]]], p[Length[#2] + 1]], #
1 〚 1 〛 , #1 〚 2 〛 ] & , Nest[Partition[#1, 2] & , Table[Nest[c[s, #] &
z, FromDigits[Reverse[IntegerDigits[i, 2, n] /. rule] + 1, 3]],
{i, 0, 2 n - 1}], n - 1], {0, n - 1}]], Range[n, 1, -1]]
(For tag system (a) from page 94 this yields a primitive recursive function of size 325.)
Universal cellular automaton
The rules for the universal cellular automaton are
{{_, 3, 7, 18, _} 12, {_, 5, 7 | 8, 0, _} 12, {_, 3, 10, 18, _} 16, {_, 5, 10 | 11, 0, _} 16, {_, 5, 8, 18, _} 7, {_, 5, 14, 0 | 18, _} 12, {_, _, 8, 5, _} 7, {_, _, 14, 5, _} 12, {_, 5, 11, 18, _} 10, {_, 5, 17, 0 | 18, _} 16, {_, _, x : (11 | 17), 5, _} x - 1, {_, 0 | 9 | 18, x : (7 | 10 | 16), 3, _} x + 1, {_, 0 | 9 | 18, 12, 3, _} 14, {_, _, 0 | 9 | 18, 7 | 10 | 12 | 16, x : (3 | 5)} 8 - x, {_, _, _, 8 | 11 | 14 | 17, x : (3 | 5)} 8 - x, {_, 13, 4, _, x : (0 | 18)} x, {18, _, 4, _, _} 18, {_, _, 18, _, 4} 18, {0, _,4, _, _} 0, {_, _, 0, _, 4} 0, {4, _, 0 | 18, 1, _} 3, {4, _, _, _, _} 4, {_, _, 4, _, _} 9, {_, 4, 12, _, _} 7, {_, 4, 16, _, _} 10, {x : (0 | 18), _, 6, _, _} x, {_, 2, 6, 15, x : (0 | 18)} x, {_, 12 | 16, 6, 7, _} 0, {_, 12 | 16, 6, 10, _} 18, {_, 9, 10, 6, _} 16, {_, 9, 7, 6, _} 12, {9, 15, 6, 7, 9} 0, {9, 15, 6, 10, 9} 18, {9, _, 6, _, _} 9, {_, 6, 7, 9, 12 | 16} 12, {_, 6, 10, 9, 12 | 16} 16, {12 | 16, 6, 7, 9, _} 12, {12 | 16, 6, 10, 9, _} 16, {6, 13, _, _, _} 9, {6, _, _, _, _} 6, {_, _, 9, 13, 3} 9, {_, 9, 13, 3, _} 15, {_, _, _, 15, 3} 3, {_, 3, 15, 0 | 18, _} 13, {_, 13, 3, _, 0 | 18} 6, {x : (0 | 18), 15, 9, _, _} x, {_, 6, 13, _, _} 15, {_, 4, 15, _, _} 13, {_, _, _, 15, 6} 6, {_, _, 2, 6, 15} 1, {_, _, 1, 6, _} 2, {_, 1, 6, _, _} 9, {_, 3, 2, _, _} 1, {3, 2, _, _, _} 3, {_, _, 3, 2, _} 3, {_, 1, 9, 1, 6} 6, {_, _, 9, 1, 6} 4, {_, 4, 2, _, _} 1, {_, _, _, _, x : (3 | 5)} x, {_, _, 3 | 5, _, x : (0 | 18)} x, {_, _, x : (1 | 2 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17), _, _} x, {_, _, 18, 7 | 10, 18} 18, {_, _, 0, 7 | 10, 0} 0, {_, _, 0 | 18, _, _} 9, {_, _, x_, _, _} x}
where the numbers correspond to the icons shown in the main text according to
The block in the initial conditions for the universal cellular automaton corresponding to a cell with color a is given by
Flatten[{Transpose[{Join[{4, 18(1 - a), 6}, Table[9, {2 2 r + 1 - 3}]], 10 - 3 rtab}], Table[{9, 1}, {r}], 9, 13}]
where r is the range of the rule to be emulated ( r = 1 for elementary rules) and rtab is the list of outcomes for that rule (starting with the outcome for {1, 1, (1) ...} ).
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 ).
The pattern corresponding to each point is the limit of Nest[Flatten[1 + {c #, Conjugate[c] #}]&, {1}, n] when n ∞ .
To next order the result is
s[d] r d (1 - RicciScalar r 2 /(6(d + 2)) + (5 RicciScalar 2 - 3 RiemannNorm + 8 RicciNorm - 18 Laplacian[RicciScalar])r 4 /(360 (d + 2)(d + 4)) + …)
where the new quantities involved are
RicciNorm = Norm[RicciTensor, {g, g}]
RiemannNorm = Norm[Riemann, {g, g, g, Inverse[g]}]
Norm[t_, gl_] := Tr[Flatten[t Dual[t, gl]]]
Dual[t_, gl_]:= Fold[Transpose[#1 .
As early as 1851, for example, Eugène Prouhet showed that if sequences of integers were partitioned according to sequence (b) on page 83 , then sums of powers of these integers would be equal: thus Apply[Plus, Flatten[Position[s, i]] k ] is equal for i = 0 and i = 1 if s is a sequence of the form (b) on page 83 with length 2 m , m > k .
And rules that involve more than two cells can be obtained by having several instances of ⊕ —which can always be flattened.
(Starting with initial condition x the digit sequence at step n is essentially
IntegerDigits[Mod[2 n Floor[2 53 x], 2 53 ], 2, 53]
on the computer, and
Flatten[IntegerDigits[IntegerDigits[ Mod[2 n Floor[10 12 x], 10 12 ], 10, 12], 2, 4]]
on the calculator.
![](/common/images/search/spacer.gif)