Search NKS | Online
81 - 90 of 121 for Table
[Converting from CAs with] more colors
Given a rule that involves three colors and nearest neighbors, the following converts each case of the rule to a collection of cases for a rule with two colors:
CA3ToCA2[{a_, b_, c_} d_] := Union[Flatten[Table[Thread[ Partition[Flatten[{l, a, b, c, r} /. coding], 11, 1] 〚 {2, 3, 4} 〛 (d /. coding)], {l, 0, 2}, {r, 0, 2}], 2]]
coding = {0 {0, 0, 0}, 1 {0, 0, 1}, 2 {0, 1, 1}}
The problem of encoding cells with several colors by blocks of black and white cells is related to standard problems in coding theory (see page 560 ).
The basic axioms for this allow forms of operators corresponding to multiplication tables for all possible commutative groups (see note above ).
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 .
For as soon as one identifies any such class of computations, one can imagine setting up a system which includes an infinite table of their results.
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 following table specifies how to enter these programs in Mathematica InputForm , using only ordinary keyboard characters:
Extended versions of (b) and (c) can be obtained from
Flatten[{IntegerDigits[1468, 2], Table[ IntegerDigits[102524348, 2], {n}], IntegerDigits[v, 2]}]
where n is a non-negative integer and v is one of
{1784, 801016, 410097400, 13304, 6406392, 3280778648}
Note that in most cases multiple copies of the same structure can travel next to each other, as seen on page 290 .
This can be done for blocks up to length n in a 1D cellular automaton with k colors using
ReversibleQ[rule_, k_, n_] := Catch[Do[ If[Length[Union[Table[CAStep[rule, IntegerDigits[i, k, m]], {i, 0, k m - 1}]]] ≠ k m , Throw[False]], {m, n}]; True]
For k = 2 , r = 1 it turns out that it suffices to test only up to n = 4 (128 out of the 256 rules fail at n = 1 , 64 at n = 2 , 44 at n = 3 and 14 at n = 4 ); for k = 2 , r = 2 it suffices to test up to n = 15 , and for k = 3 , r = 1 , up to n = 9 .
But the table below gives for example the actual algebraic formulas obtained in the case a = 4 after applying FullSimplify —and shows that these increase quite rapidly in complexity.
… 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.
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) ...} ).
This was found empirically by Carl Friedrich Gauss in 1792, based on looking at a table of primes. ( PrimePi[10 9 ] is 50,847,534 while LogIntegral[10 9 ] is about 50,849,235.)