 [i, k], {i, 0, t - 1}, {j, stot}, {k, j + 1, stot}], Table[Apply[Or, Table[  [i, j], {j, n + i, Max[0, n - i], -2}]], {i, 0, t}], Table[! …  [i, k], {i, 0, t}, {j, n + i, Max[0, n - i], -2}, {k, j + 2, n + i}], Table[Apply[Or, Table[  [i, j, k], {k, 0, ktot - 1}]], {i, 0, t - 1}, {j, Max[1, n - i], n + i}], Table[! …  [i, j, k] || If[EvenQ[n + i - j],  [i, j], False] ||  [i + 1, j, k], {i, 0, t - 2}, {j, Max[1, n - i], n + i}, {k, 0, ktot - 1}], Table[Map[Function[ z, Outer[!

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 TM cellular automaton] Given a non-deterministic Turing machine with rules in the form above, the rules for a cellular automaton which emulates it can be obtained from NDTMToCA[tm_] := Flatten[{{_, h, _}  h, {s, _c, _}  e, {s, _, _}  s, {_, s, c[i_]}  s[i], {_, s, x_}  x, {a[_, _], _s, _}  s, {_, a[x_, y_], s[i_]}  a[x, y, i], {x_, _s, _}  x, {_, _, s[i_]}  s[i], Map[Table[With[{b = (# 〚 Min[Length[#], z] 〛 &)[ {x, #} /. tm]}, If[Last[b]  -1, {{a[_], a[x, #, z], e}  h, {a[ _], a[x, #, z], s}  a[x, #, z], {a[_], a[x, #, z], _}  a[b 〚 2 〛 ], {a[x, #, z], a[w_], _}  a[b 〚 1 〛 , w], {_, a[w_], a[x, #, z]}  a[w]}, {{a[_], a[x, #, z], _}  a[b 〚 2 〛 ], {a[x, #, z], a[w_], _}  a[w], {_, a[w_], a[x, #, z]}  a[b 〚 1 〛 , w]}]], {x, Max[Map[# 〚 1, 1 〛 &, tm]]}, {z, Max[Map[Length[# 〚 2 〛 ] &, tm]]}] &, Union[Map[# 〚 1, 2 〛 &, tm]]], {_, x_, _}  x}]

For any sequence s this can be done using Module[{c, m = 0}, Map[c[#] = {m, m += Count[s, #]/Length[s]} &, Union[s]]; Function[x, (First[RealDigits[2 # Ceiling[2 -# Min[x]], 2, -#, -1]] &)[Floor[Log[2, Max[x] - Min[x]]]]][ Fold[(Max[#1] - Min[#1]) c[#2] + Min[#1] &, {0, 1}, s]]] Huffman coding of a sequence containing a single 0 block together with n 1 blocks will yield output of length about n ; arithmetic coding will yield length about Log[n] .

With a concentrations list c , the position p of a new element is given by Position[c, Max[c], 1, 1] 〚 1, 1 〛 , while the new list of concentrations is λ c + RotateRight[f, p] where f is a list of depletions associated with addition of a new element at position 1.

Ulam systems Having formulated the system around 1960, Stanislaw Ulam and collaborators (see page 877 ) in 1967 simulated 120 steps of the process shown below, with black cells after t steps occurring at positions Map[First, First[Nest[UStep[p[q[r[#1], #2]] &, {{1, 0}, {0, 1}, {-1, 0}, {0, -1}}, #] &, ({#, #} &)[{{{0, 0}, {0, 0}}}], t]]] UStep[f_, os_, {a_, b_}] := {Join[a, #], #} &[f[Flatten[ Outer[{#1 + #2, #1} &, Map[First, b], os, 1], 1], a]] r[c_]:= Map[First, Select[Split[Sort[c], First[#1]  First[#2] &], Length[#]  1 &]] q[c_, a_] := Select[c, Apply[And, Map[Function[u, qq[#1, u, a]], a]] &] p[c_]:= Select[c, Apply[And, Map[Function[u, pp[#1, u]], c]] &] pp[{x_, u_}, {y_, v_}] := Max[Abs[x - y]] > 1 || u  v qq[{x_, u_}, {y_, v_}, a_] := x  y || Max[Abs[x - y]] > 1 || u  y || First[Cases[a, {u, z_}  z]]  y These rules are fairly complicated, and involve more history than ordinary cellular automata.

Intrinsically defined curves With curvature given by a function f[s] of the arc length s , explicit coordinates {x[s], y[s]} of points are obtained from (compare page 1048 ) NDSolve[{x'[s]  Cos[ θ [s]], y'[s]  Sin[ θ [s]], θ '[s]  f[s], x[0]  y[0]  θ [0]  0}, {x, y, θ }, {s, 0, s max }] For various choices of f[s] , formulas for {x[s], y[s]} can be found using DSolve : f[s] = 1: {Sin[ θ ], Cos[ θ ]} f[s] = s: {FresnelS[ θ ], FresnelC[ θ ]} f[s] = 1/ √ s : √ θ {Sin[ √ θ ], Cos[ √ θ ]} f[s] = 1/s: θ {Cos[Log[ θ ]], Sin[Log[ θ ]]} f[s] = 1/s 2 : θ {Sin[1/ θ ], Cos[1/ θ ]} f[s] = s n : result involves Gamma[1/n, ±  θ n/n ] f[s] = Sin[s] : result involves Integrate[Sin[Sin[ θ ]], θ ] , expressible in terms of generalized Kampé de Fériet hypergeometric functions of two variables. When s max  ∞ , f[s] = a s Sin[s] yields 2D shapes that are basically nested, with pieces overlapping for Abs[a] < 1 .

Lengths of [number] representations (a) n , (b) Floor[Log[2, n] + 1] , (c) Tr[FixedPointList[Max[0, Ceiling[Log[2, #]]] &, n + 2]] - n - 3 , (d) 2 Ceiling[Log[3, 2n + 1]] , (e) Floor[Log[GoldenRatio, √ 5 (n + 1/2)]] .

_Symbol  1 //. x_[y_]  1 + Max[x, y] .)

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 .)