Note that BitOr[x, y] + BitAnd[x, y]  x + y and BitOr[x, y] - BitAnd[x, y]  BitXor[x, y] .

Implementing boundary conditions [in cellular automata] In the bitwise representation discussed on page 865 , 0's outside of a width n can be implemented by applying BitAnd[a, 2 n -1] at each step.

, a]  1 ∧ a > 1) a  BitAnd[c, d] ∧ b  BitOr[c, d] ↔ ( σ [c, a] ∧ σ [d, a] ∧ σ [b, c] ∧ σ [b, d] ∧ a + b  c + d)/. σ [x_, y_]  Mod[Binomial[x, y], 2]  1 where the last encoding uses the result on page 608 . … The corresponding form for rule 110 is BitXor[BitAnd[a, 2a, 4a], BitOr[2a, 4a]] The final equation is then obtained from {1 + x 4 + x 12  2 (1 + x 3 ) (x 1 + 2 x 3 ) , x 2 + x 13  2 x 1 , 1 + x 5 + x 14  2 x 1 , 2 x 3 x 5 + 2 x 1 + 2 x 3 x 6 + 2 x 1 + x 3 x 15 + x 16  x 4 , 1 + x 15 + x 17  2 x 3 , 1 + x 16 + x 18  2 x 3 , 2 1 + x 3 (1 + x 1 + 2 x 3 ) (-1 + x 2 ) - x 10 + x 11  2 x 4 , x 7  BitAnd[x 6 , 2 x 6 ] ∧ x 8  BitOr[x 6 , 2 x 6 ], x 9  BitAnd[x 6 , 2 x 7 ] ∧ x 19  BitOr[x 6 , 2 x 7 ], x 10  BitAnd[x 9 , 2 x 8 ] ∧ x 11  BitOr[x 9 , 2 x 8 ]} where x 1 through x 4 have the meanings indicated in the main text, and satisfy x i ≥ 0 . Non-overlapping subsidiary variables are introduced for BitOr and BitAnd , yielding a total of 79 variables.

[Generating sequences with] unequal probabilities Given a sequence a of n equally probable 0's and 1's, the following generates a single 0 or 1 with probabilities approximating {1 - p, p} to n digits: Fold[({BitAnd, BitOr} 〚 1 + First[#2] 〛 [#1, Last[#2]]) &, 0, Reverse[Transpose[{First[RealDigits[p, 2, n, -1]], a}]]] This can be generalized to allow a whole sequence to be generated with as little as an average of two input digits being used for each output digit.

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]]

The first one on the bottom (with 63 comparisons) has a nested structure and uses the method invented by Kenneth Batcher in 1964: Flatten[Reverse[Flatten[With[{m = Ceiling[Log[2, n]] - 1}, Table[With[{d = If[i  m, 2 t , 2 i + 1 - 2 t ]}, Map[ {0, d} + # &, Select[Range[n - d], BitAnd[# - 1, 2 t ]  If[i  m, 0, 2 t ] &]]], {t, 0, m}, {i, t, m}]], 1]], 1] The second one on the bottom also uses 63 comparisons, while the last one is the smallest known for n = 16 : it uses 60 comparisons and was invented by Milton Green in 1969.

Sierpiński pattern Other ways to generate step n of the pattern shown here in various orientations include: • Mod[Array[Binomial, {2, 2} n , 0], 2] (see pages 611 and 870 ) • 1 - Sign[Array[BitAnd, {2, 2} n , 0]] (see pages 608 and 871 ) • NestList[Mod[RotateLeft[#] + #, 2] &, PadLeft[{1}, 2 n ], 2 n - 1] (see page 870 ) • NestList[Mod[ListConvolve[{1, 1}, #, -1], 2] &, PadLeft[{1}, 2 n ], 2 n - 1] (see page 870 ) • IntegerDigits[NestList[BitXor[2#, #] &, 1, 2 n - 1], 2, 2 n ] (see page 906 ) • NestList[Mod[Rest[FoldList[Plus, 0, #]], 2] &, Table[1, {2 n }], 2 n - 1] (see page 1034 ) • Table[PadRight[ Mod[CoefficientList[(1 + x) t - 1 , x], 2], 2 n - 1], {t, 2 n }] (see pages 870 and 951 ) • Reverse[Mod[CoefficientList[Series[1/(1 - (1 + x)y), {x, 0, 2 n - 1}, {y, 0, 2 n - 1}], {x, y}], 2]] (see page 1091 ) • Nest[Apply[Join, MapThread[ Join, {{#, #}, {0 #, #}}, 2]] &, {{1}}, n] (compare page 1073 ) The positions of black squares can be found from: • Nest[Flatten[2# /.

In some earlier versions of Mathematica a considerably faster version of the program can be created by using the definition CAStep = Compile[{{rule, _Integer, 1}, {a, _Integer, 1}}, rule 〚 8 - (RotateLeft[a] + 2 (a + 2 RotateRight[a])) 〛 ] In addition, in Mathematica 4 and above, one can use CAStep[rule_, a_]:=rule 〚 8 - ListConvolve[{1, 2, 4}, a, 2]]] 〛 or directly in terms of the rule number num Sign[BitAnd[2^ListConvolve[{1, 2, 4}, a, 2], num]] (In versions of Mathematica subsequent to the release of this book the built-in CellularAutomaton function can be used, as discussed on page 867 .)

CTToR110[rules_ /; Select[rules, Mod[Length[#], 6] ≠ 0 &]  {}, init_] := Module[{g1, g2, g3, nr = 0, x1, y1, sp}, g1 = Flatten[ Map[If[#1 === {}, {{{2}}}, {{{1, 3, 5 - First[#1]}}, Table[ {4, 5 - # 〚 n 〛 }, {n, 2, Length[#]}]}] &, rules] /. a_Integer  Map[({d[# 〚 1 〛 , # 〚 2 〛 ], s[# 〚 3 〛 ]}) &, Partition[c[a], 3]], 4]; g2 = g1 = MapThread[If[#1 === #2 === {d[22, 11], s3}, {d[ 20, 8], s3}, #1] &, {g1, RotateRight[g1, 6]}]; While[Mod[ Apply[Plus, Map[# 〚 1, 2 〛 &, g2, 30] ≠ 0, nr++; g2 = Join[ g2, g1]]; y1 = g2 〚 1, 1, 2 〛 - 11; If[y1 < 0, y1 += 30]; Cases[ Last[g2] 〚 2 〛 , s[d[x_, y1], _, _, a_]  (x1 = x + Length[a])]; g3 = Fold[sadd, {d[x1, y1], {}}, g2]; sp = Ceiling[5 Length[ g3 〚 2 〛 ]/(28 nr) + 2]; {Join[Fold[sadd, {d[17, 1], {}}, Flatten[Table[{{d[sp 28 + 6, 1], s[5]}, {d[398, 1], s[5]}, { d[342, 1], s[5]}, {d[370, 1], s[5]}}, {3}], 1]] 〚 2 〛 , bg[ 4, 11]], Flatten[Join[Table[bgi, {sp 2 + 1 + 24 Length[init]}], init /. {0  init0, 1  init1}, bg[1, 9], bg[6, 60 - g2 〚 1, 1, 1 〛 + g3 〚 1, 1 〛 + If[g2 〚 1, 1, 2 〛 < g3 〚 1, 2 〛 , 8, 0]]]], g3 〚 2 〛 }] s[1] = struct[{3, 0, 1, 10, 4, 8}, 2]; s[2] = struct[{3, 0, 1, 1, 619, 15}, 2]; s[3] = struct[{3, 0, 1, 10, 4956, 18}, 2]; s[4] = struct[{0, 0, 9, 10, 4, 8}]; s[5] = struct[{5, 0, 9, 14, 1, 1}]; {c[1], c[2]} = Map[Join[{22, 11, 3, 39, 3, 1}, #] &, {{63, 12, 2, 48, 5, 4, 29, 26, 4, 43, 26, 4, 23, 3, 4, 47, 4, 4}, {87, 6, 2, 32, 2, 4, 13, 23, 4, 27, 16, 4}}]; {c[3], c[4], c[5]} = Map[Join[#, {4, 17, 22, 4, 39, 27, 4, 47, 4, 4}] &, {{17, 22, 4, 23, 24, 4, 31, 29}, {17, 22, 4, 47, 18, 4, 15, 19}, {41, 16, 4, 47, 18, 4, 15, 19}}] {init0, init1} = Map[IntegerDigits[216 (# + 432 10 49 ), 2] &, {246005560154658471735510051750569922628065067661, 1043746165489466852897089830441756550889834709645}] bgi = IntegerDigits[9976, 2] bg[s_, n_] := Array[bgi 〚 1 + Mod[# - 1, 14] 〛 &, n, s] ev[s[d[x_, y_], pl_, pr_, b_]] := Module[{r, pl1, pr1}, r = Sign[BitAnd[2^ListConvolve[{1, 2, 4}, Join[bg[pl - 2, 2], b, bg[pr, 2]]], 110]]; pl1 = (Position[r - bg[pl + 3, Length[r]], 1 | -1] /. {}  {{Length[r]}}) 〚 1, 1 〛 ; pr1 = Max[pl1, (Position[r - bg[pr + 5 - Length[r], Length[r]], 1 | -1] /. {}  {{1}}) 〚 -1, 1 〛 ]; s[d[x + pl1 - 2, y + 1], pl1 + Mod[pl + 2, 14], 1 + Mod[pr + 4, 14] + pr1 - Length[r], Take[r, {pl1, pr1}]]] struct[{x_, y_, pl_, pr_, b_, bl_}, p_Integer : 1] := Module[ {gr = s[d[x, y], pl, pr, IntegerDigits[b, 2, bl]], p2 = p + 1}, Drop[NestWhile[Append[#, ev[Last[#]]] &, {gr}, If[Rest[Last[#]] === Rest[gr], p2--]; p2 > 0 &], -1]] sadd[{d[x_, y_], b_}, {d[dx_, dy_], st_}] := Module[{x1 = dx - x, y1 = dy - y, b2, x2, y2}, While[y1 > 0, {x1, y1} += If[Length[st]  30, {8, -30}, {-2, -3}]]; b2 = First[Cases[st, s[d[x3_, -y1], pl_, _, sb_]  Join[bg[pl - x1 - x3, x1 + x3], x2 = x3 + Length[sb]; y2 = -y1; sb]]]; {d[x2, y2], Join[b, b2]}] CTToR110[{{}}, {1}] yields blocks of lengths {7204, 1873, 7088} .