Digit counts The number of black squares on row n in the pattern shown here is given by DigitCount[n, 2, 1] and is plotted below. … Note the inequality 1 ≤ DigitCount[n, 2, 1] ≤ Log[2, n] . Formulas for DigitCount[n, 2, 1] include n - IntegerExponent[n!

The number of black cells on row t is given by 2^DigitCount[t, 2, 1] , where DigitCount[t, 2, 1] is plotted on page 902 . The positions of the black cells are given by (and this establishes the connection with the picture on page 117 ) Fold[Flatten[{#1 - #2, #1 + #2}] &, {0}, 2^DigitPositions[t]] DigitPositions[n_] := Flatten[Position[Reverse[IntegerDigits[n, 2]], 1]] - 1 The actual pattern generated by rule 90 corresponds to the coefficients in PolynomialMod[Expand[(1/x + x) t ], 2] (see page 1091 ); the color of a particular cell is thus given by Mod[Binomial[t, (n + t)/2], 2] /; EvenQ[n + t] . … In this pattern, the color of a particular cell can be obtained directly from the digit sequences for t and n by 1 - Sign[BitAnd[-t, n]] or (see page 583 ) With[{d = Ceiling[Log[2, Max[t, n] + 1]]}, If[FreeQ[ IntegerDigits[t, 2, d] - IntegerDigits[n, 2, d], -1], 1, 0]]

Density in rule 90 From the superposition principle above and the number of black cells at step t in a pattern starting from a single black cell (see page 870 ) one can compute the density after t steps in the evolution of rule 90 with initial conditions of density p to be (see also page 602 ) 1/2 (1 - (1 - 2 p)^(2^DigitCount[t,2,1]))

Digit count sequences Starting say with {1} repeatedly replace list by Join[list, IntegerDigits[Apply[Plus, list], 2]] The resulting sequences grow in length roughly like n Log[n] .

In d dimensions (2d)^DigitCount[t, 2, 1] cells are black at step t .

The number of nodes at distance up to r from a given node is at most 1 + Sum[c[i] + c[i - 1], {i, n}] where c[i_] := 2^DigitCount[i, 2] .

The idea of arithmetic coding is to represent each such bin by the digit sequence of the shortest number within the bin—after trailing zeros have been dropped. 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] .

Properties of [recursive] sequences Sequence (d) is given by f[n_] := (n + g[IntegerDigits[n, 2]])/2 g[{1 ..}] = 1; g[{1, 0 ..}] = 0 g[{1, s__}] := 1 + g[IntegerDigits[FromDigits[{s}, 2] + 1, 2]] The list of elements in the sequence up to value m is given by Flatten[Table[Table[n, {IntegerExponent[n, 2] + 1}], {n, m}]] The differences between the first 2 (2 k -1) of these elements is Nest[Replace[#, {x___}  {x, 1, x, 0}]&, {}, k] The largest n for which f[n]  m is given by 2m + 1 - DigitCount[m, 2, 1] or IntegerExponent[(2m)!… Hump m in the picture of sequence (c) shown is given by FoldList[Plus, 0, Flatten[Nest[Delete[NestList[Rest, #, Length[#] - 1], 2]&, Append[Table[1, {m}], 0], m]] - 1/2] The first 2 m elements in the sequence can also be generated in terms of reordered base 2 digit sequences by FoldList[Plus, 1, Map[Last[Last[#]]&, Sort[Table[{Length[#], Apply[Plus, #], 1 - #}& [ IntegerDigits[i, 2]], {i, 2 m }]]]] Note that the positive and negative fluctuations in sequence (f) are not completely random: although the probability for individual fluctuations in each direction seems to be the same, the probability for two positive fluctuations in a row is smaller than for two negative fluctuations in a row.

Defining PM[s_] := IntegerDigits[Range[2 s - 1], 2, s] blocks of data of length m can be encoded with Join[data, Mod[data . Select[PM[s], Count[#, 1] > 1 &], 2]] while blocks of length n (and at most one error) can be decoded with Drop[(If[#  0, data, MapAt[1 - # &, data, #]] &)[ FromDigits[Mod[data .

One can count the number of occurrences of each of the k b possible blocks of length b in a given state using BC[list_] := With[{z = Map[FromDigits[#, k] &, Partition[list, b, 1, 1]]}, Map[Count[z, #] &, Range[0, k b - 1]]] Conserved quantities of the kind discussed here are then of the form q .