Search NKS | Online

Runs of digits [in numbers] One can consider any base 2 digit sequence as consisting of successive runs of 0's and 1's, constructed from the list of run lengths by Fold[Join[#1, Table[1 - Last[#1], {#2}]] &, {0}, list] This representation is related to so-called surreal numbers (though with the first few digits different). The number with run lengths corresponding to successive integers (so that the n th digit is Mod[Floor[1/2 + Sqrt[2n]], 2] ) turns out to be (1 - 2 1/4 EllipticTheta[2, 0, 1/2] + EllipticTheta[3, 0, 1/2])/2 , and appears at least not to be algebraic.
The programs in these notes were created for Mathematica 4.1 (released 2000). They should run without any change in all subsequent versions of Mathematica, and the majority will also run in prior versions, all the way back to Mathematica 1 (released 1988) or Mathematica 2 (released 1990). … 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 .
Rule structure [for network systems] For depth 1, the possible results from NeighborNumbers are {1} and {2} . For depth 2, they are {1, 1} , {1, 2} , {2, 1} , {2, 2} , {2, 3} and {2, 4} .
Computations with register machines As an example, the following program for a 3-register machine starting with initial condition {n, 0, 0} will compute {Round[ √ n ], 0, 0} : {d[1, 4], i[1], d[1, 15], i[2], d[1, 6], d[1, 11], i[1], d[2, 7], d[3, 7], d[1, 15], d[3, 4], i[3], d[2, 12], d[3, 4]}
Representing the strings by lists, one can write rules in the form {{1, 1, s___}  {s, 1, 0}, {1, s___}  {s, 1, 0, 1}} so that the evolution is given by MWTSEvolve[rule_, list_, t_] := Nest[Flatten[Map[ReplaceList[#, rule] &, #], 1] &, list, t]
numbers that specify the horizontal and vertical positions of the square, the square is white whenever this factor is 1, and is black otherwise. … Given the horizontal and vertical positions x and y a square is white when GCD[x, y]  1 and is black otherwise. The condition GCD[x, y]  1 is equivalent to the statement that x and y are relatively prime, or that no reduction is required to bring the fraction x/y to lowest terms.
Cyclic tag systems [emulating tag systems] From a tag system which depends only on its first element, with rules given as in the note below, the following constructs a cyclic tag system emulating it: TS1ToCT[{n_, subs_}] := With[{k = Length[subs]}, Join[Map[v[Last[#], k] &, subs], Table[{}, {k(n - 1)}]]] u[i_, k_] := Table[If[j  i + 1, 1, 0], {j, k}] v[list_, k_] := Flatten[Map[u[#, k] &, list]] The initial condition for the tag system can be converted using v[list, k] . The list representing the complete history of the resulting cyclic tag system can then be interpreted using Map[Map[Position[#, 1] 〚 1, 1 〛 - 1 &, Partition[#, k]] &, Take[history, {1, -1, n k}]] This construction is relevant to the proof of the universality of rule 110 starting on page 678 .
Extended instruction sets [for register machines] One can consider also including instructions such as RMExecute[eq[r1_, r2_, m_], {n_, list_}] := If[list 〚 r1 〛  list 〚 r2 〛 , {m, list}, {n + 1, list}] RMExecute[add[r1_, r2_], {n_, list_}] := {n + 1, ReplacePart[list, list 〚 r1 〛 + list 〚 r2 〛 , r1]} RMExecute[jmp[r1_], {n_, list_}] := {list 〚 r1 〛 , list} Note that by being able to add and subtract only 1 at each step, the register machines shown in the main text necessarily operate quite slowly: they always take at least n steps to build up a number of size n .
[Examples of] reducible systems The color of a cell at step t and position x can be found by starting with initial condition Flatten[With[{w = Max[Ceiling[Log[2, {t, x}]]]}, {2 Reverse[IntegerDigits[t, 2, w]] + 1, 5, 2 IntegerDigits[x, 2, w] + 2}]] then for rule 188 running the cellular automaton with rule {{a : (1 | 3), 1 | 3, _}  a, {_, 2 | 4, a : (2 | 4)}  a, {3, 5 | 10, 2}  6, {1, 5 | 7, 4}  0, {3, 5, 4}  7, {1, 6, 2}  10, {1, 6 | 11, 4}  8, {3, 6 | 8 | 10 | 11, 4}  9, {3, 7 | 9, 2}  11, {1, 8 | 11, 2}  9, {3, 11, 2}  8, {1, 9 | 10, 4}  11, {_, a_ /; a > 4, _}  a, {_, _, _}  0} and for rule 60 running the cellular automaton with rule {{a : (1 | 3), 1 | 3, _}  a, {_, 2 | 4, a : (2 | 4)}  a, {1, 5, 4}  0, {_, 5, _}  5, {_, _, _}  0}
The formulas for local curvature as a function of arc length for each set of pictures are as follows: 1 (circle); s (Cornu spiral or clothoid); s 2 ; 1/Sqrt[s] (involute of circle); 1/s (logarithmic or equiangular spiral); 1/s 2 ; Exp[-s 2 ] ; Sin[s] ; s Sin[s] .
1 ... 78910 ...