Given a list of blocks such as {{1, 1}, {0}} each element of Flatten[list] can be thought of as a state in a finite automaton or a Markov process (see page 1084 ). The transitions between these states have probabilities given by m[Map[Length, list]] where m[s_] := With[{q = FoldList[Plus, 0, s]}, ReplacePart[ RotateRight[IdentityMatrix[Last[q]], {0, 1}], 1/Length[s], Flatten[Outer[List, Rest[q], Drop[q, -1] + 1], 1]]] The average spectrum of sequences generated according to these probabilities can be obtained by computing the correlation function for elements a distance r apart ξ [list_, r_] := With[{w = (# - Apply[Plus, #]/Length[#] &)[ Flatten[list]]}, w . MatrixPower[ m[Map[Length, list]], r] . w/Length[w]] then forming Sum[ ξ [Abs[r]] Cos[2 π r ω ], {r, -n/2, n/2}] and taking the limit n  ∞ .

Then the rules for the language consisting of balanced runs of parentheses (see page 939 ) can be written as {s[e]  s[e, e], s[e]  s["(", e, ")"], s[e]  s["(",")"]} Different expressions in the language can be obtained by applying different sequences of these rules, say using (this gives so-called leftmost derivations) Fold[# /. rules 〚 #2 〛 &, s[e], list] Given an expression, one can then use the following to find a list of rules that will generate it—if this exists: Parse[rules_, expr_] := Catch[Block[{t = {}}, NestWhile[ ReplaceList[#, MapIndexed[ReverseRule, rules]] &, {{expr, {}}}, (# /. … = {}) &];]] ReverseRule[a_  b_, {i_}] := {___, {s[x___, b, y___], {u___}}, ___}  {s[x, a, y], {i, u}} /; FreeQ[s[x], s[a]] In general, there will in principle be more than one such list, and to pick the appropriate list in a practical situation one normally takes the rules of the language to apply with a certain precedence—which is how, for example, x + y z comes to be interpreted in Mathematica as Plus[x, Times[y, z]] rather than Times[Plus[x, y], z] .

New expressions are also created by replacing each possible variable with x ⊼ y , where x and y are new variables, and by setting every possible pair of variables equal in turn. … Pages 818 and 1175 discuss the sequence of all Nand theorems listed in order of increasing complexity.

Mobile automata [emulating cellular automata] Given the rules for an elementary cellular automaton in the form used on page 867 , the following will construct a mobile automaton which emulates it: vals = {x, p[0], q[0, 0], q[0, 1], q[1, 0], q[1, 1], p[1]} CAToMA[rules_] := Table[(#  Replace[#, {{q[a_, b_], p[c_], p[d_]}  {q[c, {a, c, d} /. rules], 1}, {q[a_, b_], p[c_], x}  {q[c, {a, c, 0} /. rules], 1}, {q[_, _], x, x}  {p[0], -1}, {q[_, _], q[_, a_], p[_]}  {p[a], -1}, {x, q[_, a_], p[_]}  {p[a], -1}, {x, x, p[_]}  {q[0, 0], 1}, {_, _, _}  {x, 0}}]) &[vals 〚 IntegerDigits[i, 7, 3] + 1 〛 ], {i, 0, 7 3 - 1}] The ordering in vals defines a mapping of symbolic cell values onto colors. Given a list of initial cell colors for the cellular automaton, the initial conditions for the mobile automaton are given by Flatten[{p[0], Map[p, list], p[0]}] surrounded by x 's, with the active cell being placed initially just before the first p[0] .

Thus, for example, rule 30 can be given as {{1, 1, 1}  0, {1, 1, 0}  0, {1, 0, 1}  0, {1, 0, 0}  1, {0, 1, 1}  1, {0, 1, 0}  1, {0, 0, 1}  1, {0, 0, 0}  0} To use rules in this form, CAStep can be rewritten as CAStep[rule_, a_List] := Transpose[{RotateRight[a], a, RotateLeft[a]}] /. rule or CAStep[rule_, a_List] := Partition[a, 3, 1, 2] /. rule The rules that are given can now contain patterns, so that rule 90, for example, can be written as {{1, _, 1}  0, {1, _, 0}  1, {0, _, 1}  1, {0, _, 0}  0} But how can one set up a program that can handle rules in several different forms? … Then, for example, one can define CAStep[ElementaryCARule[rule_List], a_List] := rule 〚 8 - (RotateLeft[a] + 2 (a + 2 RotateRight[a])) 〛 CAStep[GeneralCARule[rule_, r_Integer:1], a_List] := Partition[a, 2r + 1, 1, r + 1] /. rule CAStep[FunctionCARule[f_, r_Integer:1], a_List] := Map[f, Partition[a, 2r + 1, 1, r + 1]] Note that the second two definitions have been generalized to allow rules that involve r neighbors on each side. In each case, the use of Partition could be replaced by Transpose[Table[RotateLeft[a, i], {i, -r, r}]] .

Starting with a list of nodes, the nodes reached by following arcs with value a for one step are given by NetStep[net_, i_, a_] := Union[ReplaceList[a, Flatten[net 〚 i 〛 ]]] A list of values then corresponds to a path in the network starting from any node if Fold[NetStep[net, #1, #2]&, Range[Length[net]], list] =!… = {}, AllNet[k], q = ISets[b = Map[Table[ Position[d, NetStep[net, #, a]] 〚 1, 1 〛 , {a, 0, k - 1}]&, d]]; DeleteCases[MapIndexed[#2 〚 2 〛 - 1  #1 &, Rest[ Map[Position[q, #] 〚 1, 1 〛 &, Transpose[Map[Part[#, Map[ First, q]]&, Transpose[b]]], {2}]] - 1, {2}], _  0, {2}]]] DSets[net_, k_:2] := FixedPoint[Union[Flatten[Map[Table[NetStep[net, #, a], {a, 0, k - 1}]&, #], 1]]&, {Range[Length[net]]}] ISets[list_] := FixedPoint[Function[g, Flatten[Map[ Map[Last, Split[Sort[Part[Transpose[{Map[Position[g, #] 〚 1, 1 〛 &, list, {2}], Range[Length[list]]}], #]], First[#1]  First[#2]&], {2}]&, g], 1]], {{1}, Range[2, Length[list]]}] If net has q nodes, then in general MinNet[net] can have as many as 2 q -1 nodes. … To obtain such trimmed networks one can apply the function TrimNet[net_] := With[{m = Apply[Intersection, Map[FixedPoint[ Union[#, Flatten[Map[Last, net 〚 # 〛 , {2}]]]&, #]&, Map[List, Range[Length[net]]]]]}, net 〚 m 〛 /.

An initial condition consisting of n white cells with one black cell in the middle can then be obtained with the function (see below for comments on this and other Mathematica functions) CenterList[n_Integer] := ReplacePart[Table[0, {n}], 1, Ceiling[n/2]] For cellular automata of the kind discussed in this chapter, the rule can also be represented by a list. Thus, for example, rule 30 on page 27 corresponds to the list {0, 0, 0, 1, 1, 1, 1, 0} . … In general, the list for a particular rule can be obtained with the function ElementaryRule[num_Integer] := IntegerDigits[num, 2, 8] Given a rule together with a list representing the state a of a cellular automaton at a particular step, the following simple function gives the state at the next step: CAStep[rule_List, a_List] := rule 〚 8 - (RotateLeft[a] + 2 (a + 2 RotateRight[a])) 〛 A list of states corresponding to evolution for t steps can then be obtained with CAEvolveList[rule_, init_List, t_Integer] := NestList[CAStep[rule, #]&, init, t] Graphics of this evolution can be generated using CAGraphics[history_List] := Graphics[ Raster[1 - Reverse[history]], AspectRatio  Automatic] And having set up the definitions above, the Mathematica input Show[CAGraphics[CAEvolveList[ ElementaryRule[30], CenterList[103], 50]]] will generate the image: The description just given should be adequate for most cellular automaton simulations.

DNF minimization From a table of values for a Boolean function one can immediately get a DNF representation just by listing cases where the value is 1. … Given an original DNF list s , this can be done using PI[s, n] : PI[s_, n_] := Union[Flatten[ FixedPointList[f[Last[#], n] &, {{}, s}] 〚 All, 1 〛 , 1]] g[a_, b_] := With[{i = Position[Transpose[{a, b}], {0,1}]}, If[Length[i]  1 && Delete[a, i] === Delete[b, i], {ReplacePart[a, _, i]}, {}]] f[s_, n_] := With[ {w = Flatten[Apply[Outer[g, #1, #2, 1] &, Partition[Table[ Select[s, Count[#, 1]  i &], {i, 0, n}], 2, 1], {1}], 3]}, {Complement[s, w, SameTest  MatchQ], w}] The minimal DNF then consists of a collection of these prime implicants. … Given the original list s and the complete prime implicant list p the so-called Quine–McCluskey procedure can be used to find a minimal list of prime implicants, and thus a minimal DNF: QM[s_, p_] := First[Sort[Map[p 〚 # 〛 &, h[{}, Range[Length[s]], Outer[MatchQ, s, p, 1]]]]] h[i_, r_, t_] := Flatten[Map[h[Join[i, r 〚 # 〛 ], Drop[r, #], Delete[Drop[t, {}, #], Position[t 〚 All, # 〛 ], {True}]]] &, First[Sort[Position[#, True] &, t]]]], 1] h[i_, _, {}] := {i} The number of steps required in this procedure can increase exponentially with the length of p .

Implementation [of basic aggregation model] One way to represent a cluster is by giving a list of the coordinates at which each black cell occurs. … With a grid of cells set up in advance, each step in this type of Eden model can be achieved with AStep[a_] := ReplacePart[a, 1, (# 〚 Random[ Integer, {1, Length[#]}] 〛 &)[Position[(1 - a)Sign[ ListConvolve[{{0, 1, 0}, {1, 0, 1}, {0, 1, 0}}, a, {2, 2}]], 1]]] This implementation can readily be extended to generalized aggregation models (see below ).

Implementation [of proof example] Given the axioms in the form s[1] = (a_ ⊼ a_) ⊼ (a_ ⊼ b_)  a; s[2, x_] := b_  (b ⊼ b) ⊼ (b ⊼ x); s[3] = a_ ⊼ (a_ ⊼ b_)  a ⊼ (b ⊼ b); s[4] = a_ ⊼ (b_ ⊼ b_)  a ⊼ (a ⊼ b); s[5] = a_ ⊼ (a_ ⊼ (b_ ⊼ c_))  b ⊼ (b ⊼ (a ⊼ c)); the proof shown here can be represented by {{s[2, b], {2}}, {s[4], {}}, {s[2, (b ⊼ b) ⊼ ((a ⊼ a) ⊼ (b ⊼ b))], {2, 2}}, {s[1], {2, 2, 1}}, {s[2, b ⊼ b], {2, 2, 2, 2, 2, 2}], {s[5], {2, 2, 2}}, {s[2, b ⊼ b], {2, 2, 2, 2, 2, 1}}, {s[1], {2, 2, 2, 2, 2}}, {s[3], {2, 2, 2}}, {s[1], {2, 2, 2, 2}}, {s[4], {2, 2, 2}}, {s[5], {}}, {s[2, a], {2, 2, 1}}, {s[1], {2, 2}}, {s[3], {}}, {s[1], {2}}} and applied using FoldList[Function[{u, v}, MapAt[Replace[#, v 〚 1 〛 ] &, u, {v 〚 2 〛 }]], a ⊼ b, proof]