With a list s of possible symbols, c[s, n] gives all possible expressions with LeafCount[expr]  n : c[s_, 1] = s; c[s_, n_] := Flatten[ Table[Outer[#1[#2] &, c[s, n - m], c[s, m]], {m, n - 1}]] There are a total of Binomial[2n - 2, n - 1] Length[s] n /n such expressions.

Iterated run-length encoding Starting say with {1} consider repeatedly replacing list by (see page 1070 ) Flatten[Map[{Length[#], First[#]} &, Split[list]]] The resulting sequences contain only the numbers 1, 2 and 3, but otherwise at first appear fairly random.

Flatten[MapIndexed[ c[dlist, Reverse[#2]]  #1 &, Reverse[data], {2}], 1]

Fractal dimensions [of additive cellular automata] The total number of nonzero cells in the first t rows of the pattern generated by the evolution of an additive cellular automaton with k colors and weights w (see page 952 ) from a single initial 1 can be found using g[w_, k_, t_] := Apply[Plus, Sign[NestList[Mod[ ListCorrelate[w, #, {-1, 1}, 0], k] &, {1}, t - 1]], {0, 1}] The fractal dimension of this pattern is then given by the large m limit of Log[k,g[w, k,k m + 1 ]/g[w, k, k m ]] When k is prime it turns out that this can be computed as d[w_, k_:2] := Log[k,Max[Abs[Eigenvalues[With[ {s = Length[w] - 1}, Map[Function[u, Map[Count[u, #] &, #1]], Map[Flatten[Map[Partition[Take[#, k + s - 1], s, 1] &, NestList[Mod[ListConvolve[w, #], k] &, #, k - 1]], 1] &, Map[Flatten[Map[{Table[0, {k - 1}], #} &, Append[#, 0]]] &, #]]] &[Array[IntegerDigits[#, k, s] &, k s - 1]]]]]]] For rule 90 one gets d[{1, 0, 1}] = Log[2, 3] ≃ 1.58 .

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

The pattern after n steps is then given by Nest[Flatten[f[#]] &, {0}, n] , where for the rule on page 189 f[z_] = 1/2 (1 -  ) {z + 1/2, z - 1/2} ( f[z_] = (1 -  ){z + 1, z} gives a transformed version).

The number of sequences s n of length n that can actually occur is given by Apply[Plus, Flatten[MatrixPower[m, n]]] where the adjacency matrix m is given by MapAt[(1 + #) &, Table[0, {Length[net]}, {Length[net]}], Flatten[MapIndexed[{First[#2], Last[#1]} &, net, {2}], 1]] For rule 32, for example, s n turns out to be Fibonacci[n + 3] , so that for large n it is approximately GoldenRatio n .

Logic circuits [from cellular automata] The rules for the cellular automaton shown here are {{0, 1, 1 | 3}  1, {0, 3, 3}  3, {1, 0, 0 | 1 | 3}  1, {1, 1, 3}  4, {1, 3, 0}  3, {1, 3, 3}  2, {2, 1, 3}  3, {2, 3, 0}  2, {2, 0, _}  4, {3, 3, 0}  3, {4, 0, 0 | 1 | 2 | 4}  2, {4, 3, 3}  3, {4, 1, 3}  1, {4, 3, 0}  4, {_, _, _}  0} The initial conditions are given by Flatten[Block[{And, Or}, Map[{0, 2 (# + 1)} &, expr, {-1}] //. {!

[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}

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