(************** Content-type: application/mathematica ************** CreatedBy='Mathematica 5.0' Mathematica-Compatible Notebook This notebook can be used with any Mathematica-compatible application, such as Mathematica, MathReader or Publicon. The data for the notebook starts with the line containing stars above. To get the notebook into a Mathematica-compatible application, do one of the following: * Save the data starting with the line of stars above into a file with a name ending in .nb, then open the file inside the application; * Copy the data starting with the line of stars above to the clipboard, then use the Paste menu command inside the application. Data for notebooks contains only printable 7-bit ASCII and can be sent directly in email or through ftp in text mode. Newlines can be CR, LF or CRLF (Unix, Macintosh or MS-DOS style). NOTE: If you modify the data for this notebook not in a Mathematica- compatible application, you must delete the line below containing the word CacheID, otherwise Mathematica-compatible applications may try to use invalid cache data. For more information on notebooks and Mathematica-compatible applications, contact Wolfram Research: web: http://www.wolfram.com email: info@wolfram.com phone: +1-217-398-0700 (U.S.) Notebook reader applications are available free of charge from Wolfram Research. *******************************************************************) (*CacheID: 232*) (*NotebookFileLineBreakTest NotebookFileLineBreakTest*) (*NotebookOptionsPosition[ 201872, 6283]*) (*NotebookOutlinePosition[ 207369, 6473]*) (* CellTagsIndexPosition[ 206757, 6446]*) (*WindowFrame->Normal*) Notebook[{ Cell["\[Copyright] 2003 K. Sutner ", "SmallText", ImageSize->{288, 288}], Cell[TextData[StyleBox["Cellular Automata", FontFamily->"Charter"]], "Title", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}, CellTags->"c:1"], Cell[CellGroupData[{ Cell["Linear Cellular Automata", "Section", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}, CellTags->"c:2"], Cell[CellGroupData[{ Cell["Linear Cellular Automata", "Subsection", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}, CellTags->"c:7"], Cell[CellGroupData[{ Cell["Local Maps", "Subsubsection", ImageSize->{288, 288}, CellTags->"c:8"], Cell[TextData[{ "A ", StyleBox["linear cellular automaton", FontColor->RGBColor[0, 0, 1]], " (or simply CA) consists of \n\t- a finite alphabet ", Cell[BoxData[ \(TraditionalForm\`K\)]], ", the ", StyleBox["alphabet", FontColor->RGBColor[0, 0, 1]], " of the CA,\n\t- a positive integer ", Cell[BoxData[ \(TraditionalForm\`w\)]], ", the ", StyleBox["width", FontColor->RGBColor[0, 0, 1]], " of the CA, \n\t- a map ", Cell[BoxData[ \(TraditionalForm\`\[Rho] : K\^w \[RightArrow] K\)]], ", the ", StyleBox["local map", FontColor->RGBColor[0, 0, 1]], " of the CA.\nAs is customary, we will often use alphabets of the form \n\t\ ", Cell[BoxData[ \(TraditionalForm\`K\_\(\(\ \)\(k\)\)\ = \ {0, 1, \[Ellipsis], k - 1}\)]], ".\nNote that these alphabets are abbreviated as ", Cell[BoxData[ \(TraditionalForm\`\(-k\)\)]], " in the ", StyleBox["Automata", "MR"], " package. There is a standard coding for linear cellular automata of a \ given width ", Cell[BoxData[ \(TraditionalForm\`w\)]], " over alphabet ", Cell[BoxData[ \(TraditionalForm\`K\)]], ": Let ", Cell[BoxData[ \(TraditionalForm\`0 \[LessEqual] c < k\^w\)]], ", enumerate the words of length ", Cell[BoxData[ \(TraditionalForm\`w\)]], " over ", Cell[BoxData[ \(TraditionalForm\`k\)]], " in natural order and assign the ", Cell[BoxData[ \(TraditionalForm\`i\)]], "-th digit of ", Cell[BoxData[ \(TraditionalForm\`c\)]], " in base ", Cell[BoxData[ \(TraditionalForm\`k\)]], " (padded on the left to exactly ", Cell[BoxData[ \(TraditionalForm\`k\^w\)]], " digits) to the ", Cell[BoxData[ \(TraditionalForm\`i\)]], "-th word. At present, only cellular automata whose local map is coded as a \ integer in the appropriate base are admissible in this package." }], "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(CA[3, \(-2\), 150]\), "\n", \(%\ // \ PrintCA\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[TextData[{ "However, CAs can easily be generated from ", StyleBox["Mathematica", FontSlant->"Italic"], " functions that represent the local map. These functions must be defined \ on ", Cell[BoxData[ \(TraditionalForm\`w\)]], " integer arguments (in the range ", Cell[BoxData[ \(TraditionalForm\`0\ \[LessEqual] \ x\ < \ k\)]], "). Here is an example:" }], "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(Clear[loc]\), "\n", \(loc[x_, y_, z_] := Mod[x + y + z, 2]\), "\n", \(FunctionToCA[loc, 3, \(-2\)]\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(loc[x_, y_, z_] := Mod[x + z, 2]\), "\n", \(FunctionToCA[loc, 3, \(-2\)]\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell["\<\ Thus, rule 150 corresponds to adding the states of all three cells \ modulo 2, whereas rule 90 corresponds to adding only the states of the two \ neighboring states. Modular arithmetic in general is a good source of \ examples for cellular automata. On occasion it is significantly easier to \ describe the cellular automaton in terms of rewrite rules, in particular \ since one can then focus on intended behavior and deal with unintended local \ configurations by some default rule. Here is a typical example: a \ three-state CA that tests whether the input configuration is a balanced \ string of \"parentheses\". We use L to represent \"(\" and R to represent \")\ \". Here is a fairly intuitive set of rules: cancel adjacent LR pairs and \ move R's to the left.\ \>", "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(Clear[L, R, x]\), "\n", \(\(rules\ = \ {\[IndentingNewLine]{_, L, R}\ \[Rule] \ 0, \[IndentingNewLine]{L, R, _}\ \[Rule] \ 0, \[IndentingNewLine]{_, 0, R}\ \[Rule] \ R, \[IndentingNewLine]{0, R, _}\ \[Rule] \ 0, \[IndentingNewLine]{_, x_, _} \[Rule] \ x\ \ \ \ \ \ \ \ \ \ \ (*\ default\ rule\ *) \[IndentingNewLine]};\)\), "\n", \(\(Q\ = \ {0, L, R};\)\), "\n", \(C\ = \ RulesToCA[\ rules, \ 3, \ Q\ ]\)}], "Input", ImageSize->{288, 288}], Cell["A little test on a balanced input configuration.", "Text", ImageSize->{288, 288}], Cell[BoxData[{ \(\(X\ = \ {1, 2, 1, 1, 1, 2, 1, 2, 2, 1, 2, 1, 1, 2, 2, 2, 1, 1, 2, 2, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 1, 1, 2, 2};\)\), "\n", \(\(EvolutionCA[\ C, \ X\ , 20, GridLines \[Rule] True, \ Boundary \[Rule] Fixed, \ \[IndentingNewLine]RasterStyle \[Rule] \ Join[Take[$rastercolors, 2], {2 \[Rule] Red}]];\)\)}], "Input", ImageSize->{288, 288}], Cell["\<\ We have not specified acceptance conditions, but it is clear what \ goes wrong when the input is not balanced.\ \>", "Text", ImageSize->{288, 288}], Cell[BoxData[ \(Position[X, 1]\ // \ Flatten\)], "Input", ImageSize->{288, 288}], Cell[BoxData[ \(\(EvolutionCA[\ C, \ ReplacePart[X, 2, 21], 20, GridLines \[Rule] True, \ Boundary \[Rule] Fixed\ , \[IndentingNewLine]RasterStyle \[Rule] \ Join[Take[$rastercolors, 2], {2 \[Rule] Red}]\ ];\)\)], "Input", ImageSize->{288, 288}], Cell[BoxData[ \(Position[X, 2]\ // \ Flatten\)], "Input", ImageSize->{288, 288}], Cell[BoxData[ \(\(EvolutionCA[\ C, \ ReplacePart[X, 1, 29], 20, GridLines \[Rule] True, \ Boundary \[Rule] Fixed\ , \[IndentingNewLine]RasterStyle \[Rule] \ Join[Take[$rastercolors, 2], {2 \[Rule] Red}]\ ];\)\)], "Input", ImageSize->{288, 288}], Cell[TextData[{ "If the corresponding local function can be described in terms of a \ polynomial, one can generate the CA very conveniently using command ", ButtonBox["PolynomialToCA", ButtonStyle->"AddOnsLink"], "." }], "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[ \(PolynomialToCA[x1 + x2 + x3, 3, 2]\)], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[ \(PolynomialToCA[x1 + x4, 4]\)], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[ \(PolynomialToCA[z1\ z2 + z3, 3, 2, "\"]\)], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[TextData[{ "Lastly, there is a command ", ButtonBox["BFunctionToCA", ButtonStyle->"AddOnsLink"], " to convert a Boolean polynomial into a binary CA. Writing a Boolean \ function as a polynomial is sometimes more convenient as with logical \ operators. Of course, we use binary functions rather than Boolean ones and \ identify 0 with ", StyleBox["False", "MR"], " and 1 with ", StyleBox["True", "MR"], ". Boolean variables are ", StyleBox["x1", "MR"], ", ", StyleBox["x2", "MR"], ", ... and their negation can be expressed as ", StyleBox["y1", "MR"], ", ", StyleBox["y2", "MR"], ", \[Ellipsis] Subscripted variables ", Cell[BoxData[ \(TraditionalForm\`x\_\(\(\ \)\(i\)\)\)]], " and ", Cell[BoxData[ \(TraditionalForm\`y\_\(\(\ \)\(i\)\)\)]], " are also admissible. " }], "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(\(BFunctionToCA[x\_1 + \ \ x\_2\ x\_3, 3\ ];\)\), "\n", \(PrintCA[%]\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(\(BFunctionToCA[x\_1 + \ \(y\_2\) x\_3, 3];\)\), "\n", \(PrintCA[%]\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[TextData[{ "If it is necessary to convert the expression representing a CA, and thus \ in essence the local map of the automaton, into a ", StyleBox["Mathematica", FontSlant->"Italic"], " function we can use the command ", ButtonBox["LocalMapCA", ButtonStyle->"AddOnsLink"], " :" }], "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(\(LocalMapCA[\[Rho], CA[150]];\)\), "\n", \(Apply[\ \[Rho], \ Tuples[{0, 1}, 3], \ {1}]\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[ \(DownValues[\[Rho]]\)], "Input", ImageSize->{288, 288}], Cell["\<\ Local maps are use internally in some of the commands, e.g., to \ compute the composition of two cellular automata.\ \>", "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}] }, Closed]], Cell[CellGroupData[{ Cell[BoxData[ \(TraditionalForm\`Global\ Maps\)], "Subsubsection", ImageSize->{288, 288}, CellTags->"c:9"], Cell[TextData[{ "Let ", Cell[BoxData[ \(TraditionalForm\`K\^\[Infinity]\)]], " be the set of all biinfinite sequences of symbols from K. The elements of \ ", Cell[BoxData[ \(TraditionalForm\`K\^\[Infinity]\)]], " are called configurations over K. Linear cellular automata are \ traditionally considered as endomorphisms of the space ", Cell[BoxData[ \(TraditionalForm\`K\^\[Infinity]\)]], " of all configurations. More precisely, ", Cell[BoxData[ \(TraditionalForm\`K\^\[Infinity]\)]], " is a totally disconnected compact Hausdorff space and the local map gives \ rise to a global map ", Cell[BoxData[ \(TraditionalForm\`\[Rho]\ : \ K\^\[Infinity]\[LongRightArrow]\ K\^\[Infinity]\)]], " that is easily seen to be a continuous map on this space. The \ configuration ", Cell[BoxData[ \(TraditionalForm\`\[Rho](X)\)]], " is generated by dividing ", Cell[BoxData[ \(TraditionalForm\`X\)]], " into overlapping blocks of width w and applying the local map to all \ these blocks in parallel. Clearly, the global map commutes with the shift. In \ fact, all continuous maps that commute with the shift arise in this way. \n", Cell[BoxData[ \(TraditionalForm\`K\^\[Infinity]\)]], " together with the shift forms a primitive dynamical system, the full \ shift. It is often more interesting to consider a subshift, i.e., a closed \ subset ", Cell[BoxData[ \(TraditionalForm\`C\ \[SubsetEqual] K\^\[Infinity]\)]], " that is invariant under the shift. The simplest type of such subshifts \ are topological Markov shifts (TMS) and are described by a list of forbidden \ subwords of length 2. If one excludes a finite number of words of arbitrary \ length one obtains a subshift of finite type (SFT). Unlike TMSs, the latter \ class of shifts is closed under homeomorphisms. It is not closed under global \ maps as described above (or rather their obvious generalizations to \ subshifts). The shifts that can occur as the range of a global map are known \ as sofic systems (SoS). \nThere is a slight ambiguity in the construction of \ the global map from the local map: the blocks of width ", Cell[BoxData[ \(TraditionalForm\`w\)]], " obtained from a biinfinite sequence are only unique up to a shift. We \ will use the convention that the ", Cell[BoxData[ \(TraditionalForm\`i\)]], "-th block is centered at symbol ", Cell[BoxData[ \(TraditionalForm\`i\)]], " (for even ", Cell[BoxData[ \(TraditionalForm\`w\)]], " we choose the left center symbol). \nAlternatively, we may consider ", Cell[BoxData[ \(TraditionalForm\`\[Rho]\)]], " as a map on finite words over ", Cell[BoxData[ \(TraditionalForm\`K\)]], ". Note that ", Cell[BoxData[ \(TraditionalForm\`\(\(\ \)\(\(\(|\)\(\[Rho]( x)\)\(|\)\)\ = \ \(\(|\)\(x\)\(|\)\(\ \)\(-\ w\)\)\)\)\)]], " where ", Cell[BoxData[ \(TraditionalForm\`w\)]], " is the width of the CA (strictly speaking, this map is defined only for \ ", Cell[BoxData[ \(TraditionalForm\`\(\(\ \ \)\(\(|\)\(x\)\(|\)\(\(\[GreaterEqual]\)\(w\)\)\)\)\)]], "; for completeness sake define ", Cell[BoxData[ \(TraditionalForm\`\[Rho](x)\ = \ \[Epsilon]\)]], " for shorter words ", Cell[BoxData[ \(TraditionalForm\`x\)]], ". We will refer to this map as the word map of the CA. \nThe command ", ButtonBox["GlobalMapCA", ButtonStyle->"AddOnsLink"], StyleBox[" ", "MR"], " generates the word map of a CA. Unlike with the executable function \ generated by ", ButtonBox["LocalMapCA", ButtonStyle->"AddOnsLink"], ", the function produced by the global map command accepts as input lists \ of arbitrary length. " }], "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(\(GlobalMapCA[\[Rho], CA[150]\ ];\)\), "\n", \(NestList[\[Rho], {0, 0, 0, 1, 1, 1, 0, 0, 0}, 6]\ // \ ColumnForm\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell["\<\ On occasion it is more convenient to deal with words rather than \ lists.\ \>", "Text", ImageSize->{288, 288}], Cell[BoxData[{ \(GlobalMapCA[rho, CA[150], Boundary \[Rule] None, WordMap \[Rule] True]\), "\n", \(NestList[rho, "\<00000100000\>", 6]\ // \ ColumnForm\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[TextData[{ "As the example shows, the word map is shrinking and can be iterated only a \ bounded number of times. In order to get a more useful analogue to the \ infinitary global map of a CA we can use one of two standard conventions:\n\ \[EmptyCircle] Periodic (cyclic) boundary conditions\nOne may think of the \ word as a cyclic string so that the last symbol is adjacent to the first. The \ global map can be defined for such cyclic strings in exactly the same way as \ for biinfinite words (in fact, cyclic words correspond precisely to periodic \ biinfinite words). \n\[EmptyCircle] Fixed boundary conditions\n\ Alternatively, we can attach a prefix and suffix of length ", Cell[BoxData[ \(TraditionalForm\`\((w - 1)\)/2\)]], " to the string, usually ", Cell[BoxData[ \(TraditionalForm\`0\^\(\((w - 1)\)/2\)\)]], ", and apply the ordinary map to this augmented string. Again, length will \ be preserved and we can generate orbits of arbitrary length. Note that this \ approach does not have any immediate counterpart in the realm of biinfinite \ words. " }], "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(GlobalMapCA[rhop, CA[150], Boundary \[Rule] Cyclic, WordMap \[Rule] True]\), "\n", \(GlobalMapCA[rhof, CA[150], Boundary \[Rule] Fixed, WordMap \[Rule] True]\), "\n", \(With[{L = Words[3, \(-2\)]}, TableForm[{L, rhop /@ L, rhof /@ L}, TableSpacing \[Rule] {1, 2}]]\)}], "Input", ImageSize->{288, 288}], Cell[BoxData[ \(NestList[rhof, "\<000000010000000\>", 6]\ // \ ColumnForm\)], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[TextData[{ "Note the use of the option ", StyleBox["WordMap->True", "MR"], " everywhere. Without, the global map expects lists as inputs rather than \ words, a format that is often more convenient since ", StyleBox["Mathematica", FontSlant->"Italic"], " provide numerous tools to manipulate lists. " }], "Text", ImageSize->{288, 288}], Cell[BoxData[{ \(\(GlobalMapCA[rho, CA[150]];\)\), "\n", \(\(X = SeedConfiguration[{1}, 11];\)\), "\n", \(\(orb = NestList[rho, X, 10];\)\), "\n", \(orb\ // \ MatrixForm\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell["\<\ For example, it is now easy to perform a frequency analysis on this \ orbit:\ \>", "Text", ImageSize->{288, 288}], Cell[BoxData[ \(Flatten[orb]\ // \ Frequencies\)], "Input", ImageSize->{288, 288}], Cell[TextData[{ "In conjunction with ", ButtonBox["AnalyzeOrbit", ButtonStyle->"AddOnsLink"], " one can use global maps to study transients and periods of finite \ configurations, at least for reasonably small examples. Here is an example \ using the additive ECA number 90. The algorithm used in ", ButtonBox["AnalyzeOrbit", ButtonStyle->"AddOnsLink"], " is memoryless and so the computation is only time-bound. " }], "Text", ImageSize->{288, 288}], Cell[BoxData[{ \(GlobalMapCA[g, CA[90]]\), "\n", \(Table[\ Flatten[{k, AnalyzeOrbit[\ g, \ SeedConfiguration[{1}, k]\ ]}], {k, 3, 20}]\ // \ TableForm\)}], "Input", ImageSize->{288, 288}], Cell["\<\ The same table for the additive rule 150. It appears from the \ tables that rule 90 is always irreversible on finite grids with periodic \ boundary conditions, whereas rule 150 is irreversible if and only if the size \ of the grid is divisible by 3. It is now easy to provide formal proofs of \ these assertions.\ \>", "Text", ImageSize->{288, 288}], Cell[BoxData[{ \(GlobalMapCA[g, CA[150]]\), "\n", \(Table[\ Flatten[{k, AnalyzeOrbit[\ g, \ SeedConfiguration[{1}, k]\ ]}], {k, 3, 20}]\ // \ TableForm\)}], "Input", ImageSize->{288, 288}], Cell[TextData[{ "In most cases, the best way to study orbits is to start with a graphical \ representation. For example, for rule 150 we obtain the following well-known \ pattern. The initial configuration is a one-point seed of the form ", Cell[BoxData[ \(TraditionalForm\`00 \[Ellipsis]010\[Ellipsis]00\)]], " and we generate the first 64 steps in the orbit." }], "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[ \(\(EvolutionCA[\ CA[150], 64];\)\)], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[TextData[{ "The orbit (or rather, an initial segment thereof) of a configuration can \ be generated by the command ", ButtonBox["OrbitCA", ButtonStyle->"AddOnsLink"], ", which returns a list of configurations. " }], "Text", ImageSize->{288, 288}], Cell[BoxData[ \(OrbitCA[CA[150], {0, 0, 0, 1, 0, 0, 0}, 30]\)], "Input", ImageSize->{288, 288}], Cell[TextData[{ " ", ButtonBox["OrbitCA", ButtonStyle->"AddOnsLink"], " accepts optional arguments that control periodic versus fixed boundary \ conditions. " }], "Text", ImageSize->{288, 288}], Cell[BoxData[ \(OrbitCA[CA[150], {1, 0, 0, 0}, 5]\)], "Input", ImageSize->{288, 288}], Cell[BoxData[ \(OrbitCA[CA[150], {1, 0, 0, 0}, 5, Boundary \[Rule] Fixed]\)], "Input", ImageSize->{288, 288}], Cell[TextData[{ "To generate seed configurations of the form ", Cell[BoxData[ \(TraditionalForm\`00 \[Ellipsis]0\ L\ 0 \[Ellipsis]00\)]], " for some list ", Cell[BoxData[ \(TraditionalForm\`L\)]], " and a given length we can use the command ", ButtonBox["SeedConfiguration", ButtonStyle->"AddOnsLink"], "." }], "Text", ImageSize->{288, 288}], Cell[BoxData[{ \(SeedConfiguration[{1}, 20]\), "\n", \(SeedConfiguration[{1, 1, 1, 1, 1}, 20]\)}], "Input", ImageSize->{288, 288}], Cell[TextData[{ "We can pipe the output of ", StyleBox["OrbitCA", "MR"], " to ", ButtonBox["PlotMatrix", ButtonStyle->"AddOnsLink"], " to obtain the usual pictures. " }], "Text", ImageSize->{288, 288}], Cell[BoxData[{ \(\(orb = OrbitCA[CA[150], SeedConfiguration[{1, 1, 1, 1}, 20], 20];\)\), "\n", \(\(PlotMatrix[orb, DisplayFunction \[Rule] Identity];\)\), "\n", \(\(PlotMatrix[orb, GridLines \[Rule] True, DisplayFunction \[Rule] Identity];\)\), "\[IndentingNewLine]", \(\(ShowArray[{%%, %}];\)\)}], "Input", ImageSize->{288, 288}], Cell[TextData[{ "Alternatively, we can use the command ", ButtonBox["EvolutionCA", ButtonStyle->"AddOnsLink"], " which combines an orbit calculation with a plotting routine. " }], "Text", ImageSize->{288, 288}], Cell[BoxData[{ \(\(Unprotect[X];\)\), "\n", \(\(X = {1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1};\)\), "\n", \(\(gr1 = EvolutionCA[CA[150], X, 40, Boundary \[Rule] Fixed, DisplayFunction \[Rule] Identity];\)\), "\n", \(\(gr2 = EvolutionCA[CA[150], X, 40, Boundary \[Rule] Cyclic, DisplayFunction \[Rule] Identity];\)\), "\n", \(\(ShowArray[{gr1, gr2}];\)\)}], "Input", ImageSize->{288, 288}], Cell[BoxData[{ \(\(X = SeedConfiguration[{1, 1, 1, 0, 0, 0, 0, 1, 1, 0, 0, 0, 1}, 40];\)\), "\n", \(\(EvolutionCA[CA[110], X, 50];\)\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell["\<\ Here are the orbits of a one-point seed pattern, traced for 25 \ steps, for all (2,2)-CAs.\ \>", "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(\(w = SeedConfiguration[{1}, 31];\)\), "\n", \(\(\(EvolutionCA[CA[2, \(-2\), #], w, 25, GridLines \[Rule] False, DisplayFunction \[Rule] Identity] &\) /@ Range[0, 15];\)\), "\n", \(\(ShowArray[%];\)\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[TextData[{ "Rules based on addition modulo ", Cell[BoxData[ \(TraditionalForm\`k\)]], " are easily generated using ", ButtonBox["FunctionToCA", ButtonStyle->"AddOnsLink"], "." }], "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(\(Unprotect[C];\)\), "\[IndentingNewLine]", \(C = FunctionToCA[Mod[\(+##1\), 4] &, 3, \(-4\)]\), "\n", \(\(w = SeedConfiguration[Table[1, {10}], 50];\)\), "\n", \(\(EvolutionCA[C, w, 50];\)\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[ \(\(EvolutionCA[C, w, 100, Cyclic \[Rule] False];\)\)], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell["\<\ Here is Wolfram's example of a exceedingly simple rule that \ nonetheless appears to produce random patterns starting from a one-point \ seed. It is built from the Boolean operations 'or' and 'exclusive or':\ \>", \ "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(\(Clear[loc];\)\), "\n", \(loc[x_, y_, z_] := Mod[x + Max[y, z], 2]\), "\n", \(C = FunctionToCA[loc, 3, \(-2\)]\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[ \(\(EvolutionCA[C, 60];\)\)], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell["\<\ No method is known to compute, say, the bit pattern down the middle \ column other than brute force simulation. Even for fairly small grids, rule \ 30 produces long transients and cycles. Here is a glimpse at steps 800 - 1000 \ on a grid of size 200. \ \>", "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(\(orb = OrbitCA[C, SeedConfiguration[{1}, 200], 1000];\)\), "\n", \(\(PlotMatrix[Drop[orb, 800], GridLines \[Rule] False];\)\)}], "Input", ImageSize->{288, 288}], Cell[BoxData[ \(Length[Union[orb]]\)], "Input", ImageSize->{288, 288}], Cell[TextData[{ "The left and right shifts are easily generated via ", StyleBox["FunctionToCA", "MR"], "." }], "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[ \(ls = FunctionToCA[\ Function[{x, y, z}, z], 3, \(-2\)]\)], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[ \(\(EvolutionCA[ls, Table[Random[Integer, {0, 1}], {20}], 20];\)\)], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell["\<\ One can make the entry point to the limit cycle visible with the \ (experimental) function MarkPeriod.\ \>", "Text", ImageSize->{288, 288}], Cell[BoxData[{ \(\(orb\ = \ OrbitCA[CA[90], \ SeedConfiguration[{1}, 51], \ 299\ \ , Boundary \[Rule] Fixed];\)\), "\n", \(\(PlotMatrix[\ MarkPeriod[\ orb\ ], MultiCol \[Rule] True, NRows \[Rule] 100];\)\)}], "Input", ImageSize->{288, 288}] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Composing CAs", "Subsection", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}, CellTags->"c:7"], Cell[CellGroupData[{ Cell["Functional Composition", "Subsubsection", ImageSize->{288, 288}], Cell[TextData[{ "Given two CAs ", Cell[BoxData[ \(TraditionalForm\`\[Rho]\ : \ K\^\[Infinity]\ \ \[RightArrow] \ K\^\[Infinity]\)]], " and ", Cell[BoxData[ \(TraditionalForm\`\[Tau]\ : \ \ K\^\[Infinity]\ \ \[RightArrow] \ K\^\[Infinity]\)]], " over the same alphabet ", Cell[BoxData[ \(TraditionalForm\`K\)]], " one can compose the maps to obtain a new CA ", Cell[BoxData[ \(TraditionalForm\`\[Rho]\[VeryThinSpace]\[ThinSpace]\(\[Tau]\ : K\^\[Infinity]\ \ \[RightArrow] \ K\^\[Infinity]\)\)]], ". The width of the composite CA is ", Cell[BoxData[ \(TraditionalForm\`w(\[Rho])\ + \ w(\[Tau])\ - \ 1\)]], ". Command ", ButtonBox["ComposeCA", ButtonStyle->"AddOnsLink"], " generates the appropriate CA. " }], "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(\(C150 = CA[150];\)\), "\n", \(\(C125 = CA[125];\)\), "\n", \(CC = ComposeCA[C150, C125\ ]\), "\n", \(PrintCA[CC]\), "\n", \(\(EvolutionCA[CC, 50];\)\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[TextData[{ "Note that there is an exponential increase in the size of the rule table, \ so one has to use composition with caution. Command ", ButtonBox["IterateCA", ButtonStyle->"AddOnsLink"], " computes compositions of a CA with itself. Thus, starting at a CA ca[1] \ we can generate a sequence ca[t] of CAs of increasing width. One step in the \ evolution of a word on ca[t] corresponds to t steps in the evolution of the \ base automaton ca[1]. The width of ca[t] is ", Cell[BoxData[ \(TraditionalForm\`w\ + \ 2 \((t - 1)\)\)]], " where ", Cell[BoxData[ \(TraditionalForm\`w\)]], " is the width of ca[1]. Hence the size of ca[t] is ", Cell[BoxData[ \(TraditionalForm\`2\^\(w + 2 \((t - 1)\)\)\)]], " (assuming a binary alphabet) and gets out of hand rather quickly. " }], "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(C3 = IterateCA[C125, 3]\), "\n", \(\(EvolutionCA[\ C3, SeedConfiguration[{1, 1, 1}, 50], 40];\)\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell["\<\ Here is the result of composition with the left and right \ shift.\ \>", "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(\(ls = FunctionToCA[\ Function[{x, y, z}, z], 3, \(-2\)];\)\), "\n", \(rs = FunctionToCA[\ Function[{x, y, z}, x], 3, \(-2\)]\), "\n", \(C = CA[51]\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(\(EvolutionCA[C, 20];\)\), "\n", \(\(EvolutionCA[ComposeCA[ls, C], 20];\)\), "\n", \(\(EvolutionCA[ComposeCA[rs, C], 20];\)\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell["\<\ Cellular automata (or rather, their global maps) commute with the \ shift.\ \>", "Text", ImageSize->{288, 288}], Cell[BoxData[{ \(ComposeCA[C, ls] == ComposeCA[ls, C]\), "\n", \(ComposeCA[C, rs] == ComposeCA[rs, C]\)}], "Input", ImageSize->{288, 288}], Cell["\<\ Applying a shift, or an iterated shift, is often helpful to get \ better of visual representations of orbits. Here is an example of a rule of \ width 5 that boils down to a \"Pascal's triangle mod 2\" after a shift. \ \ \>", "Text", ImageSize->{288, 288}], Cell[BoxData[{ \(C = CA[5, \(-2\), 1717986918]\), "\n", \(CR = ComposeCA[C, rs]\)}], "Input", ImageSize->{288, 288}], Cell[BoxData[{ \(\(EvolutionCA[C, 40];\)\), "\n", \(\(EvolutionCA[CR, 40];\)\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell["\<\ In this example, eliminating useless variables is actually a better \ line of attack.\ \>", "Text", ImageSize->{288, 288}], Cell[BoxData[{ \(CS = SimplifyCA[C]\), "\n", \(\(EvolutionCA[CS, 50];\)\)}], "Input", ImageSize->{288, 288}] }, Closed]], Cell[CellGroupData[{ Cell["Tracks", "Subsubsection", ImageSize->{288, 288}], Cell[TextData[{ "A standard trick in the construction of cellular automata is to divide the \ cells into tracks. More precisely, one uses product alphabets of the form \ ", Cell[BoxData[ \(TraditionalForm\`\[CapitalSigma]\ = \ \[CapitalSigma]\_1\[Cross]\ \ \[CapitalSigma]\_2\[Cross]\ \[Ellipsis]\ \[Cross]\ \[CapitalSigma]\_\(\(\ \ \)\(t\)\)\)]], ". One can then have the automaton perform different tasks in the separate \ tracks, much like a multi-tape Turing machine. \nIn the easiest case, there \ is no interaction between the tracks, the two automata are simply glued \ together. Thus, given two CAs ", Cell[BoxData[ \(TraditionalForm\`\[Rho]\ : \ \[CapitalSigma]\_1\^\[Infinity]\ \ \ \[RightArrow] \ \[CapitalSigma]\_1\^\[Infinity]\)]], " and ", Cell[BoxData[ \(TraditionalForm\`\[Tau]\ : \ \ \[CapitalSigma]\_2\^\[Infinity]\ \ \ \[RightArrow] \ \[CapitalSigma]\_2\^\[Infinity]\)]], " of the same widtch we obtain a new CA ", Cell[BoxData[ \(TraditionalForm\`\((\[Rho]\[VeryThinSpace]\[ThinSpace], \[Tau])\)\ : \ \[CapitalSigma]\^\[Infinity]\ \ \[RightArrow] \ \[CapitalSigma]\^\[Infinity]\ \)]], " where ", Cell[BoxData[ \(TraditionalForm\`\[CapitalSigma]\ = \ \[CapitalSigma]\_1\[Cross]\ \ \[CapitalSigma]\_2\)]], ". In terms of the local maps, the new CA is defined like so:\n\t", Cell[BoxData[ \(TraditionalForm\`\((\[Rho], \[Tau])\) \((X)\)\ = \ \ \(k\_\(\(1\)\(\ \ \)\)\) \(\[Tau](X\ div\ k\_1)\)\ + \ \[Rho](X\ mod\ k\_1)\)]], "\nThis is occasionally useful to construct machines whose properties are a \ combination of the properties of the component machines. \nHere is an example \ of a combination of two ECAs. The function ", StyleBox["CombineCA", "MR"], " (which is defined in ", ButtonBox["cellaut.m", ButtonData:>{ FrontEnd`FileName[ { ParentDirectory[ ]}, "cellaut.m", CharacterEncoding -> "iso8859-1"], None}, ButtonStyle->"Hyperlink"], ") assigns the low-order bits to the first CA, and the high-order bits to \ the second. " }], "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[ \(\(<< Automata`cellaut`;\)\)], "Input", ImageSize->{288, 288}], Cell["We combine two ECAs with open global maps, rules 102 and 90.", "Text", ImageSize->{288, 288}], Cell[BoxData[ \(C\ = \ CombineCA[\ CA[102], CA[90]]\)], "Input", ImageSize->{288, 288}], Cell[TextData[{ "Generate an initial configuration of bits, corresponding to the low-order \ bits of a configuration over ", Cell[BoxData[ \(TraditionalForm\`\[CapitalSigma]\_\(\(\ \)\(4\)\)\)]], ". " }], "Text", ImageSize->{288, 288}], Cell[BoxData[ \(\(X\ = \(X\ = \ Join[Table[0, {30}], SeedConfiguration[30, Random \[Rule] 2]]\);\)\)], "Input", ImageSize->{288, 288}], Cell[TextData[{ "The global maps of the two ECAs acting on ", Cell[BoxData[ \(TraditionalForm\`X\)]], "." }], "Text", ImageSize->{288, 288}], Cell[BoxData[{ \(\(\(EvolutionCA[\ #, \ X, DisplayFunction \[Rule] Identity\ ] &\)\ /@ \ {CA[102], CA[90]};\)\), "\[IndentingNewLine]", \(\(ShowArray[%];\)\)}], "Input", ImageSize->{288, 288}], Cell[TextData[{ "Since rule 102 is quiescent we can push the some configuration to the \ high-order bits and obtain the typical rule 90 orbit from ", Cell[BoxData[ \(TraditionalForm\`C\)]], "." }], "Text", ImageSize->{288, 288}], Cell[BoxData[ \(\(EvolutionCA[\ C, \ 2\ X\ ];\)\)], "Input", ImageSize->{288, 288}], Cell[TextData[{ "An orbit of a (partially) random configuration over ", Cell[BoxData[ \(TraditionalForm\`\[CapitalSigma]\_4\)]], ". " }], "Text", ImageSize->{288, 288}], Cell[BoxData[{ \(\(Y\ = \ Join[Table[0, {75}], SeedConfiguration[25, Random \[Rule] 4]];\)\), "\n", \(\(EvolutionCA[\ C, \ Y, 100\ ];\)\)}], "Input", ImageSize->{288, 288}], Cell[TextData[{ "The combined CA still has an open global map; see below for a discussion \ of ", ButtonBox["ClassifyCA", ButtonStyle->"AddOnsLink"], "." }], "Text", ImageSize->{288, 288}], Cell[BoxData[ \(ClassifyCA[\ C, \ Full \[Rule] True\ ]\)], "Input", ImageSize->{288, 288}], Cell["\<\ Here is another example, a combination of ECA 204 and ECA 30. We \ consider both possible combinations.\ \>", "Text", ImageSize->{288, 288}], Cell[BoxData[{ \(C1\ = \ CombineCA[\ CA[30], CA[204]]\), "\[IndentingNewLine]", \(C2\ = \ CombineCA[\ CA[204], CA[30]]\)}], "Input", ImageSize->{288, 288}], Cell["\<\ Since rule 204 has the identity function as its global map, the \ resulting automata are \"essentially\" the same as rule 30, and their orbits \ should be similar.\ \>", "Text", ImageSize->{288, 288}], Cell[BoxData[{ \(\(X\ = \ Quotient[\ Range[80] - 1, \ 20\ ];\)\), "\n", \(\(\(EvolutionCA[\ #, \ X, 80, DisplayFunction \[Rule] Identity\ ] &\)\ /@ \ {C1, C2};\)\), "\n", \(\(ShowArray[%];\)\)}], "Input", ImageSize->{288, 288}], Cell[TextData[{ "We can translate the ", Cell[BoxData[ \(TraditionalForm\`C\_2\)]], " orbit of ", Cell[BoxData[ \(TraditionalForm\`X\)]], " into the ", Cell[BoxData[ \(TraditionalForm\`C\_1\)]], " orbit by swapping low- and high-order bits, once before application of \ the global map and once afterwards. " }], "Text", ImageSize->{288, 288}], Cell[BoxData[{ \(ClearAll[F]\), "\[IndentingNewLine]", \(\(F[{xx___Integer}]\ := \ {xx}\ /. \ {1 \[Rule] 2, 2 \[Rule] 1};\)\), "\[IndentingNewLine]", \(\(F[L_List]\ := \ F\ /@ \ L;\)\)}], "Input", ImageSize->{288, 288}], Cell[BoxData[ \(\(\(OrbitCA[\ C2, F[X]\ , 80\ ]\ // \ F\)\ // \ PlotMatrix;\)\)], "Input", ImageSize->{288, 288}], Cell[TextData[{ "A more interesting application of the track concept is the Morita-Harao \ method of constructing reversible cellular automata, so-called partitioned \ cellular automata (PCA). The local function of a PCA is given by a map\n\t\t\ ", Cell[BoxData[ \(TraditionalForm\`f\ \ : \ \ \[CapitalSigma]\_1\ \[Cross]\ \ \[CapitalSigma]\_2\[Cross]\ \[CapitalSigma]\_3\ \[LongRightArrow]\ \ \[CapitalSigma]\_1\[Cross]\ \[CapitalSigma]\_2\[Cross]\ \ \[CapitalSigma]\_3\)]], "\nwhich operates on global configurations by first applying a shearing map\ \n\t\t", Cell[BoxData[ \(TraditionalForm\`\(\(shear\)\(\ \)\(:\)\(\ \ \)\)\)]], Cell[BoxData[ \(TraditionalForm\`\((\ \[CapitalSigma]\_1\ \[Cross]\ \ \[CapitalSigma]\_2\[Cross]\ \[CapitalSigma]\_3)\)\^\[Infinity]\ \ \[LongRightArrow]\ \((\ \[CapitalSigma]\_1\ \[Cross]\ \[CapitalSigma]\_2\ \[Cross]\ \[CapitalSigma]\_3\ )\)\^\[Infinity]\)]], "\n\t\t", Cell[BoxData[ \(TraditionalForm\`shear(X, Y, Z)\ \ = \ \ \((leftshift(X), Y, rightshift(Z))\)\)]], "\nand then the map ", Cell[BoxData[ \(TraditionalForm\`f\)]], " pointwise. It is easy to see that the global map is injective if, and \ only if, the function ", Cell[BoxData[ \(TraditionalForm\`f\)]], " is so injective.\nHere is a simple example example: a PCA that simulates \ particles bouncing between domain walls in a reversible fashion. The \ construction uses three different alphabets for the three tracks as follows." }], "Text", ImageSize->{288, 288}], Cell[BoxData[{ \(Clear[r, l, R, L, W]\), "\[IndentingNewLine]", \(\(A\ = \ CartesianProduct[{0, r}, {0, r, l, R, L, W}, {0, l}];\)\)}], "Input", ImageSize->{288, 288}], Cell[TextData[{ "It is best to describe the map ", Cell[BoxData[ \(TraditionalForm\`f\)]], " in terms of a rewrite rules. The actual local map can then be defined by \ extracting the appropriate fields and applying the rewrite rules." }], "Text", ImageSize->{288, 288}], Cell[BoxData[{ \(Clear[carules, frules, r, l, W, R, L]\), "\n", \(\(frules\ = \ {\[IndentingNewLine]{0, 0, 0} \[Rule] {0, 0, 0}, \ \[IndentingNewLine]{0, W, 0} \[Rule] {0, W, 0}, \ \[IndentingNewLine]{r, 0, 0} \[Rule] {0, R, 0}, \ \[IndentingNewLine]{0, r, 0} \[Rule] {r, 0, 0}, \ \[IndentingNewLine]{0, 0, l} \[Rule] {0, L, 0}, \ \[IndentingNewLine]{0, l, 0} \[Rule] {0, 0, l}, \ \[IndentingNewLine]{r, W, 0} \[Rule] {0, W, l}, \ \[IndentingNewLine]{0, W, l} \[Rule] {r, W, 0}, \ \[IndentingNewLine]{0, R, 0} \[Rule] {r, 0, 0}, \ \[IndentingNewLine]{0, L, 0} \[Rule] {0, 0, l}\[IndentingNewLine]};\)\), "\n", \(\(carules\ = \ {{x_, _, _}, {_, y_, _}, {_, _, z_}}\ \[RuleDelayed] \ \(({x, y, z}\ /. \ frules)\);\)\)}], "Input", ImageSize->{288, 288}], Cell[TextData[{ "Note that triples not listed in ", StyleBox["carules", "MR"], " are thus fixed points under the local map. One can convert the local map \ to a cellular automaton. Alas, the machine is rather large and unwieldy." }], "Text", ImageSize->{288, 288}], Cell[BoxData[{ \(C\ = RulesToCA[\ {carules}, \ 3, \ A\ ]\), "\[IndentingNewLine]", \(ScientificForm[\ N@RuleCA[C]\ ]\)}], "Input", ImageSize->{288, 288}], Cell["\<\ To see how this device really works it is better to implement the \ global map directly using a shearing map and the rewrite rules on triples \ (rather than coding the triples as symbols of a larger alphabet, as in the \ CA).\ \>", "Text", ImageSize->{288, 288}], Cell[BoxData[{ \(Clear[globmap, shear]\), "\n", \(shear[L_List, rot_List]\ := \ \[IndentingNewLine]\t Thread[Apply[\ RotateLeft, \ Pairs[Thread[L], rot], {1}\ ]]; globmap[L_List]\ := \ shear[L, {\(-1\), 0, 1}]\ /. \ frules;\)}], "Input", ImageSize->{288, 288}], Cell[TextData[{ "Appropriate initial configurations can be constructed from triples \ representing the three tracks. The following configuration has two domain \ walls ", Cell[BoxData[ \(TraditionalForm\`{0, W, 0}\)]], ", a left-moving particle ", Cell[BoxData[ \(TraditionalForm\`{0, L, 0}\)]], " and a right-moving particle ", Cell[BoxData[ \(TraditionalForm\`{0, R, 0}\)]], ", separated by \"blank\" cells ", Cell[BoxData[ \(TraditionalForm\`{0, 0, 0}\)]], ". " }], "Text", ImageSize->{288, 288}], Cell[BoxData[ \(\(X = \ Join[\ {{0, 0, 0}, {0, W, 0}}, Table[{0, 0, 0}, {2}], {{0, L, 0}}, Table[{0, 0, 0}, {7}], {{0, R, 0}}, Table[{0, 0, 0}, {5}], {{0, W, 0}, {0, 0, 0}}\ ]\ ;\)\)], "Input", ImageSize->{288, 288}], Cell["\<\ First, a short orbit displaying all tracks. One can see the \ particles move in opposite directions.\ \>", "Text", ImageSize->{288, 288}], Cell[BoxData[ \(NestList[\ globmap, \ X, \ 10\ ]\ \ /. \ {0 -> "\<.\>"} // \ \(Curry[ TableForm]\)[TableSpacing \[Rule] {1, 1}]\)], "Input", ImageSize->{288, 288}], Cell["\<\ To get a traditional picture we have to colorcode the triples. The \ following selection of colors works reasonably well.\ \>", "Text", ImageSize->{288, 288}], Cell[BoxData[{ \(\(XX\ = \ X\ /. \ RankingRules[A, Index \[Rule] 0];\)\), "\[IndentingNewLine]", \(\(colrul\ = \ RankingRules[{10, 8, 1, 6, 12, 22, 11, 13}];\)\), "\[IndentingNewLine]", \(\(PlotMatrix[\ OrbitCA[\ C, \ XX, \ 99]\ /. \ colrul, MultiCol \[Rule] True, \ NRows \[Rule] 50\ \ \ ];\)\)}], "Input", ImageSize->{288, 288}], Cell["The orbit is purely periodic with period 64.", "Text", ImageSize->{288, 288}], Cell[BoxData[ \(AnalyzeOrbit[\ globmap, \ X\ ]\)], "Input", ImageSize->{288, 288}], Cell["\<\ Note that the table frules makes no direct provisions for the \ crossing of particles; nonetheless, the default works as intended. Needless \ to say, one cannot use the quadratic algorithm from below to test this CA for \ reversibility.\ \>", "Text", ImageSize->{288, 288}] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Elementary CAs and Symmetries", "Subsection", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}, CellTags->"c:7"], Cell[TextData[{ "Binary CAs of width 3 are often referred to as elementary CAs. There are \ only 256 such automata, but they still display a wide variety of behaviors. \ Hence, they are ideally suited as a standard test set for algorithms. \ Actually, it is sometimes possible to limit one's attention to even fewer \ machines since they are already equivalent in some sense to the collection of \ all elementary CAs. An example are properties of the global maps of a CA such \ as injectivity and surjectivity. It is clear that these properties are \ invariant under permutations of the underlying alphabet. Thus, to speed up \ searches, we can eliminate CAs that can be obtained by such permutations. \n\ As another example, let us determine how many elementary CAs are relevant to \ the study of their associated regular languages (see the next section). We \ can reduce the number of machines to be considered by interchanging 0 and 1 \ in the domain and/or range of the local map. Hence, we can associate any rule \ \[Rho] with four rules ", Cell[BoxData[ \(TraditionalForm\`\[Rho]\ = \ \[Rho]\_0\)]], ", ", Cell[BoxData[ \(TraditionalForm\`\[Rho]\_1\)]], ", ", Cell[BoxData[ \(TraditionalForm\`\[Rho]\_2\)]], " and ", Cell[BoxData[ \(TraditionalForm\`\[Rho]\_3\)]], " (which are not necessarily all distinct). Note that this is not the same \ as topological conjugacy. \nFor example, for rule number 89 we get the four \ following labelings: " }], "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[ \(\(\(With[\ {lab = IntegerDigits[89, 2, 8]}, \[IndentingNewLine]{lab, Reverse[lab], 1 - lab, Reverse[1 - lab]}\ ]\)\(//\)\(\ \)\(TableForm\)\(\ \)\)\)], "Input",\ AspectRatioFixed->True, ImageSize->{288, 288}], Cell[TextData[{ "In general, these variants are obtained by defining local maps\n\t", Cell[BoxData[ \(TraditionalForm\`\(\[Rho]\_0\)(X) = \[Rho](X)\)]], "\n\t", Cell[BoxData[ \(TraditionalForm\`\(\[Rho]\_1\)(X) = \[Rho](X\^c)\)]], "\n\t", Cell[BoxData[ \(TraditionalForm\`\(\[Rho]\_2\)(X) = \(\[Rho](X)\)\^c\)]], "\n\t", Cell[BoxData[ \(TraditionalForm\`\(\[Rho]\_3\)(X) = \(\[Rho](X\^c)\)\^c\)]], "\nwhere ", Cell[BoxData[ \(TraditionalForm\`Z\^\(\(\ \)\(c\)\)\)]], " denotes the result of exchanging 0's and 1's. We call a rule \[Rho] is \ essential iff ", Cell[BoxData[ \(TraditionalForm\`\[Rho]\ \[LessEqual] \ \[Rho]\_\(\(\ \)\(i\)\)\)]], " for ", Cell[BoxData[ \(TraditionalForm\`i\ = \ 0, \[Ellipsis], 3\)]], ". By Burnside's lemma, there are ", Cell[BoxData[ \(TraditionalForm\`2\^\(n - 2\) + 2\^\(n/2 - 1\)\)]], " essential binary rules of width ", Cell[BoxData[ \(TraditionalForm\`w\)]], " where ", Cell[BoxData[ \(TraditionalForm\`n = 2\^w\)]], ". In particular, there are 72 essential binary rules of width 3:" }], "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(normalForm[L_List]\ := \ First@Sort[{L, Reverse[L], 1 - L, 1 - Reverse[L]}]\), "\n", \(\(all\ = \ IntegerDigits[\ Range[0, 255], 2, 8];\)\), "\n", \(\(cls\ = \ ToClasses[\ all, \ normalForm, Type \[Rule] Function];\)\), "\n", \(Length\ /@ \ cls\), "\n", \(cls\ // \ Length\)}], "Input", ImageSize->{288, 288}], Cell["\<\ Quiescent rules, i.e., those that map 000 to 0, have even code \ numbers.\ \>", "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(\(essentialrules\ = \ \(FromDigits[#, 2] &\)\ /@ \ \(First\ /@ \ cls\);\)\), "\[IndentingNewLine]", \(quiesc = Select[essentialrules, EvenQ]\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell["\<\ Here are pictures of the evolution of a one point seed pattern for \ some essential quiescent binary rules of width 3. Note the size of the \ graphics object. \ \>", "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(\(gr = \(EvolutionCA[\ CA[#], 40, DisplayFunction \[Rule] Identity] &\) /@ quiesc;\)\), "\[IndentingNewLine]", \(gr\ // \ ByteCount\)}], "Input", ImageSize->{288, 288}], Cell[BoxData[ \(\(ShowArray[ gr\[LeftDoubleBracket]{9, 11, 13, 15}\[RightDoubleBracket]];\)\)], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[ \(\(ShowArray[Take[gr, \(-16\)]];\)\)], "Input", AspectRatioFixed->True, ImageSize->{288, 288}] }, Closed]], Cell[CellGroupData[{ Cell["Totalistic Cellular Automata", "Subsection", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}, CellTags->"c:8"], Cell[TextData[{ "There are many ways to reduce the size of the rule space for cellular \ automata by imposing conditions on the kind of admissible rules. Here we \ consider briefly a restriction based on addition over digit alphabets, \ so-called ", StyleBox["totalistic", FontColor->RGBColor[0, 0, 1]], " rules.\n\t", Cell[BoxData[ \(TraditionalForm\`\[Rho](x\_1, \[Ellipsis], x\_w)\ \ = \ f(\ x\_1 + \[Ellipsis]\ + \ x\_w)\)]], ".\nThe number of such rules is ", Cell[BoxData[ \(TraditionalForm\`k\^\(\(\ \)\(w(k - 1) + 1\)\)\)]], " as opposed to the ", Cell[BoxData[ \(TraditionalForm\`k\^\(\(\ \)\(k\^\(\(\ \)\(w\)\)\)\)\)]], " unrestricted rules. " }], "Text", ImageSize->{288, 288}], Cell[BoxData[ \(Table[\ NumberOfTotalisticCA[k, 2], \ {k, 2, 8}\ ]\)], "Input", ImageSize->{288, 288}], Cell[TextData[{ "At present, totalistic rules are simply translated into ordinary cellular \ automata via command ", ButtonBox["TotalisticRuleToCA", ButtonStyle->"AddOnsLink"], "." }], "Text", ImageSize->{288, 288}], Cell[BoxData[{ \(TotalisticRuleToCA[6, 2, 105\ ]\), "\[IndentingNewLine]", \(\(EvolutionCA[%];\)\)}], "Input", ImageSize->{288, 288}], Cell["\<\ The smaller rule spaces allow for more complete searches. It is \ not hard to show that totalistic cellular automata are computationally \ universal, so one may expect complicated behavior.\ \>", "Text", ImageSize->{288, 288}], Cell[BoxData[ \(ca\ = \ TotalisticRuleToCA[\ 3, 4, 722797]\)], "Input", ImageSize->{288, 288}], Cell[BoxData[ \(\(X = {2, 1, 1, 2, 1, 2, 1, 0, 3, 1, 3, 1, 2, 0, 1, 1, 0, 2, 0, 1, 0, 1, 1, 1, 1, 3, 1, 1, 2, 3, 2, 3, 1, 0, 3, 1, 3, 2, 0, 0, 0, 1, 2, 1, 3, 2, 1, 2, 3, 0, 2, 3, 1, 2, 3, 2, 1, 3, 1, 3, 0, 1, 2, 3, 2, 3, 1, 1, 1, 3, 1, 3, 2, 2, 3, 2, 0, 2, 2, 3, 0, 3, 0, 1, 2, 3, 1, 3, 1, 0, 0, 2, 0, 2, 0, 2, 2, 1, 0, 3};\)\)], "Input", ImageSize->{288, 288}], Cell[BoxData[ \(\(gr = EvolutionCA[ca, X, 130, GridLines \[Rule] False, RasterStyle \[Rule] {0 \[Rule] Green, 1 \[Rule] White, 2 \[Rule] Red, 3 \[Rule] Blue}];\)\)], "Input", ImageSize->{288, 288}], Cell["\<\ The starting configuration below is random and was chosen because \ it displays domain walls nicely; more examples with similar behavior can \ easily be generated. \ \>", "Text", ImageSize->{288, 288}], Cell[BoxData[ \(\(X\ = \ {1, 3, 0, 3, 2, 3, 0, 1, 0, 0, 1, 3, 1, 0, 0, 0, 3, 1, 2, 1, 3, 0, 1, 0, 3, 2, 3, 3, 2, 3, 0, 3, 2, 1, 1, 3, 3, 2, 2, 3, 2, 0, 1, 2, 0, 1, 2, 1, 0, 3, 3, 2, 1, 2, 1, 1, 2, 2, 0, 2, 3, 3, 3, 1, 0, 2, 0, 0, 1, 3, 0, 0, 1, 3, 1, 0, 1, 2, 3, 1, 2, 2, 3, 1, 3, 0, 2, 1, 2, 3, 1, 0, 1, 2, 1, 2, 0, 0, 1, 3, 1, 3, 2, 2, 2, 3, 3, 0, 0, 0, 1, 1, 0, 3, 0, 1, 2, 2, 3, 1, 3, 2, 2, 3, 3, 1, 0, 0, 0, 1, 3, 3, 2, 1, 2, 0, 2, 1, 1, 1, 3, 2, 3, 1, 1, 3, 1, 0, 2, 2, 2, 0, 3, 3, 3, 3, 2, 0, 0, 1, 0, 2, 0, 2, 1, 2, 2, 1, 3, 1, 2, 3, 3, 0, 2, 1, 2, 3, 0, 3};\)\)], "Input", ImageSize->{288, 288}], Cell[BoxData[{ \(\(ca = TotalisticRuleToCA[3, 4, 782340];\)\), "\n", \(\(gr = EvolutionCA[ca, X, 140, GridLines \[Rule] False, RasterStyle \[Rule] {0 \[Rule] Green, 1 \[Rule] Blue, 2 \[Rule] Red, 3 \[Rule] White}];\)\)}], "Input", ImageSize->{288, 288}], Cell["We should expect relatively short transients from this rule.", "Text", ImageSize->{288, 288}], Cell[BoxData[{ \(\(Y = {3, 3, 3, 2, 0, 0, 1, 0, 2, 1, 2, 1, 0, 2, 1, 3, 1, 2, 3, 3, 3};\)\), "\n", \(\(GlobalMapCA[f, ca];\)\), "\n", \(AnalyzeOrbit[f, Y]\)}], "Input", ImageSize->{288, 288}], Cell["Some totalistic rules of width 3 over a 4-symbol alphabet. ", "Text", ImageSize->{288, 288}], Cell[BoxData[{ \(\(ca = TotalisticRuleToCA[3, 4, 782353];\)\), "\n", \(\(gr = EvolutionCA[ca, X, 100, GridLines \[Rule] False, RasterStyle \[Rule] {0 \[Rule] Green, 1 \[Rule] Blue, 2 \[Rule] Red, 3 \[Rule] White}];\)\)}], "Input", ImageSize->{288, 288}], Cell[BoxData[{ \(\(ca = TotalisticRuleToCA[3, 4, 782359];\)\), "\n", \(\(gr = EvolutionCA[ca, X, 100, GridLines \[Rule] False, RasterStyle \[Rule] {0 \[Rule] Green, 1 \[Rule] Blue, 2 \[Rule] Red, 3 \[Rule] White}];\)\)}], "Input", ImageSize->{288, 288}], Cell[BoxData[{ \(\(ca = TotalisticRuleToCA[3, 4, 833219];\)\), "\n", \(\(EvolutionCA[ca, X, 150, RasterStyle \[Rule] {0 \[Rule] Blue, 1 \[Rule] Yellow, 2 \[Rule] Red, 3 \[Rule] Green}];\)\)}], "Input", ImageSize->{288, 288}] }, Closed]], Cell[CellGroupData[{ Cell["Firing Squad", "Subsection", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}, CellTags->"c:7"], Cell[TextData[{ "Below are a number of solutions to the Firing Squad problem as examples. \ Note that these cellular automata would be better represented as collections \ of rewrite rules. Alas, at present the constructor ", ButtonBox["CA", ButtonStyle->"AddOnsLink"], " requires an explicit rank of the rule in question. When alphabets and/or \ widths get large, this may produce ridiculously large numbers. \n\nNote that \ the external code currently fails to recognize ", StyleBox["$defzero", "MR"], ", so it has to be turned off for the following computations." }], "Text", ImageSize->{288, 288}], Cell[BoxData[ \(ExtAutomata[False]\)], "Input", ImageSize->{288, 288}], Cell[CellGroupData[{ Cell["Moews ", "Subsubsection", ImageSize->{288, 288}, CellTags->"c:24"], Cell["A CA over an alphabet of size 13.", "Text", ImageSize->{288, 288}], Cell[BoxData[ \(\(C\ = \ CA[\ 3, \(-13\), 21539186298170340139300263226890654007820971562149335303444132391703\ 735266535509362910426038251086154480870927835754490766672166650121099015967186\ 502805256400754065029994536780508589522931514112026609470766032587979202798292\ 218438160818765457350739592866652006292359733259401361298593667920433912891373\ 614231673054993885596247663534941351603100034488102670406619443645861259834598\ 568420298415167683708877762475064391409052235194562824552999461259939227558024\ 704549844560169757582293382517718626330869515521175751980279643520467852062578\ 974050239648413037015363335296550197575545788647043122206866868584116961676704\ 189643047647399800611625034497536571487190834814858448710886474827160024317305\ 089234976853212018933982925480522867671989683298929675861637227560023412559299\ 477097692791166532289016772739057889618329524191885501633134287299325125027704\ 291347473460698891959128301661258373502272365001077557850862215497697701224085\ 892491916893638308828103590609279217415045870764514726532731526511778922079810\ 429855831517793609115208107644120518942001055346138134826294773054082320856948\ 278662506638695687627950533617182499742477510025744323528955171400337201115885\ 914731705308940405306744323832533734412280353259589975113733448974471481637562\ 446319709500954322806058066837830253374232008259128715544070958514743590746535\ 719810787633608891159022397438638546148549086135364484193931997903801341000343\ 110790064795621928889926370940789312842246061134175755987995687588642869775610\ 147800370392355741099610342126868455673540496700171965668486838615154757813918\ 426783395024585027608573984240219272351365382158980109456482337540001039707932\ 907477786613957119925988957784590072233984474219599739236251358734382080305197\ 855964581539393075842891117356073450928314447603798956508116261356824795132701\ 551805150563223238298569782067323760968229869877732809363176515979589659106162\ 777832518567784352390319505395756029971936539059991190253691002024864663291205\ 700996118544447549615248073348387861143529574774626323390153914112521471981095\ 988615462674447100387654344710094653418090674187941755501440476601360455775529\ 989810247265648312872307653837289318146680273071236280340286560741122074656237\ 006984507488957171266316472073710412013766585977581869619328939844457890677802\ 204526404934391674139157736265405069853483368901733686702667521888845786203871\ 955775373574452885996194728468397486360643110791153592441806634577825122113864\ 22905294367];\)\)], "Input", ImageSize->{288, 288}], Cell["\<\ Since there is currently no representation of the local maps other \ than an explicit rule number this is a bit clumsy. It takes 2171 digits in \ base 13 to write down the rule number.\ \>", "Text", ImageSize->{288, 288}], Cell[BoxData[{ \(DigitCount[\ RuleCA[C], \ 13\ ]\), "\[IndentingNewLine]", \(Plus @@ %\)}], "Input", ImageSize->{288, 288}], Cell[BoxData[{ \(\(cols\ = \ Join[\ {0 \[Rule] RGBColor[0.95, 0.95, 0.95]}, \ Rest@HueRasterColors[13]];\)\), "\n", \(\(X\ = \ SeedConfiguration[{3}, 101, \ Where \[Rule] Left];\)\), "\n", \(\(Block[\ {Automata`automata`Private`$defzero\ = \ 2}, \[IndentingNewLine]EvolutionCA[\ C, X, 300, \ Boundary \[Rule] \ Fixed, RView \[Rule] True, \ RasterStyle \[Rule] \ cols\ \ ]];\)\)}], "Input", ImageSize->{288, 288}] }, Closed]], Cell[CellGroupData[{ Cell["Karr", "Subsubsection", ImageSize->{288, 288}, CellTags->"c:26"], Cell[BoxData[ \(\(C\ = \ CA[\ 3, \(-12\), 12156576341229004671820018325354952135066311604933974648055869842517\ 664431301199341930538927377081663228117279716088372353765691914588722619071249\ 286079500868068981391304028618974581983030689313838007280294776042957867234106\ 876021472665849056717408544113624407829106175677755477298716753973882476856566\ 886627037988055148237327290474468493198770049047073437147334707696389772181365\ 481060915308355162649579924904636131263078661072337836138859913352196563101966\ 694574230268243452331811937416746034043239723417048552699133795963802752230243\ 429804994069022788590053541375102960579571162336591893965272925915744285277196\ 917799935538884036480842708292403365591126453376738898314947267751533718333704\ 112802371536654674798371204182116755842333189516058663611550312353311949560659\ 368295996908351876946220753748014461288613522210644582360889997662922333448701\ 059844575532855695731390463733751578990751367812026417937765326813418215628026\ 177157409409344717498186022060882830357045939607258727081229001812846900706080\ 119335745694474196763545769735190431160439841899171948830579155102860486414216\ 442866482722916309203632317363823609799363607346314521386150862476731067116468\ 558898084729225681137007113339622052833552391463299911856546308522985020819086\ 649825996728291913601189202317983091993817127733003104519592948450428335567482\ 126237913959440070687600939392073263498848175346015409619483440423516438713640\ 772687730617975463484861589693174731849077072089196252201524977179588591588700\ 712316014464952995085946535834832541948473360980539283071062120981349269579919\ 997908765581489381437224675117745531824842590805014814678041152512828905768571\ 973985426839036213712990885367953869482678614816513197135246576208353410486325\ 528503440843242034564207784319603113890550820709149909659754416821432668067125\ 812703325771688134525539572545218051869458300999862109400594411762987450372512\ 464];\)\)], "Input", ImageSize->{288, 288}], Cell[BoxData[{ \(\(cols\ = \ Join[\ {0 \[Rule] White}, \ Rest@HueRasterColors[12]];\)\), "\n", \(\(X\ = \ SeedConfiguration[{2}, \ 101, \ Where \[Rule] Left\ ];\)\), "\n", \(\(Block[\ {Automata`automata`Private`$defzero\ = \ 1}, \[IndentingNewLine]EvolutionCA[\ C, X, 200, \ Boundary \[Rule] \ Fixed, \ RasterStyle \[Rule] \ cols\ \ ]];\)\)}], "Input", ImageSize->{288, 288}] }, Closed]], Cell[CellGroupData[{ Cell["Moore", "Subsubsection", ImageSize->{288, 288}, CellTags->"c:25"], Cell[BoxData[ \(\(C\ = \ CA[\ 3, \ \(-9\), 40925900018646101014442687976291633726932780659263085930938302240996\ 092490275935191852452103733175577241020564391083280186052537010254685317311895\ 624617818876957277463216421782570595407864127541967861102363169660174557502236\ 145961940809378118649185320222650201360088017843314104802394635900203001614688\ 910176538944227595482173477403308609548527114944435373479111330238512891122169\ 414591633644957223563747784265612513457965773074718283106227606875989305766682\ 853533816663650730440056177297789700825878322990864342737174761392594732683485\ 381481466395295588294727276360910161104175263289262117787949587572229101867683\ 175004556383362016182964060700855424677821932414955814252956340236946224189774\ 1511];\)\)], "Input", ImageSize->{288, 288}], Cell[BoxData[{ \(\(cols\ = \ Join[\ {0 \[Rule] White}, Drop[HueRasterColors[9], 1]\ ];\)\), "\n", \(X = SeedConfiguration[{1}, 80, Where \[Rule] Left]; Block[\ {Automata`automata`Private`$defzero\ = \ 5}, \[IndentingNewLine]EvolutionCA[\ C, X, 230, \ Boundary \[Rule] \ Fixed, \ RasterStyle \[Rule] \ cols\ \ ]];\)}], "Input", ImageSize->{288, 288}] }, Closed]], Cell[CellGroupData[{ Cell["Waksman", "Subsubsection", ImageSize->{288, 288}, CellTags->"c:27"], Cell[BoxData[ \(\(C\ = \ CA[\ 3, \(-9\), 13000735584836041665926658477146715512230321231116374987908620733121\ 671667041562846163315563039895498795187500143609848460317458304472350663084389\ 030636448691001814166476351171707050477843793247697152289563956354023189379810\ 070352205705415394140599146451338060997894968221385961119720702997732111909865\ 631380711670182716551552076153210860610720337110227083950442041762729912819815\ 908313779608862928582566744459436814973177894511727102106647011556545375927502\ 661301237504513576058515913074748730375828565073382716211963647915120808136514\ 512817690829744291786176876244558892595472606889373225145429992942906501084235\ 517428247735644557692062413334233773206414633458];\)\)], "Input", ImageSize->{288, 288}], Cell[BoxData[{ \(\(X = SeedConfiguration[\ 75, Where \[Rule] Left];\)\), "\n", \(\(cols = {0 \[Rule] RGBColor[0.95, 0.95, 0.95], 1 \[Rule] Ultramarine, 2 \[Rule] Yellow, 3 \[Rule] LightBlue, 4 \[Rule] SkyBlue, 5 \[Rule] Red, 6 \[Rule] Cyan, 7 \[Rule] Magenta, 8 \[Rule] Blue};\)\), "\n", \(\(Block[{Automata`automata`Private`$defzero = 5}, EvolutionCA[C, X, 150, Boundary \[Rule] Fixed, RasterStyle \[Rule] cols]];\)\)}], "Input", ImageSize->{288, 288}] }, Closed]], Cell[CellGroupData[{ Cell["Mazoyer", "Subsubsection", ImageSize->{288, 288}, CellTags->"c:28"], Cell[BoxData[ \(\(C\ = \ CA[\ 3, \ \(-6\), \ 37530235756504449597215387776201530727026778732239820223772879591465\ 706914307758173014941907997434359014594156344912956259937466230274055158802801\ 5151872];\)\)], "Input", ImageSize->{288, 288}], Cell[BoxData[{ \(\(cols\ = \ Join[\ {0 \[Rule] RGBColor[0.95, 0.95, 0.95], 1 \[Rule] Yellow, 2 \[Rule] Cyan, 3 \[Rule] LightSlateBlue, 4 \[Rule] Blue, 5 \[Rule] Magenta}];\)\), "\n", \(\(X\ = \ SeedConfiguration[{1}, 160, \ Where \[Rule] Left\ ];\)\), "\n", \(\(Block[{Automata`automata`Private`$defzero\ = \ 5}, EvolutionCA[\ C, X, 330, \ Boundary \[Rule] \ Fixed, RasterStyle \[Rule] \ cols\ \ ]];\)\)}], "Input", ImageSize->{288, 288}] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Two-Dimensional Cellular Automata", "Subsection", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}, CellTags->"c:18"], Cell[TextData[{ "Since the ", StyleBox["Automata", "MR"], " package focuses on automata theoretic aspects of cellular automata there \ is no direct support for higher dimensional cellular automata. Nonetheless, \ one can still use some of the machinery together with the built-in ", ButtonBox["CellularAutomaton", ButtonStyle->"RefGuideLink"], " to generate, display and analyze orbits of 2-dimensional automata, at \ least in reasonably simple cases. Note that ", ButtonBox["CellularAutomaton", ButtonStyle->"RefGuideLink"], " actually generates an orbit, it is not representation of the cellular \ automaton. Here are some simple examples." }], "Text", ImageSize->{288, 288}], Cell[CellGroupData[{ Cell["Fredkin Automata", "Subsubsection", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}, FontFamily->"Charter", CellTags->"c:19"], Cell["\<\ Von Neumann's original construction of a self-reproducing machine \ was a 2-dimensional cellular automaton with 29 states requiring hundreds of \ thousands of cells. The automaton constructed by von Neumann is burdened by \ computational universality, beyond self-reproduction it also can perform \ arbitrary computations. As it turns out, if all one cares about is the \ duplication of patterns in a configuration there is an embarrassingly simple \ solution to the self-reproduction problem: addition modulo 2.\ \>", "Text", ImageSize->{288, 288}], Cell[BoxData[{\(Clear[Fredkin]\), "\n", RowBox[{ RowBox[{\(Fredkin[m_]\), " ", ":=", " ", StyleBox[\(Function[\ Mod[Plus @@ Dot[Flatten[#], {0, 1, 0, 1, 1, 1, 0, 1, 0}], m\ ]]\), ShowSpecialCharacters->False, ShowStringCharacters->True, NumberMarks->True]}], StyleBox[";", ShowSpecialCharacters->False, ShowStringCharacters->True, NumberMarks->True]}]}], "Input", ImageSize->{288, 288}], Cell[BoxData[{ RowBox[{ RowBox[{"orb", " ", "=", " ", RowBox[{"CellularAutomaton", "[", " ", RowBox[{ RowBox[{"{", " ", RowBox[{ TagBox[ StyleBox[\(Fredkin[2]\), ShowSpecialCharacters->False, ShowStringCharacters->True, NumberMarks->True], FullForm], ",", \({}\), ",", " ", \({1, 1}\)}], " ", "}"}], ",", " ", \({{{1}}, \ 0\ }\), ",", " ", "15"}], " ", "]"}]}], ";"}], "\n", \(\(PlotMatrix[#, DisplayFunction \[Rule] Identity] &\)\ /@ \ \ orb;\), "\n", \(ShowArray[%, 4];\)}], "Input", ImageSize->{288, 288}], Cell[TextData[{ "At times ", Cell[BoxData[ \(TraditionalForm\`t\ = \ 2\^\(\(\ \)\(k\)\)\)]], " one has a five-fold repetition of the original one-point seed. Because \ of the linearity of the rule the same holds for arbitrary finite patterns for \ sufficiently large ", Cell[BoxData[ \(TraditionalForm\`k\)]], ". " }], "Text", ImageSize->{288, 288}], Cell[BoxData[ \(\(ini\ = {{1, 0, 0}, {1, 1, 0}, {1, 1, 1}};\)\)], "Input", ImageSize->{288, 288}], Cell[BoxData[{ RowBox[{ RowBox[{"orb", " ", "=", " ", RowBox[{"CellularAutomaton", "[", " ", RowBox[{ RowBox[{"{", " ", RowBox[{ RowBox[{ TagBox[ StyleBox["Fredkin", ShowSpecialCharacters->False, ShowStringCharacters->True, NumberMarks->True], FullForm], "[", "2", "]"}], ",", \({}\), ",", " ", \({1, 1}\)}], " ", "}"}], ",", " ", \({\ ini, \ 0\ }\), ",", " ", "15"}], " ", "]"}]}], ";"}], "\n", \(gr\ = \ \(PlotMatrix[#, DisplayFunction \[Rule] Identity] &\)\ /@ \ \ orb;\), "\n", \(ShowArray[ gr];\)}], "Input", ImageSize->{288, 288}], Cell["Alternatively, one can use higher moduli.", "Text", ImageSize->{288, 288}], Cell[BoxData[{ RowBox[{ RowBox[{"orb", " ", "=", " ", RowBox[{"CellularAutomaton", "[", " ", RowBox[{ RowBox[{"{", " ", RowBox[{ TagBox[ StyleBox[\(Fredkin[5]\), ShowSpecialCharacters->False, ShowStringCharacters->True, NumberMarks->True], FullForm], ",", \({}\), ",", " ", \({1, 1}\)}], " ", "}"}], ",", " ", \({{{1}}, \ 0\ }\), ",", " ", "15"}], " ", "]"}]}], ";"}], "\n", \(\(PlotMatrix[#, DisplayFunction \[Rule] Identity] &\)\ /@ \ \ orb;\), "\n", \(ShowArray[%, 4];\)}], "Input", ImageSize->{288, 288}], Cell["Further out in the orbit.", "Text", ImageSize->{288, 288}], Cell[BoxData[{ RowBox[{ RowBox[{"orb", " ", "=", " ", RowBox[{"CellularAutomaton", "[", " ", RowBox[{ RowBox[{"{", " ", RowBox[{ TagBox[ StyleBox[\(Fredkin[5]\), ShowSpecialCharacters->False, ShowStringCharacters->True, NumberMarks->True], FullForm], ",", \({}\), ",", " ", \({1, 1}\)}], " ", "}"}], ",", " ", \({{{1}}, \ 0\ }\), ",", " ", "49", ",", " ", \(-9\)}], " ", "]"}]}], ";"}], "\n", \(\(PlotMatrix[#, DisplayFunction \[Rule] Identity] &\)\ /@ \ Take[orb, \(-4\)];\), "\n", \(ShowArray[%, 2];\)}], "Input", ImageSize->{288, 288}], Cell["\<\ Here is an orbit for fixed size configurations with cyclic boundary \ conditions.\ \>", "Text", ImageSize->{288, 288}], Cell[BoxData[ \(twoDimSeed[n_]\ := \ \[IndentingNewLine]ReplacePart[\ Array[0 &, {2 n + 1, 2 n + 1}], 1, {n + 1, n + 1}]\)], "Input", ImageSize->{288, 288}], Cell[BoxData[{ RowBox[{ RowBox[{"orb", " ", "=", " ", RowBox[{"CellularAutomaton", "[", " ", RowBox[{ RowBox[{"{", " ", RowBox[{ TagBox[ StyleBox[\(Fredkin[2]\), ShowSpecialCharacters->False, ShowStringCharacters->True, NumberMarks->True], FullForm], ",", \({}\), ",", " ", \({1, 1}\)}], " ", "}"}], ",", " ", \(twoDimSeed[5]\), ",", " ", "35"}], " ", "]"}]}], ";"}], "\n", \(gr\ = \ \(PlotMatrix[#, DisplayFunction \[Rule] Identity] &\)\ /@ \ \ orb;\), "\n", \(ShowArray[ gr];\)}], "Input", ImageSize->{288, 288}], Cell[BoxData[{ RowBox[{ RowBox[{"orb", " ", "=", " ", RowBox[{"CellularAutomaton", "[", " ", RowBox[{ RowBox[{"{", " ", RowBox[{ TagBox[ StyleBox[\(Fredkin[2]\), ShowSpecialCharacters->False, ShowStringCharacters->True, NumberMarks->True], FullForm], ",", \({}\), ",", " ", \({1, 1}\)}], " ", "}"}], ",", " ", \(twoDimSeed[7]\), ",", " ", "24"}], " ", "]"}]}], ";"}], "\n", \(gr\ = \ \(PlotMatrix[#, DisplayFunction \[Rule] Identity] &\)\ /@ \ \ orb;\), "\n", \(ShowArray[ gr];\)}], "Input", ImageSize->{288, 288}] }, Closed]], Cell[CellGroupData[{ Cell["Conway's Game of Life", "Subsubsection", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}, FontFamily->"Charter", CellTags->"c:20"], Cell[TextData[{ "Undoubtedly the most popular two-dimensional cellular automaton is Conways \ Game of Life, a binary CA using a Moore 9-point neighborhood. Conway's CA is \ know to be computationally universal, so one may fairly expect very \ complicated orbits even for simple starting configurations. The rule is \ semi-totalistic: the next value of the center cell depends on the sum ", Cell[BoxData[ \(TraditionalForm\`s\)]], " of the values of the 8 neighbors, and the value ", Cell[BoxData[ \(TraditionalForm\`c\)]], " of the center cell:\n\t\t\tif ", Cell[BoxData[ \(TraditionalForm\`\((c = \(1\ \[And] \ s = 2\))\)\ \[Or] \ s = 3\)]], " then center cell has state 1, else 0 in the next generation.\nIt is \ straightforward to implement this rule." }], "Text", ImageSize->{288, 288}], Cell[BoxData[ RowBox[{ RowBox[{"Conway", " ", "=", " ", RowBox[{ StyleBox["Function", ShowSpecialCharacters->False, ShowStringCharacters->True, NumberMarks->True], StyleBox["[", ShowSpecialCharacters->False, ShowStringCharacters->True, NumberMarks->True], StyleBox[" ", ShowSpecialCharacters->False, ShowStringCharacters->True, NumberMarks->True], RowBox[{ StyleBox["With", ShowSpecialCharacters->False, ShowStringCharacters->True, NumberMarks->True], StyleBox["[", ShowSpecialCharacters->False, ShowStringCharacters->True, NumberMarks->True], RowBox[{ RowBox[{ StyleBox["{", ShowSpecialCharacters->False, ShowStringCharacters->True, NumberMarks->True], StyleBox[\(nb = Count[#\ *{{1, 1, 1}, {1, 0, 1}, {1, 1, 1}}, 1, {\(-1\)}]\), ShowSpecialCharacters->False, ShowStringCharacters->True, NumberMarks->True], "}"}], ",", "\[IndentingNewLine]", \(If[\ \((#[\([2, 2]\)] == 1 && nb \[Equal] 2)\) || nb == 3, 1, 0]\)}], "]"}], "]"}]}], ";"}]], "Input", ImageSize->{288, 288}], Cell["A 5 by 5 block evolves to a fixed point after 11 steps.", "Text", ImageSize->{288, 288}], Cell[BoxData[{ \(\(orb\ = \ CellularAutomaton[\ {\ Conway, {}, \ {1, 1}\ }, \ {\ Array[\ 1 &, {5, 5}], \ 0\ }, \ 11\ ];\)\), "\n", \(\(\(PlotMatrix[#, DisplayFunction \[Rule] Identity] &\)\ /@ \ \ orb;\)\), "\n", \(\(ShowArray[%];\)\)}], "Input", ImageSize->{288, 288}], Cell["A 7 by 7 block evolves to a 2-cycle after 5 steps.", "Text", ImageSize->{288, 288}], Cell[BoxData[{ \(\(orb\ = \ CellularAutomaton[\ {\ Conway, {}, \ {1, 1}\ }, \ {\ Array[\ 1 &, {7, 7}], \ 0\ }, \ 11\ ];\)\), "\n", \(\(\(PlotMatrix[#, DisplayFunction \[Rule] Identity] &\)\ /@ \ \ orb;\)\), "\n", \(\(ShowArray[%];\)\)}], "Input", ImageSize->{288, 288}], Cell["\<\ A glider, a configuration that is periodic with period 4, but only \ modulo a displacement in space.\ \>", "Text", ImageSize->{288, 288}], Cell[BoxData[{ \(\(ini\ = \ Array[1 &, {3, 3}];\)\), "\n", \(\(ini\ = \ ReplacePart[ini, 0, {{2, 2}, {2, 3}, {3, 1}, {3, 3}}];\)\)}], "Input",\ ImageSize->{288, 288}], Cell[BoxData[{ \(\(orb\ = \ CellularAutomaton[\ {\ Conway, {}, \ {1, 1}\ }, \ {\ ini, \ 0\ }, 15\ ];\)\), "\n", \(\(\(PlotMatrix[#, DisplayFunction \[Rule] Identity, GridLines \[Rule] True\ ] &\)\ /@ \ \ orb;\)\), "\n", \(\(ShowArray[%];\)\)}], "Input", ImageSize->{288, 288}], Cell[TextData[{ "A configuration that evolves to fixed point ", Cell[BoxData[ \(TraditionalForm\`0\)], FontWeight->"Bold"], ", but takes a relatively long time of 130 steps to do so. Here are the \ first and the last 36 steps." }], "Text", ImageSize->{288, 288}], Cell[BoxData[{ \(\(ini\ = \ Array[0 &, {3, 8}];\)\), "\n", \(\(ini\ = \ ReplacePart[ini, 1, {{1, 7}, {2, 1}, {2, 2}, {3, 1}, {3, 6}, {3, 7}, {3, 8}}];\)\)}], "Input", ImageSize->{288, 288}], Cell[BoxData[{ \(\(orb\ = \ CellularAutomaton[\ {\ Conway, {}, \ {1, 1}\ }, \ {\ ini, \ 0\ }, 35\ ];\)\), "\n", \(\(\(PlotMatrix[#, DisplayFunction \[Rule] Identity] &\)\ /@ \ \ orb;\)\), "\n", \(\(ShowArray[%];\)\)}], "Input", ImageSize->{288, 288}], Cell[BoxData[{ \(\(orb\ = \ CellularAutomaton[\ {\ Conway, {}, \ {1, 1}\ }, \ {\ ini, \ 0\ }, 130, \ \(-36\)\ ];\)\), "\n", \(\(\(PlotMatrix[#, DisplayFunction \[Rule] Identity] &\)\ /@ \ \ orb;\)\), "\n", \(\(ShowArray[%];\)\)}], "Input", ImageSize->{288, 288}], Cell["Lastly, a configuration that grows indefinitely.", "Text", ImageSize->{288, 288}], Cell[BoxData[{ \(\(ini\ = \ Array[1 &, {5, 5}];\)\), "\n", \(\(ini\ = \ ReplacePart[ini, 0, {{1, 4}, {2, 2}, {2, 3}, {2, 4}, {2, 5}, {3, 1}, {3, 2}, {3, 3}, {4, 1}, {4, 4}, {5, 2}, {5, 4}}];\)\)}], "Input", ImageSize->{288, 288}], Cell[BoxData[{ \(\(orb\ = \ CellularAutomaton[\ {\ Conway, {}, \ {1, 1}\ }, \ {\ ini, \ 0\ }, 35\ ];\)\), "\n", \(\(\(PlotMatrix[#, DisplayFunction \[Rule] Identity] &\)\ /@ \ \ orb;\)\), "\n", \(\(ShowArray[%];\)\)}], "Input", ImageSize->{288, 288}] }, Closed]] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Shifts and Morphisms", "Section", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}, CellTags->"c:2"], Cell[CellGroupData[{ Cell["Sofic Systems", "Subsection", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}, CellTags->"c:3"], Cell[TextData[{ "Recall that a ", StyleBox["subshift", FontColor->RGBColor[0, 0, 1]], " ", Cell[BoxData[ \(TraditionalForm\`\(\(\[LeftAngleBracket]\ S, \ \[Sigma]\ \[RightAngleBracket]\)\(\ \)\)\)]], " consists of a set ", Cell[BoxData[ \(TraditionalForm\`S\ \[SubsetEqual] \ \ \[CapitalSigma]\^\[Infinity]\)]], " that is topologically closed and shift-invariant. ", Cell[BoxData[ \(TraditionalForm\`\[CapitalSigma]\^\(\(\ \)\(\[Infinity]\)\)\)]], " is also referred to as the ", StyleBox["full shift", FontColor->RGBColor[0, 0, 1]], ". We can associate with every every configuration ", Cell[BoxData[ \(TraditionalForm\`X\ \[Element] \ \[CapitalSigma]\^\(\(\ \)\(\ \[Infinity]\)\)\)]], " a set of finite words, the so-called ", StyleBox["cover of ", FontColor->RGBColor[0, 0, 1]], Cell[BoxData[ \(TraditionalForm\`X\)], FontColor->RGBColor[0, 0, 1]], ", consisting of all finite factors of ", Cell[BoxData[ \(TraditionalForm\`X\)]], ", in symbols ", Cell[BoxData[ \(TraditionalForm\`cov(X)\)]], ". For a set of configurations the cover is the union of all the covers of \ configurations in the set. By compactness we can reconstruct the subshift \ from the cover by taking limits, so there is no loss in information.\nThe \ appropriate morphisms between shift-spaces are are continuous shift-invariant \ maps. A classical (and easy) theorem by Curtis-Lyndon-Hedlund shows that \ these maps are precisely the global maps of cellular automata. See below for \ some basic questions relating to the classification of these maps.\nIt is \ natural to study subshifts whose covers have low complexity from the point of \ view of language theory. In particular, a subshift is a ", StyleBox["sofic system", FontColor->RGBColor[0, 0, 1]], " if its cover is a regular set. Hence we can recognize membership in a \ sofic system by a finite state machine. As we will see shortly, there is a \ natural normal form for these machines that is closely associated with the \ standard minimal DFA for a regular language.\nA subshift is ", StyleBox["transitive", FontColor->RGBColor[0, 0, 1]], " if for all words ", Cell[BoxData[ \(TraditionalForm\`u\)]], ", ", Cell[BoxData[ \(TraditionalForm\`v\)]], " in the cover there is some ", Cell[BoxData[ \(TraditionalForm\`w\)]], " in the cover such that ", Cell[BoxData[ \(TraditionalForm\`u\ w\ v\)]], " is also in the cover. It is strongly transitive if this word ", Cell[BoxData[ \(TraditionalForm\`w\)]], " can always be chosen to be of the same length. For sofic systems, the \ corresponding semiautomata are then transitive and strongly transitive, \ respectively." }], "Text", ImageSize->{288, 288}], Cell[TextData[{ "As an example, consider the shift not containing any blocks of the form ", Cell[BoxData[ \(TraditionalForm\`100 \[Ellipsis]001\)]], " where the number of 0's is even. Here is semiautomaton for the cover." }], "Text", ImageSize->{288, 288}], Cell[BoxData[ RowBox[{ RowBox[{"even", " ", "=", RowBox[{"SA", "[", " ", RowBox[{"2", ",", " ", \(-2\), ",", " ", TagBox[ RowBox[{ TagBox[\({{1, 1, 2}, {2, 1, 1}, {2, 2, 1}}\), (Short[ #, 4]&)], " "}], (Short[ #, 4]&)]}], " ", "]"}]}], ";"}]], "Input", ImageSize->{288, 288}], Cell["\<\ Two consecutive 1's are always separated by on odd number of 0's.\ \ \>", "Text", ImageSize->{288, 288}], Cell[BoxData[ \(LanguageFA[\ even, \ \(-6\)\ ]\)], "Input", ImageSize->{288, 288}], Cell["\<\ The growth rates up to words of length 20 suggest entropy 1/2 for \ this subshift.\ \>", "Text", ImageSize->{288, 288}], Cell[BoxData[ \(cen\ = \ LanguageFA[\ even, \ \(-20\), \ SizeOnly \[Rule] True\ ]\)], "Input", ImageSize->{288, 288}], Cell[BoxData[ \(N[Log[2, Rest[cen]]]/Range[20]\)], "Input", ImageSize->{288, 288}], Cell["The semiautomaton is deterministic and transitive.", "Text", ImageSize->{288, 288}], Cell[BoxData[ \(DeterministicQFA[even]\)], "Input", ImageSize->{288, 288}], Cell[BoxData[ \(TransitiveQFA[even]\)], "Input", ImageSize->{288, 288}] }, Closed]], Cell[CellGroupData[{ Cell["Shifts of Finite Type", "Subsection", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}, CellTags->"c:3"], Cell[TextData[{ "Note that for any subshift ", Cell[BoxData[ \(TraditionalForm\`S\)]], " the complement of the cover ", Cell[BoxData[ \(TraditionalForm\`\(\[CapitalSigma]\^*\) - cov(S)\)]], " forms an ideal. Hence we can describe the subshift in terms of a family \ ", Cell[BoxData[ \(TraditionalForm\`\((w\_i)\)\_i\)]], " of forbidden factors. In general, the family of forbidden blocks is \ countably infinite. A subshift is of ", StyleBox["finite type", FontColor->RGBColor[0, 0, 1]], " if the family of forbidden factors can be chosen to be finite. In other \ words, the ideal of forbidden blocks has a finite base.\nA standard example \ is the Golden Mean shift where there is only one forbidden block: 11. The \ number of words of length ", Cell[BoxData[ \(TraditionalForm\`n\)]], " in this subshift ", Cell[BoxData[ \(TraditionalForm\`F\_\(n + 1\)\)]], ", the ", Cell[BoxData[ \(TraditionalForm\`n + 1\)]], "th Fibonacci number." }], "Text", ImageSize->{288, 288}], Cell[BoxData[ \(\(gm\ = \ SA[2, \(-2\), {{1, 1, 1}, {2, 1, 1}, {1, 2, 2}}];\)\)], "Input", ImageSize->{288, 288}], Cell[BoxData[ \(LanguageFA[\ gm, \ \(-12\), \ SizeOnly \[Rule] True\ ]\)], "Input", ImageSize->{288, 288}], Cell["\<\ We verify that the complement of the cover has an ideal base of \ size 1. \ \>", "Text", ImageSize->{288, 288}], Cell[BoxData[ \(gmc\ = \ MinimizeFA[ComplementFA[gm]]\)], "Input", ImageSize->{288, 288}], Cell[BoxData[{ \(\(id\ = \ IdealBaseFA[gmc];\)\), "\[IndentingNewLine]", \(InfiniteQFA[id]\)}], "Input", ImageSize->{288, 288}], Cell[BoxData[ \(LanguageFA[id, \ Full \[Rule] True]\)], "Input", ImageSize->{288, 288}], Cell["We can check that the ideal automaton works as expected.", "Text", ImageSize->{288, 288}], Cell[BoxData[ \(With[\ {allid\ = \ ConcatenateFA[\ AllDFA[\(-2\)], id, AllDFA[\(-2\)]]}, \[IndentingNewLine]{\ UnionFA[\ allid, \ gm\ ]\ // \ FullQFA, \ \[IndentingNewLine]\ IntersectionFA[\ allid, \ gm\ ]\ // \ EmptyQFA\ }\ ]\)], "Input", ImageSize->{288, 288}], Cell[TextData[{ "We can construct semiautomata for shifts of finite type by removing some \ transitions from a de Bruijn automaton. More precisely, assume without loss \ of generality that all excluded words are of length ", Cell[BoxData[ \(TraditionalForm\`k\)]], ", construct the de Bruijn automaton of order ", Cell[BoxData[ \(TraditionalForm\`k\)]], " and remove all transitions labeled by forbidden words. Here is the \ construction for forbidden blocks ", Cell[BoxData[ \(TraditionalForm\`000\)]], ", ", Cell[BoxData[ \(TraditionalForm\`011\)]], " and ", Cell[BoxData[ \(TraditionalForm\`111\)]], ".\nFirst, the full de Bruijn graph." }], "Text", ImageSize->{288, 288}], Cell[BoxData[{ \(G\ = DeBruijnGraph[2, \(-2\), Normalize \[Rule] 1]\), "\n", \(V\ = \ VertexSet[G]\), "\n", \(ed\ = \ Edges[G]\)}], "Input", ImageSize->{288, 288}], Cell["Remove the edges corresponding to the forbidden words. ", "Text", ImageSize->{288, 288}], Cell[BoxData[ \(ed0 = Select[ed, \(! MemberQ[{"\<000\>", "\<011\>", "\<111\>"}, WordFusion[ V\[LeftDoubleBracket]#1\[LeftDoubleBracket]1\ \[RightDoubleBracket]\[RightDoubleBracket], V\[LeftDoubleBracket]#1\[LeftDoubleBracket]2\ \[RightDoubleBracket]\[RightDoubleBracket], 1]]\) &]\)], "Input", ImageSize->{288, 288}], Cell[TextData[{ "Convert to transitions by labeling with the last symbol of the target word \ in ", Cell[BoxData[ \(TraditionalForm\`G\)]], ". " }], "Text", ImageSize->{288, 288}], Cell[BoxData[{ \(totrans[{p_, q_}] := {p, \(ToIndex[ StringTake[ V\[LeftDoubleBracket] q\[RightDoubleBracket], \(-1\)], \ \(-2\)]\)\[LeftDoubleBracket]1\[RightDoubleBracket], q}\), "\n", \(sa\ = \ SA[\ 4, \ \(-2\), \ totrans\ /@ \ ed0\ ]\)}], "Input", ImageSize->{288, 288}], Cell[TextData[{ "Verify that the language indeed misses the excluded blocks (and, possibly, \ others whose absence can be inferred: ", Cell[BoxData[ \(TraditionalForm\`110\)]], " in this case)." }], "Text", ImageSize->{288, 288}], Cell[BoxData[ \(LanguageFA[sa, 3]\)], "Input", ImageSize->{288, 288}], Cell[BoxData[ \(LanguageFA[sa, \(-12\), \ SizeOnly \[Rule] True]\)], "Input", ImageSize->{288, 288}], Cell["\<\ The subshift is transitive, but the semiautomaton has transient \ parts.\ \>", "Text", ImageSize->{288, 288}], Cell[BoxData[ \(StronglyConnectedComponents[\ ToGraphFA[sa], NonTrivial \[Rule] True\ ]\)], "Input", ImageSize->{288, 288}], Cell[TextData[{ "A second example where the forbidden blocks are ", Cell[BoxData[ \(TraditionalForm\`001\)]], " and ", Cell[BoxData[ \(TraditionalForm\`011. \)]] }], "Text", ImageSize->{288, 288}], Cell[BoxData[{ \(\(ed0 = Select[ed, \(! MemberQ[{"\<001\>", "\<011\>"}, WordFusion[ V\[LeftDoubleBracket]#1\[LeftDoubleBracket]1\ \[RightDoubleBracket]\[RightDoubleBracket], V\[LeftDoubleBracket]#1\[LeftDoubleBracket]2\ \[RightDoubleBracket]\[RightDoubleBracket], 1]]\) &];\)\), "\n", \(sa\ = \ SA[\ 4, \ \(-2\), \ totrans\ /@ \ ed0\ ]\)}], "Input", ImageSize->{288, 288}], Cell["This time there are 3 transitive components.", "Text", ImageSize->{288, 288}], Cell[BoxData[ \(StronglyConnectedComponents[\ ToGraphFA[sa], NonTrivial \[Rule] True\ ]\)], "Input", ImageSize->{288, 288}], Cell[BoxData[ \(LanguageFA[sa, \ 8]\ // \ TableForm\)], "Input", ImageSize->{288, 288}] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Cellular Automata and Regular Languages", "Section", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}, CellTags->"c:12"], Cell[CellGroupData[{ Cell["De Bruijn Graphs and Fischer Automata", "Subsection", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}, CellTags->"c:13"], Cell[CellGroupData[{ Cell[BoxData[ \(TraditionalForm\`Fischer\ Automata\)], "Subsubsection", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}, CellTags->"c:14"], Cell[TextData[{ "As mentioned in the last section, the range of the global map ", StyleBox["\[Rho]", FontFamily->"Symbol"], " is a regular language ", Cell[BoxData[ \(TraditionalForm\`\[ScriptCapitalL](\[Rho])\)]], " and one can use methods from automata theory to analyze these languages \ and their corresponding CAs. First, we need to convert a CA into a FSM that \ accepts ", Cell[BoxData[ \(TraditionalForm\`\[ScriptCapitalL](\[Rho])\)]], ". There is an elegant construction of a FSM for a CA based on labeled de \ Bruijn graphs. (See also the section on local universal machines in the \ Guide.) Suppose ", Cell[BoxData[ \(TraditionalForm\`B\ \((r, K)\)\)]], " is the de Bruijn graph on vertex set ", Cell[BoxData[ \(TraditionalForm\`K\^\(\(\ \)\(r\)\)\)]], ". Thus the edges are of the form \n\t\t", Cell[BoxData[ \(TraditionalForm\`\((a, \(x\_1\) \[Ellipsis]\ x\_\(r - 1\))\) \ \[RightArrow] \((\(x\_1\) \[Ellipsis]\ x\_\(r - 1\), b)\)\)]], ".\nNow suppose C is a CA over K with width ", Cell[BoxData[ \(TraditionalForm\`w\ = \ r + 1\)]], ". Then the local map ", Cell[BoxData[ \(TraditionalForm\`\[Rho] : K\^\(\(\ \)\(r + 1\)\) \[RightArrow] K\)]], " can be used to label the edges of the de Bruijn graph: edge ", Cell[BoxData[ \(TraditionalForm\`\((a\[VeryThinSpace]x, x\[VeryThinSpace]b)\)\)]], " is labeled by ", Cell[BoxData[ \(TraditionalForm\`\[Rho](a\[VeryThinSpace]x\[VeryThinSpace]b)\)]], ". Thus we obtain a semiautomaton whose transition diagram is the labeled \ de Bruijn graph. We will refer to this machine as ", Cell[BoxData[ \(TraditionalForm\`B(\[Rho], r, K)\)]], " or simply ", Cell[BoxData[ \(TraditionalForm\`B(\[Rho])\)]], ". \nA Fischer automaton is a semiautomaton whose transition diagram is \ strongly connected. De Bruijn graphs are strongly connected (and even \ Hamiltonian), hence ", Cell[BoxData[ \(TraditionalForm\`B(\[Rho])\)]], " is a Fischer automaton. \[ScriptCapitalL](\[Rho]) is the acceptance \ language of this automaton and the configurations in the range of the global \ map ", Cell[BoxData[ \(TraditionalForm\`\[Rho]\)]], StyleBox[" ", FontFamily->"Symbol"], "correspond to (the labels of) biinfinite paths in ", Cell[BoxData[ \(TraditionalForm\`B(\[Rho])\)]], StyleBox[".\n", FontFamily->"Symbol"], "Here is a plain de Bruin graph: ", Cell[BoxData[ \(TraditionalForm\`B(2, 3)\)]], ". Since the graph is ", Cell[BoxData[ \(TraditionalForm\`\((3, 3)\)\)]], "-regular the number of paths of length ", Cell[BoxData[ \(TraditionalForm\`r \[GreaterEqual] 2\)]], " from any vertex ", Cell[BoxData[ \(TraditionalForm\`p\)]], " to any other vertex ", Cell[BoxData[ \(TraditionalForm\`q\)]], " is ", Cell[BoxData[ \(TraditionalForm\`3\^\(r - 2\)\)]], StyleBox[". ", FontVariations->{"CompatibilityType"->"Superscript"}], "The spectral radius of ", Cell[BoxData[ \(TraditionalForm\`B(2, 3)\)]], " is 3. " }], "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[ \(g = DeBruijnGraph[2, \(-3\), Normalize \[Rule] 1]\)], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(\(mat = Edges[ToAdjacencyMatrix[g]];\)\), "\n", \(\(PlotMatrix[mat, GridLines \[Rule] True];\)\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[ \(MatrixPower[mat, 5]\ // \ MatrixForm\)], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[ \(Max[Eigenvalues[mat]]\)], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[TextData[{ "Subgraphs of a de Bruijn graph are also useful to represent subshifts. In \ general, the number of words of length ", Cell[BoxData[ \(TraditionalForm\`r\)]], " in a subshift is ", Cell[BoxData[ FormBox[ RowBox[{" ", FormBox[\(\[CapitalTheta](\[Lambda]\^r)\), "TraditionalForm"]}], TraditionalForm]]], " where ", Cell[BoxData[ \(TraditionalForm\`\[Lambda]\)]], " is the spectral radius of the corresponding adjacency matrix. For \ example, for the Fibonacci shift ", Cell[BoxData[ \(TraditionalForm\`\[Lambda]\)]], StyleBox[" ", FontFamily->"Symbol"], "is the golden ratio:" }], "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(\(mat = {{1, 1}, {1, 0}};\)\), "\n", \(Eigenvalues[mat]\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell["\<\ Returning to CAs, we can use the command ToSA to transforms a CA \ into the corresponding de Bruijn automaton. \ \>", "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(C150 = CA[150]\), "\n", \(m150 = ToSA[C150]\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[TextData[{ "Here are some words accepted by ", StyleBox["m150", "MR"], " and some values of the growth function." }], "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(LanguageFA[m150, \(-5\)]\ // \ ColumnForm\), "\[IndentingNewLine]", \(LanguageFA[m150, \(-8\), SizeOnly \[Rule] True]\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell["\<\ Thus, m150 accepts all words up to length 8. In fact, m150 accepts \ all inputs: \ \>", "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[ \(MinimizeFA[m150]\)], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[TextData[{ "By compactness, it follows that the global map ", Cell[BoxData[ \(TraditionalForm\`\[Rho]\ : \ C\ \[RightArrow] \ C\)]], " is surjective. \nHere is a more interesting example: rule 76." }], "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(\(C76 = CA[76];\)\), "\n", \(PrintCA[C76]\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(\(m76 = ToSA[C76];\)\), "\n", \(mm76 = MinimizeFA[m76]\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(\(L76 = LanguageFA[mm76, \(-5\)];\)\), "\n", \(L76\ // \ ColumnForm\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[ \(WordSort[Complement[Words[\(-5\), \(-2\)], Flatten[L76]]]\)], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell["\<\ This suggests that the range of C76 is a subshift of finite type \ (SFT), i.e., the language of B(76,2,2) is a finite complement language: it \ consists of all words not containing a block 111. It is easy to verify this \ conjecture:\ \>", "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[ \(EquivalentQFA[mm76, ComplementFA[ WordToFA["\<111\>", \(-2\), Full \[Rule] True]]]\)], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell["\<\ We can use the syntactic semigroup to verify that the language is \ locally testable.\ \>", "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(\(S\ = \ SyntacticSG[mm76];\)\), "\[IndentingNewLine]", \(S\ // \ LocallyIdempotentQSG\), "\[IndentingNewLine]", \(S\ // \ LocallyCommutativeQSG\)}], "Input", ImageSize->{288, 288}], Cell[TextData[{ "As usual, the state set of mm76 has additional structure which is hidden \ by normalization. It can be make visible by repeating the computation with \ option ", StyleBox["Normalize->2", "MR"], " everywhere. We will come back to the structure of the states in a related \ power automaton in the section on inversion of reversible CAs below. " }], "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(\(m0 = ToSA[C76, Normalize \[Rule] 2];\)\), "\n", \(\(m1 = ToDFA[m0, Normalize \[Rule] 2];\)\), "\n", \(\(m2 = MinimizeFA[m1, Normalize \[Rule] 2];\)\), "\n", \(\(m1\ // \ States\)\ // \ ColumnForm\), "\n", \(\(m2\ // \ States\)\ // \ ColumnForm\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[TextData[{ "A more systematic way to check whether a CA defines a SFT is to use the \ procedure ", ButtonBox["ToFactorFA", ButtonStyle->"AddOnsLink"], " which builds an automaton that accepts all words ", Cell[BoxData[ \(TraditionalForm\`x\)]], " in the language of ", StyleBox["m", "MR"], " such that no proper factor of ", Cell[BoxData[ \(TraditionalForm\`x\)]], " is also in the language. " }], "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(\(sa76\ = \ ToSA[C76];\)\), "\n", \(\(\(\(sa76\ // \ MinimizeFA\)\ // \ ComplementFA\)\ // \ \(Curry[ToFactorFA]\)[ Type \[Rule] "\"]\)\ // \ MinimizeFA\ \), "\n", \(%\ // \ InfiniteQFA\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[TextData[{ "Since any de Bruijn automaton ", Cell[BoxData[ \(TraditionalForm\`B(c, 2, 2)\)]], " has only four states, the corresponding minimal automaton can have no \ more than 16 states. Here is an example of a CA that reaches this bound: rule \ 73." }], "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(\(C73 = CA[73];\)\), "\n", \(mm73 = MinimizeFA[ToSA[C73]]\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[ \(TableForm[\ \ LanguageFA[mm73, \(-10\), SizeOnly \[Rule] True]\ \ // \ Thread, \[IndentingNewLine]TableSpacing \[Rule] 1, TableHeadings \[Rule] {Range[0, 10]}]\)], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell["\<\ Thus, we have to consider words of length at least 6 before \ anything interesting happens.\ \>", "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[ \(L6 = Complement[Words[6, \(-2\)], LanguageFA[mm73, 6]]\)], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell["\<\ It appears that rule 73 is symmetric. One can check the rule table.\ \ \>", "Text", ImageSize->{288, 288}], Cell[BoxData[ \(PrintCA[C73]\)], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell["or write a little program that does the checking.", "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(\(blocks = Words[3, \(-2\)];\)\), "\n", \(\(rules = First[ToRulesCA[C73]];\)\), "\n", \(\((blocks /. \[InvisibleSpace]rules)\) === \((WordReverse /@ blocks /. \[InvisibleSpace]rules)\)\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[TextData[{ "One should not make premature conjectures, though, with respect to the \ language of C73: excluding blocks 111001 and 100111 is not enough. In fact, \ C73 is not a SFT. This can be verified using ", StyleBox["NoFactorFA", "MR"], " as above. " }], "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(\(\(\(mm73\ // \ MinimizeFA\)\ // \ ComplementFA\)\ // \ \(Curry[ToFactorFA]\)[ Type \[Rule] "\"]\)\ // \ MinimizeFA\ \), "\[IndentingNewLine]", \(%\ // \ InfiniteQFA\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}] }, Closed]], Cell[CellGroupData[{ Cell[BoxData[ \(TraditionalForm\`Deterministic\ Semiautomata\)], "Subsubsection", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}, CellTags->"c:15"], Cell[TextData[{ "A language ", Cell[BoxData[ \(TraditionalForm\`L\)]], " is ", StyleBox["extensible", FontColor->RGBColor[0, 0, 1]], " if\n\t", Cell[BoxData[ \(TraditionalForm\`\[ForAll] \ x\ \[Element] \ L\ \ \(\[Exists] \ a\), b\ \[Element] \ K\ \ \((\ \ a\[VeryThinSpace]x\[VeryThinSpace]b\ \[Element] \ L\ )\)\)]], ". \nA language ", Cell[BoxData[ \(TraditionalForm\`L\)]], " is ", StyleBox["factorial", FontColor->RGBColor[0, 0, 1]], " (or closed under infixes) if \n\t", Cell[BoxData[ \(TraditionalForm\`u\ x\ v\ \ \[Element] \ L\)]], " implies ", Cell[BoxData[ \(TraditionalForm\`x\ \[Element] \ L\)]], ". \nA language ", Cell[BoxData[ \(TraditionalForm\`L\)]], " is ", StyleBox["transitive", FontColor->RGBColor[0, 0, 1]], " if \n\t", Cell[BoxData[ \(TraditionalForm\`\[ForAll] \ u, v\ \[Element] \ L\ \ \(\[Exists] \ x\ \((\ \ u\ x\ v\ \[Element] \ L\ )\)\)\)]], ". \n", Cell[BoxData[ \(TraditionalForm\`L\)]], " is strongly transitive if all the words ", Cell[BoxData[ \(TraditionalForm\`x\)]], " in the last definition can be chosen with uniform length. " }], "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[TextData[{ "It is clear that the acceptance language of a Fischer automaton is \ extensible, factorial and transitive (EFT). The languages ", Cell[BoxData[ \(TraditionalForm\`\[ScriptCapitalL](\[Rho])\)]], " are strongly transitive. One can show that the converse is also true for \ regular languages. In fact, there always is a deterministic Fischer automaton \ for any given factorial, transitive, regular language. \nSuppose we have the \ minimal automaton of an EFT language ", Cell[BoxData[ \(TraditionalForm\`L\)]], ". We can decompose the automaton into its strongly connected components \ and pick one such component as the diagram for the Fischer automaton. \ Ignoring possible edges to the sink of the minimal automaton, the component \ has to have out-degree 0. As it turns out, there is only one such strongly \ connected component and the minimal deterministic Fischer automaton (i.e., \ with smallest possible state set) is unique up to isomorphism. \nWe construct \ the minimal automaton for rule 172, convert it to a graph ", Cell[BoxData[ \(TraditionalForm\`g\)]], ", and compute the non-transient strongly connected components of ", Cell[BoxData[ \(TraditionalForm\`g\)]], "." }], "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(\(C = CA[172];\)\), "\n", \(ToSA[C]\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(\(m = MinimizeFA[ToSA[C]];\)\), "\n", \({Size[m], TrapStatesFA[m]}\), "\n", \(\(g = ToGraphFA[m];\)\), "\n", \(gg = NonTransientGraph[g]\), "\n", \(scc = StronglyConnectedComponents[g, NonTrivial \[Rule] True]\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell["\<\ State 7 is the sink in m, so the first component is what we are \ after. Thus, we construct a new semiautomaton mm by restricting m to that \ component.\ \>", "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[ \(mm = ToSA[SelectFA[m, scc\[LeftDoubleBracket]2\[RightDoubleBracket]]]\)], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell["The two machines ought to be equivalent:", "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[ \(EquivalentQFA[m, mm]\)], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell["\<\ Machine mm is minimal in the sense that it is accessible and \ different states have different behaviors. To see this we generate the \ minimal automata of the machines obtained by moving the initial state and \ check that they are non-isomorphic. \ \>", "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(\(minaut = \(MinimizeFA[SetInitialFA[mm, #]] &\) /@ Range[7];\)\), "\n", \(\(class = ToClasses[minaut, IsomorphicQDFA, Type \[Rule] Relation];\)\), "\n", \(class\ // \ Length\), "\n", \(class\ // \ TableForm\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell["\<\ The union of the behavior of the 7 partial machines must be the \ full language (we convert the DFAs to FAs to speed up the union operation):\ \ \>", "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(mmm = UnionFA @@ \(ToFA /@ minaut\)\), "\n", \(EquivalentQFA[m, mmm]\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[TextData[{ "The next plot shows that CA[172,3,-2] is not surjective by exhibiting a \ string that shows that the de Brujin automaton is ambiguous. To find such a \ string, we use option ", StyleBox["Full->True", "MR"], " in the function ", ButtonBox["AmbiguousQFA", ButtonStyle->"AddOnsLink"], "." }], "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[ \(AmbiguousQFA[ToSA[CA[172]], Full \[Rule] True]\)], "Input", ImageSize->{288, 288}], Cell[BoxData[ \(\(PlotComputationFA[ToSA[CA[172]], "\<0100\>", \ Full \[Rule] False\ ];\)\)], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[TextData[{ "Note the diamond. However, the witness returned by ", StyleBox["AmbiguousQFA", "MR"], " is not minimal, the suffix ", Cell[BoxData[ \(TraditionalForm\`100\)]], " also works.\nWe can generate the minimal Fischer automaton directly with \ just one call to command ", ButtonBox["MinimalFischerFA", ButtonStyle->"AddOnsLink"], ". " }], "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(\(sa\ = \ ToSA[C];\)\), "\[IndentingNewLine]", \(EquivalentQFA[\ sa, \ MinimalFischerFA[sa]\ ]\)}], "Input", ImageSize->{288, 288}], Cell[TextData[{ "Note that ", StyleBox["MinimalFischerFA", "MR"], " uses the standard Rabin-Scott power automaton construction and is thus \ potentially exponential even if the resulting minimal Fischer automaton is \ small." }], "Text", ImageSize->{288, 288}] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Automata for Elementary CAs", "Subsection", ImageSize->{288, 288}], Cell[CellGroupData[{ Cell["Minimal DFAs", "Subsubsection", ImageSize->{288, 288}], Cell["\<\ We will compute all minimal automata associated with binary CAs of \ width 3. Clearly it would suffice to consider only all essential rules, but \ we will carry out the computation for all 256 elementary CAs. \ \>", "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[ \(\(CAmin = Table[\ {r, MinimizeFA[ToSA[CA[r]]]}, {r, 0, 255}];\)\)], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell["Here are the 30 surjective (3,2)-rules: ", "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(First /@ Cases[CAmin, {_, DFA[1, __]}]\), "\n", \(Length[%]\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell["\<\ On the other end, there are 16 rules whose minimal DFAs have 16 \ states. The distribution of sizes is shown in the next plot. \ \>", "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(First /@ Cases[CAmin, {_, DFA[16, __]}]\), "\n", \(Length[%]\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[ \(TableForm[Frequencies[Size /@ \(Last /@ CAmin\)]]\)], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[ \(\(\(ListPlot[#, PlotRange \[Rule] {{0, 256}, {0, 17}}, Prolog \[Rule] PointSize[0.015], PlotStyle \[Rule] Blue, Ticks \[Rule] {50\ Range[0, 5], Range[17]}] &\)[ Size[Last /@ CAmin]];\)\)], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[TextData[{ "Removing duplicate machines from the list ", StyleBox["CAmin", "MR"], " leaves 85 DFAs. This can be done conveniently with the command ", ButtonBox["DeleteDuplicates", ButtonStyle->"AddOnsLink"], ". As it turns out, these remaining 85 machines are all non-isomorphic. See \ the section on isomorphism testing for an explanation of the test used \ below." }], "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(\(CAmin1 = Reverse /@ DeleteDuplicates[Last /@ CAmin, First /@ CAmin, OutPairs \[Rule] True];\)\), "\n", \(Length[CAmin1]\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[ \(Length[Union[AccessibleFA /@ \(Last /@ CAmin1\)]]\)], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[TextData[{ "We can now visualize the languages of these automata. The following \ picture shows the accepted words of length ", Cell[BoxData[ \(TraditionalForm\`k = 6\)]], " for all 85 machines." }], "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(\(With[{k = 6}, \n\tW = Words[k, \(-2\)]; \n\t lang = \(ToBitVector[ LanguageFA[ CAmin1\[LeftDoubleBracket]#, 2\[RightDoubleBracket], k], W] &\) /@ Range[85]];\)\), "\n", \(\(PlotMatrix[lang, AspectRatio \[Rule] 1];\)\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[TextData[{ "Since all the languages ", Cell[BoxData[ \(TraditionalForm\`L(\[Rho])\)]], " are factorial, it is of interest to find the shortest excluded words in \ these languages. In fact, many of these languages are finite complement: \ there are finitely words w such that all excluded words are of the form ", Cell[BoxData[ FormBox[ StyleBox["uwv", FontSlant->"Italic"], TraditionalForm]]], ". As one can see from the picture (?) some of the machines accept all \ words of length 6. Here are the shortest words not accepted by the machines:" }], "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[ \(sw = TransferSequenceFA /@ \(ComplementFA /@ \(Last /@ CAmin1\)\)\)], "Input",\ AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(WordLength /@ Flatten[sw]\), "\n", \(Max[%]\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell["\<\ Machine number 44 (which corresponds to rule 37) misses a few words \ of length 9.\ \>", "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(Cases[CAmin1, {37, _}]\), "\n", \(\(m37 = Last[Last[%]];\)\)}], "Input", ImageSize->{288, 288}], Cell[BoxData[ \(LanguageFA[ComplementFA[m37], 9]\)], "Input", AspectRatioFixed->True, ImageSize->{288, 288}] }, Closed]], Cell[CellGroupData[{ Cell["Minimal Fischer Automata", "Subsubsection", ImageSize->{288, 288}], Cell[TextData[{ "Suppose we wish to determine all inclusions between languages associated \ with ECAs. To this end it is advantageous to reduce the number of subset \ comparisons by first weeding out equivalent ECAs (equivalent in the sense \ that their associated languages are the same). Since ", ButtonBox["MinimizeFA", ButtonStyle->"AddOnsLink"], " is idempotent we can perform the necessary isomorphism tests by using ", StyleBox["MinimizeFA", "MR"], " as a kernel function, rather than having to apply a ", ButtonBox["EquivalentQFA", ButtonStyle->"AddOnsLink"], " test." }], "Text", ImageSize->{288, 288}], Cell[BoxData[ \(\(class\ = \ ToClasses[\ Range[0, 255], \ MinimizeFA[ToSA[CA[#]]] &, \ Type \[Rule] Function\ ];\)\ // \ Timing\)], "Input", ImageSize->{288, 288}], Cell["\<\ There are 85 different regular languages associated with ECAs. \ Note the 30 equivalent ECAs: these are none other than the surjective CAs. \ \ \>", "Text", ImageSize->{288, 288}], Cell[BoxData[{ \(class\ // \ Length\), "\[IndentingNewLine]", \(\(Length\ /@ \ class\ // \ Frequencies\)\ // \ TableForm\)}], "Input",\ ImageSize->{288, 288}], Cell[BoxData[ \(Sort[class]\ // \ Last\)], "Input", ImageSize->{288, 288}], Cell["\<\ We pick the first CA as the representative of each class and \ determine all inclusions. Note that the method used below is highly \ inefficient since the corresponding minimal DFAs have to be recomputed over \ and over. Without the external code this may take some 2+ minutes. Note that \ the table has 3570 entries.\ \>", "Text", ImageSize->{288, 288}], Cell[BoxData[{ \(\(eca\ = \ First\ /@ \ class;\)\), "\n", \(\(subs1 = FlattenOne[ Table[{i, j, SubsetQFA[ ToSA[CA[eca\[LeftDoubleBracket]i\[RightDoubleBracket]]], ToSA[CA[ eca\[LeftDoubleBracket]j\[RightDoubleBracket]]]]}, {i, 85}, {j, i + 1, 85}]];\)\ // \ Timing\)}], "Input", ImageSize->{288, 288}], Cell["\<\ Using a precomputation to obtain the minimal DFAs provides a modest \ gain of some 15%.\ \>", "Text", ImageSize->{288, 288}], Cell[BoxData[ \(\(mins\ = \ \(MinimizeFA[ToSA[CA[#]]] &\)\ /@ \ eca;\)\ // \ Timing\)], "Input", ImageSize->{288, 288}], Cell[BoxData[ \(\(subs2 = FlattenOne[ Table[{i, j, SubsetQFA[mins\[LeftDoubleBracket]i\[RightDoubleBracket], mins\[LeftDoubleBracket]j\[RightDoubleBracket]]}, {i, 85}, {j, i + 1, 85}]];\)\ // \ Timing\)], "Input", ImageSize->{288, 288}], Cell["Of course, the results are the same.", "Text", ImageSize->{288, 288}], Cell[BoxData[ \(subs1 === subs2\)], "Input", ImageSize->{288, 288}], Cell["\<\ We can model the inclusions by an acyclic graph whose depth turns \ out to be 4.\ \>", "Text", ImageSize->{288, 288}], Cell[BoxData[{ \(\(ed\ = \ Most\ /@ \ Cases[\ subs1, {__, True}];\)\), "\n", \(G\ = \ Graph[\ Max[Flatten[ed]], \ Length[ed], \ "\", \ ed\ ]\)}], "Input", ImageSize->{288, 288}], Cell[BoxData[ \(LongestPath[G]\)], "Input", ImageSize->{288, 288}] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Minimizing Iterated CAs", "Subsection", ImageSize->{288, 288}], Cell[TextData[{ "We can generate a sequence ", StyleBox["ca[t]", "MR"], " of CAs by starting with a fixed automaton ", StyleBox["ca[1]", "MR"], " and composing it repeatedly with itself. Thus, one step in the evolution \ of ", StyleBox["ca[t]", "MR"], " corresponds to ", Cell[BoxData[ \(TraditionalForm\`t\)]], " steps in the evolution of the base automaton ", StyleBox["ca[1]", "MR"], ". Note that the width of ", StyleBox["ca[t]", "MR"], " is ", Cell[BoxData[ \(TraditionalForm\`w\ + \ 2 \((t - 1)\)\)]], " where ", Cell[BoxData[ \(TraditionalForm\`w\)]], " is the width of ", StyleBox["ca[1]", "MR"], ". Hence the size of ", StyleBox["ca[t]", "MR"], " is ", Cell[BoxData[ \(TraditionalForm\`2\^\(w + 2 \((t - 1)\)\)\)]], StyleBox[" ", FontVariations->{"CompatibilityType"->"Superscript"}], " (assuming a binary alphabet) and gets out of hand rather quickly. " }], "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(\(Clear[ca];\)\), "\n", \(\(ca[1] = \(C20 = CA[20]\);\)\), "\n", \(\(ca[n_Integer?Positive] := \(ca[n] = ComposeCA[C20, ca[n - 1]]\);\)\), "\n", \(Scan[ca, Range[5]]\)}], "Input", ImageSize->{288, 288}], Cell["The code numbers also grow exponentially: ", "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(ca[5]\), "\n", \(Table[\ Plus @@ DigitCount[First[ca[i]]], \ {i, 5}]\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(\(X\ = \ Table[RandomInteger[], {50}];\)\), "\[IndentingNewLine]", \(\(EvolutionCA[\ ca[2], X, 40];\)\), "\[IndentingNewLine]", \(\(EvolutionCA[\ ca[3], X, 40];\)\)}], "Input", ImageSize->{288, 288}], Cell["\<\ Computation of the minimal automata will also take a few seconds \ (using internal code), since the largest semiautomaton has 512 states. \ \>", \ "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(\(Clear[m];\)\), "\n", \(\(m[i_] := \(m[i] = MinimizeFA[ToSA[ca[i]]]\);\)\), "\n", \(Size[\ m /@ Range[5]]\)}], "Input", ImageSize->{288, 288}], Cell["\<\ Here are the growth functions of the automata up to length 12. As \ one can see, up to words of length 5 the functions agree. The values are \ decreasing since the languages form a descending sequence (by definition of \ the automata). \ \>", "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(\(cencus = Table[\ LanguageFA[m[i], \(-12\), SizeOnly \[Rule] True], {i, 5}];\)\), "\n", \(Prepend[cencus, Range[0, 12]]\ // \ \(Curry[TableForm]\)[ TableSpacing \[Rule] {1, 2}]\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[TextData[{ "Words of length 8 that are accepted by ", StyleBox["m[i]", "MR"], " but rejected by ", StyleBox["m[i+1]", "MR"], " are" }], "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(\(k = 8;\)\), "\n", \(\(diff = \(Complement[LanguageFA[m[#], k], LanguageFA[m[# + 1], k]] &\) /@ Range[3];\)\), "\n", \(diff\ // \ ColumnForm\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Surjectivity, Openess and Injectivity", "Section", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}, CellTags->"c:19"], Cell[CellGroupData[{ Cell["The Method", "Subsection", ImageSize->{288, 288}], Cell[TextData[{ "The de Bruijn graph of a one-dimensional CA is also useful in determining \ certain properties of the global map of the CA. In this section we will show \ how to determine whether the map is injective, open or surjective. One can \ show that injectivity implies openess which implies surjectivity (the \ converse is false in each case). \nBy compactness, the global map is \ surjective iff the associated de Bruijn machine accepts", Cell[BoxData[ \(TraditionalForm\`\(\(\ \)\(K\^*\)\)\)]], ". The latter property is often referred to as NFA Universality. \ Unfortunately, it is PSPACE-hard to test NFA Universality for general \ nondeterministic automata and the problem remains hard for Fischer automata. \ However, there are quadratic time algorithms for all three properties based \ on the product of the de Bruijn graph with itself. \nThe key concept here is \ borrowed from automata theory: a finites state machine ", Cell[BoxData[ \(TraditionalForm\`M\)]], " is unambiguous iff there is no pair of states ", Cell[BoxData[ \(TraditionalForm\`p\)]], " and ", Cell[BoxData[ \(TraditionalForm\`q\)]], " in ", Cell[BoxData[ \(TraditionalForm\`M\)]], " such that there is are two distinct paths labeled ", Cell[BoxData[ \(TraditionalForm\`x\)]], " from ", Cell[BoxData[ \(TraditionalForm\`p\)]], " to ", Cell[BoxData[ \(TraditionalForm\`q\)]], ". Put loosely: the unfolding of ", Cell[BoxData[ \(TraditionalForm\`M\)]], " along ", Cell[BoxData[ \(TraditionalForm\`x\)]], " contains no diamonds, for all ", Cell[BoxData[ \(TraditionalForm\`x\)]], ". As it turns out, unambiguity of the associated de Bruijn automaton is \ equivalent with surjectivity of the local map, and stronger properties such \ openess and injectivity correspond to stronger notions of unambiguity. Here \ is an example:" }], "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(\(C = CA[4, \(-2\), 3915];\)\), "\n", \(\(EvolutionCA[C, Table[Random[Integer, {0, 1}], {81}], 50];\)\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell["\<\ From the picture, it seems plausible that the global map is \ injective. Let's take a look at the de Bruijn automaton. \ \>", "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(db = ToSA[C]\), "\n", \(DegreesFA[db]\ // \ TableForm\), "\n", \(DegreesFA[ReverseFA[db]]\ \ // \ TableForm\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[TextData[{ "Since the machine as well as its reverse is non-deterministic, it is \ quite conceivable that there are two different computations on the same \ input, starting at some state ", Cell[BoxData[ \(TraditionalForm\`p\)]], " and ending at some state ", Cell[BoxData[ \(TraditionalForm\`q\)]], ". We can take a look at the unfolding of the de Bruijn automaton along \ some random word to check that in fact no diamonds seem to appear. " }], "Text", ImageSize->{288, 288}], Cell[BoxData[{ \(w = RandomWord[10, \(-2\)]\), "\n", \(\(PlotComputationFA[db, w\ ];\)\)}], "Input", ImageSize->{288, 288}], Cell[TextData[{ "Here is a slightly more systematic approach: we look at the multiplicities \ of all words of length at most 8 in an associated unitary FA. Since the \ machine is strongly connected, we may safely consider only the case, say, ", Cell[BoxData[ \(TraditionalForm\`p\ = \ \(q\ = \ 1\)\)]], " (though the length of a hypothetical counterexample might decrease by a \ different choice). " }], "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[ \(fa = SetInitialFinalFA[db, 1, 1\ ]\)], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[ \(ToSeries[ FlattenOne[ LanguageFA[fa, \(-8\), Multiplicity \[Rule] True]]]\)], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[TextData[{ "All words in this language have multiplicity 1, as required. Of course, \ this last computation proves nothing. To demonstrate that the CA is \ injective, we have to use a product automaton construction. \nThe product of \ two labeled graphs is defined by \n\t", Cell[BoxData[ \(TraditionalForm\`V\ = \ V\_1\[Cross]\ V\_2\)]], " \n\t", Cell[BoxData[ \(TraditionalForm\`\(\(E\)\(\ \)\(=\)\(\ \)\({\ \ \((\ \((u\_1, u\_2)\), \ a, \ \((v\_1, v\_2)\)\ )\)\ \ | \ \ \ \ \((u\_1, a, v\_1)\)\ \[Element] \ E\_1\ \[And] \ \ \ \((u\_2, a, v\_2)\)\ \[Element] \ E\_\(\(2\)\(\ \)\)}\)\(\ \)\)\)]], "\nA strongly connected component (SCC) of a digraph is a maximal vertex \ induced subgraph with every two nodes lying on a cycle. A strongly connected \ component is non-trivial iff it contains an edge. The algorithms are based on \ the following proposition. Let \[Rho] be a one-dimensional cellular automaton \ and ", Cell[BoxData[ \(TraditionalForm\`B\^2\)]], " the product of ", Cell[BoxData[ \(TraditionalForm\`B(\[Rho])\)]], " with itself. Note that ", Cell[BoxData[ \(TraditionalForm\`B\^2\)]], " contains a copy of the original graph, namely the diagonal which we will \ call ", Cell[BoxData[ \(TraditionalForm\`D\)]], ". \n(1) The global map is surjective iff ", Cell[BoxData[ \(TraditionalForm\`B\)]], " is unambiguous iff the strongly connected component in ", Cell[BoxData[ \(TraditionalForm\`B\^2\)]], " that contains ", Cell[BoxData[ \(TraditionalForm\`D\)]], " is ", Cell[BoxData[ \(TraditionalForm\`D\)]], ".\n(2) The global map is open iff the strongly connected component of \ ", Cell[BoxData[ \(TraditionalForm\`D\)]], " is ", Cell[BoxData[ \(TraditionalForm\`D\)]], " and is isolated (there are no paths from or to other nontrivial strongly \ connected components). \n(3) The global map is reversible (injective) iff ", Cell[BoxData[ \(TraditionalForm\`B\^2\)]], " has only one nontrivial strongly connected component, namely ", Cell[BoxData[ \(TraditionalForm\`D\)]], ". \nTo illustrate this method we first generate the labeled de Bruijn \ graph B150 for rule 150. The we compute the product BB, translate it into a \ graph suitable as input for the command StronglyConnectedComponents and \ compute the strongly connected components. " }], "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell["\<\ All words in this language have multiplicity 1, as required. Of \ course, this last computation proves nothing. To demonstrate that the CA is \ injective, we have to use a product automaton construction. First, we compute \ the product automaton db2. Then, we translate db2 into a directed graph gr \ and compute the strongly connected components. \ \>", "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[ \(db2 = ProductFA[db, db]\)], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[ \(gr = ToGraphFA[db2]\)], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(StronglyConnectedComponents[gr]\), "\n", \(gr\ // \ \(Curry[StronglyConnectedComponents]\)[ NonTrivial \[Rule] True]\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell["\<\ The first component is the diagonal, an isomorphic copy of the \ original automaton, and all the other vertices form trivial SCCs. Thus, the \ CA is indeed injective. Here is another example: rule 150. \ \>", "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(\(db = ToSA[CA[150]];\)\), "\n", \(DegreesFA[db]\ // \ TableForm\), "\n", \(DegreesFA[ReverseFA[db]]\ // \ TableForm\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell["\<\ So, rule 150 is bideterministic and might look like a promising \ candidate for an injective rule. However, a moment's thought reveals that \ the sequence ...0110110110110.. is mapped to 0 by rule 150, as is the \ 0-sequence. The problem here is that the source and target p and q have moved out into \ infinity. To take into account this and similar problems we have to insist \ that the diagonal is the only non-trivial strongly connected components in \ the product automaton, a test that rule 150 promptly fails.\ \>", "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[ \(StronglyConnectedComponents[ToGraphFA[ProductFA[db, db]]]\)], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[TextData[{ "The first component is the diagonal, the other composes all remaining \ vertices. Thus, there are two SCCs and there are no edges between them. Hence \ the global map is open (and thus surjective) but not reversible. The command \ ", ButtonBox["ClassifyCA", ButtonStyle->"AddOnsLink"], " performs all these operations. The internal version has the option ", StyleBox["Full->True", "MR"], " which causes the collapse of the square of the de Bruijn graph to be \ displayed. " }], "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(ClassifyCA[CA[51], Full \[Rule] True]\), "\[IndentingNewLine]", \(\(\(\(CA[51]\ // \ ToSA\)\ // \ \(Curry[SquareSA]\)[ Full \[Rule] 1]\)\ // \ ToGraphFA\) // \ NonTransientGraph\), "\[IndentingNewLine]", \(%\ // \ VertexSet\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell["\<\ In this case, there is only one nontrivial strongly connected \ component, namely the diagonal. Hence, rule 51 is reversible. \ \>", "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(ClassifyCA[CA[60], Full \[Rule] True]\), "\[IndentingNewLine]", \(\(\(\(CA[60]\ // \ ToSA\)\ // \ \(Curry[SquareSA]\)[ Full \[Rule] 1]\)\ // \ ToGraphFA\) // \ NonTransientGraph\ \), "\[IndentingNewLine]", \(%\ // \ VertexSet\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell["\<\ Rule 60 is open: there is a component other than the diagonal, but \ there are no paths between the components. \ \>", "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(ClassifyCA[CA[89], Full \[Rule] True]\), "\[IndentingNewLine]", \(\(\(\(CA[89]\ // \ ToSA\)\ // \ \(Curry[SquareSA]\)[ Full \[Rule] 1]\)\ // \ ToGraphFA\) // \ NonTransientGraph\), "\[IndentingNewLine]", \(%\ // \ VertexSet\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell["\<\ Rule 89 is surjective but not open: there is a path from some \ component to the diagonal. \ \>", "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(ClassifyCA[CA[22], Full \[Rule] True]\), "\n", \(\(\(\(CA[22]\ // \ ToSA\)\ // \ \(Curry[SquareSA]\)[ Full \[Rule] 1]\)\ // \ ToGraphFA\) // \ NonTransientGraph\), "\[IndentingNewLine]", \(%\ // \ VertexSet\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[TextData[{ "Lastly, rule 22 is not even surjective. The whole product graph forms one \ strongly connected component. Note that the product graph as defined above \ ought to have 16 nodes. To speed up computation, the procedure ", ButtonBox["ClassifyCA", ButtonStyle->"AddOnsLink"], " exploits symmetries in that graph and computes only the part above the \ diagonal (i.e., nodes ", Cell[BoxData[ \(TraditionalForm\`\((i, j)\)\)]], " where ", Cell[BoxData[ \(TraditionalForm\`\(\(\ \)\(1\ \[LessEqual] \ i\ \[LessEqual] \ j\ \[LessEqual] \ n\)\)\)]], "). Thus, there are only ", Cell[BoxData[ \(TraditionalForm\`\(n(n + 1)\)/2\)]], " nodes. \nCommand ", ButtonBox["ClassifyCA", ButtonStyle->"AddOnsLink"], " works for CAs of arbitrary width--in principle. Since the size of the \ graph is exponential in the width of the automaton, width 5 is a realistic \ barrier. For larger alphabets smaller widths are appropriate. The identity \ map is always injective: there is exactly one non-trivial SCC, namely the \ copy of the original de Bruijn graph. " }], "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[ \(id[w_, k_] := FunctionToCA[{##1}\[LeftDoubleBracket] Ceiling[w/2]\[RightDoubleBracket] &, w, k]\)], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(id[4, \(-3\)]\), "\n", \(ClassifyCA[id[4, \(-3\)]]\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell["\<\ The following three rules of width four are injective, open but not \ injective, and not even surjective, respectively.\ \>", "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(ClassifyCA[CA[4, \(-2\), 43690]]\), "\n", \(ClassifyCA[CA[4, \(-2\), 38505\ ]]\), "\n", \(ClassifyCA[CA[4, \(-2\), 43754\ ]]\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell["\<\ The second rule corresponds to addition modulo 2 and is easily \ generalized to arbitrary widths.\ \>", "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(\(Clear[sigma];\)\), "\n", \(\(sigma[w_Integer] := FunctionToCA[Mod[\(+##1\), 2] &, w, \(-2\)];\)\), "\n", \(TableForm[sigma /@ Range[6]]\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[ \(Table[\ ClassifyCA[sigma[i]], {i, 6}]\)], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell["\<\ Thus, addition modulo 2 seems to produce an open but not reversible \ rule, except in the trivial case width = 1. \ \>", "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell["\<\ Here is another example of a rule of width 4 that is surjective but \ fails to be open. There are four nontrivial SCCs in the product graph and \ there is a path from the diagonal to two of them.\ \>", "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[ \(ClassifyCA[CA[4, \(-2\), 19890\ ], Full \[Rule] True]\)], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(\(g\ = \ \(\(\(CA[4, \(-2\), 19890\ ]\ // \ ToSA\)\ // \ \(Curry[SquareSA]\)[Full \[Rule] 1]\)\ // \ ToGraphFA\) // \ NonTransientGraph;\)\), "\[IndentingNewLine]", \(\(V = VertexSet[g];\)\), "\n", \(nontriv = PositionList[V, Select[V, Length[#] > 1 &]]\), "\n", \(\(WeaklyConnectedComponents[g, #] &\) /@ nontriv\ \ // \ EnumForm\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}] }, Closed]], Cell[CellGroupData[{ Cell["Elementary CAs", "Subsection", ImageSize->{288, 288}], Cell["\<\ To test all binary CAs of width 3 for injectivity, openess and \ surjectivity we could use the list essentialness from above (the equivalence \ of isomorphic rules defined in the last section clearly preserves these \ properties). To speed things up we will only consider those labelings that \ are 1-balanced, i.e., that have the same number of 0's and 1's. As is pointed \ out in the section on multiplicity below, all surjective rules are 1-balanced \ (and in fact are balanced in a much stronger sense). Only 23 rules remain. \ \ \>", "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[ \(\(essentialrules\ = \ {0, 2, 4, 6, 8, 10, 12, 14, 18, 20, 22, 24, 26, 28, 30, 34, 36, 38, 42, 44, 46, 50, 54, 58, 60, 62, 66, 70, 74, 78, 86, 90, 94, 102, 110, 126};\)\)], "Input", ImageSize->{288, 288}], Cell[BoxData[{ \(bal = Select[Range[0, 127], Plus @@ IntegerDigits[#1, 2, 8] == 4 &]\), "\n", \(Length[bal]\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell["We can now extract the various types of rules as follows.", "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(\(class = \({#, ClassifyCA[CA[3, 2, #\ ]]} &\) /@ \ bal;\)\), "\[IndentingNewLine]", \(inj = First /@ Cases[class, {_, 3}]\), "\n", \(open0 = First /@ Cases[class, {_, 2}]\), "\n", \(surj0 = First /@ Cases[class, {_, 1}]\), "\n", \(open = Sort[Join[inj, open0]]\), "\n", \(surj = Sort[Join[surj0, open]]\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell["\<\ Note that for all the injective CAs the local maps are simply \ Boolean functions of one of the arguments (since we only consider essential \ rules,only complement occurs):\ \>", "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[ \(\(\(First[ToRulesCA[CA[#]]] &\) /@ inj\ // \ Transpose\)\ // \ TableForm\)], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell["\<\ This can be made very clearly visible by deleting variables that \ the local map does not depend on:\ \>", "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[ \(\(SimplifyCA[CA[#]] &\) /@ inj\)], "Input", AspectRatioFixed->True, ImageSize->{288, 288}] }, Closed]], Cell[CellGroupData[{ Cell["F-surjective CAs", "Subsection", ImageSize->{288, 288}], Cell[TextData[{ "Another interesting property of the global map of a CA is its behavior on \ finite configurations. Here a configuration is called finite iff its support \ is finite, i.e., if only finitely many cells are in a state different from 0. \ The automata under consideration will always assumed to be quiescent: the all \ 0's configuration ", StyleBox["0", FontWeight->"Bold"], " is mapped to itself. By compactness, F-surjective implies surjective. One \ can show that a surjective CA is F-surjective iff the preimage of ", StyleBox["0", FontWeight->"Bold"], " is ", StyleBox["0", FontWeight->"Bold"], ". The latter property is easily tested by searching for cycles labeled 0 \ in the de Bruijn graph after deletion of the edge ", Cell[BoxData[ \(TraditionalForm\`\((0, 0, 0)\)\)]], ". Here are all the quiescent binary rules of width 2 (up to isomorphism, \ see the previous section). Command ", ButtonBox["FSurjectiveCA", ButtonStyle->"AddOnsLink"], " tests for F-surjectivity. " }], "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[ \(surjq = \(If[EvenQ[#], #, 255 - #] &\) /@ surj\)], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(\(L1 = \(FSurjectiveCA[CA[#]] &\) /@ surjq;\)\), "\n", \(\(L2 = \(ClassifyCA[CA[#]] &\) /@ surjq;\)\), "\n", \({surjq, L1, L2}\ // \ \(Curry[TableForm]\)[ TableSpacing \[Rule] {1, 2}]\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell["\<\ Thus, with the exception of rule 166, all F-surjective (3,2)-CAs \ are already injective. Note that F-surjective CAs may or may not be open. \ \ \>", "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}] }, Closed]], Cell[CellGroupData[{ Cell["Highly Symmetric Rules", "Subsection", ImageSize->{288, 288}], Cell[TextData[{ "One can use the operation ", StyleBox["ListMultiply", "MR"], " to generate highly symmetric rule tables that produce surjective (albeit \ trivial) automata. The basic idea is to define a function on binary lists as \ follows.\n\t", Cell[BoxData[ \(TraditionalForm\`F(\ L, \ {0})\ = \ Join[L, L]\)]], ",\n\t", Cell[BoxData[ \(TraditionalForm\`F(\ L, \ {1}\ )\ = \ Join[\ L, \ 1 - L\ ]\)]], "\nExtend to ", Cell[BoxData[ \(TraditionalForm\`F(\ L, \ B\ )\)]], " in the obvious way. " }], "Text", ImageSize->{288, 288}], Cell[BoxData[{ \(ClearAll[F, ff, L, b]\), "\n", \(\(ff[L_List, b_Integer] := ListMultiply[L, {0, b}];\)\), "\n", \(\(F[L_List, B_List] := Fold[ff, L, B];\)\), "\n", \(\(F[B_List] := Fold[ff, {0}, B];\)\)}], "Input", ImageSize->{288, 288}], Cell[TextData[{ "Here is a trace of the computation of ", Cell[BoxData[ \(TraditionalForm\`F[{0}, \ {0, 1, 0, 1, 0}]\)]], ". " }], "Text", ImageSize->{288, 288}], Cell[BoxData[{ \(\(L = FoldList[ff, {0}, {0, 1, 0, 1, 0}];\)\), "\n", \(L\ // \ \(Curry[TableForm]\)[TableSpacing \[Rule] {0, 0}]\), "\n", \(Frequencies[Last[L]]\)}], "Input", ImageSize->{288, 288}], Cell[TextData[{ "It is not hard to show that for any binary list ", Cell[BoxData[ \(TraditionalForm\`B\)]], " of length ", Cell[BoxData[ \(TraditionalForm\`w\)]], " other than ", Cell[BoxData[ \(TraditionalForm\`\((0, 0, \[Ellipsis], 0)\)\)]], " we always have ", Cell[BoxData[ \(TraditionalForm\`\(\(\ \)\(\(#\_0\) \(F({0}, B)\)\ = \ \ \(#\_1\) \(F({0}, B)\)\)\)\)]], ". Here is a test for all lists of length 32. " }], "Text", ImageSize->{288, 288}], Cell[BoxData[{ \(\(BB = F\ /@ \ Rest[CartesianProduct @@ Table[{0, 1}, {5}]];\)\), "\n", \(\(Count[#, 1] &\) /@ BB\)}], "Input", ImageSize->{288, 288}], Cell[BoxData[ \(\(PlotMatrix[BB, GridLines \[Rule] True];\)\)], "Input", ImageSize->{288, 288}], Cell["\<\ And here are the corresponding binary cellular automata of width 5.\ \ \>", "Text", ImageSize->{288, 288}], Cell[BoxData[ \(class = \(With[{rr = FromDigits[#, 2]}, {ClassifyCA[CA[5, \(-2\), rr]], rr}] &\) /@ BB\)], "Input", ImageSize->{288, 288}], Cell[BoxData[ \(Frequencies[First /@ class]\ // \ TableForm\)], "Input", ImageSize->{288, 288}], Cell["\<\ All the CAs are open or even reversible. Perhaps surprisingly, we \ can make things a bit more complicated by rotating the lists and still obtain \ only surjective automata. Unfortunately, the reversible ones are not very \ interesting. But the open ones are at least in part real width 5 automata. \ Alas, they are all deterministic.\ \>", "Text", ImageSize->{288, 288}], Cell[BoxData[{ \(\(rot[L_List] := \(RotateLeft[L, #] &\) /@ Range[Length[L]];\)\), "\n", \(\(BBB = Union[FlattenOne[rot /@ BB]];\)\), "\n", \(Length[BBB]\)}], "Input", ImageSize->{288, 288}], Cell["Without the external code this will take a bit. ", "Text", ImageSize->{288, 288}], Cell[BoxData[ \(BBBi\ = \ \(FromDigits[#, 2] &\)\ /@ \ BBB; class = \({ClassifyCA[CA[5, \(-2\), #]], #} &\) /@ BBBi;\)], "Input", ImageSize->{288, 288}], Cell[BoxData[ \(Frequencies[First /@ class]\ // \ TableForm\)], "Input", ImageSize->{288, 288}], Cell["\<\ Unfortunately, the reversible ones are not very interesting: they \ shrink to width 1.\ \>", "Text", ImageSize->{288, 288}], Cell[BoxData[ \(Union[\ \(SimplifyCA[CA[5, 2, #]] &\) /@ \(Last /@ Cases[class, {3, _}]\)]\)], "Input", ImageSize->{288, 288}], Cell["\<\ And the open maps turn out to be somewhat boring, too: the ones of \ real width 5 are all deterministic. \ \>", "Text", ImageSize->{288, 288}], Cell[BoxData[ \(\(\(SimplifyCA[CA[5, 2, #]] &\) /@ \(Last /@ Cases[class, {2, _}]\);\)\)], "Input", ImageSize->{288, 288}], Cell[BoxData[ \(W5 = Select[%, WidthCA[#1] == 5 &]\)], "Input", ImageSize->{288, 288}], Cell[BoxData[ \(Union[\(DeterministicQFA[ToSA[#]] &\) /@ W5]\)], "Input", ImageSize->{288, 288}], Cell["\<\ There remain 128 surjective automata that all fail to be \ deterministic, but they are codeterministic.\ \>", "Text", ImageSize->{288, 288}], Cell[BoxData[{ \(\(W5 = Select[\(SimplifyCA[CA[5, \(-2\), #]] &\) /@ \(Last /@ Cases[class, {1, _}]\), WidthCA[#] == 5 &];\)\), "\n", \(Length[W5]\)}], "Input", ImageSize->{288, 288}], Cell[BoxData[{ \(Union[\(DeterministicQFA[ToSA[#]] &\) /@ W5]\), "\n", \(Union[\(DeterministicQFA[ToSA[#], Direction \[Rule] Backward] &\) /@ W5]\)}], "Input", ImageSize->{288, 288}] }, Closed]], Cell[CellGroupData[{ Cell["Fredkin's Trick", "Subsection", ImageSize->{288, 288}], Cell[TextData[{ "There is a standard trick that turns a cellular automaton over alphabet ", Cell[BoxData[ \(TraditionalForm\`\[CapitalSigma]\)]], " into a reversible CA over alphabet ", Cell[BoxData[ \(TraditionalForm\`\[CapitalSigma]\^\(\(\ \)\(2\)\)\)]], ". The idea is to code a second-order CA over the smaller alphabet into a \ first-order CA over the larger alphabet. The second order CA is determined \ from the given one by \n\t\t", Cell[BoxData[ \(TraditionalForm\`\(\[Rho]\_\(\(\ \)\(2\)\)\)(X, Y)\ = \ \ \ \(\(\[Rho]( Y)\)\(\ \)\(\[CirclePlus]\)\(\ \)\(X\)\(\ \)\)\)]], ". \nHere is a little program that computes the resulting CA. " }], "Text", ImageSize->{288, 288}], Cell[BoxData[ \(ToFredkinCA[\ C_CA] := \ \[IndentingNewLine]Module[\ {f, ff, k = \ AlphabetSize[C], w\ = \ WidthCA[C], zz, ci}, \[IndentingNewLine]\t LocalMapCA[\ f, C, WordMap \[Rule] False]; \[IndentingNewLine]\t ff[xx__]\ := \ \[IndentingNewLine]\t\((\[IndentingNewLine]\t\tzz\ = \ \ Mod[{xx}, k\ ]; \[IndentingNewLine]\t\tci\ = \ Ceiling[w/2]; \[IndentingNewLine]\t\tk\ zz[\([ci]\)]\ + \ Mod[\ f @@ zz + Quotient[{xx}[\([ci]\)], k], k]\ \[IndentingNewLine]\t)\); \[IndentingNewLine]\t FunctionToCA[ff, w, \(-k^2\)]\[IndentingNewLine]]\)], "Input", ImageSize->{288, 288}], Cell["\<\ Note that the initial CA may well be utterly irreversible. For \ example, the local map may be constant.\ \>", "Text", ImageSize->{288, 288}], Cell[BoxData[ \(c\ = \ ToFredkinCA[\ CA[0]]\)], "Input", ImageSize->{288, 288}], Cell[BoxData[ \(c\ // \ ClassifyCA\)], "Input", ImageSize->{288, 288}], Cell["\<\ Though the resulting second-order CA is somewhat boring in this \ case. \ \>", "Text", ImageSize->{288, 288}], Cell[BoxData[{ \(SimplifyCA[c]\ \), "\[IndentingNewLine]", \(%\ // \ PrintCA\)}], "Input", ImageSize->{288, 288}], Cell["Here are some better examples. ", "Text", ImageSize->{288, 288}], Cell[BoxData[{ \(c\ = \ ToFredkinCA[\ CA[50]]\), "\[IndentingNewLine]", \(c\ // \ ClassifyCA\)}], "Input", ImageSize->{288, 288}], Cell[BoxData[{ \(\(X\ = \ Join[Table[0, {50}], Table[Random[ Integer, {0, 3}], {100}]];\)\), "\[IndentingNewLine]", \(\(cols\ = \ {0 \[Rule] \ Cyan, 1 \[Rule] Blue, 2 \[Rule] Red, 3 \[Rule] Yellow};\)\), "\n", \(\(EvolutionCA[c, X, 150, RasterStyle \[Rule] cols];\)\)}], "Input", ImageSize->{288, 288}], Cell[BoxData[{ \(\(c\ = \ ToFredkinCA[\ CA[58\ ]];\)\), "\[IndentingNewLine]", \(\(EvolutionCA[c, X, 150, RasterStyle \[Rule] cols];\)\)}], "Input", ImageSize->{288, 288}], Cell[BoxData[{ \(\(c\ = \ ToFredkinCA[\ CA[90]];\)\), "\[IndentingNewLine]", \(\(EvolutionCA[c, X, 150, RasterStyle \[Rule] cols];\)\)}], "Input", ImageSize->{288, 288}], Cell[BoxData[{ \(\(c\ = \ ToFredkinCA[\ CA[77]];\)\), "\[IndentingNewLine]", \(\(EvolutionCA[c, X, 150, RasterStyle \[Rule] cols];\)\)}], "Input", ImageSize->{288, 288}], Cell[TextData[{ "We can verify reversibility by running the evolution backwards as follows, \ see ", ButtonBox["InverseCA", ButtonStyle->"AddOnsLink"], " below." }], "Text", ImageSize->{288, 288}], Cell[BoxData[{ \(\(orb1\ = \ OrbitCA[c, X, 150];\)\), "\n", \(\(cc = InverseCA[c];\)\), "\n", \(\(orb2\ = \ OrbitCA[\ cc, \ Last[orb1], \ 150\ ];\)\)}], "Input", ImageSize->{288, 288}], Cell[BoxData[{ \(\(gr1\ = \ PlotMatrix[orb1, RasterStyle \[Rule] cols, DisplayFunction \[Rule] Identity];\)\), "\n", \(\(gr2\ = \ PlotMatrix[orb2, RasterStyle \[Rule] cols, DisplayFunction \[Rule] Identity];\)\), "\n", \(\(ShowArray[{gr1, gr2}];\)\)}], "Input", ImageSize->{288, 288}] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Multiplicity and Welch Indices", "Section", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}, CellTags->"c:24"], Cell[CellGroupData[{ Cell["Multiplicity", "Subsection", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}, CellTags->"c:7"], Cell[CellGroupData[{ Cell[BoxData[ \(TraditionalForm\`Balance\)], "Subsubsection", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}, CellTags->"c:26"], Cell[TextData[{ "There is a wealth of information about the connections between properties \ of the global map of a one-dimensional CA such as surjectivity and properties \ of the corresponding finite state machines. For example, \n- the global map \ ", Cell[BoxData[ \(TraditionalForm\`\[Rho]\ : K\^\[Infinity]\ \[LongRightArrow]\ K\^\[Infinity]\)]], " is surjective iff \n- the acceptance language of the de Bruijn automaton \ ", Cell[BoxData[ \(TraditionalForm\`B(\[Rho])\)]], " is the set of all finite strings over the alphabet ", Cell[BoxData[ \(TraditionalForm\`K\)]], " iff \n- every word has multiplicity ", Cell[BoxData[ \(TraditionalForm\`n\)]], " over ", Cell[BoxData[ \(TraditionalForm\`B(\[Rho])\)]], " where ", Cell[BoxData[ \(TraditionalForm\`n\ = \ k\^\(w - 1\)\)]], " is the number of states of ", Cell[BoxData[ \(TraditionalForm\`B(\[Rho])\)]], ". \nAs pointed out above, surjectivity testing via acceptance languages is \ computationally very inefficient. In general, the problem of testing whether \ a Fischer automaton accepts all inputs is PSPACE-complete (at least for \ alphabets of size larger than 2). However, for elementary CA we still can use \ minimization to verify that all the (3,2)-CAs computed above are indeed \ surjective." }], "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(\(surj = {15, 30, 45, 51, 60, 75, 85, 86, 89, 90, 101, 102, 105, 106, 120, 135, 149, 150, 153, 154, 165, 166, 169, 170, 180, 195, 204, 210, 225, 240};\)\), "\n", \(\(FullQFA[ToSA[CA[#]]] &\) /@ surj\)}], "Input", ImageSize->{288, 288}], Cell[TextData[{ "The multiplicities of accepted words can be determined using option ", StyleBox["Multiplicity->True", "MR"], " in the command ", ButtonBox["LanguageFA", ButtonStyle->"AddOnsLink"], ". For example, in the de Bruijn automaton for rule 60 all words have \ multiplicity 4." }], "Text", ImageSize->{288, 288}], Cell[BoxData[ \(ToSeries[ LanguageFA[ToSA[CA[60]], 5, Multiplicity \[Rule] True]]\)], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[TextData[{ "We have switched to alphabet ", Cell[BoxData[ \(TraditionalForm\`{a, b}\)]], " for the sake of legibility. For the nonsurjective rule 73 on the other \ hand we obtain:" }], "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(\(L = LanguageFA[ToSA[CA[73]], 6, Multiplicity \[Rule] True];\)\), "\n", \(L\ // \ ToSeries\), "\n", \(Plus @@ \(Last /@ L\)\), "\n", \(Complement[Words[6, \(-2\)], First /@ L]\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[TextData[{ "Option ", Cell[BoxData[ \(MR\`Multiplicity\)], "TraditionalForm"], " suppresses words with multiplicity 0, thus the two missing words are not \ listed and have to be computed separately. Note that the multiplicity \ characterization for surjective rules implies that labelings in a surjective \ rule must be ", Cell[BoxData[ \(TraditionalForm\`b\)]], "-balanced for all ", Cell[BoxData[ \(TraditionalForm\`b\)]], ": every word of length ", Cell[BoxData[ \(TraditionalForm\`b\)]], " is accepted equally often by the de Bruijn semiautomaton. Hence we can \ weed out all rules that fail to be ", Cell[BoxData[ \(TraditionalForm\`b\)]], "-balanced without using the classification algorithm. \nThe following \ procedure tests whether a CA is ", Cell[BoxData[ \(TraditionalForm\`b\)]], "-balanced. It assumes that all symbols in ", Cell[BoxData[ \(TraditionalForm\`K\)]], " appear in the range of the local map. " }], "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(\(Clear[balanceQ];\)\), "\n", \(\(balanceQ[C_CA, b_Integer] := Equal @@ \(Last /@ LanguageFA[ToSA[C], b, Multiplicity \[Rule] True]\);\)\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[TextData[{ "For example, ", Cell[BoxData[ FormBox[ StyleBox[\(CA[11173, 4, 2]\), "MR"], TraditionalForm]]], " is 1-balanced but not 2-balanced (and therefore not surjective). \ Similarly, ", Cell[BoxData[ FormBox[ RowBox[{ StyleBox[\(CA[194310571, 3, 3]\), "MR"], " "}], TraditionalForm]]], " is 3-balanced but not 4-balanced." }], "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(C = CA[4, 2, 11173]\), "\n", \(balanceQ[C, 1]\), "\n", \(balanceQ[C, 2]\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(C = CA[3, 3, 194310571]\), "\n", \(balanceQ[C, 3]\), "\n", \(balanceQ[C, 4]\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[TextData[{ "The function ", StyleBox["balanceQ", "MR"], " can be iterated to filter out ", Cell[BoxData[ \(TraditionalForm\`b\)]], "-balanced rules (needless to say, this operation is quite inefficient):" }], "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[ \(pick[LL_List, b_Integer] := Select[LL, balanceQ[CA[#], b] &]\)], "Input",\ AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(\(cnt = 0;\)\), "\n", \(\(bal = FixedPointList[pick[#1, \(++cnt\)] &, Range[254]];\)\), "\n", \(Length[bal]\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[ \(Last[bal]\)], "Input", ImageSize->{288, 288}], Cell[BoxData[ \(\(ClassifyCA[CA[#]] &\)\ /@ \ Last[bal]\)], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[TextData[{ "Thus, all 3-balanced binary rules of width 3 are already surjective. Of \ course, the use of ", ButtonBox["LanguageFA", ButtonStyle->"AddOnsLink"], " in ", StyleBox["balanceQ", "MR"], " makes this approach very inefficient. To obtain a better algorithm it is \ best to use an external program that generates only 1-balanced labelings to \ start with and then eliminates ", Cell[BoxData[ \(TraditionalForm\`b\)]], "-unbalanced rules for some small value of ", Cell[BoxData[ \(TraditionalForm\`b\)]], ". This provides a speed-up since testing for ", Cell[BoxData[ \(TraditionalForm\`b\)]], "-balance takes some ", Cell[BoxData[ \(TraditionalForm\`O(k\^\(w + b - 1\))\)]], " steps and the classification algorithm is ", Cell[BoxData[ \(TraditionalForm\`O(k\^\(2 w\))\)]], "." }], "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}] }, Closed]], Cell[CellGroupData[{ Cell[BoxData[ \(TraditionalForm\`The\ multiplicity\ matrix\ semigroup\)], \ "Subsubsection", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}, CellTags->"c:27"], Cell[TextData[{ "The multiplicity property of surjective CAs can also be visualized using \ the semigroup of integer matrices associated with the de Bruijn automaton ", Cell[BoxData[ \(TraditionalForm\`B(\[Rho])\ = \[LeftAngleBracket]Q, K, \[Delta]\[RightAngleBracket]\)]], ". For any symbol ", Cell[BoxData[ \(TraditionalForm\`a\ \[Element] \ K\)]], " let ", Cell[BoxData[ \(TraditionalForm\`M\_a\)]], " be the ", Cell[BoxData[ \(TraditionalForm\`Q\[Cross]Q\)]], " matrix defined by\n\t", Cell[BoxData[ \(TraditionalForm\`M\_a[p, q] = 1\)]], " if there is a transition ", Cell[BoxData[ \(TraditionalForm\`\((p, a, q)\)\)]], ", and 0 otherwise. \t\nWe can extend this definition to words over ", Cell[BoxData[ \(TraditionalForm\`K\)]], " and obtain a homomorphism\n\t", Cell[BoxData[ \(TraditionalForm\`\[Mu]\ : \ \(K\^*\)\[LongRightArrow]\ Q\ \[Cross]\ Q\ \[LongRightArrow]\ \[DoubleStruckCapitalN]\)]], "\t\nfrom the words over ", Cell[BoxData[ \(TraditionalForm\`K\)]], " to non-negative integer matrices. The image of this homomorphism is the \ semigroup ", Cell[BoxData[ \(TraditionalForm\`\(\(S\)\(\ \)\)\)]], " generated by ", Cell[BoxData[ \(TraditionalForm\`M\_a\)]], ", ", Cell[BoxData[ \(TraditionalForm\`a\ \[Element] \ K\)]], ". The most important property of this semigroup is captured in the \ following theorem." }], "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[TextData[{ StyleBox["Theorem", FontWeight->"Bold"], ": The cellular automaton \[Rho] is surjective iff the associated matrix \ semigroup ", Cell[BoxData[ \(TraditionalForm\`S\)]], " is finite." }], "Text", ImageSize->{288, 288}], Cell[TextData[{ "One can provide a direct proof of this fact using the Frobenius-Perron \ theorem (i.e., circumventing automata theory). The key observation is that \ the matrix semigroup is finite iff it fails to contain the 0 matrix. It \ follows that all the multiplicity matrices of surjective automaton are \ actually 0/1-matrices. Moreover, their 1-norm is always ", Cell[BoxData[ \(TraditionalForm\`n = \(\(\(|\)\(Q\)\(|\)\) = k\^\(w - 1\)\)\)]], ". \nHere is an example. We define an auxiliary procedure ", StyleBox["makematrix", "MR"], " that computes a list of the generator matrices ", Cell[BoxData[ \(TraditionalForm\`M\_a\)]], ", ", Cell[BoxData[ \(TraditionalForm\`a\ \[Element] \ K\)]], "." }], "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[ \(makematrix[ C_CA] := \[IndentingNewLine]Module[{ff}, \[IndentingNewLine]\t TransitionMatrixFA[ToSA[C], ff]; \[IndentingNewLine]\t ff /@ Alphabet[C]\[IndentingNewLine]]\)], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(\(gen = makematrix[CA[3, 2, 150]];\)\), "\n", \(MatrixForm /@ gen\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell["\<\ At current, the external code handles only transition semigroups, \ so we have to use the internal algorithm to generate the semigroup. Also note \ that it is a good idea to test for surjectivity first so that one does not \ attempt to generate an infinite semigroup. \ \>", "Text", ImageSize->{288, 288}], Cell[BoxData[ \(oneNorm[M_] := Plus @@ Abs[Flatten[M]]\)], "Input", ImageSize->{288, 288}], Cell[BoxData[{ \(\(S = GenerateSG[GEN[4, 2, gen], External \[Rule] False];\)\), "\n", \(Length[S]\), "\n", \(oneNorm /@ ToList[S]\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell["\<\ A picture of the matrix semigroup shows that there is a unique \ computation starting at each state for each input. \ \>", "Text", ImageSize->{288, 288}], Cell[BoxData[{ \(\(\(PlotMatrix[#, DisplayFunction \[Rule] Identity, GridLines \[Rule] True] &\) /@ ToList[S];\)\), "\n", \(\(ShowArray[%, 4, GraphicsSpacing \[Rule] .2];\)\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell["\<\ Since the de Bruijn automaton is a permutation automaton \ (deterministic and codeterministic), all the matrices are permutation \ matrices. For injective rule 51 there are only 4 matrices:\ \>", "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(\(gen = makematrix[CA[3, 2, 51]];\)\), "\n", \(MatrixForm /@ gen\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(\(S = GenerateSG[GEN[4, 2, gen], External \[Rule] False];\)\), "\n", \(Length[S]\), "\n", \(oneNorm /@ ToList[S]\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(\(\(PlotMatrix[#, DisplayFunction \[Rule] Identity, GridLines \[Rule] True] &\) /@ ToList[S];\)\), "\n", \(\(ShowArray[%, 4, GraphicsSpacing \[Rule] .2];\)\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell["\<\ Note that these matrices have rank 1 and fail to be invertible. \ Lastly, an example for a rule of width 4. This time, the semigroup has size \ 77. \ \>", "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(ClassifyCA[CA[4, 2, 13628]]\), "\n", \(\(gen = makematrix[CA[4, 2, 13628]];\)\), "\n", \(\({S, wit, eq} = GenerateSG[GEN[8, 2, gen], External \[Rule] False, Equations \[Rule] True];\)\), "\n", \(Length[S]\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell["\<\ For the further study of this matrix semigroup the collection of \ matrices of minimal rank turns out to be important. \ \>", "Text", ImageSize->{288, 288}], Cell[BoxData[{ \(\(rank[m_?MatrixQ] := Last[Dimensions[m]] - Length[NullSpace[m]];\)\), "\n", \(\(SS = ToList[S];\)\), "\n", \(\(rk = rank /@ SS;\)\), "\n", \(TableForm[Frequencies[rk]]\)}], "Input", ImageSize->{288, 288}], Cell["There are 24 matrices of minimal rank 1.", "Text", ImageSize->{288, 288}], Cell[BoxData[{ \(\(pos = Flatten[Position[rk, Min[rk]]];\)\), "\n", \(\(mS = SS\[LeftDoubleBracket]pos\[RightDoubleBracket];\)\), "\n", \(\(\(PlotMatrix[#, DisplayFunction \[Rule] Identity, GridLines \[Rule] True] &\) /@ mS;\)\), "\n", \(\(ShowArray[%, 6];\)\)}], "Input", ImageSize->{288, 288}], Cell[TextData[{ "These matrices form an ideal ", Cell[BoxData[ \(TraditionalForm\`I\)]], ", i.e., we have ", Cell[BoxData[ \(TraditionalForm\`S\ I\ S\ \[SubsetEqual] \ I\)]], ". " }], "Text", ImageSize->{288, 288}], Cell[BoxData[{ \(\(eqq = SimplifyRewriteSystem[eq];\)\), "\n", \(mwit = wit\[LeftDoubleBracket]pos\[RightDoubleBracket]\), "\n", \(mwit\ // \ Length\)}], "Input", ImageSize->{288, 288}], Cell[BoxData[{ \(w = RandomWord[10, 2] <> mwit\[LeftDoubleBracket]Random[ Integer, {1, 24}]\[RightDoubleBracket] <> RandomWord[10, 2]\), "\n", \(WordReduce[w, eqq]\), "\n", \(Position[mwit, %]\)}], "Input", ImageSize->{288, 288}] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Welch Indices", "Subsection", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}, CellTags->"c:7"], Cell[TextData[{ "There are several interesting numerical parameters that can be associated \ with a surjective one-dimensional CA. \nThe first such parameter is the least \ number of preimages of any biinfinite word under ", Cell[BoxData[ \(TraditionalForm\`\[Rho]\)]], " which we will denote ", Cell[BoxData[ FormBox[ FormBox[\(\(W\_m\)(\[Rho])\), "TraditionalForm"], TraditionalForm]]], ". Hence for an injective rule we have ", Cell[BoxData[ \(TraditionalForm\`\(\(\ \)\(\(W\_m\)(\[Rho]) = \ 1\)\)\)]], ", and, more generally, for any open rule the number of preimages of any \ biinfinite word in the range of \[Rho] is always equal to ", Cell[BoxData[ \(TraditionalForm\`\(W\_m\)(\[Rho])\)]], ". One can show that this number is always realized by some bilaterally \ transitive word (a biinfinite word such that every finite word occurs to the \ left as well as to the right of the origin). In terms of the de Bruijn \ automaton ", Cell[BoxData[ \(TraditionalForm\`B(\[Rho])\)]], " we can describe ", Cell[BoxData[ \(TraditionalForm\`\(W\_m\)(\[Rho])\)]], " as follows. For any finite word ", Cell[BoxData[ \(TraditionalForm\`x\)]], " let ", Cell[BoxData[ \(TraditionalForm\`B(\[Rho], x)\)]], " be the graph obtained by unfolding ", Cell[BoxData[ \(TraditionalForm\`B(\[Rho])\)]], " according to labeling ", Cell[BoxData[ \(TraditionalForm\`x\)]], ": the nodes of ", Cell[BoxData[ \(TraditionalForm\`\(\(B(\[Rho], x)\)\(\ \)\)\)]], "are pairs ", Cell[BoxData[ \(TraditionalForm\`\((u, i)\)\)]], " where ", Cell[BoxData[ \(TraditionalForm\`u\)]], " is a node in ", Cell[BoxData[ \(TraditionalForm\`B(\[Rho])\)]], " and ", Cell[BoxData[ \(TraditionalForm\`0\ \[LessEqual] \ i\ \[LessEqual] \ | \(\(x\)\(|\)\)\)]], ". The edges are of the form", Cell[BoxData[ \(TraditionalForm\`\(\(\ \)\((\ \((u, i - 1)\), \ \((v, i)\)\ )\)\)\)]], " where", Cell[BoxData[ \(TraditionalForm\`\((u, x\_i, v)\)\)]], " is a labeled edge in ", Cell[BoxData[ \(TraditionalForm\`B(\[Rho])\)]], ". The core of ", Cell[BoxData[ \(TraditionalForm\`B(\[Rho], x)\)]], ", denoted ", Cell[BoxData[ \(TraditionalForm\`cB(\[Rho], x)\)]], ", is the subgraph induced by all paths in ", Cell[BoxData[ \(TraditionalForm\`\(\(B(\[Rho], x)\)\(\ \)\)\)]], "from some vertex ", Cell[BoxData[ \(TraditionalForm\`\((u, 0)\)\)]], " to ", Cell[BoxData[ \(TraditionalForm\`\((v, \(\(|\)\(x\)\(|\)\))\)\)]], ". Note that the multiplicity of ", Cell[BoxData[ \(TraditionalForm\`x\)]], " is the number of such paths. \nHere are a few examples. The thin gray \ lines indicate ", Cell[BoxData[ \(TraditionalForm\`B(\[Rho], x)\)]], " and the solid black lines joining red vertices represent ", Cell[BoxData[ \(TraditionalForm\`cB(\[Rho], x)\)]], ". For the sake of clarity we draw the full vertex set in both cases. " }], "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[ \(m = ToSA[CA[51]]\)], "Input", ImageSize->{288, 288}], Cell[BoxData[ \(\(PlotComputationFA[m, "\<000111000\>", ShowAll \[Rule] True, PlotStyle \[Rule] {0.02, 0.03}, LabelGrid \[Rule] Automatic];\)\)], "Input", ImageSize->{288, 288}], Cell[TextData[{ "Rule 90 has a deterministic de Bruijn automaton, as a consequence the core \ of ", Cell[BoxData[ \(TraditionalForm\`B(\[Rho], x)\)]], " is the whole graph." }], "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(\(m = ToSA[CA[90]];\)\), "\n", \(DeterministicQFA[m]\), "\n", \(\(PlotComputationFA[m, "\<000111000\>", ShowAll \[Rule] True, PlotStyle \[Rule] {0.02, 0.02}, LabelGrid \[Rule] Automatic];\)\)}], "Input", ImageSize->{288, 288}], Cell["Here is an example for width 4.", "Text", ImageSize->{288, 288}], Cell[BoxData[{ \(\(m = ToNFA[ToSA[CA[4, \(-2\), 7770]]];\)\), "\n", \(\(PlotComputationFA[m, "\<000000000\>", ShowAll \[Rule] True, PlotStyle \[Rule] {0.02, 0.02}, LabelGrid \[Rule] Automatic];\)\)}], "Input", ImageSize->{288, 288}], Cell[TextData[{ "One can show that ", Cell[BoxData[ \(TraditionalForm\`\(Wm\_m\)(\[Rho])\)]], " is the minimum number of connected components of ", Cell[BoxData[ \(TraditionalForm\`B(\[Rho], x)\)]], " as ", Cell[BoxData[ \(TraditionalForm\`x\)]], " varies over all finite words. As one can see from the pictures, the \ connected components have the form of two trees connected via a path. We will \ call such graphs bi-trees and their component trees in-trees and out-trees, \ respectively (the decomposition is not unique but that does not matter here). \ That the connected components of any unfolding ", Cell[BoxData[ \(TraditionalForm\`cB(\[Rho], x)\)]], " are always bi-trees follows from the fact that any surjective rule is \ locally injective (no two nontrivial paths in have the same source and \ target; the de Bruijn automaton is unambiguous). \nThe other two indices have \ to do with the maximum number of leaves in the in- and out-trees. Put \ differently, consider the the semiautomaton ", Cell[BoxData[ \(TraditionalForm\`B(\[Rho])\ = \ \((Q, K, \[Delta])\)\)]], ". Define \n\t", Cell[BoxData[ \(TraditionalForm\`\(W\_r\)(\[Rho])\ = \ \(\(max\)\(\ \)\(|\)\(\ \)\(\ \[Delta](p, x)\)\(\ \)\(|\)\(\ \)\)\)]], "\nwhere ", Cell[BoxData[ \(TraditionalForm\`p\)]], " is in ", Cell[BoxData[ \(TraditionalForm\`Q\)]], " and ", Cell[BoxData[ \(TraditionalForm\`x\)]], " ranges over ", Cell[BoxData[ \(TraditionalForm\`\(K\^*\)\)]], ". Since ", Cell[BoxData[ \(TraditionalForm\`B(\[Rho])\)]], " is strongly connected, the choice of ", Cell[BoxData[ \(TraditionalForm\`p\)]], " does not matter here. Then ", Cell[BoxData[ \(TraditionalForm\`\(W\_l\)(\[Rho])\)]], " is the maximum number of leaves in any out-tree. Similarly we define \n\t\ ", Cell[BoxData[ \(TraditionalForm\`\(W\_l\)(\[Rho]) = max | \[Delta]\^\(r(p, x)\) | \)]], "\nwhere ", Cell[BoxData[ \(TraditionalForm\`\[Delta]\^r\)]], StyleBox[" ", FontVariations->{"CompatibilityType"->"Superscript"}], "is the reverse transition function. Note that in a deterministic de \ Bruijn automaton we have ", Cell[BoxData[ \(TraditionalForm\`\(W\_r\)(\[Rho]) = \ 1\)]], " and similarly in a codeterministic automaton ", Cell[BoxData[ \(TraditionalForm\`\(W\_l\)(\[Rho])\ = \ 1\)]], ". \nA bi-tree in ", Cell[BoxData[ \(TraditionalForm\`B(\[Rho], x)\)]], " is maximal iff its in-tree has ", Cell[BoxData[ \(TraditionalForm\`\(W\_l\)(\[Rho])\)]], " leaves and its out-tree has ", Cell[BoxData[ \(TraditionalForm\`\(W\_r\)(\[Rho])\)]], " leaves. Using transitivity it is not hard to see that there always is a \ word such that all its bi-trees are maximal. With a little more effort one \ can show further that \n\t", Cell[BoxData[ \(TraditionalForm\`\(\(W\_l\)(\[Rho])\) \(\(W\_m\)(\[Rho])\) \ \(\(W\_r\)(\[Rho])\) = k\^\(w - 1\)\)], FontColor->RGBColor[0, 0, 1]], "\nwhere ", Cell[BoxData[ \(TraditionalForm\`k\)]], " is the alphabet size and ", Cell[BoxData[ \(TraditionalForm\`w\)]], " the width of the CA.\nWe can easily compute the Welch indices using a \ variation of the Rabin-Scott deterministic simulation algorithm. Instead of \ constructing all states in the power set machine reachable from the initial \ state of the nondeterministic machine (i.e., the full state set in this case) \ we only construct the states reachable from ", Cell[BoxData[ \(TraditionalForm\`{1}\)]], " using ", ButtonBox["ToKernelFA", ButtonStyle->"AddOnsLink"], ". The maximum cardinality of the state sets in these machines are the \ Welch indices and the states that have maximum cardinality form a transitive \ subautomaton (if we remove the sink, the only transitive subautomaton).\nHere \ are the results for all essential surjective binary CAs of width 3. " }], "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(Clear[ndb, rndb, ddb, rddb]\), "\n", \(Scan[\((ndb[#1] = ToSA[CA[#1]])\) &, surj]\), "\n", \(Scan[\((rndb[#1] = ReverseFA[ndb[#1]])\) &, surj]\), "\n", \(Scan[\((ddb[#1] = ToKernelFA[ndb[#1], 1])\) &, surj]\), "\n", \(Scan[\((rddb[#1] = ToKernelFA[rndb[#1], 1])\) &, surj]\), "\n", \(weight[m_SA] := Max[Length /@ States[m]]\), "\n", \(\(wr = \((weight[ddb[#1]] &)\) /@ surj;\)\), "\n", \(\(wl = \((weight[rddb[#1]] &)\) /@ surj;\)\), "\n", \(\(det = \((DeterministicQFA[ndb[#1]] &)\) /@ surj;\)\), "\n", \(\(cod = \((DeterministicQFA[rndb[#1]] &)\) /@ surj;\)\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[ \(TableForm[\ Thread[{surj, wl, 4/\((wl\ wr)\), wr, cod, det}], TableHeadings \[Rule] {None, {"\", "\", "\", "\", \ "\", "\"}}]\)], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[TextData[{ "Command ", ButtonBox["WelchCA", ButtonStyle->"AddOnsLink"], " computes the three indices. " }], "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[ \(WelchCA[CA[3, 2, 102]]\)], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell["\<\ The Welch coefficients of the right and left shifts for alphabets \ of size 2 to 5 are:\ \>", "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(\(ClearAll[RightShiftCA, LeftShiftCA];\)\), "\[IndentingNewLine]", \(RightShiftCA[k_]\ := \ FunctionToCA[\ Function[{y, z}, z], 2, \(-k\)]\), "\[IndentingNewLine]", \(LeftShiftCA[k_]\ := \ FunctionToCA[\ Function[{y, z}, y], 2, \(-k\)]\)}], "Input", ImageSize->{288, 288}], Cell[BoxData[{ \(\(WelchCA[RightShiftCA[#]] &\) /@ Range[2, 5]\ \ // \ TableForm\), "\n", \(\(WelchCA[LeftShiftCA[#]] &\) /@ Range[2, 5]\ // \ TableForm\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell["\<\ Note that every CA whose de Bruijn automaton is deterministic or \ codeterministic is automatically surjective. CAs of this type are easily \ generated by gluing together random permutations of the underlying alphabet. \ \ \>", "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(\(k = 3;\)\), "\n", \(\(w = 3;\)\), "\n", \(\(L = Permutations[Range[0, k - 1]];\)\), "\n", \(dig1 = Flatten[\((L\[LeftDoubleBracket] Random[Integer, {1, \(k!\)}]\[RightDoubleBracket] &)\) /@ Range[k\^\(w - 1\)]]\), "\n", \(dig2 = Flatten[Transpose[\((L\[LeftDoubleBracket] Random[Integer, {1, \(k!\)}]\[RightDoubleBracket] &)\) /@ Range[k\^\(w - 1\)]]]\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(C1 = CA[\ w, \(-k\), FromDigits[dig1, k]]\), "\n", \(C2 = CA[\ w, \(-k\), FromDigits[dig2, k]]\), "\n", \(ClassifyCA[C1]\), "\n", \(ClassifyCA[C2]\), "\n", \(WelchCA[C1]\), "\n", \(WelchCA[C2]\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[TextData[{ "To obtain a CA whose de Bruijn automaton is both deterministic and \ codeterministic we can pick a random permutation of order at least k of the \ underlying alphabet ", Cell[BoxData[ \(TraditionalForm\`{0, \[Ellipsis], k - 1}\)]], " and define \n\t", Cell[BoxData[ \(TraditionalForm\`\[Rho]( a\[VeryThinSpace]x\[VeryThinSpace]b) = \[Pi]\^\(a(b)\)\)]], " .\nThe corresponding global map is always open and fails to be injective. \ " }], "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(\(t = T[2, 3, 1];\)\), "\n", \(\(grid = Pairs[Flatten[\((Table[#1, {k\^\(w - 1\)}] &)\) /@ Range[0, k - 1]], Flatten[\((Range[0, k - 1] &)\) /@ Range[k\^\(w - 1\)]]];\)\), "\n", \(\(make[{a_Integer, b_Integer}] := \(t\^a\)\[LeftDoubleBracket] b + 1\[RightDoubleBracket] - 1;\)\), "\n", \(dig = make /@ grid\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(C = CA[w, \(-k\), FromDigits[dig, k]]\), "\n", \(\(sa = ToSA[C];\)\), "\n", \(DeterministicQFA[sa]\), "\n", \(DeterministicQFA[sa, Direction \[Rule] Backward]\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(ClassifyCA[C]\), "\n", \(WelchCA[C]\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell["\<\ Note that one can extract the Welch indices also from the matrix \ semigroups constructed in the last section. One only has to compute the \ maximum row and column norms:\ \>", "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(\(C = CA[4, \(-2\), 13628];\)\), "\n", \(WelchCA[C]\), "\n", \(\(gen = makematrix[C];\)\), "\n", \(\(S = ToList[GenerateSG[GEN[8, 2, gen], External \[Rule] False]];\)\), "\n", \(Max[\(Plus @@ # &\) /@ Flatten[Transpose /@ S, 1]]\), "\n", \(Max[\(Plus @@ # &\) /@ Flatten[S, 1]]\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}] }, Closed]], Cell[CellGroupData[{ Cell["Welch Automata", "Subsection", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}, CellTags->"c:7"], Cell[TextData[{ "The deterministic semiautomata used in the computation of the Welch \ parameters are also of interest. By selecting all state sets in the kernel \ automaton of maximal cardinality we obtain a deterministic semiautomaton. \ Doing this for both the forward and backward machine one constructs two such \ automata, which we will call the Welch pair of the CA. The Welch pair of a CA \ can be generated by the command ", ButtonBox["ToWelchCA", ButtonStyle->"AddOnsLink"], ". The output consists of two pieces:\n\t- the Welch indices,\n\t- the \ Welch pair itself. " }], "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[TextData[{ "For example, for the automaton ", StyleBox["CA[7770,4,2]", "MR"], " from above we find" }], "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(\({ind, {sl, sr}} = WelchCA[CA[4, \(-2\), 7770], Full \[Rule] True, Normalize \[Rule] 2];\)\), "\n", \(ind\), "\n", \(sl\), "\n", \(sr\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[TextData[{ "Hence, in the picture above, the bi-trees associated with word 0", StyleBox["10", FontVariations->{"CompatibilityType"->"Superscript"}], " were not maximal. To find a suitable word ", Cell[BoxData[ \(TraditionalForm\`x\)]], " we can use the semiautomata ", StyleBox["ml", "MR"], " and ", StyleBox["mr", "MR"], " obtained by performing the kernel automaton construction to ", StyleBox["sa", "MR"], ", the de Bruijn automaton of the CA, starting with a singleton state:" }], "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(\(sa = ToSA[CA[4, \(-2\), 7770]];\)\), "\n", \(\(mr = ToKernelFA[sa, 1];\)\), "\n", \(\(ml = ToKernelFA[ReverseFA[sa], 1];\)\), "\n", \(Fl = Select[States[ml], Length[#1] == 2 &]\), "\n", \(Fr = Select[States[mr], Length[#1] == 4 &]\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[ \(\(\(TransferSequenceFA[ml, 1, PositionList[States[ml], Fl]]\)\(\ \)\)\)], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[ \(ts = TransferSequenceFA[mr, 1, PositionList[States[mr], Fr]]\)], "Input",\ AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[ \(\(PlotComputationFA[sa, ts\[LeftDoubleBracket]1\[RightDoubleBracket]];\)\)], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[TextData[{ "Voila. Since ", Cell[BoxData[ \(TraditionalForm\`\(W\_m\)(C)\ = \ 1\)]], " the states of ", StyleBox["sl", "MR"], " and ", StyleBox["sr", "MR"], " have intersections of cardinality 1:" }], "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(sl1 = States[sl]\), "\n", \(sr1 = States[sr]\), "\n", \(Apply[Intersection, CartesianProduct[sl1, sr1], {1}]\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}] }, Closed]], Cell[CellGroupData[{ Cell["Welch Indices and Composition", "Subsection", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}, CellTags->"c:7"], Cell[TextData[{ "The maps ", Cell[BoxData[ \(TraditionalForm\`W\_l\)]], " and ", Cell[BoxData[ \(TraditionalForm\`W\_r\)]], " are multiplicative under composition (monoid homomorphisms from the \ epimorphisms of ", Cell[BoxData[ \(TraditionalForm\`K\^\[Infinity]\)]], " under composition to \[DoubleStruckCapitalN] under multiplication). " }], "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(\(C51 = CA[51];\)\), "\n", \(\(C102 = CA[102];\)\), "\n", \(CC = ComposeCA[C51, C102]\), "\n", \(PrintCA[CC]\), "\n", \(\(EvolutionCA[CC, 40\ ];\)\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell["\<\ All three global maps are open, the first one is even a \ bijection.\ \>", "Text", ImageSize->{288, 288}], Cell[BoxData[ \(ClassifyCA /@ {C51, C102, CC}\)], "Input", ImageSize->{288, 288}], Cell["\<\ The Welch indices of CC are the product of the respective indices \ of C51 and C102.\ \>", "Text", ImageSize->{288, 288}], Cell[BoxData[ \(WelchCA /@ {C51, C102, CC}\ // \ ColumnForm\)], "Input", AspectRatioFixed->True, ImageSize->{288, 288}] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Inverting Cellular Automata", "Section", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}, CellTags->"c:31"], Cell[CellGroupData[{ Cell["An Inversion Algorithm", "Subsection", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}, CellTags->"c:7"], Cell[CellGroupData[{ Cell[BoxData[ \(TraditionalForm\`Finding\ Bottlenecks\)], "Subsubsection", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}, CellTags->"c:33"], Cell[TextData[{ "For one-dimensional cellular automata it is effectively decidable whether \ the global map of the automaton is reversible. All injective global maps are \ open and surjective, and hence homeomorphisms of ", Cell[BoxData[ \(TraditionalForm\`K\^\[Infinity]\)]], ". By Headland's theorem, the inverse maps must also be given by a suitable \ CA. We will now show how to construct this inverse automaton. Note that the \ constraint of dimension 1 is essential here, in higher dimensions \ reversibility is undecidable by a result by Kari." }], "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[TextData[{ "To determine the appropriate local rule one can proceed as follows. \ Suppose we are given a reversible automaton ", Cell[BoxData[ \(TraditionalForm\`CA[\[Rho], w, k]\)]], " with local rule ", Cell[BoxData[ \(TraditionalForm\`\[Rho]\)]], ". We have to find a sufficiently large width ", Cell[BoxData[ \(TraditionalForm\`w\^\[Prime]\)]], " so that every word ", Cell[BoxData[ \(TraditionalForm\`z\ = \ \[Rho](x)\)]], " of length ", Cell[BoxData[ \(TraditionalForm\`w\^\[Prime]\)]], " contains enough information to reconstruct at least one symbol in ", Cell[BoxData[ \(TraditionalForm\`x\)]], ". We can then design an inverse CA of width ", Cell[BoxData[ \(TraditionalForm\`w\^\[Prime]\)]], " by mapping ", Cell[BoxData[ \(TraditionalForm\`z\)]], " to that one symbol. In terms of the de Bruijn automaton, this means that \ all the accepting computations of ", Cell[BoxData[ \(TraditionalForm\`B(\[Rho])\)]], " on input ", Cell[BoxData[ \(TraditionalForm\`z\)]], " must pass through a bottleneck: a particular state ", Cell[BoxData[ \(TraditionalForm\`p\)]], " reached after scanning a certain number of symbols in ", Cell[BoxData[ \(TraditionalForm\`z\)]], ". Here is a simple example. " }], "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(\(C = CA[51];\)\), "\n", \(m = ToSA[C, Normalize \[Rule] 1]\), "\n", \(States[m]\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(\(\(PlotComputationFA[m, #, PlotStyle \[Rule] {0.05, 0.05}, DisplayFunction \[Rule] Identity] &\) /@ Words[4, \(-2\)];\)\), "\n", \(\(ShowArray[%];\)\)}], "Input", ImageSize->{288, 288}], Cell[TextData[{ "As one can see, all computations are in the same state even after just one \ step. In fact, for ", Cell[BoxData[ \(TraditionalForm\`CA[51, 3, 2]\)]], " it suffices to use ", Cell[BoxData[ \(TraditionalForm\`w\^\[Prime] = \ w\_l + w\_r\)]], " where ", Cell[BoxData[ \(TraditionalForm\`w\_l = \ 1\)]], " and ", Cell[BoxData[ \(TraditionalForm\`w\_r = \ 1\)]], "." }], "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(\(\(PlotComputationFA[m, #, PlotStyle \[Rule] {0.05, 0.05}, DisplayFunction \[Rule] Identity] &\) /@ Words[2, \(-2\)];\)\), "\n", \(\(ShowArray[%];\)\)}], "Input", ImageSize->{288, 288}], Cell[TextData[{ "To find the appropriate states we have to trace the computation of m. This \ can be done--albeit in an exceedingly inefficient way--by inspecting all \ possible computations of the semiautomaton on some input. For example, for \ the string ", Cell[BoxData[ FormBox[ StyleBox["01", FontSlant->"Italic"], TraditionalForm]]], " we have:" }], "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[ \(ComputationFA[m, "\<01\>"]\ // \ TableForm\)], "Input", ImageSize->{288, 288}], Cell[TextData[{ "which shows that state 3 is a bottleneck, corresponding to the second \ picture in the first row. We repeat this operation for all words ", Cell[BoxData[ \(TraditionalForm\`z\)]], " of length 2 and obtain the local rule for the inverse CA. Note the \ reversal operation, by convention the least significant digit of the rule \ number is on the right. " }], "Text", ImageSize->{288, 288}], Cell[BoxData[{ \(\(getstate[z_] := \(ComputationFA[m, z]\)\[LeftDoubleBracket]1, 3\[RightDoubleBracket];\)\), "\n", \(states = \(States[m]\)\[LeftDoubleBracket] getstate /@ Words[2, \(-2\)]\[RightDoubleBracket]\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(\(lab = \(StringTake[#, 1] &\) /@ states;\)\), "\n", \(Ci = CA[\ 2, \(-2\), Automata`automata`Private`LabelToCodeCA[Reverse[lab], 2, \(-2\)]]\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell["\<\ To make sure that Ci works properly we compute the composition and \ eliminate superfluous variables.\ \>", "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(CC = ComposeCA[C, Ci]\), "\n", \(SimplifyCA[CC]\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell["\<\ The Welch indices show the appropriate multiplicative behavior. \ \ \>", "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[ \(WelchCA /@ {C, Ci, CC}\ // \ ColumnForm\)], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(PrintCA[CCC = ComposeCA[C, CC]]\), "\[IndentingNewLine]", \(SimplifyCA[CCC]\)}], "Input", ImageSize->{288, 288}] }, Closed]], Cell[CellGroupData[{ Cell[BoxData[ \(TraditionalForm\`Another\ Example\)], "Subsubsection", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}, CellTags->"c:34"], Cell[TextData[{ "Let us perform the necessary computations by hand for another example, a \ binary CA of width 4. In order to determine the proper choice of ", Cell[BoxData[ \(TraditionalForm\`w\^\[Prime] = \ w\_l\ + \ w\_r\)]], " we use the Welch automata associated with the CA. " }], "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(C = CA[4, \(-2\), 3915]\), "\n", \(sa = ToSA[C, Normalize \[Rule] 1]\), "\n", \(PrintCA[C]\), "\n", \(ClassifyCA[C]\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell["\<\ First we compute the Welch automata. The indices turn out to be 4 \ and 2, respectively. \ \>", "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[ \(WelchCA[C]\)], "Input", ImageSize->{288, 288}], Cell[BoxData[{ \(\({Wl, Wr} = Last[WelchCA[C, Full \[Rule] True]];\)\), "\n", \(States[Wl]\), "\n", \(States[Wr]\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[TextData[{ "The procedure ", StyleBox["DefiniteQFA", "MR"], " tests whether an automaton is definite, and also determines the maximum \ number of steps before any two computations with the same input in a definite \ automaton merge." }], "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(\(defl = DefiniteQFA[Wl, Full \[Rule] True];\)\), "\n", \(\(defr = DefiniteQFA[Wr, Full \[Rule] True];\)\), "\n", \({defl, defr, ww = defl + defr}\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell["Let's try for the left Welch automaton. ", "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(TransitionFunctionFA[Wl, dell]\), "\n", \(\((dell[#1, "\<0000\>"] &)\) /@ Range[6]\), "\n", \(\((dell[#1, "\<0001\>"] &)\) /@ Range[6]\), "\n", \(\((dell[#1, "\<1111\>"] &)\) /@ Range[6]\), "\n", \(\((dell[#1, "\<0011\>"] &)\) /@ Range[6]\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell["\<\ Seems to work. Let's also try a few random words of length 6 to \ check if the computations of the de Bruijn automaton really all have a bottle \ neck. \ \>", "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[ \(W = \((RandomWord[6, \(-2\)] &)\) /@ Range[4]\)], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(\(\(PlotComputationFA[sa, #, PlotStyle \[Rule] { .02, .03}, LineStyle \[Rule] { .005, .01}, DisplayFunction \[Rule] Identity, \ Frame \[Rule] True] &\) /@ W;\)\), "\n", \(\(ShowArray[%];\)\)}], "Input", ImageSize->{288, 288}], Cell[TextData[{ "From the pictures, it seems that words of length 2 + 4 produce the desired \ bottleneck after two steps in the computation. Let's take a closer look at \ one of these computations. The bottleneck here is at state ", Cell[BoxData[ \(TraditionalForm\`p = 8\)]], ", after two steps." }], "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[ \(ComputationFA[sa, "\<100010\>"]\ // \ ColumnForm\)], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[TextData[{ "Moreover, only computations starting at ", Cell[BoxData[ \(TraditionalForm\`{2, 3}\)]], " and ending at ", Cell[BoxData[ \(TraditionalForm\`{3, 5, 6, 8}\)]], " survive, two states in Wl and Wr, respectively. To find the bottleneck \ for all words of length 6, we compute all words of length ", Cell[BoxData[ \(TraditionalForm\`defl = 2\)]], " that lead to the same state in Wl and similarly all words of length ", Cell[BoxData[ \(TraditionalForm\`defr = 4\)]], " that lead to the same state in Wr. This can be accomplished with the \ procedure ", StyleBox["fullanguage", "MR"], ", a private function in ", StyleBox["Automata", "MR"], ". It will output a list of all words of a given length that label a \ computation starting at a specific state ", Cell[BoxData[ \(TraditionalForm\`p\)]], ", for all states ", Cell[BoxData[ \(TraditionalForm\`p\)]], "." }], "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(Lr = Automata`automata`Private`fullanguage[sa, defl]\), "\n", \(Ll = Automata`automata`Private`fullanguage[ReverseFA[sa], defr]\)}], "Input",\ AspectRatioFixed->True, ImageSize->{288, 288}], Cell[TextData[{ "Since the words in Ll are backwards from the point of view of the cellular \ automaton, we have to revert them before we glue them to their counterparts \ in Lr. We use ", ButtonBox["MapIndexed", ButtonStyle->"RefGuideLink"], " to keep track of the state where the strings join." }], "Text", ImageSize->{288, 288}], Cell[BoxData[{ \(\(join[{L1_List, L2_List}] := Apply[StringJoin, CartesianProduct[StringReverse /@ L1, L2], 1];\)\), "\n", \(LL = Sort[FlattenOne[ MapIndexed[CartesianProduct, join /@ Pairs[Ll, Lr]]]]\)}], "Input", ImageSize->{288, 288}], Cell["\<\ Note that reversal/append operation has indeed produced all strings \ of length 6. Since the cellular automaton under consideration is surjective, \ this better be the case. The associated states, or rather, their structured \ counterparts in the de Bruijn automaton determine the image of the string \ under the local map of the inverse CA. \ \>", "Text", ImageSize->{288, 288}], Cell[BoxData[ \(States[sa]\)], "Input", ImageSize->{288, 288}], Cell[BoxData[ \(rul = Thread[Range[8] \[Rule] \((StringTake[#1, 1] &)\) /@ States[sa]]; lab = Reverse[Last /@ LL /. \[InvisibleSpace]rul]\)], "Input", ImageSize->{288, 288}], Cell["\<\ After some some cleaning up we obtain the local map for the inverse \ CA. \ \>", "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(Automata`automata`Private`LabelToCodeCA[lab, ww, \(-2\)]\), "\n", \(Ci = CA[ww, \(-2\), %]\)}], "Input", ImageSize->{288, 288}], Cell["\<\ To check, we compute the composition of C with Ci. To speed up \ composition we first shrink Ci. \ \>", "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(Ci = SimplifyCA[Ci]\), "\n", \(CC = ComposeCA[Ci, C]\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell["\<\ Looks wrong, but after elimination of useless variables we get the \ right answer.\ \>", "Text", ImageSize->{288, 288}], Cell[BoxData[ \(SimplifyCA[CC]\)], "Input", AspectRatioFixed->True, ImageSize->{288, 288}] }, Closed]], Cell[CellGroupData[{ Cell[BoxData[ \(TraditionalForm\`An\ Algorithm\)], "Subsubsection", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}, CellTags->"c:35"], Cell[TextData[{ "A crucial step in inversion process is to decide how far computations have \ to be traced forward and backward to ensure the existence of bottlenecks. As \ it turns out, the proper choice of ", Cell[BoxData[ \(TraditionalForm\`w\^\[Prime]\ = \ w\_l\ + \ w\_r\)]], " can be determined from the Welch automata. For injective rules these \ automata are always definite and their definiteness numbers are equal to ", Cell[BoxData[ \(TraditionalForm\`w\_l\)]], " and ", Cell[BoxData[ \(TraditionalForm\`w\_r\)]], ". The necessary computations are carried out in the procedure ", StyleBox["InverseCA", "MR"], ". Note that in general ", StyleBox["InverseCA", "MR"], " will only construct a CA whose composition with the original machine is a \ shift, but not necessarily the exact inverse. " }], "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(C = CA[4, \(-2\), 3915]\), "\n", \(Ci = InverseCA[C]\), "\n", \(CC = ComposeCA[C, Ci]\), "\n", \(SimplifyCA[CC]\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell["\<\ The last CA is remarkable because it is the smallest example of a \ CA whose reversibility is not caused by simple properties of the local \ function. \ \>", "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[ \(PrintCA[C]\)], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[TextData[{ "The second bit is always flipped, except in the context ", Cell[BoxData[ \(TraditionalForm\`\((0, \(-\(\(,\)\(1\)\(,\)\(0\)\)\))\)\)]], ". Another interesting example is the following machine based on addition \ modulo 2, but over an alphabet of size 8 (so that every state can be \ construed as a 3-bit block). " }], "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(Clear[loc]\), "\n", \(\(loc[x_, y_] := Module[{x0, x1, x2, y0, y1, y2}, {x0, x1, x2} = Reverse[IntegerDigits[x, 2, 3]]; {y0, y1, y2} = Reverse[IntegerDigits[y, 2, 3]]; FromDigits[{Mod[x1 + y2, 2], Mod[x0 + y1, 2], y0}, 2]];\)\), "\n", \(C = FunctionToCA[loc, 2, \(-8\)]\), "\n", \(PrintCA[C]\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell["\<\ To understand how the machine works it is best to think of the \ cells as consisting of three layers of bits. The top bit is unchanged, the \ second is obtained by xor with the top bit of the cell on the left, and the \ bottom bit is obtained from xor with the second bit on the left. Note that the corresponding de Bruijn automaton is deterministic, but not \ co-deterministic. \ \>", "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(\(sa = ToSA[C];\)\), "\n", \(\(sar = ReverseFA[sa];\)\), "\n", \(DeterministicQFA[sa]\), "\n", \(DeterministicQFA[sar]\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(DegreesFA[sa]\ // \ TableForm\), "\n", \(DegreesFA[sar]\ // \ TableForm\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell["The Welch coefficients are 8 and 1 for C. ", "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[ \(WelchCA[C]\)], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell["Hence, C is reversible. ", "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[ \(ClassifyCA[C]\)], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell["Which fact is also clearly visible in the orbits of C.", "Text", ImageSize->{288, 288}], Cell[BoxData[{ \(\(X\ = \ Join[Table[0, {20}], Table[\ Random[Integer, {0, 7}], {40}], Table[0, {20}]];\)\), "\n", \(\(EvolutionCA[\ C, \ X, \ 50\ ];\)\)}], "Input", ImageSize->{288, 288}], Cell["Here is the inverse CA.", "Text", ImageSize->{288, 288}], Cell[BoxData[ \(Ci = InverseCA[C]\)], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell["\<\ We can verify that the composition of C and Ci really simplifies to \ the identity -- though the intermediate automaton is quite large.\ \>", "Text",\ Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[ \(ComposeCA[C, Ci]\)], "Input", ImageSize->{288, 288}], Cell[BoxData[{ \(%\ // \ SimplifyCA\), "\[IndentingNewLine]", \(%\ // \ PrintCA\)}], "Input", ImageSize->{288, 288}], Cell[TextData[{ "Here is an example where the output of ", StyleBox["InverseCA", "MR"], " is off by a shift. Consider the following reversible ", Cell[BoxData[ \(TraditionalForm\`\((3, 3)\)\)]], "-CA." }], "Text", ImageSize->{288, 288}], Cell[BoxData[{ \(\(C\ = \ \ CA[3, 3, 382450783];\)\), "\n", \(ClassifyCA[\ C\ ]\)}], "Input", ImageSize->{288, 288}], Cell["\<\ Generate an orbit that has clear visual features, so it will be \ easy to see if the inverse automaton works properly.\ \>", "Text", ImageSize->{288, 288}], Cell[BoxData[{ \(\(orb1\ = \ OrbitCA[\ C\ , Join[Table[0, {70}], SeedConfiguration[30, Random \[Rule] 3]], 100];\)\), "\[IndentingNewLine]", \(cols\ = \ \ {0 \[Rule] \ Yellow, 1 \[Rule] Blue, 2 \[Rule] Gray}; PlotMatrix[\ orb1, \ RasterStyle \[Rule] cols\ ];\)}], "Input", ImageSize->{288, 288}], Cell["\<\ We construct the inverse CA and generate the backwards orbit, \ starting at the last configutaration in the forward orbit. \ \>", "Text", ImageSize->{288, 288}], Cell[BoxData[{ \(CC\ = \ InverseCA[C]\), "\[IndentingNewLine]", \(\(orb2\ = \ OrbitCA[\ CC\ , Last[orb1], 100];\)\), "\[IndentingNewLine]", \(\(PlotMatrix[\ orb2, \ RasterStyle \[Rule] cols\ ];\)\)}], "Input", ImageSize->{288, 288}], Cell["\<\ Clearly wrong; the triangular region is sheared to the right. By \ composition with the double shift we can fix the problem.\ \>", "Text", ImageSize->{288, 288}], Cell[BoxData[{ \(\(rs\ = \ FunctionToCA[Function[{x, y, z, u}, u], 4, 3];\)\), "\n", \(\(Ci\ = \ ComposeCA[CC, rs];\)\), "\n", \(\(orb2\ = \ OrbitCA[\ Ci\ , Last[orb1], 100];\)\), "\n", \(\(gr1\ = \ PlotMatrix[orb1, RasterStyle \[Rule] cols, DisplayFunction \[Rule] Identity];\)\), "\n", \(\(gr2\ = \ PlotMatrix[orb2, RasterStyle \[Rule] cols, DisplayFunction \[Rule] Identity];\)\), "\n", \(\(ShowArray[{gr1, gr2}];\)\)}], "Input", ImageSize->{288, 288}], Cell[TextData[{ "The simplification routine will convert the actual inverse CA into the \ output of ", StyleBox["InverseCA", "MR"], "." }], "Text", ImageSize->{288, 288}], Cell[BoxData[ \(CC\ \[Equal] \ SimplifyCA[Ci]\)], "Input", ImageSize->{288, 288}] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Binary Width 4 CAs", "Subsection", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}, CellTags->"c:7"], Cell["\<\ We will now compute the inverse CAs for all reversible binary CAs \ of width 4. We start with a list of all essential reversible CAs:\ \>", "Text",\ Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(\(inj4 = \((CA[4, \(-2\), #1] &)\) /@ {255, 3855, 3915, 11535, 13107, 13155, 14643, 21845};\)\), "\n", \(TableForm[inj4]\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell["\<\ To speed up the computation a little, we first shrink the automata. \ As it turns out, only 4 rules that depend on all 4 variables remain. \ \>", \ "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(\(sinj4 = SimplifyCA /@ inj4;\)\), "\n", \(TableForm[sinj4]\), "\n", \(\(sinj4 = Select[sinj4, WidthCA[#1] == 4 &];\)\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(\(inv4 = SimplifyCA /@ \(InverseCA /@ sinj4\);\)\), "\n", \(Thread[{sinj4, inv4}]\ // \ TableForm\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell["\<\ Note that the first CA is the inverse of the second, and the third \ the inverse of the fourth. To check the results we compute the compositions. \ After shrinking the automata all turn out to produce the identity map. \ \>", \ "Text", Evaluatable->False, AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[{ \(\(cc = Apply[ComposeCA, Pairs[sinj4, inv4], {1}];\)\), "\n", \(cc\ // \ TableForm\)}], "Input", AspectRatioFixed->True, ImageSize->{288, 288}], Cell[BoxData[ \(SimplifyCA /@ Union[cc]\)], "Input", AspectRatioFixed->True, ImageSize->{288, 288}] }, Closed]] }, Closed]] }, FrontEndVersion->"5.0 for X", ScreenRectangle->{{0, 1280}, {0, 1024}}, AutoGeneratedPackage->None, WindowToolbars->{}, CellGrouping->Automatic, WindowSize->{1016, 996}, WindowMargins->{{Automatic, 1}, {Automatic, 0}}, PrintingStartingPageNumber->1, PrivateNotebookOptions->{"ColorPalette"->{RGBColor, 128}}, ShowSelection->True, ShowCellLabel->False, CellLabelAutoDelete->True, ShowCellTags->False, ImageSize->{216, 216}, RenderingOptions->{"ObjectDithering"->True, "RasterDithering"->False}, CharacterEncoding->Automatic, Magnification->1.5, StyleDefinitions -> "TextDemoMod.nb" ] (******************************************************************* Cached data follows. If you edit this Notebook file directly, not using Mathematica, you must remove the line containing CacheID at the top of the file. The cache data will then be recreated when you save this file from within Mathematica. *******************************************************************) (*CellTagsOutline CellTagsIndex->{ "c:1"->{ Cell[1831, 54, 171, 5, 108, "Title", Evaluatable->False, CellTags->"c:1"]}, "c:2"->{ Cell[2027, 63, 135, 4, 84, "Section", Evaluatable->False, CellTags->"c:2"], Cell[76802, 2237, 131, 4, 52, "Section", Evaluatable->False, CellTags->"c:2"]}, "c:7"->{ Cell[2187, 71, 138, 4, 63, "Subsection", Evaluatable->False, CellTags->"c:7"], Cell[26284, 824, 127, 4, 52, "Subsection", Evaluatable->False, CellTags->"c:7"], Cell[42686, 1327, 143, 4, 63, "Subsection", Evaluatable->False, CellTags->"c:7"], Cell[52436, 1606, 126, 4, 52, "Subsection", Evaluatable->False, CellTags->"c:7"], Cell[146643, 4481, 126, 4, 63, "Subsection", Evaluatable->False, CellTags->"c:7"], Cell[161251, 4960, 127, 4, 63, "Subsection", Evaluatable->False, CellTags->"c:7"], Cell[175113, 5371, 128, 4, 63, "Subsection", Evaluatable->False, CellTags->"c:7"], Cell[178357, 5482, 143, 4, 63, "Subsection", Evaluatable->False, CellTags->"c:7"], Cell[179904, 5547, 136, 4, 63, "Subsection", Evaluatable->False, CellTags->"c:7"], Cell[199994, 6216, 132, 4, 63, "Subsection", Evaluatable->False, CellTags->"c:7"]}, "c:8"->{ Cell[2350, 79, 79, 2, 64, "Subsubsection", CellTags->"c:8"], Cell[47511, 1469, 142, 4, 52, "Subsection", Evaluatable->False, CellTags->"c:8"]}, "c:9"->{ Cell[11069, 362, 114, 3, 67, "Subsubsection", CellTags->"c:9"]}, "c:24"->{ Cell[53286, 1632, 76, 2, 64, "Subsubsection", CellTags->"c:24"], Cell[146476, 4473, 142, 4, 52, "Section", Evaluatable->False, CellTags->"c:24"]}, "c:26"->{ Cell[56940, 1703, 74, 2, 64, "Subsubsection", CellTags->"c:26"], Cell[146794, 4489, 158, 5, 67, "Subsubsection", Evaluatable->False, CellTags->"c:26"]}, "c:25"->{ Cell[59526, 1751, 75, 2, 64, "Subsubsection", CellTags->"c:25"]}, "c:27"->{ Cell[60873, 1783, 77, 2, 64, "Subsubsection", CellTags->"c:27"], Cell[153781, 4720, 189, 6, 67, "Subsubsection", Evaluatable->False, CellTags->"c:27"]}, "c:28"->{ Cell[62301, 1815, 77, 2, 64, "Subsubsection", CellTags->"c:28"]}, "c:18"->{ Cell[63223, 1843, 148, 4, 52, "Subsection", Evaluatable->False, CellTags->"c:18"]}, "c:19"->{ Cell[64103, 1868, 159, 5, 65, "Subsubsection", Evaluatable->False, CellTags->"c:19"], Cell[117819, 3602, 149, 4, 52, "Section", Evaluatable->False, CellTags->"c:19"]}, "c:20"->{ Cell[70872, 2060, 164, 5, 65, "Subsubsection", Evaluatable->False, CellTags->"c:20"]}, "c:3"->{ Cell[76958, 2245, 127, 4, 63, "Subsection", Evaluatable->False, CellTags->"c:3"], Cell[81429, 2382, 135, 4, 63, "Subsection", Evaluatable->False, CellTags->"c:3"]}, "c:12"->{ Cell[87416, 2584, 151, 4, 52, "Section", Evaluatable->False, CellTags->"c:12"]}, "c:13"->{ Cell[87592, 2592, 152, 4, 63, "Subsection", Evaluatable->False, CellTags->"c:13"]}, "c:14"->{ Cell[87769, 2600, 168, 5, 67, "Subsubsection", Evaluatable->False, CellTags->"c:14"]}, "c:15"->{ Cell[99567, 2989, 178, 5, 67, "Subsubsection", Evaluatable->False, CellTags->"c:15"]}, "c:31"->{ Cell[179740, 5539, 139, 4, 52, "Section", Evaluatable->False, CellTags->"c:31"]}, "c:33"->{ Cell[180065, 5555, 171, 5, 67, "Subsubsection", Evaluatable->False, CellTags->"c:33"]}, "c:34"->{ Cell[185851, 5745, 167, 5, 67, "Subsubsection", Evaluatable->False, CellTags->"c:34"]}, "c:35"->{ Cell[192833, 5979, 164, 5, 67, "Subsubsection", Evaluatable->False, CellTags->"c:35"]} } *) (*CellTagsIndex CellTagsIndex->{ {"c:1", 202881, 6313}, {"c:2", 202984, 6317}, {"c:7", 203183, 6324}, {"c:8", 204177, 6355}, {"c:9", 204358, 6361}, {"c:24", 204445, 6364}, {"c:26", 204630, 6370}, {"c:25", 204821, 6376}, {"c:27", 204909, 6379}, {"c:28", 205100, 6385}, {"c:18", 205188, 6388}, {"c:19", 205300, 6392}, {"c:20", 205512, 6399}, {"c:3", 205626, 6403}, {"c:12", 205835, 6410}, {"c:13", 205944, 6414}, {"c:14", 206056, 6418}, {"c:15", 206171, 6422}, {"c:31", 206286, 6426}, {"c:33", 206396, 6430}, {"c:34", 206512, 6434}, {"c:35", 206628, 6438} } *) (*NotebookFileOutline Notebook[{ Cell[1754, 51, 74, 1, 41, "SmallText"], Cell[1831, 54, 171, 5, 108, "Title", Evaluatable->False, CellTags->"c:1"], Cell[CellGroupData[{ Cell[2027, 63, 135, 4, 84, "Section", Evaluatable->False, CellTags->"c:2"], Cell[CellGroupData[{ Cell[2187, 71, 138, 4, 63, "Subsection", Evaluatable->False, CellTags->"c:7"], Cell[CellGroupData[{ Cell[2350, 79, 79, 2, 64, "Subsubsection", CellTags->"c:8"], Cell[2432, 83, 1996, 68, 384, "Text", Evaluatable->False], Cell[4431, 153, 137, 4, 74, "Input"], Cell[4571, 159, 473, 15, 69, "Text", Evaluatable->False], Cell[5047, 176, 194, 5, 97, "Input"], Cell[5244, 183, 163, 4, 74, "Input"], Cell[5410, 189, 866, 15, 204, "Text", Evaluatable->False], Cell[6279, 206, 563, 11, 258, "Input"], Cell[6845, 219, 89, 1, 42, "Text"], Cell[6937, 222, 407, 6, 120, "Input"], Cell[7347, 230, 159, 4, 42, "Text"], Cell[7509, 236, 87, 2, 51, "Input"], Cell[7599, 240, 279, 5, 97, "Input"], Cell[7881, 247, 87, 2, 51, "Input"], Cell[7971, 251, 279, 5, 97, "Input"], Cell[8253, 258, 311, 9, 69, "Text", Evaluatable->False], Cell[8567, 269, 118, 3, 51, "Input"], Cell[8688, 274, 110, 3, 51, "Input"], Cell[8801, 279, 126, 3, 51, "Input"], Cell[8930, 284, 914, 29, 123, "Text", Evaluatable->False], Cell[9847, 315, 159, 4, 74, "Input"], Cell[10009, 321, 158, 4, 74, "Input"], Cell[10170, 327, 387, 12, 69, "Text", Evaluatable->False], Cell[10560, 341, 178, 4, 74, "Input"], Cell[10741, 347, 76, 2, 51, "Input"], Cell[10820, 351, 212, 6, 69, "Text", Evaluatable->False] }, Closed]], Cell[CellGroupData[{ Cell[11069, 362, 114, 3, 67, "Subsubsection", CellTags->"c:9"], Cell[11186, 367, 3835, 95, 654, "Text", Evaluatable->False], Cell[15024, 464, 211, 5, 74, "Input"], Cell[15238, 471, 122, 4, 42, "Text"], Cell[15363, 477, 233, 5, 74, "Input"], Cell[15599, 484, 1175, 22, 333, "Text", Evaluatable->False], Cell[16777, 508, 364, 8, 120, "Input"], Cell[17144, 518, 142, 3, 51, "Input"], Cell[17289, 523, 356, 9, 69, "Text"], Cell[17648, 534, 254, 6, 120, "Input"], Cell[17905, 542, 125, 4, 42, "Text"], Cell[18033, 548, 89, 2, 51, "Input"], Cell[18125, 552, 469, 11, 96, "Text"], Cell[18597, 565, 219, 5, 97, "Input"], Cell[18819, 572, 363, 7, 96, "Text"], Cell[19185, 581, 220, 5, 97, "Input"], Cell[19408, 588, 460, 10, 96, "Text", Evaluatable->False], Cell[19871, 600, 115, 3, 51, "Input"], Cell[19989, 605, 263, 7, 69, "Text"], Cell[20255, 614, 101, 2, 51, "Input"], Cell[20359, 618, 205, 7, 42, "Text"], Cell[20567, 627, 91, 2, 51, "Input"], Cell[20661, 631, 115, 2, 51, "Input"], Cell[20779, 635, 377, 12, 69, "Text"], Cell[21159, 649, 141, 3, 74, "Input"], Cell[21303, 654, 217, 8, 42, "Text"], Cell[21523, 664, 380, 8, 120, "Input"], Cell[21906, 674, 222, 6, 69, "Text"], Cell[22131, 682, 461, 10, 189, "Input"], Cell[22595, 694, 226, 6, 74, "Input"], Cell[22824, 702, 187, 6, 42, "Text", Evaluatable->False], Cell[23014, 710, 316, 7, 120, "Input"], Cell[23333, 719, 285, 11, 42, "Text", Evaluatable->False], Cell[23621, 732, 290, 6, 120, "Input"], Cell[23914, 740, 133, 3, 51, "Input"], Cell[24050, 745, 306, 8, 69, "Text", Evaluatable->False], Cell[24359, 755, 207, 5, 97, "Input"], Cell[24569, 762, 107, 3, 51, "Input"], Cell[24679, 767, 348, 8, 96, "Text", Evaluatable->False], Cell[25030, 777, 189, 3, 74, "Input"], Cell[25222, 782, 76, 2, 51, "Input"], Cell[25301, 786, 197, 7, 42, "Text", Evaluatable->False], Cell[25501, 795, 138, 3, 51, "Input"], Cell[25642, 800, 155, 4, 51, "Input"], Cell[25800, 806, 151, 4, 42, "Text"], Cell[25954, 812, 281, 6, 74, "Input"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[26284, 824, 127, 4, 52, "Subsection", Evaluatable->False, CellTags->"c:7"], Cell[CellGroupData[{ Cell[26436, 832, 72, 1, 64, "Subsubsection"], Cell[26511, 835, 892, 26, 96, "Text", Evaluatable->False], Cell[27406, 863, 255, 7, 143, "Input"], Cell[27664, 872, 911, 21, 150, "Text", Evaluatable->False], Cell[28578, 895, 195, 5, 74, "Input"], Cell[28776, 902, 163, 6, 42, "Text", Evaluatable->False], Cell[28942, 910, 243, 5, 97, "Input"], Cell[29188, 917, 219, 5, 97, "Input"], Cell[29410, 924, 123, 4, 42, "Text"], Cell[29536, 930, 149, 3, 74, "Input"], Cell[29688, 935, 267, 6, 69, "Text"], Cell[29958, 943, 127, 3, 74, "Input"], Cell[30088, 948, 150, 4, 74, "Input"], Cell[30241, 954, 134, 4, 42, "Text"], Cell[30378, 960, 119, 3, 74, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[30534, 968, 56, 1, 38, "Subsubsection"], Cell[30593, 971, 2155, 48, 360, "Text", Evaluatable->False], Cell[32751, 1021, 83, 2, 51, "Input"], Cell[32837, 1025, 101, 1, 42, "Text"], Cell[32941, 1028, 94, 2, 51, "Input"], Cell[33038, 1032, 249, 7, 42, "Text"], Cell[33290, 1041, 166, 4, 51, "Input"], Cell[33459, 1047, 154, 6, 42, "Text"], Cell[33616, 1055, 228, 5, 74, "Input"], Cell[33847, 1062, 242, 7, 69, "Text"], Cell[34092, 1071, 89, 2, 51, "Input"], Cell[34184, 1075, 183, 6, 42, "Text"], Cell[34370, 1083, 204, 5, 74, "Input"], Cell[34577, 1090, 200, 7, 42, "Text"], Cell[34780, 1099, 96, 2, 51, "Input"], Cell[34879, 1103, 152, 4, 42, "Text"], Cell[35034, 1109, 168, 3, 74, "Input"], Cell[35205, 1114, 212, 5, 69, "Text"], Cell[35420, 1121, 269, 6, 97, "Input"], Cell[35692, 1129, 376, 13, 69, "Text"], Cell[36071, 1144, 252, 5, 97, "Input"], Cell[36326, 1151, 130, 3, 51, "Input"], Cell[36459, 1156, 1543, 34, 357, "Text"], Cell[38005, 1192, 188, 4, 74, "Input"], Cell[38196, 1198, 284, 7, 69, "Text"], Cell[38483, 1207, 950, 16, 350, "Input"], Cell[39436, 1225, 273, 6, 69, "Text"], Cell[39712, 1233, 165, 3, 74, "Input"], Cell[39880, 1238, 275, 6, 69, "Text"], Cell[40158, 1246, 292, 6, 120, "Input"], Cell[40453, 1254, 546, 17, 96, "Text"], Cell[41002, 1273, 253, 5, 97, "Input"], Cell[41258, 1280, 149, 4, 42, "Text"], Cell[41410, 1286, 180, 3, 74, "Input"], Cell[41593, 1291, 170, 4, 69, "Text"], Cell[41766, 1297, 403, 9, 97, "Input"], Cell[42172, 1308, 85, 1, 42, "Text"], Cell[42260, 1311, 88, 2, 51, "Input"], Cell[42351, 1315, 286, 6, 69, "Text"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[42686, 1327, 143, 4, 63, "Subsection", Evaluatable->False, CellTags->"c:7"], Cell[42832, 1333, 1576, 32, 363, "Text", Evaluatable->False], Cell[44411, 1367, 255, 6, 74, "Input"], Cell[44669, 1375, 1218, 36, 291, "Text", Evaluatable->False], Cell[45890, 1413, 373, 8, 143, "Input"], Cell[46266, 1423, 170, 6, 42, "Text", Evaluatable->False], Cell[46439, 1431, 247, 5, 74, "Input"], Cell[46689, 1438, 256, 7, 69, "Text", Evaluatable->False], Cell[46948, 1447, 223, 5, 74, "Input"], Cell[47174, 1454, 180, 5, 51, "Input"], Cell[47357, 1461, 117, 3, 51, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[47511, 1469, 142, 4, 52, "Subsection", Evaluatable->False, CellTags->"c:8"], Cell[47656, 1475, 742, 19, 174, "Text"], Cell[48401, 1496, 108, 2, 51, "Input"], Cell[48512, 1500, 227, 7, 69, "Text"], Cell[48742, 1509, 144, 3, 74, "Input"], Cell[48889, 1514, 239, 5, 69, "Text"], Cell[49131, 1521, 101, 2, 51, "Input"], Cell[49235, 1525, 411, 6, 120, "Input"], Cell[49649, 1533, 238, 5, 74, "Input"], Cell[49890, 1540, 213, 5, 69, "Text"], Cell[50106, 1547, 699, 10, 212, "Input"], Cell[50808, 1559, 299, 6, 97, "Input"], Cell[51110, 1567, 101, 1, 42, "Text"], Cell[51214, 1570, 218, 5, 97, "Input"], Cell[51435, 1577, 100, 1, 42, "Text"], Cell[51538, 1580, 299, 6, 97, "Input"], Cell[51840, 1588, 299, 6, 97, "Input"], Cell[52142, 1596, 257, 5, 97, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[52436, 1606, 126, 4, 52, "Subsection", Evaluatable->False, CellTags->"c:7"], Cell[52565, 1612, 617, 12, 228, "Text"], Cell[53185, 1626, 76, 2, 51, "Input"], Cell[CellGroupData[{ Cell[53286, 1632, 76, 2, 64, "Subsubsection", CellTags->"c:24"], Cell[53365, 1636, 74, 1, 42, "Text"], Cell[53442, 1639, 2590, 35, 879, "Input"], Cell[56035, 1676, 233, 5, 69, "Text"], Cell[56271, 1683, 134, 3, 74, "Input"], Cell[56408, 1688, 495, 10, 143, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[56940, 1703, 74, 2, 64, "Subsubsection", CellTags->"c:26"], Cell[57017, 1707, 2022, 28, 695, "Input"], Cell[59042, 1737, 447, 9, 120, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[59526, 1751, 75, 2, 64, "Subsubsection", CellTags->"c:25"], Cell[59604, 1755, 824, 13, 304, "Input"], Cell[60431, 1770, 405, 8, 120, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[60873, 1783, 77, 2, 64, "Subsubsection", CellTags->"c:27"], Cell[60953, 1787, 786, 12, 304, "Input"], Cell[61742, 1801, 522, 9, 143, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[62301, 1815, 77, 2, 64, "Subsubsection", CellTags->"c:28"], Cell[62381, 1819, 269, 6, 143, "Input"], Cell[62653, 1827, 521, 10, 143, "Input"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[63223, 1843, 148, 4, 52, "Subsection", Evaluatable->False, CellTags->"c:18"], Cell[63374, 1849, 704, 15, 150, "Text"], Cell[CellGroupData[{ Cell[64103, 1868, 159, 5, 65, "Subsubsection", Evaluatable->False, CellTags->"c:19"], Cell[64265, 1875, 562, 9, 150, "Text"], Cell[64830, 1886, 493, 13, 97, "Input"], Cell[65326, 1901, 737, 18, 97, "Input"], Cell[66066, 1921, 375, 11, 69, "Text"], Cell[66444, 1934, 104, 2, 51, "Input"], Cell[66551, 1938, 814, 20, 97, "Input"], Cell[67368, 1960, 82, 1, 42, "Text"], Cell[67453, 1963, 737, 18, 97, "Input"], Cell[68193, 1983, 66, 1, 42, "Text"], Cell[68262, 1986, 763, 18, 97, "Input"], Cell[69028, 2006, 130, 4, 42, "Text"], Cell[69161, 2012, 174, 3, 74, "Input"], Cell[69338, 2017, 747, 18, 97, "Input"], Cell[70088, 2037, 747, 18, 97, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[70872, 2060, 164, 5, 65, "Subsubsection", Evaluatable->False, CellTags->"c:20"], Cell[71039, 2067, 836, 18, 201, "Text"], Cell[71878, 2087, 1527, 41, 97, "Input"], Cell[73408, 2130, 96, 1, 42, "Text"], Cell[73507, 2133, 322, 7, 120, "Input"], Cell[73832, 2142, 91, 1, 42, "Text"], Cell[73926, 2145, 322, 7, 120, "Input"], Cell[74251, 2154, 149, 4, 42, "Text"], Cell[74403, 2160, 189, 5, 74, "Input"], Cell[74595, 2167, 327, 7, 97, "Input"], Cell[74925, 2176, 280, 8, 69, "Text"], Cell[75208, 2186, 237, 6, 97, "Input"], Cell[75448, 2194, 301, 7, 97, "Input"], Cell[75752, 2203, 313, 7, 97, "Input"], Cell[76068, 2212, 89, 1, 42, "Text"], Cell[76160, 2215, 277, 6, 97, "Input"], Cell[76440, 2223, 301, 7, 97, "Input"] }, Closed]] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[76802, 2237, 131, 4, 52, "Section", Evaluatable->False, CellTags->"c:2"], Cell[CellGroupData[{ Cell[76958, 2245, 127, 4, 63, "Subsection", Evaluatable->False, CellTags->"c:3"], Cell[77088, 2251, 2818, 70, 456, "Text"], Cell[79909, 2323, 272, 6, 69, "Text"], Cell[80184, 2331, 382, 10, 51, "Input"], Cell[80569, 2343, 116, 4, 42, "Text"], Cell[80688, 2349, 88, 2, 51, "Input"], Cell[80779, 2353, 131, 4, 42, "Text"], Cell[80913, 2359, 131, 3, 51, "Input"], Cell[81047, 2364, 88, 2, 51, "Input"], Cell[81138, 2368, 91, 1, 42, "Text"], Cell[81232, 2371, 80, 2, 51, "Input"], Cell[81315, 2375, 77, 2, 51, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[81429, 2382, 135, 4, 63, "Subsection", Evaluatable->False, CellTags->"c:3"], Cell[81567, 2388, 1046, 29, 189, "Text"], Cell[82616, 2419, 129, 3, 51, "Input"], Cell[82748, 2424, 112, 2, 51, "Input"], Cell[82863, 2428, 123, 4, 42, "Text"], Cell[82989, 2434, 96, 2, 51, "Input"], Cell[83088, 2438, 139, 3, 74, "Input"], Cell[83230, 2443, 93, 2, 51, "Input"], Cell[83326, 2447, 97, 1, 42, "Text"], Cell[83426, 2450, 313, 6, 97, "Input"], Cell[83742, 2458, 730, 21, 162, "Text"], Cell[84475, 2481, 182, 4, 97, "Input"], Cell[84660, 2487, 96, 1, 42, "Text"], Cell[84759, 2490, 377, 8, 97, "Input"], Cell[85139, 2500, 193, 7, 42, "Text"], Cell[85335, 2509, 340, 8, 74, "Input"], Cell[85678, 2519, 243, 7, 69, "Text"], Cell[85924, 2528, 75, 2, 51, "Input"], Cell[86002, 2532, 106, 2, 51, "Input"], Cell[86111, 2536, 121, 4, 42, "Text"], Cell[86235, 2542, 136, 3, 51, "Input"], Cell[86374, 2547, 218, 8, 42, "Text"], Cell[86595, 2557, 448, 9, 97, "Input"], Cell[87046, 2568, 85, 1, 42, "Text"], Cell[87134, 2571, 136, 3, 51, "Input"], Cell[87273, 2576, 94, 2, 51, "Input"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[87416, 2584, 151, 4, 52, "Section", Evaluatable->False, CellTags->"c:12"], Cell[CellGroupData[{ Cell[87592, 2592, 152, 4, 63, "Subsection", Evaluatable->False, CellTags->"c:13"], Cell[CellGroupData[{ Cell[87769, 2600, 168, 5, 67, "Subsubsection", Evaluatable->False, CellTags->"c:14"], Cell[87940, 2607, 3186, 87, 480, "Text", Evaluatable->False], Cell[91129, 2696, 133, 3, 51, "Input"], Cell[91265, 2701, 185, 4, 74, "Input"], Cell[91453, 2707, 121, 3, 51, "Input"], Cell[91577, 2712, 105, 3, 51, "Input"], Cell[91685, 2717, 754, 24, 96, "Text", Evaluatable->False], Cell[92442, 2743, 146, 4, 74, "Input"], Cell[92591, 2749, 208, 6, 69, "Text", Evaluatable->False], Cell[92802, 2757, 134, 4, 74, "Input"], Cell[92939, 2763, 209, 7, 42, "Text", Evaluatable->False], Cell[93151, 2772, 209, 4, 74, "Input"], Cell[93363, 2778, 178, 6, 42, "Text", Evaluatable->False], Cell[93544, 2786, 100, 3, 51, "Input"], Cell[93647, 2791, 301, 8, 81, "Text", Evaluatable->False], Cell[93951, 2801, 132, 4, 74, "Input"], Cell[94086, 2807, 145, 4, 74, "Input"], Cell[94234, 2813, 159, 4, 74, "Input"], Cell[94396, 2819, 141, 3, 51, "Input"], Cell[94540, 2824, 330, 8, 69, "Text", Evaluatable->False], Cell[94873, 2834, 181, 5, 51, "Input"], Cell[95057, 2841, 182, 6, 42, "Text", Evaluatable->False], Cell[95242, 2849, 217, 4, 97, "Input"], Cell[95462, 2855, 450, 10, 96, "Text", Evaluatable->False], Cell[95915, 2867, 355, 7, 143, "Input"], Cell[96273, 2876, 517, 17, 96, "Text", Evaluatable->False], Cell[96793, 2895, 319, 7, 120, "Input"], Cell[97115, 2904, 354, 10, 69, "Text", Evaluatable->False], Cell[97472, 2916, 148, 4, 74, "Input"], Cell[97623, 2922, 260, 5, 74, "Input"], Cell[97886, 2929, 188, 6, 42, "Text", Evaluatable->False], Cell[98077, 2937, 138, 3, 51, "Input"], Cell[98218, 2942, 118, 4, 42, "Text"], Cell[98339, 2948, 96, 3, 51, "Input"], Cell[98438, 2953, 138, 3, 42, "Text", Evaluatable->False], Cell[98579, 2958, 293, 6, 97, "Input"], Cell[98875, 2966, 351, 9, 69, "Text", Evaluatable->False], Cell[99229, 2977, 301, 7, 97, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[99567, 2989, 178, 5, 67, "Subsubsection", Evaluatable->False, CellTags->"c:15"], Cell[99748, 2996, 1324, 46, 273, "Text", Evaluatable->False], Cell[101075, 3044, 1327, 27, 309, "Text", Evaluatable->False], Cell[102405, 3073, 126, 4, 74, "Input"], Cell[102534, 3079, 322, 8, 143, "Input"], Cell[102859, 3089, 249, 7, 69, "Text", Evaluatable->False], Cell[103111, 3098, 171, 5, 51, "Input"], Cell[103285, 3105, 129, 3, 42, "Text", Evaluatable->False], Cell[103417, 3110, 104, 3, 51, "Input"], Cell[103524, 3115, 345, 8, 96, "Text", Evaluatable->False], Cell[103872, 3125, 330, 8, 120, "Input"], Cell[104205, 3135, 240, 7, 69, "Text", Evaluatable->False], Cell[104448, 3144, 159, 4, 74, "Input"], Cell[104610, 3150, 401, 12, 69, "Text", Evaluatable->False], Cell[105014, 3164, 104, 2, 51, "Input"], Cell[105121, 3168, 166, 4, 51, "Input"], Cell[105290, 3174, 454, 14, 81, "Text", Evaluatable->False], Cell[105747, 3190, 160, 3, 74, "Input"], Cell[105910, 3195, 268, 7, 69, "Text"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[106227, 3208, 74, 1, 63, "Subsection"], Cell[CellGroupData[{ Cell[106326, 3213, 62, 1, 64, "Subsubsection"], Cell[106391, 3216, 306, 7, 69, "Text", Evaluatable->False], Cell[106700, 3225, 156, 4, 51, "Input"], Cell[106859, 3231, 130, 3, 42, "Text", Evaluatable->False], Cell[106992, 3236, 150, 4, 74, "Input"], Cell[107145, 3242, 224, 6, 69, "Text", Evaluatable->False], Cell[107372, 3250, 151, 4, 74, "Input"], Cell[107526, 3256, 133, 3, 51, "Input"], Cell[107662, 3261, 302, 6, 97, "Input"], Cell[107967, 3269, 470, 12, 96, "Text", Evaluatable->False], Cell[108440, 3283, 245, 7, 97, "Input"], Cell[108688, 3292, 133, 3, 51, "Input"], Cell[108824, 3297, 297, 9, 69, "Text", Evaluatable->False], Cell[109124, 3308, 367, 8, 120, "Input"], Cell[109494, 3318, 674, 16, 123, "Text", Evaluatable->False], Cell[110171, 3336, 158, 5, 51, "Input"], Cell[110332, 3343, 134, 4, 74, "Input"], Cell[110469, 3349, 179, 6, 42, "Text", Evaluatable->False], Cell[110651, 3357, 123, 3, 74, "Input"], Cell[110777, 3362, 116, 3, 51, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[110930, 3370, 74, 1, 64, "Subsubsection"], Cell[111007, 3373, 637, 14, 150, "Text"], Cell[111647, 3389, 195, 4, 74, "Input"], Cell[111845, 3395, 192, 5, 69, "Text"], Cell[112040, 3402, 174, 4, 74, "Input"], Cell[112217, 3408, 81, 2, 51, "Input"], Cell[112301, 3412, 367, 7, 96, "Text"], Cell[112671, 3421, 431, 10, 120, "Input"], Cell[113105, 3433, 136, 4, 42, "Text"], Cell[113244, 3439, 135, 3, 51, "Input"], Cell[113382, 3444, 319, 7, 74, "Input"], Cell[113704, 3453, 77, 1, 42, "Text"], Cell[113784, 3456, 73, 2, 51, "Input"], Cell[113860, 3460, 129, 4, 42, "Text"], Cell[113992, 3466, 215, 5, 74, "Input"], Cell[114210, 3473, 72, 2, 51, "Input"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[114331, 3481, 70, 1, 63, "Subsection"], Cell[114404, 3484, 1032, 34, 135, "Text", Evaluatable->False], Cell[115439, 3520, 251, 6, 120, "Input"], Cell[115693, 3528, 131, 3, 42, "Text", Evaluatable->False], Cell[115827, 3533, 159, 4, 74, "Input"], Cell[115989, 3539, 233, 4, 97, "Input"], Cell[116225, 3545, 237, 7, 69, "Text", Evaluatable->False], Cell[116465, 3554, 176, 4, 97, "Input"], Cell[116644, 3560, 334, 8, 96, "Text", Evaluatable->False], Cell[116981, 3570, 299, 7, 74, "Input"], Cell[117283, 3579, 231, 9, 42, "Text", Evaluatable->False], Cell[117517, 3590, 253, 6, 97, "Input"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[117819, 3602, 149, 4, 52, "Section", Evaluatable->False, CellTags->"c:19"], Cell[CellGroupData[{ Cell[117993, 3610, 57, 1, 63, "Subsection"], Cell[118053, 3613, 2010, 51, 363, "Text", Evaluatable->False], Cell[120066, 3666, 201, 5, 74, "Input"], Cell[120270, 3673, 217, 6, 42, "Text", Evaluatable->False], Cell[120490, 3681, 205, 5, 97, "Input"], Cell[120698, 3688, 507, 12, 96, "Text"], Cell[121208, 3702, 134, 3, 74, "Input"], Cell[121345, 3707, 499, 11, 96, "Text", Evaluatable->False], Cell[121847, 3720, 118, 3, 51, "Input"], Cell[121968, 3725, 171, 5, 51, "Input"], Cell[122142, 3732, 2586, 65, 597, "Text", Evaluatable->False], Cell[124731, 3799, 445, 9, 123, "Text", Evaluatable->False], Cell[125179, 3810, 107, 3, 51, "Input"], Cell[125289, 3815, 103, 3, 51, "Input"], Cell[125395, 3820, 216, 5, 74, "Input"], Cell[125614, 3827, 301, 7, 69, "Text", Evaluatable->False], Cell[125918, 3836, 214, 5, 97, "Input"], Cell[126135, 3843, 616, 12, 189, "Text", Evaluatable->False], Cell[126754, 3857, 141, 3, 51, "Input"], Cell[126898, 3862, 589, 14, 123, "Text", Evaluatable->False], Cell[127490, 3878, 342, 7, 120, "Input"], Cell[127835, 3887, 223, 6, 69, "Text", Evaluatable->False], Cell[128061, 3895, 344, 7, 120, "Input"], Cell[128408, 3904, 209, 6, 42, "Text", Evaluatable->False], Cell[128620, 3912, 342, 7, 120, "Input"], Cell[128965, 3921, 189, 6, 42, "Text", Evaluatable->False], Cell[129157, 3929, 325, 7, 120, "Input"], Cell[129485, 3938, 1201, 28, 243, "Text", Evaluatable->False], Cell[130689, 3968, 198, 5, 51, "Input"], Cell[130890, 3975, 141, 4, 74, "Input"], Cell[131034, 3981, 216, 6, 42, "Text", Evaluatable->False], Cell[131253, 3989, 220, 5, 97, "Input"], Cell[131476, 3996, 194, 6, 42, "Text", Evaluatable->False], Cell[131673, 4004, 242, 6, 97, "Input"], Cell[131918, 4012, 121, 3, 51, "Input"], Cell[132042, 4017, 211, 6, 42, "Text", Evaluatable->False], Cell[132256, 4025, 293, 7, 69, "Text", Evaluatable->False], Cell[132552, 4034, 137, 3, 51, "Input"], Cell[132692, 4039, 473, 9, 143, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[133202, 4053, 61, 1, 63, "Subsection"], Cell[133266, 4056, 630, 12, 150, "Text", Evaluatable->False], Cell[133899, 4070, 248, 4, 97, "Input"], Cell[134150, 4076, 188, 5, 74, "Input"], Cell[134341, 4083, 146, 3, 42, "Text", Evaluatable->False], Cell[134490, 4088, 425, 9, 166, "Input"], Cell[134918, 4099, 269, 7, 69, "Text", Evaluatable->False], Cell[135190, 4108, 165, 4, 51, "Input"], Cell[135358, 4114, 197, 6, 42, "Text", Evaluatable->False], Cell[135558, 4122, 114, 3, 51, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[135709, 4130, 63, 1, 63, "Subsection"], Cell[135775, 4133, 1121, 27, 204, "Text", Evaluatable->False], Cell[136899, 4162, 130, 3, 51, "Input"], Cell[137032, 4167, 288, 6, 97, "Input"], Cell[137323, 4175, 240, 7, 69, "Text", Evaluatable->False] }, Closed]], Cell[CellGroupData[{ Cell[137600, 4187, 69, 1, 52, "Subsection"], Cell[137672, 4190, 578, 16, 186, "Text"], Cell[138253, 4208, 259, 5, 120, "Input"], Cell[138515, 4215, 176, 6, 42, "Text"], Cell[138694, 4223, 215, 4, 97, "Input"], Cell[138912, 4229, 511, 16, 69, "Text"], Cell[139426, 4247, 172, 4, 74, "Input"], Cell[139601, 4253, 101, 2, 51, "Input"], Cell[139705, 4257, 118, 4, 42, "Text"], Cell[139826, 4263, 159, 3, 51, "Input"], Cell[139988, 4268, 102, 2, 51, "Input"], Cell[140093, 4272, 384, 7, 96, "Text"], Cell[140480, 4281, 217, 5, 97, "Input"], Cell[140700, 4288, 89, 1, 42, "Text"], Cell[140792, 4291, 165, 3, 74, "Input"], Cell[140960, 4296, 102, 2, 51, "Input"], Cell[141065, 4300, 135, 4, 42, "Text"], Cell[141203, 4306, 143, 3, 51, "Input"], Cell[141349, 4311, 154, 4, 42, "Text"], Cell[141506, 4317, 139, 3, 51, "Input"], Cell[141648, 4322, 92, 2, 51, "Input"], Cell[141743, 4326, 102, 2, 51, "Input"], Cell[141848, 4330, 152, 4, 42, "Text"], Cell[142003, 4336, 218, 5, 97, "Input"], Cell[142224, 4343, 202, 4, 74, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[142463, 4352, 62, 1, 63, "Subsection"], Cell[142528, 4355, 739, 16, 174, "Text"], Cell[143270, 4373, 676, 11, 281, "Input"], Cell[143949, 4386, 154, 4, 42, "Text"], Cell[144106, 4392, 86, 2, 51, "Input"], Cell[144195, 4396, 77, 2, 51, "Input"], Cell[144275, 4400, 121, 4, 42, "Text"], Cell[144399, 4406, 125, 3, 74, "Input"], Cell[144527, 4411, 72, 1, 42, "Text"], Cell[144602, 4414, 142, 3, 74, "Input"], Cell[144747, 4419, 365, 8, 97, "Input"], Cell[145115, 4429, 183, 3, 74, "Input"], Cell[145301, 4434, 181, 3, 74, "Input"], Cell[145485, 4439, 181, 3, 74, "Input"], Cell[145669, 4444, 208, 7, 42, "Text"], Cell[145880, 4453, 202, 4, 97, "Input"], Cell[146085, 4459, 342, 8, 97, "Input"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[146476, 4473, 142, 4, 52, "Section", Evaluatable->False, CellTags->"c:24"], Cell[CellGroupData[{ Cell[146643, 4481, 126, 4, 63, "Subsection", Evaluatable->False, CellTags->"c:7"], Cell[CellGroupData[{ Cell[146794, 4489, 158, 5, 67, "Subsubsection", Evaluatable->False, CellTags->"c:26"], Cell[146955, 4496, 1430, 36, 306, "Text", Evaluatable->False], Cell[148388, 4534, 285, 5, 97, "Input"], Cell[148676, 4541, 338, 9, 69, "Text"], Cell[149017, 4552, 155, 4, 51, "Input"], Cell[149175, 4558, 284, 9, 69, "Text", Evaluatable->False], Cell[149462, 4569, 287, 7, 120, "Input"], Cell[149752, 4578, 1083, 31, 216, "Text", Evaluatable->False], Cell[150838, 4611, 264, 7, 97, "Input"], Cell[151105, 4620, 487, 17, 69, "Text", Evaluatable->False], Cell[151595, 4639, 167, 5, 97, "Input"], Cell[151765, 4646, 171, 5, 97, "Input"], Cell[151939, 4653, 310, 10, 69, "Text", Evaluatable->False], Cell[152252, 4665, 146, 4, 51, "Input"], Cell[152401, 4671, 203, 5, 97, "Input"], Cell[152607, 4678, 67, 2, 51, "Input"], Cell[152677, 4682, 124, 3, 51, "Input"], Cell[152804, 4687, 940, 28, 150, "Text", Evaluatable->False] }, Closed]], Cell[CellGroupData[{ Cell[153781, 4720, 189, 6, 67, "Subsubsection", Evaluatable->False, CellTags->"c:27"], Cell[153973, 4728, 1564, 46, 279, "Text", Evaluatable->False], Cell[155540, 4776, 254, 9, 42, "Text"], Cell[155797, 4787, 832, 20, 189, "Text", Evaluatable->False], Cell[156632, 4809, 275, 6, 143, "Input"], Cell[156910, 4817, 156, 4, 74, "Input"], Cell[157069, 4823, 317, 6, 96, "Text"], Cell[157389, 4831, 96, 2, 51, "Input"], Cell[157488, 4835, 208, 5, 97, "Input"], Cell[157699, 4842, 165, 4, 42, "Text"], Cell[157867, 4848, 260, 5, 74, "Input"], Cell[158130, 4855, 287, 8, 108, "Text", Evaluatable->False], Cell[158420, 4865, 155, 4, 74, "Input"], Cell[158578, 4871, 208, 5, 97, "Input"], Cell[158789, 4878, 260, 5, 74, "Input"], Cell[159052, 4885, 247, 7, 69, "Text", Evaluatable->False], Cell[159302, 4894, 325, 8, 120, "Input"], Cell[159630, 4904, 168, 4, 42, "Text"], Cell[159801, 4910, 252, 6, 120, "Input"], Cell[160056, 4918, 81, 1, 42, "Text"], Cell[160140, 4921, 329, 6, 120, "Input"], Cell[160472, 4929, 240, 9, 42, "Text"], Cell[160715, 4940, 202, 4, 97, "Input"], Cell[160920, 4946, 282, 8, 97, "Input"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[161251, 4960, 127, 4, 63, "Subsection", Evaluatable->False, CellTags->"c:7"], Cell[161381, 4966, 3163, 94, 363, "Text", Evaluatable->False], Cell[164547, 5062, 74, 2, 51, "Input"], Cell[164624, 5066, 201, 4, 74, "Input"], Cell[164828, 5072, 270, 9, 42, "Text", Evaluatable->False], Cell[165101, 5083, 277, 6, 120, "Input"], Cell[165381, 5091, 72, 1, 42, "Text"], Cell[165456, 5094, 261, 5, 97, "Input"], Cell[165720, 5101, 4065, 105, 816, "Text", Evaluatable->False], Cell[169788, 5208, 691, 12, 258, "Input"], Cell[170482, 5222, 252, 5, 74, "Input"], Cell[170737, 5229, 203, 8, 42, "Text", Evaluatable->False], Cell[170943, 5239, 106, 3, 51, "Input"], Cell[171052, 5244, 184, 6, 42, "Text", Evaluatable->False], Cell[171239, 5252, 330, 7, 97, "Input"], Cell[171572, 5261, 242, 6, 74, "Input"], Cell[171817, 5269, 318, 8, 69, "Text", Evaluatable->False], Cell[172138, 5279, 531, 13, 158, "Input"], Cell[172672, 5294, 303, 8, 166, "Input"], Cell[172978, 5304, 567, 15, 147, "Text", Evaluatable->False], Cell[173548, 5321, 454, 10, 160, "Input"], Cell[174005, 5333, 259, 6, 120, "Input"], Cell[174267, 5341, 126, 4, 74, "Input"], Cell[174396, 5347, 267, 7, 69, "Text", Evaluatable->False], Cell[174666, 5356, 410, 10, 166, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[175113, 5371, 128, 4, 63, "Subsection", Evaluatable->False, CellTags->"c:7"], Cell[175244, 5377, 675, 14, 228, "Text", Evaluatable->False], Cell[175922, 5393, 195, 7, 42, "Text", Evaluatable->False], Cell[176120, 5402, 255, 8, 120, "Input"], Cell[176378, 5412, 603, 17, 108, "Text", Evaluatable->False], Cell[176984, 5431, 338, 7, 143, "Input"], Cell[177325, 5440, 160, 4, 51, "Input"], Cell[177488, 5446, 146, 4, 51, "Input"], Cell[177637, 5452, 165, 4, 51, "Input"], Cell[177805, 5458, 308, 12, 42, "Text", Evaluatable->False], Cell[178116, 5472, 204, 5, 97, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[178357, 5482, 143, 4, 63, "Subsection", Evaluatable->False, CellTags->"c:7"], Cell[178503, 5488, 456, 15, 69, "Text", Evaluatable->False], Cell[178962, 5505, 252, 7, 143, "Input"], Cell[179217, 5514, 117, 4, 42, "Text"], Cell[179337, 5520, 87, 2, 51, "Input"], Cell[179427, 5524, 133, 4, 42, "Text"], Cell[179563, 5530, 128, 3, 51, "Input"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[179740, 5539, 139, 4, 52, "Section", Evaluatable->False, CellTags->"c:31"], Cell[CellGroupData[{ Cell[179904, 5547, 136, 4, 63, "Subsection", Evaluatable->False, CellTags->"c:7"], Cell[CellGroupData[{ Cell[180065, 5555, 171, 5, 67, "Subsubsection", Evaluatable->False, CellTags->"c:33"], Cell[180239, 5562, 649, 13, 150, "Text", Evaluatable->False], Cell[180891, 5577, 1415, 43, 177, "Text", Evaluatable->False], Cell[182309, 5622, 176, 5, 97, "Input"], Cell[182488, 5629, 236, 5, 97, "Input"], Cell[182727, 5636, 507, 18, 69, "Text", Evaluatable->False], Cell[183237, 5656, 236, 5, 97, "Input"], Cell[183476, 5663, 466, 13, 96, "Text", Evaluatable->False], Cell[183945, 5678, 101, 2, 51, "Input"], Cell[184049, 5682, 419, 9, 96, "Text"], Cell[184471, 5693, 303, 6, 74, "Input"], Cell[184777, 5701, 259, 7, 74, "Input"], Cell[185039, 5710, 198, 6, 42, "Text", Evaluatable->False], Cell[185240, 5718, 138, 4, 74, "Input"], Cell[185381, 5724, 163, 6, 42, "Text", Evaluatable->False], Cell[185547, 5732, 124, 3, 51, "Input"], Cell[185674, 5737, 140, 3, 74, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[185851, 5745, 167, 5, 67, "Subsubsection", Evaluatable->False, CellTags->"c:34"], Cell[186021, 5752, 381, 9, 69, "Text", Evaluatable->False], Cell[186405, 5763, 216, 6, 120, "Input"], Cell[186624, 5771, 186, 6, 42, "Text", Evaluatable->False], Cell[186813, 5779, 68, 2, 51, "Input"], Cell[186884, 5783, 191, 5, 97, "Input"], Cell[187078, 5790, 329, 9, 69, "Text", Evaluatable->False], Cell[187410, 5801, 242, 5, 97, "Input"], Cell[187655, 5808, 129, 3, 42, "Text", Evaluatable->False], Cell[187787, 5813, 344, 7, 143, "Input"], Cell[188134, 5822, 249, 7, 69, "Text", Evaluatable->False], Cell[188386, 5831, 129, 3, 51, "Input"], Cell[188518, 5836, 290, 6, 97, "Input"], Cell[188811, 5844, 395, 10, 96, "Text", Evaluatable->False], Cell[189209, 5856, 133, 3, 51, "Input"], Cell[189345, 5861, 1025, 30, 150, "Text", Evaluatable->False], Cell[190373, 5893, 227, 6, 74, "Input"], Cell[190603, 5901, 343, 8, 96, "Text"], Cell[190949, 5911, 285, 7, 97, "Input"], Cell[191237, 5920, 391, 7, 96, "Text"], Cell[191631, 5929, 68, 2, 51, "Input"], Cell[191702, 5933, 184, 3, 74, "Input"], Cell[191889, 5938, 171, 6, 42, "Text", Evaluatable->False], Cell[192063, 5946, 155, 3, 74, "Input"], Cell[192221, 5951, 194, 6, 42, "Text", Evaluatable->False], Cell[192418, 5959, 143, 4, 74, "Input"], Cell[192564, 5965, 131, 4, 42, "Text"], Cell[192698, 5971, 98, 3, 51, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[192833, 5979, 164, 5, 67, "Subsubsection", Evaluatable->False, CellTags->"c:35"], Cell[193000, 5986, 928, 22, 177, "Text", Evaluatable->False], Cell[193931, 6010, 212, 6, 120, "Input"], Cell[194146, 6018, 248, 7, 69, "Text", Evaluatable->False], Cell[194397, 6027, 94, 3, 51, "Input"], Cell[194494, 6032, 430, 10, 96, "Text", Evaluatable->False], Cell[194927, 6044, 438, 10, 189, "Input"], Cell[195368, 6056, 476, 10, 135, "Text", Evaluatable->False], Cell[195847, 6068, 219, 6, 120, "Input"], Cell[196069, 6076, 164, 4, 74, "Input"], Cell[196236, 6082, 131, 3, 42, "Text", Evaluatable->False], Cell[196370, 6087, 94, 3, 51, "Input"], Cell[196467, 6092, 113, 3, 42, "Text", Evaluatable->False], Cell[196583, 6097, 97, 3, 51, "Input"], Cell[196683, 6102, 95, 1, 42, "Text"], Cell[196781, 6105, 220, 5, 97, "Input"], Cell[197004, 6112, 64, 1, 42, "Text"], Cell[197071, 6115, 101, 3, 51, "Input"], Cell[197175, 6120, 234, 7, 69, "Text", Evaluatable->False], Cell[197412, 6129, 74, 2, 51, "Input"], Cell[197489, 6133, 129, 3, 74, "Input"], Cell[197621, 6138, 256, 8, 69, "Text"], Cell[197880, 6148, 128, 3, 74, "Input"], Cell[198011, 6153, 167, 4, 42, "Text"], Cell[198181, 6159, 344, 7, 120, "Input"], Cell[198528, 6168, 172, 4, 69, "Text"], Cell[198703, 6174, 259, 5, 97, "Input"], Cell[198965, 6181, 174, 4, 69, "Text"], Cell[199142, 6187, 531, 11, 166, "Input"], Cell[199676, 6200, 178, 6, 42, "Text"], Cell[199857, 6208, 88, 2, 51, "Input"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[199994, 6216, 132, 4, 63, "Subsection", Evaluatable->False, CellTags->"c:7"], Cell[200129, 6222, 232, 7, 69, "Text", Evaluatable->False], Cell[200364, 6231, 224, 5, 74, "Input"], Cell[200591, 6238, 238, 7, 69, "Text", Evaluatable->False], Cell[200832, 6247, 213, 5, 97, "Input"], Cell[201048, 6254, 189, 4, 74, "Input"], Cell[201240, 6260, 318, 8, 69, "Text", Evaluatable->False], Cell[201561, 6270, 173, 4, 74, "Input"], Cell[201737, 6276, 107, 3, 51, "Input"] }, Closed]] }, Closed]] } ] *) (******************************************************************* End of Mathematica Notebook file. *******************************************************************)