(*********************************************************************** Mathematica-Compatible Notebook This notebook can be used on any computer system with Mathematica 3.0, MathReader 3.0, or any compatible application. The data for the notebook starts with the line of 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[ 201447, 6074]*) (*NotebookOutlinePosition[ 202523, 6111]*) (* CellTagsIndexPosition[ 202479, 6107]*) (*WindowFrame->Normal*) Notebook[{ Cell[CellGroupData[{Cell[TextData["Genetic Programming"], "Title", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[{ StyleBox["A ", CellMargins->{{162, 90}, {Inherited, Inherited}}, Evaluatable->False, TextAlignment->Right, AspectRatioFixed->True, FontFamily->"Palatino", FontWeight->"Bold", FontSlant->"Plain", FontTracking->"Plain", FontVariations->{"Underline"->False, "Outline"->False, "Shadow"->False}], StyleBox["Mathematica", CellMargins->{{162, 90}, {Inherited, Inherited}}, Evaluatable->False, TextAlignment->Right, AspectRatioFixed->True, FontFamily->"Palatino", FontWeight->"Bold", FontSlant->"Italic", FontTracking->"Plain", FontVariations->{"Underline"->False, "Outline"->False, "Shadow"->False}], StyleBox[ " implementation for genetically evoloving reusable programs is described. \ It makes use of the built-in features of functional programming, recursion, \ and hierarchical data structures. An example for symbolic regression is \ presented.", CellMargins->{{162, 90}, {Inherited, Inherited}}, Evaluatable->False, TextAlignment->Right, AspectRatioFixed->True, FontFamily->"Palatino", FontWeight->"Bold", FontSlant->"Plain", FontTracking->"Plain", FontVariations->{"Underline"->False, "Outline"->False, "Shadow"->False}] }], "Special2", CellMargins->{{162, 90}, {Inherited, Inherited}}, Evaluatable->False, TextAlignment->Right, AspectRatioFixed->True, FontFamily->"Palatino", FontWeight->"Bold", FontSlant->"Plain", FontTracking->"Plain", FontVariations->{"Underline"->False, "Outline"->False, "Shadow"->False}], Cell[BoxData[ \(<< "\"\)], "Input", CellOpen->False, InitializationCell->True, AspectRatioFixed->True], Cell[TextData["Robert B. Nachbar"], "Text", Evaluatable->False, AspectRatioFixed->True, FontWeight->"Plain", FontSlant->"Italic", FontTracking->"Plain", FontVariations->{"Underline"->False, "Outline"->False, "Shadow"->False}], Cell[TextData[{ StyleBox[ "Evolutionary computing has become a popular method to robustly search \ very large solution spaces for optimal or near-optimal solutions to a wide \ variety of problems. These methods begin with an initial, usually randomly \ generated, population of individual instances of a data structure that can be \ evaluated to a solution for the problem at hand. The term \ \[OpenCurlyQuote]solution\[CloseCurlyQuote] is used rather loosely here \ because these primordial individuals are generally not very good solutions. \ Then, in the spirit of survival of the fittest, they are propagated directly, \ through recombination with mates, or by mutation into new, and hopefully more \ fit, individuals. This iterative process is repeated until one either grows \ weary or a satisfactory solution is found. The governing principle of these \ stochastic methods is that the fittest individuals possess a part of the \ final solution and by operating on them to make more-fit individuals one will \ eventually discover the optimal solution. Unlike the more traditional \ analytic methods (", Evaluatable->False, AspectRatioFixed->True], StyleBox["e.g.", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox[", least squares, conjugate gradients, ", Evaluatable->False, AspectRatioFixed->True], StyleBox["etc.", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox[ "), the stochastic nature of the multiple search trajectories endows these \ methods with the ability to avoid local minima and to sample a large portion \ of the solution space.", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[{ StyleBox[ "John R. Koza has recently described his approach to genetic programming \ with the Lisp language [Koza 1992]. It is difficult to provide a more \ thorough introduction to this topic than his, and the reader is directed to \ this work for further examples and more detailed discussions. What the \ present author intends to show here is that genetic programming is easily \ done in ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Mathematica", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox[" as well.", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{Cell[TextData["Evolutionary Computing"], "Section", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[{ StyleBox[ "In a genetic algorithm (GA) the individuals are character strings in whose \ elements are encoded the parameters that specify a solution for the problem \ at hand. A very close analogy between the strings and chromosomes has been \ drawn [Goldberg 1989]. In a GA, mutation is achieved by randomly selecting \ one of the letters of a string and exchanging it for a different letter of \ the alphabet. Typically a binary alphabet is used (", Evaluatable->False, AspectRatioFixed->True], StyleBox["i.e.", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox[ ", 0 and 1). Recombination via mating is carried out by crossing over part \ of one parent with the homologous part of the other parent. This is done by \ selecting a point at random along the string and then exchanging the distal \ portions between the parents, thus generating two new offspring. Because the \ string is a coded representation of a solution, its length is fixed. In spite \ of this rigid linear data structure, GAs have been applied successfully to a \ large number of problems. See [Goldberg 1989] and [Davis 1991] for further \ details and examples. James Freeman has recently described the use of ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Mathematica", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox[" for GAs [Freeman 1993].", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "A genetic program (GP) shares most of the features of a GA. However, the \ data structure that GP uses is hierarchical rather than linear. In addition, \ instead of employing an alphabet to encode the solution parameters, the \ parameters themselves are stored in the data structure along with the \ functions that operate on them. A graph-theoretical tree is suitable \ hierarchical data structure for a GP. (This is the same data structure that \ most compilers use to parse mathematical expressions.) The parameters occupy \ the terminal or external nodes (sometimes called leaves) and the functions \ occupy the internal nodes (of which, the highest is known as the root). These \ trees are customerily drawn \"upside-down\" with the root at the top and the \ leaves at the bottom. For example, the expression 2 sin x + b x + c can be \ represented as the tree shown in Figure 1."], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{Cell[BoxData[ \(\(DrawExpression[plus[times[2, sin[x]], times[b, x], c]]; \)\)], "Input",\ Evaluatable->False, CellOpen->False, AspectRatioFixed->True], Cell[GraphicsData["PostScript", "\<\ %! %%Creator: Mathematica %%AspectRatio: .52364 MathPictureStart %% Graphics /Courier findfont 10 scalefont setfont % Scaling calculations 0.481818 0.0727273 0.48 0.0727273 [ [ 0 0 0 0 ] [ 1 .52364 0 0 ] ] MathScale % Start of Graphics 1 setlinecap 1 setlinejoin newpath [ ] 0 setdash 0 g p P 0 0 m 1 0 L 1 .52364 L 0 .52364 L closepath clip newpath p [(plus)] .48182 .48 0 0 Mshowa .004 w .48182 .43636 m .19091 .37818 L s .48182 .43636 m .66364 .37818 L s .48182 .43636 m .95455 .37818 L s p [(times)] .19091 .33455 0 0 Mshowa .19091 .29091 m .04545 .23273 L s .19091 .29091 m .26364 .23273 L s [(2)] .04545 .18909 0 0 Mshowa p [(sin)] .26364 .18909 0 0 Mshowa .26364 .14545 m .26364 .08727 L s [(x)] .26364 .04364 0 0 Mshowa P P p [(times)] .66364 .33455 0 0 Mshowa .66364 .29091 m .59091 .23273 L s .66364 .29091 m .73636 .23273 L s [(b)] .59091 .18909 0 0 Mshowa [(x)] .73636 .18909 0 0 Mshowa P [(c)] .95455 .33455 0 0 Mshowa P % End of Graphics MathPictureEnd \ \>"], "Graphics", Evaluatable->False, AspectRatioFixed->True, ImageSize->{200, 104}, ImageMargins->{{34, Inherited}, {Inherited, Inherited}}, ImageCache->GraphicsData["Bitmap", "\<\ CF5dJ6E]HGAYHf4PAg9QL6QYHggYjN[Vi^OShn03ooeGooj[ooonICXf=SLcII03=Voc=Vc3=V VC=VIS=VP02oe@000380000b000000001<0 0olI00;oB@000ol0000?0003o`0003T0000F00;o5P000ol0001:0003o`0000d000?o0000>P0001P0 0_lC0003o`0004`00_l;00;o?@0001X00ol?0003o`0004l000?o00001`000ol0000m00007@02o`/0 0_mC0003o`0000D000?o0000?P0001l00_l80003o`0005@000?o00000`000ol0000o00008@03o`@0 00?o0000EP001Ol0003o0480000T00;o00<0o`00F@000ol0o`1300009P000ol0001J0003o`000480 00380000b0000`0004T01OlL00Co3`08od<0001>00Go5003o`X02Om;0000D`05o``00ol500SoE00005P0 1Ol400_oG00005d01_mU0000b0000"], ImageRangeCache->{{{0, 199}, {103, 0}} -> {-6.70545, -6.60003, 0.0699041, 0.0699041}}]}, Open]], Cell[TextData[{ StyleBox["FIGURE 1.", Evaluatable->False, PageBreakAbove->False, AspectRatioFixed->True, FontWeight->"Bold"], StyleBox[ " The hierarchical tree structure of the expression 2 sin x + b x + c", Evaluatable->False, PageBreakAbove->False, AspectRatioFixed->True], StyleBox[".", Evaluatable->False, PageBreakAbove->False, AspectRatioFixed->True, FontSize->12] }], "Special1", Evaluatable->False, PageBreakAbove->False, AspectRatioFixed->True], Cell[TextData[ "This expression tree is in fact a reusable program whose inputs are the \ symbolic terminal nodes and whose output is the result produced by the root \ node."], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "In an expression tree, a subtree is the analog of a substring in a genetic \ algorithm. The genetic operations of mutation and crossover are applied to \ the subtrees."], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[{ StyleBox["Mathematica", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox[ " is a functional language that employs a hierarchical data structure for \ mathematical expressions. In addition, the language allows one to freely \ manipulate parts of expressions. These features make ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Mathematica", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox[" eminently suited for genetic programming.", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[TextData["A Problem"], "Section", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[{ StyleBox[ "We first became interested in genetic programming for solving symbolic \ regression problems, a generalization of curve-fitting. In traditional \ methods, such as least squares, one uses a presumed functional form (", Evaluatable->False, AspectRatioFixed->True], StyleBox["e.g.", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox[", ", Evaluatable->False, AspectRatioFixed->True], StyleBox["y ", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox[" = ", Evaluatable->False, AspectRatioFixed->True], StyleBox["mx", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox[" + ", Evaluatable->False, AspectRatioFixed->True], StyleBox["b", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox[") and determines only the coefficients (", Evaluatable->False, AspectRatioFixed->True], StyleBox["m", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox[" and ", Evaluatable->False, AspectRatioFixed->True], StyleBox["b", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox[ ") that best fit the observed data. In symbolic regression, one is \ interested in finding the best functional form as well as the coefficients. \ For example, given the series 5, 31, 121, 341, 781, 1555, 2801, 4681, what is \ the next entry? What is the 12", Evaluatable->False, AspectRatioFixed->True], StyleBox["th", Evaluatable->False, AspectRatioFixed->True, FontSize->12, FontVariations->{"CompatibilityType"->"Superscript"}], StyleBox[ "? To answer these questions, one must discover the the relationship \ between ", Evaluatable->False, AspectRatioFixed->True], StyleBox["i", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox[", the position in the series, and ", Evaluatable->False, AspectRatioFixed->True], StyleBox["S", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox["i", Evaluatable->False, AspectRatioFixed->True, FontSize->12, FontSlant->"Italic", FontVariations->{"CompatibilityType"->"Subscript"}], StyleBox[", the ", Evaluatable->False, AspectRatioFixed->True], StyleBox["i", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox[ "-th entry. The task of genetic programming is to find the appropriate \ combination of functions, variables, and coefficients to exactly reproduce \ this series. Then we can use the result to find any element of the series.", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[TextData["Expression Trees"], "Section", Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{Cell[TextData["Functions and Terminals"], "Subsection", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[{ StyleBox[ "The basic data structure of a genetic program is the expression tree. At \ the root of the tree is a function, and the pendant nodes are the operands or \ arguments of the function. The internal representation of expressions in ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Mathematica", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox[" (as revealed with the ", Evaluatable->False, AspectRatioFixed->True], StyleBox["FullForm", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[" function) is just this sort of data structure.", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{Cell[BoxData[ \(FullForm[\((x + 1)\)\ \((y - z)\)]\)], "Input", AspectRatioFixed->True], Cell[BoxData[ TagBox[ StyleBox[\(Times[Plus[1, x], Plus[y, Times[\(-1\), z]]]\), ShowSpecialCharacters->False, ShowStringCharacters->True], FullForm]], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[TextData[{ StyleBox[ "A powerful feature of the tree structure is that it is recursive. Each \ subtree is itself a valid tree. All the internal nodes (", Evaluatable->False, AspectRatioFixed->True], StyleBox["Times", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[", ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Plus", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[", ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Plus", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[", and ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Times", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[ " in this instance) are at the roots of subtrees. Even the terminal nodes \ (", Evaluatable->False, AspectRatioFixed->True], StyleBox["1", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[", ", Evaluatable->False, AspectRatioFixed->True], StyleBox["x", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[", ", Evaluatable->False, AspectRatioFixed->True], StyleBox["y", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[", ", Evaluatable->False, AspectRatioFixed->True], StyleBox["-1", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[", and ", Evaluatable->False, AspectRatioFixed->True], StyleBox["z", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[ ") are themselves trivial expression trees. From this example, it is \ obvious that functions occupy internal nodes and numbers and variables occupy \ terminal nodes.", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[{ StyleBox[ "Evaluation of an expression tree is carried out recursively. For a good \ description of trees and recursive programming see [Gaylord ", Evaluatable->False, AspectRatioFixed->True], StyleBox["et al.", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox[" 1993]. Since we are dealing with ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Mathematica", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox[ " expressions directly, we will not need a special evaluation function; ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Mathematica", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox[" will do it automatically.", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[{ StyleBox[ "Notice that in the example above, the expression has been rearranged by ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Mathematica", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox[" into a canonical form equivalent to ", Evaluatable->False, AspectRatioFixed->True], StyleBox["(1 + x) * (y + (-1 * z))", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[". ", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier", FontSize->12], StyleBox["The input form that matches the original expression is ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Times[Plus[x, 1], Subtract[y, z]]", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[ ". This rearrangement is relatively minor and could be ignored. However, ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Times", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[" and ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Divide", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[ " present difficulties because their use can introduce a new function, \ namely ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Power", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[".", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{Cell[BoxData[ \(FullForm[x\ x]\)], "Input", AspectRatioFixed->True], Cell[BoxData[ TagBox[ StyleBox[\(Power[x, 2]\), ShowSpecialCharacters->False, ShowStringCharacters->True], FullForm]], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[BoxData[ \(FullForm[x\/y]\)], "Input", AspectRatioFixed->True], Cell[BoxData[ TagBox[ StyleBox[\(Times[x, Power[y, \(-1\)]]\), ShowSpecialCharacters->False, ShowStringCharacters->True], FullForm]], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[TextData[{ StyleBox[ "This may be undesirable for the problem at hand because genetic \ recombination of individuals could easily replace the second argument of ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Power", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[ " with an expression that does not evaluate to an integer. Aside from this, \ it introduces a general lack of control over the function set.", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "Another difficulty arises when we use built-in functions whose arguments are \ entirely made up of numbers. We loose the full tree structure and are left \ with but a single node."], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{Cell[BoxData[ \(FullForm[5\ \((3 + 2)\)]\)], "Input", AspectRatioFixed->True], Cell[BoxData[ TagBox[ StyleBox["25", ShowSpecialCharacters->False, ShowStringCharacters->True], FullForm]], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[TextData[{ StyleBox[ "One way of overcoming these problems is to keep the functions and their \ arguments in lists, as described by [Gaylord ", Evaluatable->False, AspectRatioFixed->True], StyleBox["et al.", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox[" 1993] (", Evaluatable->False, AspectRatioFixed->True], StyleBox["e.g.", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox[", ", Evaluatable->False, AspectRatioFixed->True], StyleBox["{Times, {5}, {Plus, {3}, {2}}}", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[ "). Alternatively, we can introduce our own arithmetic functions (", Evaluatable->False, AspectRatioFixed->True], StyleBox["e.g.", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox[", ", Evaluatable->False, AspectRatioFixed->True], StyleBox["plus", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[", ", Evaluatable->False, AspectRatioFixed->True], StyleBox["times", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[", ", Evaluatable->False, AspectRatioFixed->True], StyleBox["subtract", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[", and ", Evaluatable->False, AspectRatioFixed->True], StyleBox["divide", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[ ") that do not evalute to anything. Both methods preserve the full \ structure of the expression and both require a function that can evaluate the \ expression and return a usable result. The evaluator for the former \ representation must recursively traverse the nested lists while it builds up \ a ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Mathematica", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox[ " expression. For the latter method the evaluator need only provide a set \ of replacement rules. We have found the second approach more convenient, and \ it probably requires less memory as well.", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[{ \(\(evalRules = {plus \[Rule] Plus, times \[Rule] Times, subtract \[Rule] Subtract, divide \[Rule] Divide}; \)\), \(Eval[expr_] := expr /. evalRules\)}], "Input", AspectRatioFixed->True], Cell[TextData["Thus, for the examples above:"], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{Cell[BoxData[ \(times[plus[x, 1], subtract[y, z]]\)], "Input", AspectRatioFixed->True], Cell[BoxData[ \(times[plus[x, 1], subtract[y, z]]\)], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[BoxData[ \(Eval[%]\)], "Input", AspectRatioFixed->True], Cell[BoxData[ \(\((1 + x)\)\ \((y - z)\)\)], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[BoxData[ \(times[x, x]\)], "Input", AspectRatioFixed->True], Cell[BoxData[ \(times[x, x]\)], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[BoxData[ \(Eval[%]\)], "Input", AspectRatioFixed->True], Cell[BoxData[ \(x\^2\)], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[BoxData[ \(divide[x, y]\)], "Input", AspectRatioFixed->True], Cell[BoxData[ \(divide[x, y]\)], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[BoxData[ \(Eval[%]\)], "Input", AspectRatioFixed->True], Cell[BoxData[ \(x\/y\)], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[BoxData[ \(times[5, plus[3, 2]]\)], "Input", AspectRatioFixed->True], Cell[BoxData[ \(times[5, plus[3, 2]]\)], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[BoxData[ \(Eval[%]\)], "Input", AspectRatioFixed->True], Cell[BoxData[ \(25\)], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[TextData[{ StyleBox[ "At this point it is appropriate to discuss two requirements of the sets of \ functions and terminals used in GP: ", Evaluatable->False, AspectRatioFixed->True], StyleBox["closure", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox[" and ", Evaluatable->False, AspectRatioFixed->True], StyleBox["sufficiency", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox[ ". The value at any terminal node or result of any function at an internal \ node can be an argument to the function at the next level up the tree. One \ must therefore ensure that the choice of terminals and functions be fully \ compatible so that functions can accept any arguments they may receive and \ still yield valid results. That is, the functions should be well defined and \ ", Evaluatable->False, AspectRatioFixed->True], StyleBox["closed", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox[ ". For example, one would not want to freely mix numerical and Boolean \ terminals, as the result is still partially unevaluated:", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{Cell[BoxData[ \(FullForm[Eval[plus[2, True]]]\)], "Input", AspectRatioFixed->True], Cell[BoxData[ TagBox[ StyleBox[\(Plus[2, True]\), ShowSpecialCharacters->False, ShowStringCharacters->True], FullForm]], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[TextData["Nor does one want to encounter undefined results:"], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{Cell[BoxData[ \(FullForm[Eval[divide[subtract[x, x], 0]]]\)], "Input", AspectRatioFixed->True], Cell[TextData["General::dbyz: Division by zero."], "Message", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "Infinity::indet: \n Indeterminate expression 0 ComplexInfinity \ encountered."], "Message", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ TagBox[ StyleBox["Indeterminate", ShowSpecialCharacters->False, ShowStringCharacters->True], FullForm]], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[TextData[{ StyleBox[ "This latter situation (both the division by 0 and the resulting ", Evaluatable->False, AspectRatioFixed->True], StyleBox["0*Infinity", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[") is easily remedied by using ", Evaluatable->False, AspectRatioFixed->True], StyleBox["protected division", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox[ " which tests the denominator before the division is carried out. If it is \ zero, then a value such as 1 can be returned for the result which maintains \ closure [Koza 1992, p. 82]. However, it is more practical to return a very \ large machine number because it not only satisfies closure but is more \ appropriate in real-world problems than is 1 as it is more like the true \ result (\[Infinity]) [Lee 1994]. (We could allow ", Evaluatable->False, AspectRatioFixed->True], StyleBox["1/0", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[" to evaluate to ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Infinity", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[" and ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Infinity/Infinity", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[" to evalute to ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Infinity", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[ ", but this causes problems further down the road if we try to compile the \ result.) Similar protected functions should be used for ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Sqrt", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[" and ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Log", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[", and ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Exp", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[" should be protected from over- and underflow.", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[{ \(\(bigInteger = 2\^63 - 1; \)\), \(\(bigReal = N[bigInteger]; \)\), \(PDivide[n_Integer, 0] := bigInteger\), \(PDivide[n_Integer, 0. ] := bigInteger\), \(PDivide[n_, 0] := bigInteger\), \(PDivide[n_Real, 0] := bigReal\), \(PDivide[n_Real, 0. ] := bigReal\), \(PDivide[n_, 0. ] := bigReal\), \(PDivide[n_, d_?NumberQ] := n\/d\)}], "Input", AspectRatioFixed->True], Cell[CellGroupData[{Cell[BoxData[ \(evalRules = ReplacePart[evalRules, PDivide, Position[evalRules, Divide]]\)], "Input",\ AspectRatioFixed->True], Cell[BoxData[ \({plus \[Rule] Plus, times \[Rule] Times, subtract \[Rule] Subtract, divide \[Rule] PDivide}\)], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[BoxData[ \(Eval[divide[subtract[x, x], 0]]\)], "Input", AspectRatioFixed->True], Cell[BoxData[ \(9223372036854775807\)], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[TextData[{ StyleBox["All of the type-testing for ", Evaluatable->False, AspectRatioFixed->True], StyleBox["PDivide", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[ " is necessary so that actual division does not take place before it is \ known if the denominator is 0 and that an appropriate precision result is \ returned.", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{Cell[BoxData[ \(Eval[divide[subtract[x, 1], y]]\)], "Input", AspectRatioFixed->True], Cell[BoxData[ \(PDivide[\(-1\) + x, y]\)], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[TextData[{ StyleBox["Sufficiency", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox[ " of the function set and terminal set means that some combination of them \ is capable of producing an expression that is the solution to the problem. \ This responsibility lies solely with the user and is not always a straight \ forward task. If variables without sufficient explanatory power are used, the \ solution cannot be found. Likewise for functions. One must also be careful \ not to include extraneous functions or terminals as this can hamper the \ performance of the search for the solution.", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[TextData["Conditional Functions"], "Subsection", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[{ StyleBox[ "Logical tests are very common in procedural programs written in languages \ such as FORTRAN or C, but somewhat unexpected in mathematical expressions. \ The ", Evaluatable->False, AspectRatioFixed->True], StyleBox["If", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[" function in ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Mathematica", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox[ " not only controls which branch is followed, but it also returns the final \ value of the branch followed. Because the first argument of ", Evaluatable->False, AspectRatioFixed->True], StyleBox["If", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[ " must be a Boolean we cannot use it directly, but the functionality we \ seek can be implemented by using a modified ", Evaluatable->False, AspectRatioFixed->True], StyleBox["If", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[" function that uses only numerical arguments. For example:", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[{ \(\(Attributes[ltz] = {HoldRest}; \)\), \(\(AppendTo[evalRules, ltz[test_, t_, f_] \[RuleDelayed] If[test < 0, t, f]]; \)\)}], "Input", AspectRatioFixed->True], Cell[CellGroupData[{Cell[BoxData[ \(Eval[ltz[\(-3\), x, y]]\)], "Input", AspectRatioFixed->True], Cell[BoxData[ \(x\)], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[BoxData[ \(Eval[ltz[2, x, y]]\)], "Input", AspectRatioFixed->True], Cell[BoxData[ \(y\)], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[TextData[{ StyleBox["The attribute ", Evaluatable->False, AspectRatioFixed->True], StyleBox["HoldRest", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[" is necessary to prevent ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Mathematica", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox[" from evaluating ", Evaluatable->False, AspectRatioFixed->True], StyleBox["t", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[" and ", Evaluatable->False, AspectRatioFixed->True], StyleBox["f", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[" prior to comparing ", Evaluatable->False, AspectRatioFixed->True], StyleBox["test", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[ " against 0. The reason is not obvious from this example, but if either ", Evaluatable->False, AspectRatioFixed->True], StyleBox["t", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[" or ", Evaluatable->False, AspectRatioFixed->True], StyleBox["f", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[ " produced a side effect that was used elsewhere, one would want only the \ correct side effect to be produced. (The reader might try clearing the \ attribute and including a ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Print", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[" in each of the branches to see the effect.)", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[TextData["Constant Terminals"], "Subsection", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "Frequently one needs constants to fully describe the solution to a problem. \ Even if one does not include them in the terminal set, they can be \ constructed during the evolution of the run. Integer and rational constants \ are the easiest to come across."], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{Cell[BoxData[ \(Eval[plus[x, x]]\)], "Input", AspectRatioFixed->True], Cell[BoxData[ \(2\ x\)], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[TextData[ "Irrational constants can also be spontaneously generated. In a GP used to \ find trigonometric identities [Koza 1992, pp. 242-5], the constant \[Pi]/2 \ was approximately constructed as"], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{Cell[BoxData[ \(N[Eval[2 - Sin[Sin[Sin[Sin[Sin[Sin[Sin[Sin[1]]\ Sin[Sin[1]]]]]]]]]]\)], "Input", AspectRatioFixed->True], Cell[BoxData[ \(1.567209585915016\)], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[BoxData[ \(N[\[Pi]\/2]\)], "Input", AspectRatioFixed->True], Cell[BoxData[ \(1.570796326794897\)], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[TextData[{ StyleBox["To facilitate the incorporation of constants, the ", Evaluatable->False, AspectRatioFixed->True], StyleBox["ephemeral random constant", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox[ " was introduced. It is used as a terminal during the creation of the \ initial generation, and whenever it is encountered, a random number of the \ appropriate type is generated. During the evolution of the population, these \ constants can be recombined in many ways to form new constants.", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(ephemeralReal := Random[Real, {\(-1\), 1}]\)], "Input", AspectRatioFixed->True], Cell[CellGroupData[{Cell[BoxData[ \(Table[ephemeralReal, {5}]\)], "Input", AspectRatioFixed->True], Cell[BoxData[ \({\(-0.6471024965781407\), 0.7229671790567716, \(-0.4439688922960512\), \(-0.5398362890679549\), 0.0853297885996003}\)], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]]}, Open]], Cell[CellGroupData[{Cell[TextData["Algebraic Simplification"], "Subsection", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[{ StyleBox[ "As mentioned above, we chose to define our own arithmetic functions so \ that we could maintain better control of the functions used. With this change \ we also lost all of ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Mathematica", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox["\[CloseCurlyQuote]s built in simplification. For example,", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{Cell[BoxData[ \(\((x - x)\) + 2\ \(x + 2\)\/2\)], "Input", AspectRatioFixed->True], Cell[BoxData[ \(2 + x\)], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[TextData["whereas,"], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{Cell[BoxData[ \(plus[subtract[x, x], times[2, divide[plus[x, 2], 2]]]\)], "Input", AspectRatioFixed->True], Cell[BoxData[ \(plus[subtract[x, x], times[2, divide[plus[x, 2], 2]]]\)], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[TextData[{ StyleBox["Just how much simplification is ", Evaluatable->False, AspectRatioFixed->True], StyleBox["necessary", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox[" is not always clear. The result ", Evaluatable->False, AspectRatioFixed->True], StyleBox["2 + x", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[ " is certainly concise, which is desirable for a solution to a regression \ problem. However, we have also lost a great deal of genetic flexibility. For \ example, there are only 3 positions available at which genetic operations may \ occur in the simplified result as opposed to 11 in the original expression.", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[{ StyleBox[ "We will hope to strike a useful balance by just employing the associative, \ identity, and inverse properties of algebra. Associativity is conferred by \ flattening out immediate subexpressions with the same head. We could have \ given the attribute ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Flat", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[" to the functions, but then ", Evaluatable->False, AspectRatioFixed->True], StyleBox["plus[x]", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[" would not reduce to ", Evaluatable->False, AspectRatioFixed->True], StyleBox["x", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[".", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{Cell[BoxData[ \(plus[times[u, x], plus[y, z]]\)], "Input", AspectRatioFixed->True], Cell[BoxData[ \(plus[times[u, x], plus[y, z]]\)], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[BoxData[{ \(plus[a___, b_plus, c___] := Flatten[Unevaluated[plus[a, b, c]], 1, plus]\), \(plus[a_] := a\), \(times[a___, b_times, c___] := Flatten[Unevaluated[times[a, b, c]], 1, times]\), \(times[a_] := a\)}], "Input", AspectRatioFixed->True], Cell[CellGroupData[{Cell[BoxData[ \(plus[times[u, x], plus[y, z]]\)], "Input", AspectRatioFixed->True], Cell[BoxData[ \(plus[times[u, x], y, z]\)], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[TextData[{ StyleBox[ "Very often we have seen expressions that contain subexpressions that will \ always reduce to 0 or 1 (", Evaluatable->False, AspectRatioFixed->True], StyleBox["e.g.", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox[", ", Evaluatable->False, AspectRatioFixed->True], StyleBox["subtract[x, x]", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[ "). It is probably useful to provide rules for these cases. The following \ evaluation rules below make use of the identity and inverse properties of \ addition and multiplication:", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[{ \(plus[a___, 0, b___] := plus[a, b]\), \(plus[a___, 0. , b___] := plus[a, b]\), \(subtract[a_, 0] := a\), \(subtract[a_, 0. ] := a\), \(subtract[a_, a_] := 0\), \(times[a___, 1, b___] := times[a, b]\), \(times[a___, 1. , b___] := times[a, b]\), \(divide[a_, 1] := a\), \(divide[a_, 1. ] := a\), \(divide[a_, a_] := 1\)}], "Input", AspectRatioFixed->True], Cell[TextData["Finally, here is the full effect:"], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{Cell[BoxData[ \(plus[subtract[x, x], times[2, divide[plus[x, 2], 2]]]\)], "Input", AspectRatioFixed->True], Cell[BoxData[ \(times[2, divide[plus[x, 2], 2]]\)], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]]}, Open]]}, Open]], Cell[CellGroupData[{Cell[TextData["Adam & Eve"], "Section", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[{ StyleBox[ "The initial population in a GA is created by generating random character \ strings of a prescribed length, which is a fairly trivial task. In GP, on the \ other hand, we must generate random expression trees which have not only a \ length (depth), but also breadth. The inputs to a random expression generator \ are the lists of functions and terminals to use. In addition, the number of \ arguments that each function takes is needed. (For simplicity, we restrict ", Evaluatable->False, AspectRatioFixed->True], StyleBox["plus", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[" and ", Evaluatable->False, AspectRatioFixed->True], StyleBox["times", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[" to two arguments even though ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Mathematica", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox[" has no such restriction for ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Plus", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[" and ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Times", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[".)", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[{ \(\(funcs = {{plus, 2}, {subtract, 2}, {times, 2}, {divide, 2}}; \)\), \(\(terms := {x, y, z, Random[Integer, 3]}; \)\)}], "Input", AspectRatioFixed->True], Cell[TextData[{ StyleBox[ "We use recursion to construct the expression tree. The depth of the tree \ is controlled by decrementing a counter as we enter each level. The attribute \ ", Evaluatable->False, AspectRatioFixed->True], StyleBox["HoldRest", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[" is necessary so that ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Random", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[" can be used in the terminal list.", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(randomElement[list_] := list\[LeftDoubleBracket]Random[Integer, {1, Length[list]}] \[RightDoubleBracket]\)], "Input", AspectRatioFixed->True], Cell[BoxData[{ \(RandomExpression[max_, funcs_, terms_] := Module[{f, n}, {f, n} = randomElement[funcs]; If[n > 0, f@@Table[RandomExpression[max - 1, funcs, terms], {n}], f]] \), \(RandomExpression[0, funcs_, terms_] := randomElement[terms]\), \(\(Attributes[RandomExpression] = {HoldRest}; \)\)}], "Input", AspectRatioFixed->True], Cell[CellGroupData[{Cell[BoxData[ \(RandomExpression[2, funcs, terms]\)], "Input", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(times[divide[x, y], plus[x, x]]\)], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[TextData[ "All the expressions produced in this manner have the same shape. They are \ full trees, that is, the distance from the root to each leaf is the same, and \ they always have a maximal number of nodes (that is, of course, before \ simplification). This was accomplished by restricting the use of terminals to \ the last level. Variably shaped trees are produced when terminals are allowed \ at any level."], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(\(comb = Join[funcs, \(({#1, 0}&)\)/@terms]; \)\)], "Input", AspectRatioFixed->True], Cell[CellGroupData[{Cell[BoxData[ \(re = RandomExpression[3, comb, terms]\)], "Input", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(times[plus[x, y], divide[times[y, x], plus[1, x]]]\)], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[BoxData[ \(\(re = times[plus[x, y], divide[times[y, x], plus[1, x]]]; \)\)], "Input", CellOpen->False, AspectRatioFixed->True], Cell[TextData[ "The following two recursive functions allow us to ascertain the variability \ of the trees in the constructed population. This is important because the \ early use of terminals may prevent even one branch of a tree from reaching \ the prescribed depth."], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[{ \(DepthExpression[_[args__]] := 1 + Max[DepthExpression/@{args}]\), \(DepthExpression[_?AtomQ] := 0\)}], "Input", AspectRatioFixed->True], Cell[BoxData[{ \(SizeExpression[_[args__]] := 1 + Plus@@\(SizeExpression/@{args}\)\), \(SizeExpression[_?AtomQ] := 1\)}], "Input", AspectRatioFixed->True], Cell[CellGroupData[{Cell[BoxData[ \(SizeExpression[re]\)], "Input", AspectRatioFixed->True], Cell[BoxData[ \(11\)], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[TextData[{ StyleBox[ "In constructing the initial population of expression trees, one should \ strive for variety. In the ramped-half-and-half method [Koza 1992, p. 93], \ the population is divided into equal groups for each depth and half the \ expression trees in each group are full and the other half are not. The \ function ", Evaluatable->False, AspectRatioFixed->True], StyleBox["makePop", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[" does this. The attribute ", Evaluatable->False, AspectRatioFixed->True], StyleBox["HoldAll", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[" is necessary so that ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Random", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[" can be used in the terminal set.", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[{ \(makePop[funcs_, terms_, nPop_, maxDepth_, minDepth_: 2] := Module[{comb = Join[funcs, \(({#1, 0}&)\)/@terms], pop, d = maxDepth - minDepth + 1, i, depth, r}, Table[depth = minDepth + Floor[\(\((i - 1)\)\ d\)\/nPop]; If[OddQ[i], While[DepthExpression[ r = RandomExpression[depth, funcs, terms]] < depth]; r, While[DepthExpression[r = RandomExpression[depth, comb, terms]] < depth]; r], {i, nPop}]]\), \(\(Attributes[makePop] = {HoldAll}; \)\)}], "Input", AspectRatioFixed->True], Cell[BoxData[ \(\(pop = makePop[funcs, terms, 500, 6]; \)\)], "Input", AspectRatioFixed->True], Cell[TextData[{ StyleBox["We can use ", Evaluatable->False, AspectRatioFixed->True], StyleBox["DepthExpression", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[" and ", Evaluatable->False, AspectRatioFixed->True], StyleBox["SizeExpression", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[ " to check our generative method to make sure that we achieved the variety \ we sought. For a depth of 6 and all the functions taking 2 arguments, there \ will be a maximum size of 127 nodes (", Evaluatable->False, AspectRatioFixed->True], StyleBox["i.e.", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox[", 2", Evaluatable->False, AspectRatioFixed->True], StyleBox["7", Evaluatable->False, AspectRatioFixed->True, FontSize->12, FontVariations->{"CompatibilityType"->"Superscript"}], StyleBox["-1). First we load the standard package ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Statistics`DataManipulation`", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[" so that we can use the functions ", Evaluatable->False, AspectRatioFixed->True], StyleBox["CategoryCounts", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[" and ", Evaluatable->False, AspectRatioFixed->True], StyleBox["RangeCounts", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[".", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(\(Needs["\"]; \)\)], "Input", AspectRatioFixed->True], Cell[CellGroupData[{Cell[BoxData[{ \(\(depths = DepthExpression/@pop; \)\), \(\(d = Range[Min[depths], Max[depths]]; \)\), \(\(c = CategoryCounts[depths, d]; \)\), \(TableForm[Transpose[{d, c}], TableHeadings \[Rule] {None, {"\", "\<# trees\>"}}, TableSpacing \[Rule] {0, 3}]\)}], "Input", AspectRatioFixed->True], Cell[BoxData[ TagBox[GridBox[{ {"\<\"depth\"\>", "\<\"# trees\"\>"}, {"2", "100"}, {"3", "100"}, {"4", "100"}, {"5", "100"}, {"6", "100"} }, RowSpacings->0, ColumnSpacings->3, RowAlignments->Baseline, ColumnAlignments->{Left}], (TableForm[ #, TableHeadings -> {None, {"depth", "# trees"}}, TableSpacing -> {0, 3}]&)]], "Output", Evaluatable->False, LineSpacing->{1.25, 0}, AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[BoxData[{ \(\(sizes = SizeExpression/@pop; \)\), \(\(s = Range[0, 128, 8]; \)\), \(\(c = RangeCounts[sizes, s]; \)\), \(\(s = Transpose[{Drop[s, \(-1\)], Drop[s, 1]}]; \)\), \(\(s = Apply[ToString[#1]<>"\<<=size<\>"<>ToString[#2]&, s, {1}]; \)\), \(TableForm[Transpose[{s, Take[c, {2, Length[c] - 1}]}], TableHeadings \[Rule] {None, {"\", "\<# trees\>"}}, TableSpacing \[Rule] {0, 3}]\)}], "Input", AspectRatioFixed->True], Cell[BoxData[ TagBox[GridBox[{ {"\<\"size\"\>", "\<\"# trees\"\>"}, {"\<\"0<=size<8\"\>", "124"}, {"\<\"8<=size<16\"\>", "157"}, {"\<\"16<=size<24\"\>", "59"}, {"\<\"24<=size<32\"\>", "51"}, {"\<\"32<=size<40\"\>", "7"}, {"\<\"40<=size<48\"\>", "12"}, {"\<\"48<=size<56\"\>", "31"}, {"\<\"56<=size<64\"\>", "9"}, {"\<\"64<=size<72\"\>", "0"}, {"\<\"72<=size<80\"\>", "0"}, {"\<\"80<=size<88\"\>", "0"}, {"\<\"88<=size<96\"\>", "3"}, {"\<\"96<=size<104\"\>", "18"}, {"\<\"104<=size<112\"\>", "24"}, {"\<\"112<=size<120\"\>", "5"}, {"\<\"120<=size<128\"\>", "0"} }, RowSpacings->0, ColumnSpacings->3, RowAlignments->Baseline, ColumnAlignments->{Left}], (TableForm[ #, TableHeadings -> {None, {"size", "# trees"}}, TableSpacing -> {0, 3}]&)]], "Output", Evaluatable->False, LineSpacing->{1.25, 0}, AspectRatioFixed->True]}, Open]]}, Open]], Cell[CellGroupData[{Cell[TextData["Cain & Abel"], "Section", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "The evolution of the population is carried out by applying the genetic \ operators to selected individuals to create offspring that become the next \ generation. In terms of frequency of occurance, reproduction and crossover \ are the two main genetic operators in GP, with mutation occuring less often. \ Reproduction, as the name suggests, is a direct copying of an individual \ expression from one generation to the next, crossover exchanges \ subexpressions from two parents to create two children, and mutation replaces \ a subexpression in an individual with a randomly generated subexpression. We \ also use a fourth operator, constant perturbation [Spencer, 1994], in those \ applications that employ constants as part of the terminal set. "], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{Cell[TextData["Crossover"], "Subsection", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "Crossover in GP is a bit more complicated than in a GA. To carry it out, two \ parents are selected at random from the population. Then a subexpression is \ randomly selected from one parent and exchanged with a randomly selected \ subexpression from the other parent."], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[{ StyleBox[ "Given two expression trees drawn on paper, a pair of scissors, and some \ glue, a person has very little trouble performing a crossover. However, this \ was the trickiest function to program for our GP. The process can be divided \ into two parts: first identifying the subexpressions to exchange, and second \ swapping them. We can use the built-in function ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Position", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[ " to return a list of positions of subexpressions which are the parts that \ match the very simple pattern", Evaluatable->False, AspectRatioFixed->True], StyleBox[" _", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[".", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{Cell[BoxData[ \(Adam = RandomExpression[2, funcs, terms]\)], "Input", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(plus[divide[z, x], times[y, 2]]\)], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[BoxData[ \(\(Adam = plus[divide[z, x], times[y, 2]]; \)\)], "Input", CellOpen->False, AspectRatioFixed->True, FontColor->RGBColor[1, 0, 0]], Cell[CellGroupData[{Cell[BoxData[ \(p = Position[Adam, _, Heads \[Rule] False]\)], "Input", AspectRatioFixed->True], Cell[BoxData[ \({{1, 1}, {1, 2}, {1}, {2, 1}, {2, 2}, {2}, {}}\)], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[TextData[{ StyleBox["Next we use the built-in function ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Part", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[ " to excise a subexpression. It takes as its second and following arguments \ the indices of the part, so all we have to do is make a list of the indices \ of all the subexpressions in the expression and then select one of them at \ random. To use one of the lists of indices returned by ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Position", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[", it has to be recast as a sequence.", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{Cell[BoxData[ \(Adam \[LeftDoubleBracket]Sequence@@ p\[LeftDoubleBracket]6\[RightDoubleBracket]\[RightDoubleBracket]\)], "Input", AspectRatioFixed->True], Cell[BoxData[ \(times[y, 2]\)], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[TextData[{ StyleBox["The built-in function ", Evaluatable->False, AspectRatioFixed->True], StyleBox["ReplacePart", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[ " can be used to insert the excised subexpressions. It takes as its third \ argument the position for replacement (we have to make a slight amendment to \ it so that the whole expression can be replaced). Finally, we present below \ the full crossover function.", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[{ \(\(Unprotect[ReplacePart]; \)\), \(ReplacePart[expr_, new_, {}] := new\), \(\(Protect[ReplacePart]; \)\)}], "Input", AspectRatioFixed->True], Cell[BoxData[ \(CrossOver[parents_] := Module[{pos, ind, sub}, pos = \((Position[#1, _, Heads \[Rule] False]&)\)/@parents; ind = randomElement/@pos; sub = MapThread[#1 \[LeftDoubleBracket]Sequence@@#2\[RightDoubleBracket]&, { parents, ind}]; MapThread[ReplacePart, {parents, Reverse[sub], ind}]]\)], "Input", AspectRatioFixed->True], Cell[TextData[{ StyleBox["Now to show it in action, let's create ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Adam", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox["'s mate, ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Eve", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[", and then produce their offspring, ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Cain", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[" and ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Abel", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[".", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{Cell[BoxData[ \(Eve = RandomExpression[3, funcs, terms]\)], "Input", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(divide[subtract[plus[1, 1], times[y, x]], divide[subtract[z, x], plus[z, 1]]]\)], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[BoxData[ \(\(Eve = divide[subtract[plus[1, 1], times[y, x]], divide[subtract[z, x], plus[z, 1]]]; \)\)], "Input", CellOpen->False, AspectRatioFixed->True, FontColor->RGBColor[1, 0, 0]], Cell[BoxData[ \(\({Cain, Abel} = CrossOver[{Adam, Eve}]; \)\)], "Input", AspectRatioFixed->True], Cell[CellGroupData[{Cell[BoxData[ \(Cain\)], "Input", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(plus[divide[z, x], x]\)], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[BoxData[ \(\(Cain = plus[divide[z, x], x]; \)\)], "Input", CellOpen->False, AspectRatioFixed->True, FontColor->RGBColor[1, 0, 0]], Cell[CellGroupData[{Cell[BoxData[ \(Abel\)], "Input", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(divide[subtract[plus[1, 1], times[y, x]], divide[subtract[z, times[y, 2]], plus[z, 1]]]\)], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[BoxData[ \(\(Abel = divide[subtract[plus[1, 1], times[y, x]], divide[subtract[z, times[y, 2]], plus[z, 1]]]; \)\)], "Input", CellOpen->False, AspectRatioFixed->True, FontColor->RGBColor[1, 0, 0]], Cell[TextData[{ StyleBox["As one can see in Figure 2, part {2} of ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Adam", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[" (", Evaluatable->False, AspectRatioFixed->True], StyleBox["times[y, 2]", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[") was swapped with part {2, 1, 2} of ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Eve", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[" (", Evaluatable->False, AspectRatioFixed->True], StyleBox["x", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[").", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{Cell[BoxData[{ \(\(Needs["\"]; \)\), \(\(Show[ GraphicsArray[{{ DrawExpression[Adam, DisplayFunction \[Rule] Identity, xMargin \[Rule] 1.2, deltaX \[Rule] 1.5, style \[Rule] {{2, Red}}], DrawExpression[Eve, DisplayFunction \[Rule] Identity, xMargin \[Rule] 1.2, deltaX \[Rule] 1.5, style \[Rule] {{{2, 1, 2}, Blue}}]}, {{}, {}}, { DrawExpression[Cain, DisplayFunction \[Rule] Identity, xMargin \[Rule] 1.2, deltaX \[Rule] 1.5, style \[Rule] {{2, Blue}}], DrawExpression[Abel, DisplayFunction \[Rule] Identity, xMargin \[Rule] 1.2, deltaX \[Rule] 1.5, style \[Rule] {{{2, 1, 2}, Red}}]}}, Epilog \[Rule] { Line[{{0.5, 0.90}, {0.5, 0.83}, {1.5, 0.83}, {1.5, 0.90}}], Line[{{1.0, 0.83}, {1.0, 0.62}}], Line[{{0.5, 0.62}, {1.5, 0.62}}], Arrow[{0.5, 0.62}, {0.5, 0.5}, HeadScaling \[Rule] Absolute], Arrow[{1.5, 0.62}, {1.5, 0.5}, HeadScaling \[Rule] Absolute], Text["\", {0.45, 0.90}, {1, 0}], Text["\", {1.55, 0.90}, {\(-1\), 0}], Text["\", {0.45, 0.5}, {1, 0}], Text["\", {1.55, 0.5}, {\(-1\), 0}]}]]; \)\)}], "Input", Evaluatable->False, CellOpen->False, AspectRatioFixed->True], Cell[GraphicsData["PostScript", "\<\ %! %%Creator: Mathematica %%AspectRatio: .71709 MathPictureStart %% Graphics /Courier findfont 10 scalefont setfont % Scaling calculations 0.0238095 0.47619 0.0170735 0.47619 [ [ 0 0 0 0 ] [ 1 .71709 0 0 ] ] MathScale % Start of Graphics 1 setlinecap 1 setlinejoin newpath [ ] 0 setdash 0 g p P 0 0 m 1 0 L 1 .71709 L 0 .71709 L closepath clip newpath % Start of user PostScript /mathtops { gsave MBeginOrig moveto MEndOrig currentpoint grestore } bind def /MAtocoords { mathtops 4 2 roll mathtops 4 copy pop pop 3 -1 roll sub /arry exch def exch sub /arrx exch def arrx dup mul arry dup mul add sqrt /arrl exch def translate } bind def /MAarrowhead1 { gsave MAtocoords currentlinewidth 1 Mabswid currentlinewidth dup scale setlinewidth [ arrx arrl div arry arrl div -1 arry mul arrl div arrx arrl div 0 0 ] concat -15. 3.75 moveto 0 0 lineto -15. -3.75 lineto fill -15. 3.75 moveto 0 0 lineto -15. -3.75 lineto -15. 3.75 lineto stroke grestore } def % End of user PostScript p p % Start of sub-graphic p 0.0238095 0.0170735 0.477324 0.230492 MathSubStart %% Graphics /Courier findfont 10 scalefont setfont % Scaling calculations 0.386364 0.151515 0.666667 0.151515 [ [ 0 0 0 0 ] [ 1 .72727 0 0 ] ] MathScale % Start of Graphics 1 setlinecap 1 setlinejoin newpath [ ] 0 setdash p P 0 0 m 1 0 L 1 .72727 L 0 .72727 L closepath clip newpath p [(plus)] .38636 .66667 0 0 Mshowa .004 w .38636 .57576 m .23485 .45455 L s .38636 .57576 m .91667 .45455 L s p [(divide)] .23485 .36364 0 0 Mshowa .23485 .27273 m .08333 .15152 L s .23485 .27273 m .38636 .15152 L s [(z)] .08333 .06061 0 0 Mshowa [(x)] .38636 .06061 0 0 Mshowa P p 0 0 1 r [(x)] .91667 .36364 0 0 Mshowa P P MathSubEnd P % End of sub-graphic % Start of sub-graphic p 0.522676 0.0170735 0.97619 0.230492 MathSubStart %% Graphics /Courier findfont 10 scalefont setfont % Scaling calculations 0.5 0.0362319 0.318841 0.0362319 [ [ 0 0 0 0 ] [ 1 .34783 0 0 ] ] MathScale % Start of Graphics 1 setlinecap 1 setlinejoin newpath [ ] 0 setdash p P 0 0 m 1 0 L 1 .34783 L 0 .34783 L closepath clip newpath p [(divide)] .5 .31884 0 0 Mshowa .004 w .5 .2971 m .22826 .26812 L s .5 .2971 m .71739 .26812 L s p [(subtract)] .22826 .24638 0 0 Mshowa .22826 .22464 m .11957 .19565 L s .22826 .22464 m .31884 .19565 L s p [(plus)] .11957 .17391 0 0 Mshowa .11957 .15217 m .08333 .12319 L s .11957 .15217 m .1558 .12319 L s [(1)] .08333 .10145 0 0 Mshowa [(1)] .1558 .10145 0 0 Mshowa P p [(times)] .31884 .17391 0 0 Mshowa .31884 .15217 m .28261 .12319 L s .31884 .15217 m .35507 .12319 L s [(y)] .28261 .10145 0 0 Mshowa [(x)] .35507 .10145 0 0 Mshowa P P p [(divide)] .71739 .24638 0 0 Mshowa .71739 .22464 m .62681 .19565 L s .71739 .22464 m .88043 .19565 L s p [(subtract)] .62681 .17391 0 0 Mshowa .62681 .15217 m .51812 .12319 L s .62681 .15217 m .66304 .12319 L s [(z)] .51812 .10145 0 0 Mshowa p 1 0 0 r [(times)] .66304 .10145 0 0 Mshowa .66304 .07971 m .62681 .05072 L s .66304 .07971 m .69928 .05072 L s [(y)] .62681 .02899 0 0 Mshowa [(2)] .69928 .02899 0 0 Mshowa P P p [(plus)] .88043 .17391 0 0 Mshowa .88043 .15217 m .8442 .12319 L s .88043 .15217 m .91667 .12319 L s [(z)] .8442 .10145 0 0 Mshowa [(1)] .91667 .10145 0 0 Mshowa P P P MathSubEnd P % End of sub-graphic P p P p % Start of sub-graphic p 0.0238095 0.486595 0.477324 0.700013 MathSubStart %% Graphics /Courier findfont 10 scalefont setfont % Scaling calculations 0.47549 0.0980392 0.431373 0.0980392 [ [ 0 0 0 0 ] [ 1 .47059 0 0 ] ] MathScale % Start of Graphics 1 setlinecap 1 setlinejoin newpath [ ] 0 setdash p P 0 0 m 1 0 L 1 .47059 L 0 .47059 L closepath clip newpath p [(plus)] .47549 .43137 0 0 Mshowa .004 w .47549 .37255 m .18137 .29412 L s .47549 .37255 m .81863 .29412 L s p [(divide)] .18137 .23529 0 0 Mshowa .18137 .17647 m .08333 .09804 L s .18137 .17647 m .27941 .09804 L s [(z)] .08333 .03922 0 0 Mshowa [(x)] .27941 .03922 0 0 Mshowa P p 1 0 0 r [(times)] .81863 .23529 0 0 Mshowa .81863 .17647 m .72059 .09804 L s .81863 .17647 m .91667 .09804 L s [(y)] .72059 .03922 0 0 Mshowa [(2)] .91667 .03922 0 0 Mshowa P P MathSubEnd P % End of sub-graphic % Start of sub-graphic p 0.522676 0.486595 0.97619 0.700013 MathSubStart %% Graphics /Courier findfont 10 scalefont setfont % Scaling calculations 0.5 0.0362319 0.23913 0.0362319 [ [ 0 0 0 0 ] [ 1 .26087 0 0 ] ] MathScale % Start of Graphics 1 setlinecap 1 setlinejoin newpath [ ] 0 setdash p P 0 0 m 1 0 L 1 .26087 L 0 .26087 L closepath clip newpath p [(divide)] .5 .23913 0 0 Mshowa .004 w .5 .21739 m .22826 .18841 L s .5 .21739 m .71739 .18841 L s p [(subtract)] .22826 .16667 0 0 Mshowa .22826 .14493 m .11957 .11594 L s .22826 .14493 m .31884 .11594 L s p [(plus)] .11957 .0942 0 0 Mshowa .11957 .07246 m .08333 .04348 L s .11957 .07246 m .1558 .04348 L s [(1)] .08333 .02174 0 0 Mshowa [(1)] .1558 .02174 0 0 Mshowa P p [(times)] .31884 .0942 0 0 Mshowa .31884 .07246 m .28261 .04348 L s .31884 .07246 m .35507 .04348 L s [(y)] .28261 .02174 0 0 Mshowa [(x)] .35507 .02174 0 0 Mshowa P P p [(divide)] .71739 .16667 0 0 Mshowa .71739 .14493 m .62681 .11594 L s .71739 .14493 m .88043 .11594 L s p [(subtract)] .62681 .0942 0 0 Mshowa .62681 .07246 m .59058 .04348 L s .62681 .07246 m .66304 .04348 L s [(z)] .59058 .02174 0 0 Mshowa p 0 0 1 r [(x)] .66304 .02174 0 0 Mshowa P P p [(plus)] .88043 .0942 0 0 Mshowa .88043 .07246 m .8442 .04348 L s .88043 .07246 m .91667 .04348 L s [(z)] .8442 .02174 0 0 Mshowa [(1)] .91667 .02174 0 0 Mshowa P P P MathSubEnd P % End of sub-graphic P P .004 w .2619 .44564 m .2619 .41231 L .7381 .41231 L .7381 .44564 L s .5 .41231 m .5 .31231 L s .2619 .31231 m .7381 .31231 L s p .2619 .31231 m .2619 .25517 L s % Start of user PostScript 0.5 0.62 0.5 0.5 MAarrowhead1 % End of user PostScript P p .7381 .31231 m .7381 .25517 L s % Start of user PostScript 1.5 0.62 1.5 0.5 MAarrowhead1 % End of user PostScript P [(Adam)] .2381 .44564 1 0 Mshowa [(Eve)] .7619 .44564 -1 0 Mshowa [(Cain)] .2381 .25517 1 0 Mshowa [(Abel)] .7619 .25517 -1 0 Mshowa % End of Graphics MathPictureEnd \ \>"], "Graphics", Evaluatable->False, AspectRatioFixed->False, ImageSize->{414, 296}, ImageMargins->{{34, Inherited}, {Inherited, Inherited}}, RenderingOptions->{"RenderThickness"->False}, ImageCache->GraphicsData["Bitmap", "\<\ CF5dJ6E]HGAYHf4PAg9QL6QYHggYjN[Vi^OShn03ooeGooj[ooonICXf=SLcII03=Voc=Vc3=V VC=VIS=V/000?o00000`000ol0000L0003o`0000<000?o0000 :`03o`T000?o00009P000ol000030003o`0001`0003/0005o`000?l080001Ol0003o03400ol50003 o`0002P000Go0000o`0O0000k@000ol0o`0R0003o`3o03D00ol00`3o000[0003o`3o0200003^0003 o`00028000?o0000=`000ol0000/0003o`0001l0003R00CoRP04obX0003S0003o`0008/000?o0000 :P0002D02_l200;o0`05o`801Ol00`3oo`02of/00]800`3BdP0/00Co0P05o`030?oo00?o00<0ool0 0_l=00?o0P05o`060?l0o`3o0P04o`030?oo00;o5@04o`801Ol00`3oo`02o`<00ol200Co0P05o`80 0ol300?o3@04o`801Ol00`3oo`03o`030?oo00;o5`0002@000Go0000o`030003o`0000800_l50005 o`000?l00`000ol0o`1`0003dP3B02d000Go0000o`030005o`000?l00P000ol000030003o`0000/0 00Co003o0`002ol0003o0?l0o`3o00P000?o00005P001?l00?l20004o`00o`<000Co003o0P001?l0 0?l40004o`00o`8000Go0000o`020004o`00o``000Go0000o`030005o`000?l00P000ol000030003 o`0001D0000T0005o`000?l00`001_l0003o00;o10001Ol0003o00<000?o0?l01?m]0003dP0002`0 00Go0000o`030005o`000?l00P000ol00004o`d000?o000010002_l0003o0?l0o`05o`030?oo00;o 5@04o`8000Co003o0P001Ol0003o008000?o00000`000ol0000200Co0P000ol000040003o`0000d0 00Go0000o`030005o`000?l00P000ol00004oaL0000T0005o`000?l00`001Ol0003o008000?o0000 0P001Ol0003o00<000?o0?l00`000ol0001Z0003dP3B02d000Go0000o`030005o`000?l00P001?l0 0?l@0003o`0000@000_o0000o`3o0?l0o`030003o`3o01P000?o00000`001?l00?l20005o`000?l0 0P000ol0000300;o1P001?l00?l30004o`00o`l000Go0000o`030005o`000?l00P001?l00?lJ0000 9@04o`800_l200;o0P02o`800_l400Co0P03of`00]800`3BdP0[00Go10000ol00002o`030?oo0080 1?l<00Co0`02o`801_l200?o0P04oaD01?l0103oo`02o`801?l200Co0P02o`030?oo00800ol300Co 00<0ool00_l<00Go10000ol00002o`030?oo00801?lG0000:0000ol0000E0003o`000:P000?o0000 60000ol0000i0003o`0000@000?o00005@000ol0000E0003o`000280000W00;o0`000ol000090003 o`0000@00_nX00?o6P000ol000040003o`0003400_l60003o`0001D000?o00004`03ob@0003o09l0 003^00;o8P02ocT00_l[00?o8@000?000olL00?o?@03ob@01?lT0000l`03oaL00_m300;o7@05obP0 003f00?o4@03odL00olF00Co;@000?T00ol<00;oC@02oa001?la0000=@02og/01?m600?o1`02oe40 0_l900Go=@0003L00_mb00OoC@03o`040?oooeD00ol200Co>P0003T00_mY00OoE`000ol0001I00;o ?P0003/00_mQ00KonP0003d00_mH00Ooo`010000?`02oe001_oo00P0001100;oA`07oeX01?l200Go 00<0ool00_l300?o0P04o`801Ol200?o0`03ocD02_l200;o0`05o`801Ol00`3oo`02obh0001300;o ?P07of@000Co003o0P001?l00?l30004o`00o`8000Co003o10001?l00?l20005o`000?l00P001?l0 0?lc0005o`000?l00`000ol0000200;o1@001Ol0003o00<000?o0?l000;o 3006oj001?mE00Co?`0005000_l300OoZP07odT01Om30000DP03okP01_ln00GoB0000?l05006oc<0 1Om=0000o`0J00Oo9`05oe80003o02401_lL00GoE`000?l09`06oa401OmL0000o`0]00Oo1@05of40 003o03@01OmV0000AP04ool0E@0004L000?o0000o`1E0000A`04o`801Ol00`3oo`03o`030?oo00;o b00:o`800_l300Go0P05o`030?oo00;oE`0004L000Go0000o`030005o`000?l00P000ol000030003 o`00000;o2`03odh0001[00?o`@03of`0001[00?o`@03of`0001Z00Co`@04of/0001Z00Go_`05of/0 001Z00Go_`05of/0001Y00Ko_`06ofX0001Y00Ko_`06ofX0001Y00Ko_`06ofX0001Y00Oo_@07ofX0 001X00So_@08ofT0001X00So_@08ofT0001/0003o`000<4000?o0000J`0006`000?o0000`@000ol0 001[0000K0000ol000310003o`0006/0001/0003o`000<4000?o0000J`0006`000?o0000`@000ol0 001[0000K0000ol000310003o`0006/0001/0003o`000<4000?o0000J`0006`000?o0000`@000ol0 001[0000K035ofd0003>0003o`0000003o`0000003o`0000003o`0000003o`0000003o`0000003o`0000003o`0000003o`0000003o`0000003o`0000003o`0000003o`0000003o`0000003o`0000003o`0000003o`0000003o`0000003o`0000003o`0000003o`0000003o`0000003o`0000003o`0000003o`0000003o`0000003o`0000003o`0000003o`0000003o`0000003o`0000003o`0000003o`0000003o`0000003o`0000003o`0000003o`0000003o`0000003o`0000003o`000801OmO0000E002ool0B@000?l0W`000?l0W`000?l0W`000?l0W`000?l0W`000?l0 W`000?l0W`000?l0W`000?l0W`000?l0W`000?l0W`000?l0W`000?l0W`000?l0W`000?l0W`0008d0 0b=i00?oTP0008h000L000?o0000 2P000ol0000E0003o`0000/000?o0000:@000ol0000;0003o`0001h000?o00002`000ol0000H0000 i`000ol0000:0003o`0001D000?o00002`000ol0000Y0003o`0000/000?o00007P000ol0000;0003 o`0001P0003X0003o`0000P000?o00005`000ol000090003o`0002/000?o00002@000ol0000P0003 o`0000T000?o00006@000>T000?o00001P000ol0000I0003o`0000L000?o0000;@000ol000070003 o`00028000?o00001`000ol0000J00006@02ob800_mA008S8P028c<000?o00001P000ol0000I0003 o`0000L000?o0000;@000ol000070003o`00028000?o00001`000ol0000J00006`000ol0000N0003 o`0005<000@001?l00?lQ0005 o`000?l0=@001Ol0003o02X000Go0000o`0O00007`02oaH000?o0000G@000b<0000D008S?@000ol0 o`0R0003o`3o03L000?o0?l0;0000ol0o`0P00008@000ol0000B0003o`0005l000@000ol0 00040003o`0001D000?o00005@000ol0000R0000j@03oaX000?o000010000ol0000a00;o1P000ol0 000E0003o`0001<00olT0000o`2O0000o`2O0000o`2O0000kP02ob800_li00;o:`03ob40003`00;o 7P02ocd00_lV00?o90000?800olI00;o@@02ob400olW00006`0:o`800_l300Go0P05o`030?oo00;o F@038`801B<01P0S02<08`8012<00`0S8`028d@00_lE00;oA@02oa/01?lZ00006P001Ol0003o00<0 00?o00000P02o`D000Go0000o`030003o`3o05d000@S000S0`002b<0000S02<08`0S00P0000003o`0004/000?o00004003oc40 000J0005o`000?l00`001Ol0003o008000?o00000P001Ol0003o00<000?o0?l00`000ol0001G0003 8`0000@000/S00008`0S02<08`0300038`0S04d00_l:00;oC`02o``01?ld00006`04o`800_l200;o 0P02o`800_l400Co0P03oeT012<3008S0P068`800b<200@SC003o`D00_mC00;o1`03ocP0000N0003 o`0001D000?o0000G@000b<0001W00;o00<0ool0E`02o`800olk00007@02o`<000?o00002@000ol0 000400;oG`000b<0000400038`00068000?o0000F@02och0003o09l0003o09l0003o09l0003o09l0 003o09l0003[00Co0P05o`030?oo00;o0`03o`801?l200Go0P03o`<00ole00[o0P02o`<01Ol200Go 00<0ool00_l^0000:`03og<00om:0004o`00o`8000Co003o0`001?l00?l20004o`00o`@000Co003o 0P001Ol0003o008000Co003o<`001Ol0003o00<000?o00000P02o`D000Go0000o`030003o`3o0380 000^00CoJP05odX01?l20004o`00o`8000Go0000o`020003o`0000<000?o00000P04o`8000?o0000 10000ol0000d0005o`000?l00`001_l0003o00;o10001Ol0003o00<000?o0?l01?l^0000`04odX0001I00Co 3005ojL01Olb00CoCP0005d01?l300Go/@05obP01OmB0000H@03ok/01OlO00CoE`000?l09@05oaH0 1?mK0000o`0Z00Go3@04oel0003o02l01Ol400CoH`000?l0=004ofL0003o09l0003o09l0001F00Co o`150000E`000ol0003o04D0001G00Co0P05o`030?oo00?o00<0ool00_nh00[o0P02o`<01Ol200Go 00<0ool00_mG0000E`001Ol0003o00<000Go0000o`020003o`0000<000?o0000]@001Ol0003o00<0 00?o00000P02o`D000Go0000o`030003o`3o05/0001G0005o`000?l00`001Ol0003o008000?o0000 1?ng0005o`000?l00`001_l0003o00;o10001Ol0003o00<000?o0?l01?mG0000E`001Ol0003o00<0 00Go0000o`020004o`00okX000Go0000o`030005o`000?l00P000ol000020005o`000?l00`000ol0 o`030003o`0005D0001F00Go10000ol00002o`030?oo00801?nh00Co0P02o`800_l200;o0P02o`@0 1?l200?oF00005l000?o0000aP000ol0000E0003o`0005/0001M00?oa`02o`<000?o00002@000ol0 000400;oG@000?l0W`000?l0W`000?l0W`000?l0W`000?l0W`000?l0W`000?l0W`000?l0W`000?l0 W`000?l0W`000001\ \>"], ImageRangeCache->{{{0, 413}, {295, 0}} -> {-0.0500105, -0.0358619, 0.0050848, 0.00510476}, {{9.8125, 197.125}, {287.938, 200.125}} -> {-2.89579, -4.78608, 0.0352356, 0.0546623}, {{215.812, 403.125}, {287.938, 200.125}} -> {-45.5998, -9.57217, 0.147349, 0.109326}, {{9.8125, 197.125}, {94.8125, 7}} -> {-5.38439, -15.3428, 0.054455, 0.0546627}, {{215.812, 403.125}, {94.8125, 7}} -> {-45.5998, -23.0142, 0.147349, 0.0819938}}]}, Open]], Cell[TextData[{ StyleBox["FIGURE 2.", Evaluatable->False, PageBreakAbove->False, AspectRatioFixed->True, FontWeight->"Bold"], StyleBox[" The crossover of ", Evaluatable->False, PageBreakAbove->False, AspectRatioFixed->True], StyleBox["Adam", Evaluatable->False, PageBreakAbove->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[" and ", Evaluatable->False, PageBreakAbove->False, AspectRatioFixed->True], StyleBox["Eve", Evaluatable->False, PageBreakAbove->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[" to produce ", Evaluatable->False, PageBreakAbove->False, AspectRatioFixed->True], StyleBox["Cain", Evaluatable->False, PageBreakAbove->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[" and ", Evaluatable->False, PageBreakAbove->False, AspectRatioFixed->True], StyleBox["Abel", Evaluatable->False, PageBreakAbove->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[".", Evaluatable->False, PageBreakAbove->False, AspectRatioFixed->True, FontSize->12] }], "Special1", Evaluatable->False, PageBreakAbove->False, AspectRatioFixed->True], Cell[TextData[{ StyleBox[ "There are some interesting special cases that should be discussed. If the \ exchange takes place between two terminal nodes, then we have effected two \ mutations. Even if crossover takes place between two identical parents, the \ offspring will in general not be identical because the subexpressions \ selected for exchange will not necessarily be the same. This is in contrast \ to a GA where the fixed data structure forces the generation of two offspring \ not only identical to each other, but also identical to the parents. During \ the evolution of the population, the depth of individuals tends to grow \ because subexpressions of different depths are exchanged. While this will \ allow great flexibility in finding a solution, these larger expressions take \ longer to evaluate. Therefore it is practical to impose an upper limit on the \ depth of an expression. In the event that a crossover will exceed this limit, \ then the offending offspring is replaced with one of its parents [Koza 1992, \ p. 104], as shown in this revised definition of ", Evaluatable->False, AspectRatioFixed->True], StyleBox["CrossOver", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[":", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[{ \(\(Clear[CrossOver]; \)\), \(CrossOver[parents_, maxDepth_: 16] := Module[{pos, ind, sub, children}, pos = \((Position[#1, _, Heads \[Rule] False]&)\)/@parents; ind = randomElement/@pos; sub = MapThread[#1 \[LeftDoubleBracket]Sequence@@#2\[RightDoubleBracket]&, { parents, ind}]; children = MapThread[ReplacePart, {parents, Reverse[sub], ind}]; MapThread[ If[DepthExpression[#1] \[LessEqual] maxDepth, #1, #2]&, {children, parents}]]\)}], "Input", AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[TextData["Mutation"], "Subsection", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[{ StyleBox[ "In the traditional GA, mutation merely exhanges the letter in a randomly \ selected gene for another one from the allowed alphabet. Typically, a bit is \ flipped, as most GAs use a binary representation. In genetic programming, \ mutation replaces a randomly selected subexpression with a new, randomly \ generated subexpression. The depth of the new subexpression can be anywhere \ from 0 (", Evaluatable->False, AspectRatioFixed->True], StyleBox["i.e.", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox[ ", a terminal) to some maximum based on the overall maximum depth for an \ expression, which may be larger than the orignal subexpression.", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[{ \(Mutate[expr_, funcs_, terms_, maxDepth_: 16] := Module[{pos, ind, depth, newSub}, pos = Position[expr, _, Heads \[Rule] False]; ind = randomElement[pos]; depth = Random[Integer, 1\/4\ \((maxDepth - Length[ind])\)]; newSub = RandomExpression[depth, funcs, terms]; ReplacePart[expr, newSub, ind]]\), \(\(Attributes[Mutate] = {HoldRest}; \)\)}], "Input", AspectRatioFixed->True], Cell[TextData[{ StyleBox["In the example shown in Figure 3, we see that part {2,1} of ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Simon", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[ " of depth 0 was replaced by a subexpression of depth 1 to become ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Peter", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[".", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{Cell[BoxData[ \(Simon = RandomExpression[2, funcs, terms]\)], "Input", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(times[divide[y, z], subtract[1, z]]\)], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[BoxData[ \(\(Simon = times[divide[y, z], subtract[1, z]]; \)\)], "Input", CellOpen->False, AspectRatioFixed->True, FontColor->RGBColor[1, 0, 0]], Cell[CellGroupData[{Cell[BoxData[ \(Peter = Mutate[parent, funcs, terms]\)], "Input", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(times[divide[y, z], subtract[times[z, y], z]]\)], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[BoxData[ \(\(Peter = times[divide[y, z], subtract[times[z, y], z]]; \)\)], "Input",\ CellOpen->False, AspectRatioFixed->True, FontColor->RGBColor[1, 0, 0]], Cell[CellGroupData[{Cell[BoxData[ \(\(Show[ GraphicsArray[{{ DrawExpression[Simon, DisplayFunction \[Rule] Identity, xMargin \[Rule] 1.2, deltaX \[Rule] 1.5, style \[Rule] {{{2, 1}, Red}}]}, {}, { DrawExpression[Peter, DisplayFunction \[Rule] Identity, xMargin \[Rule] 1.2, deltaX \[Rule] 1.5, style \[Rule] {{{2, 1}, Red}}]}}, Epilog \[Rule] { Arrow[{0.5, 0.825}, {0.5, 0.5}, HeadScaling \[Rule] Absolute], Text["\", {0.45, 0.825}, {1, 0}], Text["\", {0.55, 0.5}, {\(-1\), 0}]}]]; \)\)], "Input", Evaluatable->False, CellOpen->False, AspectRatioFixed->True], Cell[GraphicsData["PostScript", "\<\ %! %%Creator: Mathematica %%AspectRatio: 1.28 MathPictureStart %% Graphics /Courier findfont 10 scalefont setfont % Scaling calculations 0.0238095 0.952381 0.0304762 0.952381 [ [ 0 0 0 0 ] [ 1 1.28 0 0 ] ] MathScale % Start of Graphics 1 setlinecap 1 setlinejoin newpath [ ] 0 setdash 0 g p P 0 0 m 1 0 L 1 1.28 L 0 1.28 L closepath clip newpath % Start of user PostScript /mathtops { gsave MBeginOrig moveto MEndOrig currentpoint grestore } bind def /MAtocoords { mathtops 4 2 roll mathtops 4 copy pop pop 3 -1 roll sub /arry exch def exch sub /arrx exch def arrx dup mul arry dup mul add sqrt /arrl exch def translate } bind def /MAarrowhead1 { gsave MAtocoords currentlinewidth 1 Mabswid currentlinewidth dup scale setlinewidth [ arrx arrl div arry arrl div -1 arry mul arrl div arrx arrl div 0 0 ] concat -15. 3.75 moveto 0 0 lineto -15. -3.75 lineto fill -15. 3.75 moveto 0 0 lineto -15. -3.75 lineto -15. 3.75 lineto stroke grestore } def % End of user PostScript p p % Start of sub-graphic p 0.0238095 0.0304762 0.97619 0.411429 MathSubStart %% Graphics /Courier findfont 10 scalefont setfont % Scaling calculations 0.465278 0.0694444 0.458333 0.0694444 [ [ 0 0 0 0 ] [ 1 .5 0 0 ] ] MathScale % Start of Graphics 1 setlinecap 1 setlinejoin newpath [ ] 0 setdash p P 0 0 m 1 0 L 1 .5 L 0 .5 L closepath clip newpath p [(times)] .46528 .45833 0 0 Mshowa .004 w .46528 .41667 m .15278 .36111 L s .46528 .41667 m .70833 .36111 L s p [(divide)] .15278 .31944 0 0 Mshowa .15278 .27778 m .08333 .22222 L s .15278 .27778 m .22222 .22222 L s [(y)] .08333 .18056 0 0 Mshowa [(z)] .22222 .18056 0 0 Mshowa P p [(subtract)] .70833 .31944 0 0 Mshowa .70833 .27778 m .63889 .22222 L s .70833 .27778 m .91667 .22222 L s p 1 0 0 r [(times)] .63889 .18056 0 0 Mshowa .63889 .13889 m .56944 .08333 L s .63889 .13889 m .70833 .08333 L s [(z)] .56944 .04167 0 0 Mshowa [(y)] .70833 .04167 0 0 Mshowa P [(z)] .91667 .18056 0 0 Mshowa P P MathSubEnd P % End of sub-graphic P p P p % Start of sub-graphic p 0.0238095 0.868571 0.97619 1.24952 MathSubStart %% Graphics /Courier findfont 10 scalefont setfont % Scaling calculations 0.541667 0.0833333 0.366667 0.0833333 [ [ 0 0 0 0 ] [ 1 .4 0 0 ] ] MathScale % Start of Graphics 1 setlinecap 1 setlinejoin newpath [ ] 0 setdash p P 0 0 m 1 0 L 1 .4 L 0 .4 L closepath clip newpath p [(times)] .54167 .36667 0 0 Mshowa .004 w .54167 .31667 m .16667 .25 L s .54167 .31667 m .83333 .25 L s p [(divide)] .16667 .2 0 0 Mshowa .16667 .15 m .08333 .08333 L s .16667 .15 m .25 .08333 L s [(y)] .08333 .03333 0 0 Mshowa [(z)] .25 .03333 0 0 Mshowa P p [(subtract)] .83333 .2 0 0 Mshowa .83333 .15 m .75 .08333 L s .83333 .15 m .91667 .08333 L s p 1 0 0 r [(1)] .75 .03333 0 0 Mshowa P [(z)] .91667 .03333 0 0 Mshowa P P MathSubEnd P % End of sub-graphic P P p .004 w .5 .81619 m .5 .50667 L s % Start of user PostScript 0.5 0.825 0.5 0.5 MAarrowhead1 % End of user PostScript P [(Simon)] .45238 .81619 1 0 Mshowa [(Peter)] .54762 .50667 -1 0 Mshowa % End of Graphics MathPictureEnd \ \>"], "Graphics", Evaluatable->False, AspectRatioFixed->False, ImageSize->{237, 303}, ImageMargins->{{34, Inherited}, {Inherited, Inherited}}, ImageCache->GraphicsData["Bitmap", "\<\ CF5dJ6E]HGAYHf4PAg9QL6QYHggYjN[Vi^OShn03ooeGooj[ooonICXf=SLcII03=Voc=Vc3=V VC=VIS=Vd0003]0000k@000>d0003]0000k@000>d0 003]0000k@000>d0003]0000X@038dT0002R00038`0004P0002300@S70000b<000170000Q0000b<0 000L00038`0004L00024008S70000b<08`180000Q@000b<0000J00038`0S04P0002300@S6P028`03 02d0003]0000k@0008D00R0000 S`000b<00008008SD@0009000R<700038`000540002B008S0`028e@0002D00038`0S05H0002E0003 8`0005D0003]0000k@0001D00ooE00005P000ol0003D00005`000ol0000K00CoC`038`801B<01P0S 02<08`8012<00`0S8`028bh01?lH00005`000ol0000L0003o`0004l000@S000S0`002b<0000S02<0 8`0S00P00000038`0000@000/S00008`0S02<08`030003 8`0S03<000?o00005`0001D00_l00`3oo`0K00CoCP048`<00R<200HS0P038`8012<^00Co600008P0 00d0003]00006002oa`00_mM00;o>P03oaT0 000J0003o`0001P000?o0000G`000ol0000b00Go700001/00_lF00;oH`02obd01OlQ00007@000ol0 000A00;oI`000ol0000V00Co9P0001h00_l@0003o`0006P00_lQ00Go:P00020000?o00002`02ofd0 00?o00006@05obl0000Q00;o2P000ol0001^00;o5005oc@0000S0003o`0000D00_mc0003o`0000d0 1?li00009002o`<00_mf00;o2005ocd0000V0003o`3o07X000?o00001Om200009`000ol0001j00;o A`000>d0003]0000k@000>d0000G00[o0P02o`<01Ol200Go00<0ool00_mD00Co0P05o`030?oo00;o 0`03o`801?l200Go0P03o`<00olb00005P001Ol0003o00<000?o00000P02o`D000Go0000o`030003 o`3o05/000Co003o0P001?l00?l30004o`00o`8000Co003o10001?l00?l20005o`000?l00P001?l0 0?la00005P001Ol0003o00<000Ko0000o`02o`@000Go0000o`030003o`3o00CoE004o`8000Co003o 0P001Ol0003o008000?o00000`000ol0000200Co0P000ol000040003o`000380000F0005o`000?l0 0`001Ol0003o008000?o00000P001Ol0003o00<000?o0?l00`000ol0001B0003o`0000<000Co003o 0P001Ol0003o008000?o00000`02o`H000Co003o0`001?l00?ld00005`04o`800_l200;o0P02o`80 0_l400Co0P03oeD01?l0103oo`02o`801?l200Co0P02o`030?oo00800ol300Co00<0ool00_lb0000 6P000ol0000E0003o`0006@000?o000010000ol0000E0003o`000380000I00;o0`000ol000090003 o`0000@00_mU00;o1P000ol0000E0003o`000380003]0000k@000>d0000W00GoM@04odP0000/00Oo J@05od`0000c00OoG006oe40000j00OoD005oeL0001100OoA005oe`0001800Oo=`06of40001?00Oo :`05ofL0001F00Oo7P06of`0001M00Oo4P05og80001T00Oo1P05ogL0001[00KoO0000>d0003]0000 k@000>d0001Q00?o0P05o`060?l0o`3o0P04o`030?oo00;oL@00064000Co003o0`002ol0003o0?l0 o`3o00P000?o0000K`00064000?o000010002_l0003o0?l0o`05o`030?oo00;oL@00064000?o0000 10002ol0003o0?l0o`3o00<000?o0?l0M00006001?l300;o0P06o`800ol200CoL@00064000?o0000 R@00064000?o000010000ol000220000k@000>d0003]0000k@000>d0003]0000k@000>d0003]0000 k@000>d0003]0000k@000>d0003]0000k@000>d0003]0000k@000>d0003]0000k@000>d0002100?o 1@04o`800ol300Co00<0ool00_m?0000PP000ol000030003o`0000@000Ko003o0?l60003o`0004l0 001f0003o`0000T00ol300Go0P000ol0000200Go0P000ol0001?0000MP000ol000090004o`00o`80 00Go0000o`020003o`00008000Go0000o`0200;oD00007H000?o00002@001?l00?l300?o0P04o`<0 0ol200;o00<0ool0CP0007D00ol900Co2P000ol0001K0000M@03oaL000?o0000F`0007D00ome0000 M@03ogD0001d00CoM@0007@01Omd0000M005og@0001c00KoM00007<01_md0000L`06og@0001c00Oo L`0007802?mc0000LP08og<0001f0003o`0007@0001f0003o`0007@0001f0003o`0007@0001f0003 o`0007@0001f0003o`0007@0001f0003o`0007@0001f0003o`0007@0001f0003o`0007@0001f0003 o`0007@0001f0003o`0007@0001f0003o`0007@0001f0003o`0007@0001f0003o`0007@0001f0003 o`0007@0001f0003o`0007@0001f0003o`0007@0001f0003o`0007@0001f0003o`0007@0001f0003 o`0007@0001f0003o`0007@0001f0003o`0007@0001f0003o`0007@0001f0003o`0007@0001f0003 o`0007@0001f0003o`0007@0001f0003o`0007@0001f0003o`0007@0001f0003o`0007@0001f0003 o`0007@0001f0003o`0007@0001f0003o`0007@0001f0003o`0007@0001f0003o`0007@0001f0003 o`0007@0001f0003o`0007@0001f0003o`0007@0001f0003o`0007@0001f0003o`0007@0001f0003 o`0007@0001f0003o`0007@0001f0003o`0007@0001f0003o`0007@0001f0003o`0007@0001f0003 o`0007@0001f0003o`0007@0001f0003o`0007@0001f0003o`0007@0001f0003o`0007@0001f0003 o`0007@0001f0003o`0007@0001f0003o`0007@0001f0003o`0007@0001f0003o`0007@0001f0003 o`0007@0001f0003o`0007@0001=00?o0`05o`060?l0o`3o0P03o`800_l00`3oo`0<0003o`0007@0 001=0004o`00o`@000_o0000o`3o0?l0o`030003o`3o008000?o00002`000ol0001d0000C`02o`@0 00_o0000o`3o0?l0o`030003o`3o008000?o00002`000ol0001d0000C@02o`H000_o0000o`3o0?l0 o`030003o`3o008000?o0000PP0004d000Co003o0`02o`801_l200?o00<0ool00on40000CP03oi`0 001E0003o`0009D0003]0000k@000>d0003]0000k@000>d0003]0000k@000>d0003]0000k@0001D0 0ooE00005P000ol0003D00005`000ol0000Q00CoK@038b801?lH00005`000ol0000R0003o`0006h0 00d0003]0000k@000>d0003]0000k@0001P00_lR00;oL002ob800_lI00006P000ol0000N0003 o`00078000?o00007P000ol0000I00006`000ol0000L0003o`0007@000?o000070000ol0000J0000 70000ol0000J0003o`0007H000?o00006P000ol0000K00007@02oaT000?o0000N0000ol0000G00;o 7P0001l000?o00005002og`00_lF0003o`0001h0000P0003o`00018000?o0000OP000ol0000B0003 o`0001l0000Q00;o4@000ol000200003o`0000l00_lR00008`000ol0000=0003o`00088000?o0000 3@000ol0000R000090000ol0000;0003o`0008@000?o00002`000ol0000S00009@000ol0000800;o R002o`X000?o0000900002H00_l70003o`0008X000?o00001@02obL0000X0003o`0000<000?o0000 S0000ol000030003o`0002L0000Y0005o`000?l0T0001Ol0003o02X0000Z0003o`3o098000?o0?l0 :`0002/000?o0000TP000ol0000Z0000k@000>d0003]0000k@000>d0003]0000k@000>d0000K00[o 0P02o`<01Ol200Go00<0ool00_m/00Co0P05o`030?oo00;o0`03o`801?l200Go0P03o`<00olF0000 6P001Ol0003o00<000?o00000P02o`D000Go0000o`030003o`3o07<000Co003o0P001?l00?l30004 o`00o`8000Co003o10001?l00?l20005o`000?l00P001?l00?lE00006P001Ol0003o00<000Ko0000 o`02o`@000Go0000o`030003o`3o00CoK004o`8000Co003o0P001Ol0003o008000?o00000`000ol0 000200Co0P000ol000040003o`0001H0000J0005o`000?l00`001Ol0003o008000?o00000P001Ol0 003o00<000?o0?l00`000ol0001Z0003o`0000<000Co003o0P001Ol0003o008000?o00000`02o`H0 00Co003o0`001?l00?lH00006`04o`800_l200;o0P02o`800_l400Co0P03ofd01?l0103oo`02o`80 1?l200Co0P02o`030?oo00800ol300Co00<0ool00_lF00007P000ol0000E0003o`0007`000?o0000 10000ol0000E0003o`0001H0000M00;o0`000ol000090003o`0000@00_mm00;o1P000ol0000E0003 o`0001H0003]0000k@000>d0003]0000k@000>d0003]0000:`04ohl00ol/0000;`05ohD01Ol_0000 =006og/01?ld0000>P06og401?lh0000@005ofL01Oll0000A@06oed01?m10000B`05oe@01?m50000 D006odT01Om90000EP06ocl01?m>0000G005ocH01?mB0000H@06ob/01OmF0000I`05ob801?mK0000 K006oaP01?mO0000LP06o`d01OmS0000N005o`@01?mX0000O@04of`0003]0000k@000>d0003]0000 k@000>d0003]0000k@0007800ol200Go00H0o`3o0?l200Co00<0ool00_mP0000LP001?l00?l3000; o`000?l0o`3o0?l020000ol0001N0000LP000ol00004000:o`000?l0o`3o00Go00<0ool00_mP0000 LP000ol00004000;o`000?l0o`3o0?l00`000ol0o`1S0000L@04o`<00_l200Ko0P03o`801?mP0000 LP000ol0001h0000LP000ol000040003o`000740003]0000k@000>d0003]0000k@000>d0003]0000 k@000>d0003]0000\ \>"], ImageRangeCache->{{{0, 236}, {302, 0}} -> {-0.0250052, -0.0320067, 0.0044492, 0.00445038}, {{5.5625, 230.375}, {294.75, 204.875}} -> {-7.05638, -7.18085, 0.0640541, 0.0801121}, {{5.5625, 230.375}, {97.0625, 7.1875}} -> {-6.79698, -15.3453, 0.0533784, 0.0534081}}]}\ , Open]], Cell[TextData[{ StyleBox["FIGURE 3.", Evaluatable->False, PageBreakAbove->False, AspectRatioFixed->True, FontWeight->"Bold"], StyleBox[" The mutation of ", Evaluatable->False, PageBreakAbove->False, AspectRatioFixed->True], StyleBox["Simon", Evaluatable->False, PageBreakAbove->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[" to produce ", Evaluatable->False, PageBreakAbove->False, AspectRatioFixed->True], StyleBox["Peter", Evaluatable->False, PageBreakAbove->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[".", Evaluatable->False, PageBreakAbove->False, AspectRatioFixed->True, FontSize->12] }], "Special1", Evaluatable->False, PageBreakAbove->False, AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[TextData["Constant Perturbation"], "Subsection", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[{ StyleBox[ "In many instances, an expression tree can be improved by making a small \ change to one of the component constants. Fine tuning of this sort is often \ more efficient than relying on mutation to achieve the same effect. We begin \ by identifying only those terminal parts of an expression tree that hold a \ constant numeric value with the pattern ", Evaluatable->False, AspectRatioFixed->True], StyleBox["_?NumberQ", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[".", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(\(terms := {x, Random[Integer, {\(-5\), 5}]}; \)\)], "Input", AspectRatioFixed->True], Cell[CellGroupData[{Cell[BoxData[ \(Saul = RandomExpression[3, funcs, terms]\)], "Input", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(divide[times[subtract[4, x], 3, \(-1\)], subtract[subtract[\(-5\), x], subtract[3, x]]]\)], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[BoxData[ \(\(Saul = divide[times[subtract[4, x], times[3, \(-1\)]], subtract[subtract[\(-5\), x], subtract[3, x]]]; \)\)], "Input", CellOpen->False, AspectRatioFixed->True, FontColor->RGBColor[1, 0, 0]], Cell[CellGroupData[{Cell[BoxData[ \(cp = Position[Saul, _?NumberQ]\)], "Input", AspectRatioFixed->True], Cell[BoxData[ \({{1, 1, 1}, {1, 2}, {1, 3}, {2, 1, 1}, {2, 2, 1}}\)], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[BoxData[ \(\((Saul\[LeftDoubleBracket]Sequence@@#1\[RightDoubleBracket]&)\)/@cp \)], "Input", AspectRatioFixed->True], Cell[BoxData[ \({4, 3, \(-1\), \(-5\), 3}\)], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[TextData[{ StyleBox[ "Now one of these nodes is randomly selected and the value stored there is \ perturbed by a small amount. Note that we replace ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Real", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox["s with ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Real", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox["s and ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Integer", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox["s with ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Integer", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox["s. Similar actions should be taken for ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Complex", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[" and ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Rational", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[" constants as well.", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[{ \(perturbConstant[n_Real] := Random[Real, n\ {0.8, 1.25}]\), \(perturbConstant[n_Integer] := Random[Integer, {Min[n - 3, Floor[0.8\ n]], Max[Ceiling[1.25\ n], n + 3]}] /; n \[GreaterEqual] 0\), \(perturbConstant[n_Integer] := Random[Integer, {Min[n - 3, Floor[1.25\ n]], Max[Ceiling[0.8\ n], n + 3]}] /; n < 0\)}], "Input", AspectRatioFixed->True], Cell[BoxData[ \(Perturb[expr_] := Module[{constants, ind, oldTerm, newTerm}, constants = Position[expr, _?NumberQ]; If[Length[constants] > 0, ind = randomElement[constants]; oldTerm = expr\[LeftDoubleBracket]Sequence@@ind\[RightDoubleBracket]; newTerm = perturbConstant[oldTerm]; ReplacePart[expr, newTerm, ind], expr]]\)], "Input", AspectRatioFixed->True], Cell[TextData[{ StyleBox[ "The example in Figure 4 shows that the value 4 at part {1, 1, 1} of ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Saul", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[" was replaced with the value 1 in ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Paul", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[".", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{Cell[BoxData[ \(Paul = Perturb[Saul]\)], "Input", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(divide[times[subtract[1, x], 3, \(-1\)], subtract[subtract[\(-5\), x], subtract[3, x]]]\)], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[BoxData[ \(\(Paul = divide[times[subtract[1, x], 3, \(-1\)], subtract[subtract[\(-5\), x], subtract[3, x]]]; \)\)], "Input", CellOpen->False, AspectRatioFixed->True, FontColor->RGBColor[1, 0, 0]], Cell[CellGroupData[{Cell[BoxData[ \(\(Show[ GraphicsArray[{{ DrawExpression[Saul, DisplayFunction \[Rule] Identity, xMargin \[Rule] 1.2, deltaX \[Rule] 1.5, style \[Rule] {{{1, 1, 1}, Red}}]}, {}, { DrawExpression[Paul, DisplayFunction \[Rule] Identity, xMargin \[Rule] 1.2, deltaX \[Rule] 1.5, style \[Rule] {{{1, 1, 1}, Red}}]}}, Epilog \[Rule] { Arrow[{0.5, 0.45}, {0.5, 0.25}, HeadScaling \[Rule] Absolute], Text["\", {0.47, 0.45}, {1, 0}], Text["\", {0.53, 0.25}, {\(-1\), 0}]}]]; \)\)], "Input", Evaluatable->False, CellOpen->False, AspectRatioFixed->True], Cell[GraphicsData["PostScript", "\<\ %! %%Creator: Mathematica %%AspectRatio: .71111 MathPictureStart %% Graphics /Courier findfont 10 scalefont setfont % Scaling calculations 0.0238095 0.952381 0.0169312 0.952381 [ [ 0 0 0 0 ] [ 1 .71111 0 0 ] ] MathScale % Start of Graphics 1 setlinecap 1 setlinejoin newpath [ ] 0 setdash 0 g p P 0 0 m 1 0 L 1 .71111 L 0 .71111 L closepath clip newpath % Start of user PostScript /mathtops { gsave MBeginOrig moveto MEndOrig currentpoint grestore } bind def /MAtocoords { mathtops 4 2 roll mathtops 4 copy pop pop 3 -1 roll sub /arry exch def exch sub /arrx exch def arrx dup mul arry dup mul add sqrt /arrl exch def translate } bind def /MAarrowhead1 { gsave MAtocoords currentlinewidth 1 Mabswid currentlinewidth dup scale setlinewidth [ arrx arrl div arry arrl div -1 arry mul arrl div arrx arrl div 0 0 ] concat -15. 3.75 moveto 0 0 lineto -15. -3.75 lineto fill -15. 3.75 moveto 0 0 lineto -15. -3.75 lineto -15. 3.75 lineto stroke grestore } def % End of user PostScript p p % Start of sub-graphic p 0.0238095 0.0169312 0.97619 0.228571 MathSubStart %% Graphics /Courier findfont 10 scalefont setfont % Scaling calculations 0.5 0.0320513 0.211538 0.0320513 [ [ 0 0 0 0 ] [ 1 .23077 0 0 ] ] MathScale % Start of Graphics 1 setlinecap 1 setlinejoin newpath [ ] 0 setdash p P 0 0 m 1 0 L 1 .23077 L 0 .23077 L closepath clip newpath p [(divide)] .5 .21154 0 0 Mshowa .004 w .5 .19231 m .19551 .16667 L s .5 .19231 m .74038 .16667 L s p [(times)] .19551 .14744 0 0 Mshowa .19551 .12821 m .11538 .10256 L s .19551 .12821 m .29167 .10256 L s .19551 .12821 m .37179 .10256 L s p [(subtract)] .11538 .08333 0 0 Mshowa .11538 .0641 m .08333 .03846 L s .11538 .0641 m .14744 .03846 L s p 1 0 0 r [(1)] .08333 .01923 0 0 Mshowa P [(x)] .14744 .01923 0 0 Mshowa P [(3)] .29167 .08333 0 0 Mshowa [(-1)] .37179 .08333 0 0 Mshowa P p [(subtract)] .74038 .14744 0 0 Mshowa .74038 .12821 m .59615 .10256 L s .74038 .12821 m .88462 .10256 L s p [(subtract)] .59615 .08333 0 0 Mshowa .59615 .0641 m .5641 .03846 L s .59615 .0641 m .64423 .03846 L s [(-5)] .5641 .01923 0 0 Mshowa [(x)] .64423 .01923 0 0 Mshowa P p [(subtract)] .88462 .08333 0 0 Mshowa .88462 .0641 m .85256 .03846 L s .88462 .0641 m .91667 .03846 L s [(3)] .85256 .01923 0 0 Mshowa [(x)] .91667 .01923 0 0 Mshowa P P P MathSubEnd P % End of sub-graphic P p P p % Start of sub-graphic p 0.0238095 0.48254 0.97619 0.69418 MathSubStart %% Graphics /Courier findfont 10 scalefont setfont % Scaling calculations 0.5 0.0308642 0.203704 0.0308642 [ [ 0 0 0 0 ] [ 1 .22222 0 0 ] ] MathScale % Start of Graphics 1 setlinecap 1 setlinejoin newpath [ ] 0 setdash p P 0 0 m 1 0 L 1 .22222 L 0 .22222 L closepath clip newpath p [(divide)] .5 .2037 0 0 Mshowa .004 w .5 .18519 m .20679 .16049 L s .5 .18519 m .74691 .16049 L s p [(times)] .20679 .14198 0 0 Mshowa .20679 .12346 m .1142 .09877 L s .20679 .12346 m .34568 .09877 L s p [(subtract)] .1142 .08025 0 0 Mshowa .1142 .06173 m .08333 .03704 L s .1142 .06173 m .14506 .03704 L s p 1 0 0 r [(4)] .08333 .01852 0 0 Mshowa P [(x)] .14506 .01852 0 0 Mshowa P p [(times)] .34568 .08025 0 0 Mshowa .34568 .06173 m .29938 .03704 L s .34568 .06173 m .37654 .03704 L s [(3)] .29938 .01852 0 0 Mshowa [(-1)] .37654 .01852 0 0 Mshowa P P p [(subtract)] .74691 .14198 0 0 Mshowa .74691 .12346 m .60802 .09877 L s .74691 .12346 m .8858 .09877 L s p [(subtract)] .60802 .08025 0 0 Mshowa .60802 .06173 m .57716 .03704 L s .60802 .06173 m .65432 .03704 L s [(-5)] .57716 .01852 0 0 Mshowa [(x)] .65432 .01852 0 0 Mshowa P p [(subtract)] .8858 .08025 0 0 Mshowa .8858 .06173 m .85494 .03704 L s .8858 .06173 m .91667 .03704 L s [(3)] .85494 .01852 0 0 Mshowa [(x)] .91667 .01852 0 0 Mshowa P P P MathSubEnd P % End of sub-graphic P P p .004 w .5 .4455 m .5 .25503 L s % Start of user PostScript 0.5 0.45 0.5 0.25 MAarrowhead1 % End of user PostScript P [(Saul)] .47143 .4455 1 0 Mshowa [(Paul)] .52857 .25503 -1 0 Mshowa % End of Graphics MathPictureEnd \ \>"], "Graphics", Evaluatable->False, AspectRatioFixed->False, ImageSize->{311, 221}, ImageMargins->{{34, Inherited}, {Inherited, Inherited}}, RenderingOptions->{"RenderThickness"->False}, ImageCache->GraphicsData["Bitmap", "\<\ CF5dJ6E]HGAYHf4PAg9QL6QYHggYjN[Vi^OShn03ooeGooj[ooonICXf=SLcII03=Voc=Vc3=V VC=VIS=V0000?l0>0000?l0>0000?l0>0000?l0 >0000?l0>0000?l0>0000?l0>0000?l0>00001d00b00;oA0000ol000090003 o`000280000T0003o`0000H00_n30003o`0000T00_m700;o1`02obD0000U0003o`0000@000?o0000 Q0000ol0000600;oB`000ol000030003o`0002D0000V00;o0`000ol0002600;o1002odh000Go0000 o`0X0000:0000ol0o`2;0004o`3ooe4000?o0?l0:@0002T000?o0000R`000ol0001B0003o`0002P0 003o03P0003o03P0000B00Co0P05o`030?oo00;o0`03o`801?l200Go0P03o`<00olK00?o6003obL0 1?l200Go00<0ool00_l300?o0P04o`801Ol200?o0`03obL01?l200Go00<0ool00_l300?o0P04o`80 1Ol200?o0`03oa@0000E0004o`00o`8000Co003o0`001?l00?l20004o`00o`@000Co003o0P001Ol0 003o008000Co003o7@000ol0000F0003o`0002T000Co003o0P001?l00?l30004o`00o`8000Co003o 10001?l00?l20005o`000?l00P001?l00?lY0004o`00o`8000Co003o0`001?l00?l20004o`00o`@0 00Co003o0P001Ol0003o008000Co003o4`0001801?l20004o`00o`8000Go0000o`020003o`0000<0 00?o00000P04o`8000?o000010000ol0000N0003o`0000l01Ol20003o`0002H01?l20004o`00o`80 00Go0000o`020003o`0000<000?o00000P04o`8000?o000010000ol0000W00Co0P001?l00?l20005 o`000?l00P000ol000030003o`0000801?l20003o`0000@000?o00005000018000?o00000`001?l0 0?l20005o`000?l00P000ol0000300;o1P001?l00?l30004o`00oah00_lI0003o`0002H000?o0000 0`001?l00?l20005o`000?l00P000ol0000300;o1P001?l00?l30004o`00obT000?o00000`001?l0 0?l20005o`000?l00P000ol0000300;o1P001?l00?l30004o`00oaH0000B00Co00@0ool00_l200Co 0P04o`800_l00`3oo`0200?o0`04o`030?oo00;o7P000ol0000F0003o`0002H01?l0103oo`02o`80 1?l200Co0P02o`030?oo00800ol300Co00<0ool00_lW00Co00@0ool00_l200Co0P04o`800_l00`3o o`0200?o0`04o`030?oo00;o500001h000?o000010000ol0000E0003o`0001/00olH00;o=0000ol0 00040003o`0001D000?o0000<`000ol000040003o`0001D000?o0000500001d00_l60003o`0001D0 00?o0000J`02o`H000?o00005@000ol0000b00;o1P000ol0000E0003o`0001@0003o03P0000Y00?o ;`03oa<01Om100CoCP04obX0000/00?o:004o`l01om:00Ko@P06obh0000_00Co8004o`/02?mG00Ko =P06oc@0000c00?o6@04o`P01omU00Ko:@07ocX0000f00?o4P04o`D01omb00Ko7@06od40000i00Co 2P04o`030?oo00KoO`06oa401_m70000?@03o`<02On=00Ko1@06odd0001000GoVP05oe<0003o03P0 003o03P0003o03P0000d00?o0P05o`060?l0o`3o0P04o`030?oo00;oN`04o`801Ol00`3oo`02o`<0 0ol200Co0P05o`800ol300?o?`0003@000Co003o0`002ol0003o0?l0o`3o00P000?o0000O0001?l0 0?l20004o`00o`<000Co003o0P001?l00?l40004o`00o`8000Go0000o`020004o`00och0000d0003 o`0000@000[o0000o`3o0?l01Ol00`3oo`02og/01?l20004o`00o`8000Go0000o`020003o`0000<0 00?o00000P04o`8000?o000010000ol0000o0000=0000ol00004000;o`000?l0o`3o0?l00`000ol0 o`1n0003o`0000<000Co003o0P001Ol0003o008000?o00000`02o`H000Co003o0`001?l00?m10000 <`04o`<00_l200Ko0P03o`801?mk00Co00@0ool00_l200Co0P04o`800_l00`3oo`0200?o0`04o`03 0?oo00;o?`0003@000?o0000W`000ol000040003o`0001D000?o0000?`0003@000?o000010000ol0 002G00;o1P000ol0000E0003o`0003l0001100OoU006oeD0001800goO@0:oe/0001E00goIP0:ofD0 001R00goCP0;ofl0001_00co>00:ogX0001k00go8@0:oh@0002800go2P0:ohh0002E00[oV0000?l0 >0000?l0>0000?l0>00008X02_l200;o0`05o`801Ol00`3oo`02oh/000290005o`000?l00`000ol0 000200;o1@001Ol0003o00<000?o0?l0S`0008T000Go0000o`030006o`000?l00_l40005o`000?l0 0`000ol0o`04oh/000290005o`000?l00`001Ol0003o008000?o00000P001Ol0003o00<000?o0?l0 0`000ol000290000RP04o`800_l200;o0P02o`800_l400Co0P03oh`0002=0003o`0001D000?o0000 S`0008`00_l30003o`0000T000?o00001002oi40003o03P0003o03P0003o03P0003o03P0003o03P0 003o03P0002S00?o1005o`030?oo00?o00<0ool00oml0000Y0000ol000030004o`00o`8000Co003o 10000ol0001l0000V`000ol0000600?o0`04o`8000Co003o10000ol0001l0000V`000ol000060004 o`00o`D000Co003o0P000ol000020003o`0007`0002K0003o`0000H000Co003o0`03o`040?oo00;o 10000ol0001l0000VP03o`H01?lA0003o`0007`0002J00?o6@03ogh0002J00?oVP0009X00onJ0000 V@04oiX0002I00GoV@0009T01OnI0000V006oiT0002H00KoV@0009P01_nI0000V007oiP0002G00So V00009L02?nH0000V`000ol0002I0000V`000ol0002I0000V`000ol0002I0000V`000ol0002I0000 V`000ol0002I0000V`000ol0002I0000V`000ol0002I0000V`000ol0002I0000V`000ol0002I0000 V`000ol0002I0000V`000ol0002I0000V`000ol0002I0000V`000ol0002I0000V`000ol0002I0000 V`000ol0002I0000V`000ol0002I0000V`000ol0002I0000V`000ol0002I0000V`000ol0002I0000 V`000ol0002I0000V`000ol0002I0000V`000ol0002I0000V`000ol0002I0000V`000ol0002I0000 V`000ol0002I0000V`000ol0002I0000V`000ol0002I0000V`000ol0002I0000V`000ol0002I0000 V`000ol0002I0000V`000ol0002I0000V`000ol0002I0000V`000ol0002I0000V`000ol0002I0000 V`000ol0002I0000V`000ol0002I0000V`000ol0002I0000V`000ol0002I0000V`000ol0002I0000 V`000ol0002I0000V`000ol0002I0000N`03o`<01Ol00`3oo`03o`030?oo00?o2@000ol0002I0000 N`001?l00?l20004o`00o`8000Co003o10000ol000090003o`0009T0001m00;o0P04o`8000Co003o 10000ol000090003o`0009T0001k00;o1`001?l00?l20003o`00008000?o0000Y@0007/000Co003o 0`03o`040?oo00;o10000ol0002U0000O003oa0000?o0000Y@0008d00onW0000o`0h0000o`0h0000 o`0h0000o`0h0000o`0h0000o`0h0000o`0h0000o`0h0000o`0h0000o`0h00007P038`h00_l00`3o o`0Y00?o5`03ocP00ol@00;o00<0ool0=`03o`h00_l00`3oo`0P00007`000b<0000>0003o`3o02d0 00?o00005@000ol0000j0003o`0000h000?o0?l0>`000ol0000<0003o`3o0240000M00@S40000ol0 000/0003o`0000h01Ol20003o`0003401Ol40003o`0000l000?o0000>P000ol0000=0003o`000200 000M00038`0S010000?o0?l0:`02oaP000?o0000=`03oa4000?o0?l0>@02o`l000?o0?l08@0001d0 00@04od/00olc0000o`0h0000o`0h00007`02oa000_l/00;o 5002ocX00_lD00;o>P02o`l00_lQ00008@000ol0000<0003o`0002h00_lA0003o`0003`000?o0000 3`02och000?o00002`000ol0000Q00008P02o`/000?o0000<@02o`h000?o0000?P000ol0000<00;o @@000ol000090003o`000280000T0003o`0000H00_lf00;o2P02od800_l:00;oA002o`L00_lU0000 9@000ol000040003o`0003P00_l70003o`0004@000?o00001@02odP000?o00000`000ol0000U0000 9P02o`<000?o0000>`02o`@000?o0000AP000ol0000200;oB`001Ol0003o02P0000X0003o`3o0400 0_l00`3o00190004o`3oodh000?o0?l0:@0002T000?o0000@@000ol0001:0003o`0004l000?o0000 :0000?l0>0000?l0>00001801?l200Go00<0ool00_l300?o0P04o`801Ol200?o0`03ob000ol200Go 00H0o`3o0?l200Co00<0ool00_lX00Co0P05o`030?oo00;o0`03o`801?l200Go0P03o`<00olT00Co 0P05o`030?oo00;o0`03o`801?l200Go0P03o`<00olD00005@001?l00?l20004o`00o`<000Co003o 0P001?l00?l40004o`00o`8000Go0000o`020004o`00oal000Co003o0`002ol0003o0?l0o`3o00P0 00?o0000:@001?l00?l20004o`00o`<000Co003o0P001?l00?l40004o`00o`8000Go0000o`020004 o`00obH000Co003o0P001?l00?l30004o`00o`8000Co003o10001?l00?l20005o`000?l00P001?l0 0?lC00004P04o`8000Co003o0P001Ol0003o008000?o00000`000ol0000200Co0P000ol000040003 o`00020000?o000010002_l0003o0?l0o`05o`030?oo00;o:004o`8000Co003o0P001Ol0003o0080 00?o00000`000ol0000200Co0P000ol000040003o`0002@01?l20004o`00o`8000Go0000o`020003 o`0000<000?o00000P04o`8000?o000010000ol0000D00004P000ol000030004o`00o`8000Go0000 o`020003o`0000<00_l60004o`00o`<000Co003o8P000ol00004000;o`000?l0o`3o0?l00`000ol0 o`0[0003o`0000<000Co003o0P001Ol0003o008000?o00000`02o`H000Co003o0`001?l00?lV0003 o`0000<000Co003o0P001Ol0003o008000?o00000`02o`H000Co003o0`001?l00?lF00004P04o`04 0?oo00;o0P04o`801?l200;o00<0ool00P03o`<01?l00`3oo`02oal01?l300;o0P06o`800ol200Co :004o`040?oo00;o0P04o`801?l200;o00<0ool00P03o`<01?l00`3oo`02ob@01?l0103oo`02o`80 1?l200Co0P02o`030?oo00800ol300Co00<0ool00_lD00007P000ol000040003o`0001D000?o0000 80000ol0001<0003o`0000@000?o00005@000ol0000`0003o`0000@000?o00005@000ol0000D0000 7@02o`H000?o00005@000ol0000P0003o`0000@000?o0000A002o`H000?o00005@000ol0000_00;o 1P000ol0000E0003o`0001@0003o03P0000Y00?o?P04od`01?m;00Co:P0002`01?ld00KoE006ocl0 1_l^0000<004obX01_mP00Ko<`06oc@0000d00Co8006of`01_lW00Ko>P0003P00olH00GoN005oad0 1Om00000>`04o`h01_n200Ko4@06odD0000o00Co1006ohh01_l500KoB`0004<01?nJ00GoD@000?l0 >0000?l0>0000?l0>00003L00ol200Go00H0o`3o0?l200Co00<0ool00_mj00Co0P05o`030?oo00;o 0`03o`801?l200Go0P03o`<00olm0000=`001?l00?l3000;o`000?l0o`3o0?l020000ol0001k0004 o`00o`8000Co003o0`001?l00?l20004o`00o`@000Co003o0P001Ol0003o008000Co003o?00003L0 00?o000010002_l0003o0?l0o`05o`030?oo00;oNP04o`8000Co003o0P001Ol0003o008000?o0000 0`000ol0000200Co0P000ol000040003o`0003d0000g0003o`0000@000_o0000o`3o0?l0o`030003 o`3o07d000?o00000`001?l00?l20005o`000?l00P000ol0000300;o1P001?l00?l30004o`00ocl0 000f00Co0`02o`801_l200?o0P04ogX01?l0103oo`02o`801?l200Co0P02o`030?oo00800ol300Co 00<0ool00_lm0000=`000ol0002N0003o`0000@000?o00005@000ol0000m0000=`000ol000040003 o`0009H00_l60003o`0001D000?o0000?@0004@01onC00KoD`0004/03?ml00_oF@0005L03OmU00[o I00006@03?m>00_oKP0007003?lh00[oN@0007`03OlQ00[oP`0008T03?l:00_oS@0009D02_nH0000 o`0h0000o`0h0000o`0h0000RP0:o`800_l300Go0P05o`030?oo00;oR`0008T000Go0000o`030003 o`0000800_l50005o`000?l00`000ol0o`2?0000R@001Ol0003o00<000Ko0000o`02o`@000Go0000 o`030003o`3o00CoR`0008T000Go0000o`030005o`000?l00P000ol000020005o`000?l00`000ol0 o`030003o`0008T0002:00Co0P02o`800_l200;o0P02o`@01?l200?oS00008d000?o00005@000ol0 002?0000S002o`<000?o00002@000ol0000400;oT@000?l0>0000?l0>0000?l0>0000?l0>0000?l0 >0000?l0>0000001\ \>"], ImageRangeCache->{{{0, 310}, {220, 0}} -> {-0.0250052, -0.0177815, 0.00338713, 0.00339397}, {{7.375, 302.562}, {214.75, 149.25}} -> {-16.3797, -7.17712, 0.105697, 0.109925}, {{7.375, 302.562}, { 70.6875, 5.1875}} -> {-17.0097, -23.013, 0.109762, 0.109924}}]}, Open]], Cell[TextData[{ StyleBox["FIGURE 4.", Evaluatable->False, PageBreakAbove->False, AspectRatioFixed->True, FontWeight->"Bold"], StyleBox[" The perturbation of ", Evaluatable->False, PageBreakAbove->False, AspectRatioFixed->True], StyleBox["Saul", Evaluatable->False, PageBreakAbove->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[" to produce ", Evaluatable->False, PageBreakAbove->False, AspectRatioFixed->True], StyleBox["Paul", Evaluatable->False, PageBreakAbove->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[".", Evaluatable->False, PageBreakAbove->False, AspectRatioFixed->True, FontSize->12] }], "Special1", Evaluatable->False, PageBreakAbove->False, AspectRatioFixed->True]}, Open]]}, Open]], Cell[CellGroupData[{Cell[TextData["Fitness & Selection"], "Section", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "\tHow does one judge the usefulness of an expression tree for solving a \ problem? In the problem outlined above, we have a set of observations or \ cases against which we can measure the performance of the program. "], "Text",\ Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[{ \(\(cases = {{1, 5}, {2, 31}, {3, 121}, {4, 341}, {5, 781}, {6, 1555}, { 7, 2801}, {8, 4681}}; \)\), \(\(x = \((Drop[#1, \(-1\)]&)\)/@cases; \)\), \(\(y = Last/@cases; \)\)}], "Input", AspectRatioFixed->True], Cell[TextData[{ StyleBox[ "The better the program does, the more fit it is and thus likely to survive \ to the next generation and/or mate with other individuals. What constitutes \ \[OpenCurlyQuote]better\[CloseCurlyQuote] depends on the problem, but most \ commonly, we want to minimize an error function. In this case the error is \ the ", Evaluatable->False, AspectRatioFixed->True], StyleBox["raw fitness", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox[ ". One could use the sum of absolute errors or the sum of squared errors \ over the fitness cases, and there is no compelling reason to choose one over \ the other. In the functions ", Evaluatable->False, AspectRatioFixed->True], StyleBox["SumAbs", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[" and ", Evaluatable->False, AspectRatioFixed->True], StyleBox["SumSqr", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[", the arguments ", Evaluatable->False, AspectRatioFixed->True], StyleBox["x", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[" and ", Evaluatable->False, AspectRatioFixed->True], StyleBox["y", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[ " are the independent and dependent values of the fitness cases, ", Evaluatable->False, AspectRatioFixed->True], StyleBox["vars", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[ " is the list of variables or terminals that correspond to the columns in ", Evaluatable->False, AspectRatioFixed->True], StyleBox["x", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[", and ", Evaluatable->False, AspectRatioFixed->True], StyleBox["expr", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[" is an expression. ", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(SumAbs[x_, y_, vars_, expr_] := Module[{f}, f = Function[vars, Evaluate[Eval[expr]]]; N[Plus@@Abs[y - Apply[f, x, {1}]]]]\)], "Input", AspectRatioFixed->True], Cell[BoxData[ \(SumSqr[x_, y_, vars_, expr_] := Module[{f, d}, f = Function[vars, Evaluate[Eval[expr]]]; d = N[y - Apply[f, x, {1}]]; d . d]\)], "Input", AspectRatioFixed->True], Cell[BoxData[{ \(\(funcs = {{plus, 2}, {subtract, 2}, {times, 2}, {divide, 2}}; \)\), \(\(terms = {i, 1, 2, 3, 4}; \)\), \(\(vars = {i}; \)\)}], "Input", AspectRatioFixed->True], Cell[BoxData[ \(\(pop = makePop[funcs, terms, 10, 6]; \)\)], "Input", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(\(pop = {times[subtract[3, 4], plus[i, 3]], times[divide[i, 2], divide[4, 3]], plus[times[plus[3, 3], divide[4, 2]], plus[divide[i, i], times[2, 4]]], subtract[divide[3, plus[4, i]], divide[divide[i, 4], 2]], plus[subtract[subtract[plus[3, 1], times[i, 2]], divide[plus[2, 4], divide[3, 3]]], subtract[divide[divide[4, i], plus[2, 3]], plus[times[4, 1], times[1, i]]]], times[divide[subtract[4, 2], 3], times[times[divide[1, 4], 1], 1]], divide[subtract[ times[subtract[times[i, 4], divide[4, i]], times[plus[4, 4], subtract[1, 3]]], divide[times[subtract[4, 3], divide[2, 2]], subtract[divide[i, 2], subtract[i, 2]]]], subtract[ times[times[divide[1, i], subtract[3, 4]], times[subtract[4, 2], subtract[i, 4]]], subtract[divide[divide[3, 3], subtract[i, 1]], plus[divide[3, 1], subtract[i, i]]]]], plus[times[times[i, 2], plus[subtract[2, plus[1, 2]], times[3, plus[3, i]]]], 3], plus[divide[ subtract[ subtract[subtract[subtract[1, 2], times[1, i]], subtract[divide[i, i], plus[2, i]]], subtract[plus[subtract[i, 2], subtract[i, 1]], divide[times[i, 3], subtract[2, 3]]]], divide[times[times[times[4, 1], subtract[2, i]], subtract[divide[1, i], times[i, i]]], times[times[plus[1, 2], plus[2, 4]], subtract[subtract[4, 2], plus[3, 4]]]]], subtract[ plus[times[times[divide[2, 3], divide[4, i]], times[subtract[3, i], divide[1, i]]], plus[divide[plus[2, 2], divide[2, 4]], times[times[4, 3], subtract[1, 3]]]], divide[divide[divide[divide[1, i], plus[1, 4]], plus[plus[4, 1], divide[4, 2]]], plus[plus[plus[2, 4], subtract[4, 3]], times[subtract[i, 4], divide[i, i]]]]]], times[4, subtract[i, times[plus[subtract[4, i], 2], subtract[1, divide[times[1, 2], 2]]]]]}; \)\)], "Input", CellOpen->False, AspectRatioFixed->True, FontColor->RGBColor[1, 0, 0]], Cell[TextData[{ StyleBox["The list of raw fitnesses is obtained by mapping ", Evaluatable->False, AspectRatioFixed->True], StyleBox["sumAbs", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[" onto the population.", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{Cell[BoxData[ \(rawFit = \((SumAbs[x, y, vars, #1]&)\)/@pop\)], "Input", AspectRatioFixed->True], Cell[BoxData[ \({10376. , 10292. , 10180. , 10317.44036796537, 10469.82571428571, 10314.66666666667, 3.458764513820552\ 10\^18, 8588. , 1.844674407370956\ 10\^19, 10172. }\)], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[TextData[ "One should be aware that it is always possible to minimize error by adding \ more adjustable parameters to the fitting function, and we have done nothing \ to protect against this so-called overfitting. One could build parsimony into \ the fitness function by inflating the error proportional to the number of \ terminals and/or functions in the expression tree, however, it has been shown \ [Koza 1992, pp. 612-4] that penalizing the fitness by the expression size \ seriously degrades performance. Therefore, it is more convenient to enforce \ parsimony via the genetic operators and algebraic simplification, as \ described above."], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[{ StyleBox[ "Depending on the problem, we may want to either minimize or maximize the \ raw fitness. To simplify things, the raw fitness is converted to ", Evaluatable->False, AspectRatioFixed->True], StyleBox["standardized fitness", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox[ ", which is always minimized. When raw fitness is error, then this \ definition suffices.", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(standardizedFit[rawfit_] := rawfit\)], "Input", AspectRatioFixed->True], Cell[CellGroupData[{Cell[BoxData[ \(standFit = standardizedFit[rawFit]\)], "Input", AspectRatioFixed->True], Cell[BoxData[ \({10376. , 10292. , 10180. , 10317.44036796537, 10469.82571428571, 10314.66666666667, 3.458764513820552\ 10\^18, 8588. , 1.844674407370956\ 10\^19, 10172. }\)], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[TextData[{ StyleBox[ "When the raw fitness is a score, as in a game, which should be maximized, \ then the following definitions may be appropriate. If there is no theoretical \ upper bound to the score, ", Evaluatable->False, AspectRatioFixed->True], StyleBox["maxScore", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[ " may be set to some practical value or simply the maximum value of the \ population's raw fitness.", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[{ \(standardizedFit[rawfit_] := maxScore - rawfit\), \(standardizedFit[rawfit_] := Max[rawfit] - rawfit\)}], "Input", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[{ StyleBox["Finally, the standardized fitnesses are inverted to give the ", Evaluatable->False, AspectRatioFixed->True], StyleBox["adjusted fitness", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox[".", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(adjustedFit[standfit_] := 1\/\(1 + standfit\)\)], "Input", AspectRatioFixed->True], Cell[CellGroupData[{Cell[BoxData[ \(adjFit = adjustedFit[standFit]\)], "Input", AspectRatioFixed->True], Cell[BoxData[ \({0.0000963669654042594, 0.0000971534052268532, 0.0000982221785679206, 0.0000969138711218994, 0.0000955034519040523, 0.0000969399295569845, 2.891205793294669\/10\^19, 0.000116427989288625, 5.421010862427522\/10\^20, 0.0000982994200334218}\)], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[TextData[{ StyleBox[ "The adjusted fitness is used to determine the likelihood an individual is \ selected for input to a genetic operator. The following example shows that it \ is not necessary to convert adjusted fitness to ", Evaluatable->False, AspectRatioFixed->True], StyleBox["normalized fitness", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox[ " (Koza 1992, pp. 97-8). Adjusted fitness is used directly by the function \ ", Evaluatable->False, AspectRatioFixed->True], StyleBox["selectOne", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[ " (defined below). The last column in the table shows that the probability \ of selection is indeed the same as the normalized fitness.", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{Cell[BoxData[{ \(\(af = Table[Random[], {naf = 20}]; \)\), \(\(cumSum = Rest[FoldList[Plus, 0, af]]; \)\), \(\(t = Table[selectOne[cumSum], {n = 10000}]; \)\), \(\(c = N[CategoryCounts[t, Range[naf]]\/n]; \)\), \(TableForm[Transpose[{af, af\/Last[cumSum], c}], TableHeadings \[Rule] { None, {"\", "\", "\"}}, TableSpacing \[Rule] {0, 3}]\)}], "Input", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ TagBox[GridBox[{ {\("adjusted\nfitness"\), \("normalized\nfitness"\), \("probabili ty\nselected"\)}, {"0.3932170542581287", "0.04213092435449185", "0.0397"}, {"0.7192377824800739", "0.07706215251454608", "0.0836"}, {"0.95458983835143", "0.1022787588524826", "0.1073"}, {"0.4186278589325298", "0.04485354454080039", "0.0485"}, {"0.6407742041866314", "0.0686552356581533", "0.06700000000000001"}, {"0.3027306679416267", "0.03243583342257796", "0.029"}, {"0.5313095860296926", "0.05692673737171871", "0.0559"}, {"0.894683467427785", "0.09586013902304", "0.091"}, {"0.1038014129757395", "0.01112171873170947", "0.0107"}, {"0.6784519764690828", "0.07269219020192973", "0.0769"}, {"0.5597867647458842", "0.05997790173330721", "0.0561"}, {"0.5606182340832149", "0.06006698884531013", "0.05709999999999999"}, {"0.1760661250229273", "0.01886446306029238", "0.0179"}, {"0.7072079134529787", "0.07577322189343859", "0.07700000000000001"}, {"0.002655515756317965", "0.0002845230954254335", "0.0001"}, {"0.2818582611634028", "0.03019947622100994", "0.0289"}, {"0.4049853850933641", "0.04339183267682636", "0.0431"}, {"0.5842771470923008", "0.06260190401112329", "0.0618"}, {"0.0958079905957808", "0.01026526993332528", "0.0104"}, {"0.322529691633594", "0.03455718385849137", "0.038"} }, RowSpacings->0, ColumnSpacings->3, RowAlignments->Baseline, ColumnAlignments->{Left}], (TableForm[ #, TableHeadings -> {None, {"adjusted\nfitness", "normalized\nfitness", "probabili ty\nselected"}}, TableSpacing -> {0, 3}]&)]], "Output", Evaluatable->False, LineSpacing->{1.25, 0}, AspectRatioFixed->True]}, Open]], Cell[TextData[{ StyleBox["There are three main types of selection. In ", Evaluatable->False, AspectRatioFixed->True], StyleBox["fitness proportionate", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox[ " selection the probability of selection is directly proportional to the \ relative fitness. This method is also known as roulette wheel selection. It \ is most easily accomplished by using a list of cumulative sums of adjusted \ fitnesses [Freeman 1993].", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{Cell[BoxData[ \(cumSum = Rest[FoldList[Plus, 0, adjFit]]\)], "Input", AspectRatioFixed->True], Cell[BoxData[ \({0.0000963669654042594, 0.0001935203706311126, 0.0002917425491990332, 0.0003886564203209326, 0.0004841598722249849, 0.0005810998017819696, 0.0005810998017819698, 0.0006975277910705948, 0.0006975277910705948, 0.0007958272111040166}\)], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[TextData[{ StyleBox[ "Selection is then done by generating a random number between 0 and the \ final cumulative sum, and finding the position of first cumulant that exceeds \ it. ", Evaluatable->False, AspectRatioFixed->True], StyleBox["selectOne", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[" returns the index of the selected individual.", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(selectOne[list_] := Module[{r = Random[]\ Last[list]}, \(Position[list, _?\((#1 \[GreaterEqual] r&)\), {1}, 1] \)\[LeftDoubleBracket]1, 1\[RightDoubleBracket]]\)], "Input", AspectRatioFixed->True], Cell[CellGroupData[{Cell[BoxData[ \(selectOne[cumSum]\)], "Input", AspectRatioFixed->True], Cell[BoxData[ \(6\)], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[BoxData[ \(pop\[LeftDoubleBracket]%\[RightDoubleBracket]\)], "Input", AspectRatioFixed->True], Cell[BoxData[ \(times[divide[subtract[4, 2], 3], divide[1, 4]]\)], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[TextData[{ StyleBox["While this definition of ", Evaluatable->False, AspectRatioFixed->True], StyleBox["selectOne", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[ " is an example of functional programming, it is not very fast because each \ element of the list of cumulative fitnesses must be examined in turn until \ one matches the pattern. The algorithm is of order ", Evaluatable->False, AspectRatioFixed->True], StyleBox["O", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox["(", Evaluatable->False, AspectRatioFixed->True], StyleBox["n", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox[ "). Because the list is nondecreasing, we can use a more efficient binary \ search algorithm of order ", Evaluatable->False, AspectRatioFixed->True], StyleBox["O", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox["(log", Evaluatable->False, AspectRatioFixed->True], StyleBox["2", Evaluatable->False, AspectRatioFixed->True, FontSize->12, FontVariations->{"CompatibilityType"->"Subscript"}], StyleBox[" ", Evaluatable->False, AspectRatioFixed->True], StyleBox["n", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox[ "). The procedural binary search version shown below is more than 3 times \ faster for a list of 500 elements.", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[{ \(\(fit = Table[Random[], {500}]; \)\), \(\(cumSum = Rest[FoldList[Plus, 0, fit]]; \)\)}], "Input", AspectRatioFixed->True], Cell[CellGroupData[{Cell[BoxData[{ \(\(rs = $RandomState; \)\), \(t1 = First[Timing[Table[selectOne[cumSum], {100}]]]\)}], "Input", AspectRatioFixed->True], Cell[BoxData[ \(5.620000000000005\ Second\)], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[BoxData[{ \(\(Clear[selectOne]; \)\), \(selectOne[list_] := Module[{lo = 1, hi = Length[list], mid, r = Random[]\ Last[list]}, While[lo \[NotEqual] hi - 1, mid = Round[\(lo + hi\)\/2]; If[r < list\[LeftDoubleBracket]mid\[RightDoubleBracket], hi = mid, lo = mid]]; If[r \[LessEqual] list\[LeftDoubleBracket]lo\[RightDoubleBracket], lo, hi]]\)}], "Input", AspectRatioFixed->True], Cell[CellGroupData[{Cell[BoxData[{ \(\($RandomState = rs; \)\), \(t2 = First[Timing[Table[selectOne[cumSum], {100}]]]\)}], "Input", AspectRatioFixed->True], Cell[BoxData[ \(1.590000000000003\ Second\)], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[BoxData[ \(t1\/t2\)], "Input", AspectRatioFixed->True], Cell[BoxData[ \(3.534591194968549\)], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[TextData[{ StyleBox["Rank ", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox[ "selection is closely related to fitness proportionate selection. In this \ method, the probability of selection is proportional to only the rank, or \ order, of the adjusted fitness and not the actual magnitude. It would be used \ when one wants to enhance the distinction between individuals that are nearly \ equally fit. The function ", Evaluatable->False, AspectRatioFixed->True], StyleBox["rankedFit", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[ " takes a list of adjusted fitnesses and returns their ranks (where 1 is \ low and ties are allowed).", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(toRank[adjFit_] := Module[{f = adjFit \[Union] \((SameTest \[Rule] SameQ)\), c, r = Range[Length[adjFit]], g, b, nr}, c = CategoryCounts[f, adjFit]; g = \((\((b = Take[r, #1]; r = Drop[r, #1]; b)\)&)\)/@c; nr = \((Plus@@#1\/Length[#1]&)\)/@g; nr\[LeftDoubleBracket]Flatten[\((Position[f, #1]&)\)/@adjFit] \[RightDoubleBracket]]\)], "Input", AspectRatioFixed->True], Cell[CellGroupData[{Cell[BoxData[ \(N[toRank[adjFit]]\)], "Input", AspectRatioFixed->True], Cell[BoxData[ \({4. , 7. , 8. , 5. , 3. , 6. , 2. , 10. , 1. , 9. }\)], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[TextData[{ StyleBox[ "The cumulative sum of ranks would then be used in place of the cumulative \ sum of adjusted fitnesses in ", Evaluatable->False, AspectRatioFixed->True], StyleBox["selectOne", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[".", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{Cell[BoxData[ \(cumSum = Rest[FoldList[Plus, 0, %]]\)], "Input", AspectRatioFixed->True], Cell[BoxData[ \({4. , 11. , 19. , 24. , 27. , 33. , 35. , 45. , 46. , 55. }\)], "Output",\ Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[TextData[{ StyleBox["The third method of selection is ", Evaluatable->False, AspectRatioFixed->True], StyleBox["tournament ", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox[ "selection. Here, two or more individuals are drawn at random from the \ population and the most fit one is selected.", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[TextData["Putting it all together"], "Section", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[{ StyleBox["Before we present the synthesis of ", Evaluatable->False, AspectRatioFixed->True], StyleBox["geneticProgram", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[ ", we need to define a success predicate that returns true when an optimal \ or, depending on the problem, near-optimal solution is found. When the raw \ fitness is error, then a perfect solution would have zero error, otherwise we \ might be willing to accept an error below a predefined threshold, as shown in \ this example:", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(successQ[rawfit_] := Position[rawfit, _?\((#1 < 0.5&)\)] \[NotEqual] {}\)], "Input", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[{ StyleBox["We would like ", Evaluatable->False, AspectRatioFixed->True], StyleBox["GeneticProgram", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[ " to be as generic as possible so that it can be used in many problem \ domains without the need of alteration. The number of required arguments \ should be kept to a minimum, so we have made liberal use of options.", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(\(Options[GeneticProgram] = {PopulationSize \[Rule] 500, MaxGenerations \[Rule] 50, GeneticOpers \[Rule] {{CrossOver, 2, .85}, {Reproduce, 1, .01}, {Mutate, 1, .01}, {Perturb, 1, .13}}, MaxDepthInitial \[Rule] 6, MaxDepthCreated \[Rule] 16, Selection \[Rule] Roulette, FitnessFunction \[Rule] SumAbs}; \)\)], "Input", AspectRatioFixed->True], Cell[TextData[{ StyleBox["LISTING 1.", Evaluatable->False, PageBreakAbove->False, AspectRatioFixed->True, FontWeight->"Bold"], StyleBox[" The options for ", Evaluatable->False, PageBreakAbove->False, AspectRatioFixed->True], StyleBox["GeneticProgram", Evaluatable->False, PageBreakAbove->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[".", Evaluatable->False, PageBreakAbove->False, AspectRatioFixed->True, FontSize->12] }], "Special1", Evaluatable->False, PageBreakAbove->False, AspectRatioFixed->True], Cell[BoxData[{ \(GeneticProgram[fitCases_, vars_, funcs_, terms_, standardFit_, successQ_, options___] := Module[{popSize, maxGen, genOpers, cumProb, maxInitial, maxCreated, optlist, result, pop, g, selection, x, y, rawFit, adjFit, cumSum, p, newPop, i, j, k, np, op, parents, children, bGen, bRun}, optlist = Flatten[{options}]; popSize = \(PopulationSize /. optlist\) /. Options[GeneticProgram]; maxGen = \(MaxGenerations /. optlist\) /. Options[GeneticProgram]; maxInitial = \(MaxDepthInitial /. optlist\) /. Options[GeneticProgram]; maxCreated = \(MaxDepthCreated /. optlist\) /. Options[GeneticProgram]; genOpers = \(GeneticOpers /. optlist\) /. Options[GeneticProgram]; cumProb = Rest[FoldList[Plus, 0, Apply[#3\/#2&, genOpers, {1}]]]; genOpers = \((Drop[#1, \(-1\)]&)\)/@genOpers; genOpers = genOpers /. {Reproduce \[Rule] \((#1&)\), Mutate \[Rule] \(({Mutate[Sequence@@#1, funcs, terms, maxCreated]}&)\), CrossOver \[Rule] \((CrossOver[#1, maxCreated]&)\), Perturb \[Rule] \(({Perturb[Sequence@@#1]}&)\)}; selection = \(Selection /. optlist\) /. Options[GeneticProgram]; fit = \(FitnessFunction /. optlist\) /. Options[GeneticProgram]; x = \((Drop[#1, \(-1\)]&)\)/@fitCases; y = Last/@fitCases; pop = makePop[funcs, terms, popSize, maxInitial]; g = 0; rawFit = \((fit[x, y, vars, #1]&)\)/@pop; adjFit = \((1\/\(1 + #1\)&)\)/@standardFit[rawFit]; p = \(Position[adjFit, Max[adjFit]]\)\[LeftDoubleBracket]1, 1 \[RightDoubleBracket]; bGen = {{rawFit\[LeftDoubleBracket]p\[RightDoubleBracket], pop\[LeftDoubleBracket]p\[RightDoubleBracket]}}; bRun = {adjFit\[LeftDoubleBracket]p\[RightDoubleBracket], rawFit\[LeftDoubleBracket]p\[RightDoubleBracket], pop\[LeftDoubleBracket]p\[RightDoubleBracket]}; Print["\", g, "\<, bestOfRun = \>", rawFit\[LeftDoubleBracket]p\[RightDoubleBracket], "\<, bestOfGen = \>", rawFit\[LeftDoubleBracket]p\[RightDoubleBracket]]; While[g < maxGen && \(\[InvisibleSpace]! \((successQ[rawFit])\)\), cumSum = Which[selection === Roulette, Rest[FoldList[Plus, 0, adjFit]], selection === Rank, Rest[FoldList[Plus, 0, toRank[adjFit]]]]; newPop = Table[Null, {popSize}]; i = 0; While[i < popSize, {op, np} = genOpers\[LeftDoubleBracket]selectOne[cumProb] \[RightDoubleBracket]; p = Table[selectOne[cumSum], {np}]; parents = pop\[LeftDoubleBracket]p\[RightDoubleBracket]; children = op[parents]; For[j = 1, j \[LessEqual] np && i < popSize, \(j++\), newPop\[LeftDoubleBracket]\(++i\)\[RightDoubleBracket] = children\[LeftDoubleBracket]j\[RightDoubleBracket]]; ]; pop = newPop; \(g++\); rawFit = \((fit[x, y, vars, #1]&)\)/@pop; adjFit = 1\/\(1 + standardFit[rawFit]\); p = \(Position[adjFit, Max[adjFit]]\)\[LeftDoubleBracket]1, 1 \[RightDoubleBracket]; AppendTo[ bGen, {rawFit\[LeftDoubleBracket]p\[RightDoubleBracket], pop\[LeftDoubleBracket]p\[RightDoubleBracket]}]; If[adjFit\[LeftDoubleBracket]p\[RightDoubleBracket] > First[bRun], bRun = {adjFit\[LeftDoubleBracket]p\[RightDoubleBracket], rawFit\[LeftDoubleBracket]p\[RightDoubleBracket], pop\[LeftDoubleBracket]p\[RightDoubleBracket]}]; If[Mod[g, 5] == 0, Print["\", g, "\<, bestOfRun = \>", bRun\[LeftDoubleBracket]2\[RightDoubleBracket], "\<, bestOfGen = \>", rawFit\[LeftDoubleBracket]p\[RightDoubleBracket]]]; ]; If[Mod[g, 5] \[NotEqual] 0, Print["\", g, "\<, bestOfRun = \>", bRun\[LeftDoubleBracket]2\[RightDoubleBracket], "\<, bestOfGen = \>", rawFit\[LeftDoubleBracket]p\[RightDoubleBracket]]]; { BestOfRun \[Rule] Rest[bRun], BestOfGen \[Rule] bGen, FinalFit \[Rule] rawFit, FinalPop \[Rule] pop}]\), \(\(Attributes[GeneticProgram] = {HoldAll}; \)\)}], "Input", AspectRatioFixed->True], Cell[TextData[{ StyleBox["LISTING 2.", Evaluatable->False, PageBreakAbove->False, AspectRatioFixed->True, FontWeight->"Bold"], StyleBox[" ", Evaluatable->False, PageBreakAbove->False, AspectRatioFixed->True] }], "Special1", Evaluatable->False, PageBreakAbove->False, AspectRatioFixed->True], Cell[TextData[{ StyleBox["Two interesting features of ", Evaluatable->False, AspectRatioFixed->True], StyleBox["GeneticProgram", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[ " should be pointed out. First, the genetic operators, their numbers of \ input expressions, and their relative frequencies are kept in a list, much \ the same way as the set of functions. This allows us to draw any one of them \ at random and apply it to the appropriate number of individuals drawn from \ the population. Second, the asexual genetic operators return a single \ expression, whereas the sexual one (crossover) returns a list of expressions. \ One of the great strengths of ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Mathematica", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox[ " is its ability to be customized on the fly. Thus we are able to recast ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Mutate", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[" and ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Perturb", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[" to return a list of one, and define ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Reproduce", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[" with the following snippet of code:", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(\(genOpers = GenOpers /. {Reproduce \[Rule] \((#1&)\), Mutate \[Rule] \(({Mutate[Sequence@@#1, funcs, terms, maxCreated]}&)\), CrossOver \[Rule] \((CrossOver[#1, maxCreated]&)\), Perturb \[Rule] \(({Perturb[Sequence@@#1]}&)\)}; \)\)], "Input", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "The relative frequencies for the genetic operators do not indicate the \ frequency with which they are invoked, but rather the frequency with which \ new individuals are created from the operations. Therefore, to obtain the \ necessary probability of using an operator, the relative frequency is divided \ by the number of parents (which is the same as the number of offspring \ produced). "], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[{ StyleBox["The result returned by ", Evaluatable->False, AspectRatioFixed->True], StyleBox["GeneticProgram", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[" is a list of replacement rules. ", Evaluatable->False, AspectRatioFixed->True], StyleBox["BestOfRun", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[ " is a couplet of the raw fitness and the expression for the best \ individual found during the entire course of the run. ", Evaluatable->False, AspectRatioFixed->True], StyleBox["BestOfGen", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[ " is a list of couplets of the raw fitness and the expression for the best \ individual found at each generation of the run. ", Evaluatable->False, AspectRatioFixed->True], StyleBox["FinalFit", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[" is a list of the raw fitnesses for the final population, and ", Evaluatable->False, AspectRatioFixed->True], StyleBox["FinalPop", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[ " is the corresponding list of expressions. In many of the problems we \ encounter in medicinal chemistry, there is no one correct answer, so we \ prefer to look at an ensemble of good answers.", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[TextData["Trying It Out"], "Section", Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{Cell[TextData["Finding some solutions"], "Subsection", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "So, back to the problem: finding an expression for our series 5, 31, 121, \ 341, 781, 1555, 2801, 4681. Here is the list of the eight observations:"], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(\(cases = {{1, 5}, {2, 31}, {3, 121}, {4, 341}, {5, 781}, {6, 1555}, { 7, 2801}, {8, 4681}}; \)\)], "Input", AspectRatioFixed->True], Cell[TextData[ "The function set contains just the four arithmetic functions; nothing in the \ data warrants the use of trigonometric functions or logarithms."], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[{ \(\(funcs = {{plus, 2}, {subtract, 2}, {times, 2}, {divide, 2}}; \)\), \(terms := {i, Random[Integer, \(-3\), 3]}\)}], "Input", AspectRatioFixed->True], Cell[TextData[ "Standardized fitness is the same as raw fitness, and the success predicate \ will be a perfect fit."], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(standardizeFit[rawFit_] := rawFit\)], "Input", AspectRatioFixed->True], Cell[BoxData[ \(successQ[rawFit_] := Position[Chop[rawFit], 0] \[NotEqual] {}\)], "Input", AspectRatioFixed->True], Cell[TextData[ "We will use a population size of 500, a typical value. This number may seem \ rather high for such a simple problem, but it is required to allow the \ population to maintain the necessary diversity. It is difficult, however, to \ predict how the population size scales with the complexity of the problem. \ Suffice it to say here that we have solved a 3-variable problem with the same \ population size."], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(\($RandomState = 237764531722971666468549632958215741574142595365515512858561683494814414\ 620358026473816197073500967434695681164333620211668533602408626784773256890632\ 463126609491760662265551166647452642040412088526176271167140053197316328874016\ 538820278137762891521494267970218642877864737357129160238619145090686333149272\ 015341548726507910001755682468871795134115364293722258275260837874223612133862\ 724833862000430328464160451043563446027703208920656325907280288354075227732168\ 744396984530975357358629574421856537872591805479351726258673210852609181927929\ 9192809795573413387; \)\)], "Input", CellOpen->False, AspectRatioFixed->True, FontColor->RGBColor[1, 0, 0]], Cell[CellGroupData[{Cell[BoxData[ \(\(result = GeneticProgram[cases, {i}, funcs, terms, standardizeFit, successQ, FitnessFunction \[Rule] SumSqr, PopulationSize \[Rule] 500, MaxGenerations \[Rule] 50]; \)\)], "Input", AspectRatioFixed->True], Cell[TextData[ "g = 0, bestOfRun = 732572., bestOfGen = 732572.\ng = 5, bestOfRun = 1.52742, \ bestOfGen = 1.52742\ng = 10, bestOfRun = 1.52742, bestOfGen = 1.52742\ng = \ 15, bestOfRun = 1.52742, bestOfGen = 1.52742\ng = 18, bestOfRun = 0, \ bestOfGen = 0"], "Print", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[TextData["Here is the best fitting expression and its depth:"], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{Cell[BoxData[ \(b = BestOfRun /. result\)], "Input", AspectRatioFixed->True], Cell[BoxData[ \({0, times[plus[subtract[i, \(-1\)], times[i, i]], subtract[ subtract[times[i, i], times[0, subtract[subtract[i, times[i, i, i]], subtract[i, times[\(-1\), i]]]]], subtract[divide[\(-1\), i], divide[\(-1\), times[i, plus[subtract[i, \(-1\)], times[i, i]]]]]]]}\)], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[BoxData[ \(DepthExpression[Last[b]]\)], "Input", AspectRatioFixed->True], Cell[BoxData[ \(7\)], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[BoxData[ \(\(DrawExpression[Last[b], AspectRatio \[Rule] 210\/480]; \)\)], "Input",\ Evaluatable->False, CellOpen->False, AspectRatioFixed->True], Cell[GraphicsData["PostScript", "\<\ %! %%Creator: Mathematica %%AspectRatio: .4375 MathPictureStart %% Graphics /Courier findfont 10 scalefont setfont % Scaling calculations 0.506494 0.012987 0.401042 0.0260417 [ [ 0 0 0 0 ] [ 1 .4375 0 0 ] ] MathScale % Start of Graphics 1 setlinecap 1 setlinejoin newpath [ ] 0 setdash 0 g p P 0 0 m 1 0 L 1 .4375 L 0 .4375 L closepath clip newpath p [(times)] .50649 .40104 0 0 Mshowa .004 w .50649 .38542 m .1039 .36458 L s .50649 .38542 m .61039 .36458 L s p [(plus)] .1039 .34896 0 0 Mshowa .1039 .33333 m .06494 .3125 L s .1039 .33333 m .16234 .3125 L s p [(subtract)] .06494 .29688 0 0 Mshowa .06494 .28125 m .04545 .26042 L s .06494 .28125 m .07792 .26042 L s [(i)] .04545 .24479 0 0 Mshowa [(-1)] .07792 .24479 0 0 Mshowa P p [(times)] .16234 .29688 0 0 Mshowa .16234 .28125 m .14935 .26042 L s .16234 .28125 m .17532 .26042 L s [(i)] .14935 .24479 0 0 Mshowa [(i)] .17532 .24479 0 0 Mshowa P P p [(subtract)] .61039 .34896 0 0 Mshowa .61039 .33333 m .40909 .3125 L s .61039 .33333 m .80519 .3125 L s p [(subtract)] .40909 .29688 0 0 Mshowa .40909 .28125 m .25974 .26042 L s .40909 .28125 m .44805 .26042 L s p [(times)] .25974 .24479 0 0 Mshowa .25974 .22917 m .24675 .20833 L s .25974 .22917 m .27273 .20833 L s [(i)] .24675 .19271 0 0 Mshowa [(i)] .27273 .19271 0 0 Mshowa P p [(times)] .44805 .24479 0 0 Mshowa .44805 .22917 m .31818 .20833 L s .44805 .22917 m .46104 .20833 L s [(0)] .31818 .19271 0 0 Mshowa p [(subtract)] .46104 .19271 0 0 Mshowa .46104 .17708 m .4026 .15625 L s .46104 .17708 m .52597 .15625 L s p [(subtract)] .4026 .14063 0 0 Mshowa .4026 .125 m .35714 .10417 L s .4026 .125 m .41558 .10417 L s [(i)] .35714 .08854 0 0 Mshowa p [(times)] .41558 .08854 0 0 Mshowa .41558 .07292 m .38961 .05208 L s .41558 .07292 m .41558 .05208 L s .41558 .07292 m .44156 .05208 L s [(i)] .38961 .03646 0 0 Mshowa [(i)] .41558 .03646 0 0 Mshowa [(i)] .44156 .03646 0 0 Mshowa P P p [(subtract)] .52597 .14063 0 0 Mshowa .52597 .125 m .48701 .10417 L s .52597 .125 m .53896 .10417 L s [(i)] .48701 .08854 0 0 Mshowa p [(times)] .53896 .08854 0 0 Mshowa .53896 .07292 m .52597 .05208 L s .53896 .07292 m .55844 .05208 L s [(-1)] .52597 .03646 0 0 Mshowa [(i)] .55844 .03646 0 0 Mshowa P P P P P p [(subtract)] .80519 .29688 0 0 Mshowa .80519 .28125 m .65584 .26042 L s .80519 .28125 m .85065 .26042 L s p [(divide)] .65584 .24479 0 0 Mshowa .65584 .22917 m .64286 .20833 L s .65584 .22917 m .67532 .20833 L s [(-1)] .64286 .19271 0 0 Mshowa [(i)] .67532 .19271 0 0 Mshowa P p [(divide)] .85065 .24479 0 0 Mshowa .85065 .22917 m .72727 .20833 L s .85065 .22917 m .87013 .20833 L s [(-1)] .72727 .19271 0 0 Mshowa p [(times)] .87013 .19271 0 0 Mshowa .87013 .17708 m .76623 .15625 L s .87013 .17708 m .88312 .15625 L s [(i)] .76623 .14063 0 0 Mshowa p [(plus)] .88312 .14063 0 0 Mshowa .88312 .125 m .84416 .10417 L s .88312 .125 m .94156 .10417 L s p [(subtract)] .84416 .08854 0 0 Mshowa .84416 .07292 m .82468 .05208 L s .84416 .07292 m .85714 .05208 L s [(i)] .82468 .03646 0 0 Mshowa [(-1)] .85714 .03646 0 0 Mshowa P p [(times)] .94156 .08854 0 0 Mshowa .94156 .07292 m .92857 .05208 L s .94156 .07292 m .95455 .05208 L s [(i)] .92857 .03646 0 0 Mshowa [(i)] .95455 .03646 0 0 Mshowa P P P P P P P % End of Graphics MathPictureEnd \ \>"], "Graphics", Evaluatable->False, AspectRatioFixed->False, ImageSize->{480, 210}, ImageMargins->{{34, Inherited}, {Inherited, Inherited}}, RenderingOptions->{"RenderThickness"->False}, ImageCache->GraphicsData["Bitmap", "\<\ CF5dJ6E]HGAYHf4PAg9QL6QYHggYjN[Vi^OShn03ooeGooj[ooonICXf=SLcII03=Voc=Vc3=V VC=VIS=V0003o`0001d000?o00002P000ol0 000D0000^P000ol0000:0003o`0000T000?o00008005o`8000?o00002`000ol0001m0003o`0000L0 1Ol20003o`0001d000?o00002P000ol0000D0000^P000ol0000:0003o`0000T000?o00009`000ol0 000;0003o`0007d000?o00003P000ol0000M0003o`0000X000?o000050000;T00_l;00;o2P02obT0 00?o00002P02ogh00_l@0003o`0001`00_l;00;o5P000?`00_nM00;o@`000;X000?o00002P000ol0 00090003o`0003D000?o0000O@000ol0000^0003o`0000X000?o000050000?l0h@000?l0h@000;X0 0_l;0003o`0000P00_lW0003o`0000d000?o0000O@000ol0000<0003o`0001l000?o00002P000ol0 000D0000_0000ol000080003o`0000L000?o00009`000ol0000=0003o`0007d000?o000030000ol0 000O0003o`0000X000?o000050000;d000?o00001`000ol000060003o`0002T000?o00002`000ol0 001o0003o`0000X000?o00008@000ol000080003o`0001D0002n00;o1`000ol000050003o`0002/0 00?o00002@000ol000210003o`0000P000?o00008`000ol000060003o`0001H000300003o`0000@0 00?o000010000ol0000/0003o`0000P000?o0000P`000ol000070003o`0002<000?o00001P000ol0 000F0000`@000ol000030003o`0000800_l`0003o`0000H000?o0000Q@000ol000050003o`0002D0 00?o000010000ol0000G0000`P000ol000020005o`000?l0<`000ol000040003o`0008L000?o0000 10000ol0000V0003o`0000<000?o00005`000<<00_l20004o`00ocD000?o00000P000ol000290003 o`00008000?o0000:0001Ol0003o01X000350005o`3o0?l0=P001Ol0003o08d000Co003o:`001?l0 0?lK0000aP03ocP000?o0?l0S`000ol0o`0/0003o`3o01/000370003o`0003P000?o0000S`000ol0 000/0003o`0001X0003o0>40003o0>40003o0>40003o0>40003o0>40002Y00Go3003o`801Ol01P3o 0?l0o`801?l00`3oo`02oa801Ol900?o0P05o`060?l0o`3o0P04o`030?oo00;oK@04o`801Ol00`3o o`02o`<00ol200Co0P05o`800ol300?o2`03o`801Ol01P3o0?l0o`801?l00`3oo`02o`l0002[0003 o`0000`000Co003o0`002ol0003o0?l0o`3o00P000?o00004P000ol000090004o`00o`<000_o0000 o`3o0?l0o`080003o`0006h000Co003o0P001?l00?l30004o`00o`8000Co003o10001?l00?l20005 o`000?l00P001?l00?l:0004o`00o`<000_o0000o`3o0?l0o`080003o`0000d0002[0003o`0000`0 00?o000010002_l0003o0?l0o`05o`030?oo00;o50000ol000090003o`0000@000[o0000o`3o0?l0 1Ol00`3oo`02ofd01?l20004o`00o`8000Go0000o`020003o`0000<000?o00000P04o`8000?o0000 10000ol0000;0003o`0000@000[o0000o`3o0?l01Ol00`3oo`02o`l0002[0003o`0000`000?o0000 10002ol0003o0?l0o`3o00<000?o0?l05`000ol000090003o`0000@000_o0000o`3o0?l0o`030003 o`3o070000?o00000`001?l00?l20005o`000?l00P000ol0000300;o1P001?l00?l30004o`00o`d0 00?o000010002ol0003o0?l0o`3o00<000?o0?l04P000:X00_l=00Co0`02o`801_l200?o0P04oa<0 0_l:00Co0`02o`801_l200?o0P04ofd01?l0103oo`02o`801?l200Co0P02o`030?oo00800ol300Co 00<0ool00_l:00Co0`02o`801_l200?o0P04o`l0002j0003o`0003P000?o0000T@000ol000040003 o`0001D000?o00002`000ol0000W0000Z`000ol0000<0003o`0000@000?o00009@000ol000090003 o`0000@000?o0000R@02o`H000?o00005@000ol0000;0003o`0000@000?o000080000?l0h@000?l0 h@000:/00_lJ0003o`0001l00_lG0003o`0008l00_l/00;o70000:d00_lH0003o`0002400_lE0003 o`0009400_lW00?o7P000:l00_lE0003o`0002@00_lB0003o`0009@00_lR00?o8@000;400_lB0003 o`0002L000?o00003P000ol0002G00;o7@03ob@0002c00;o40000ol0000X00;o3P000ol0002I00;o 6003obL0002e00?o30000ol0000[00;o2`000ol0002L0003o`0001<00_lZ0000^002o`T000?o0000 ;P02o`P000?o0000WP02oa000ol/0000^P02o`H000?o0000<@02o`D000?o0000X@02o`/00ol_0000 _002o`@000?o0000<`000ol000020003o`000:<00_l600?o`000?l0 h@000?l0h@000<000_lg00?oL`03ocD000?o0000=P000<800ola00?oN@05oc0000?o0000=P00000000000@000=000olD00?oX@05oa<000?o0000>P000=<0 0ol>00?oZ@05o`d000?o0000>`000=H00ol800?o/@05o`P000?o0000>`000=T00ol200?o^@05o`80 00?o0000?0000=`00_o100;o?`000?l0h@000?l0h@000?l0h@000?l0h@000?l0h@0007@01Ol700Go 4P02ob`01?l200Go00<0ool00_l300?o0P04o`801Ol200?o0`03od400ol:00Go5`03oc<00ol200Go 00H0o`3o0?l200Co00<0ool00_lb0000MP000ol000090003o`00014000Co003o;P001?l00?l20004 o`00o`<000Co003o0P001?l00?l40004o`00o`8000Go0000o`020004o`00od4000?o00002`000ol0 000H0003o`00038000Co003o0`002ol0003o0?l0o`3o00P000?o0000<00007H000?o00002@000ol0 000A0004o`00ob/01?l20004o`00o`8000Go0000o`020003o`0000<000?o00000P04o`8000?o0000 10000ol0000k00Go0P000ol0000;0003o`0001401Ol20003o`00038000?o000010002_l0003o0?l0 o`05o`030?oo00;o0000ol000040003o`0001D000?o0000@@02obL00_ld0003 o`0004X0001f0003o`0000T000?o0000B`02o`H000?o00005@000ol0001@0003o`0004d000?o0000 10000ol000130000o`3Q0000o`3Q0000MP000ol000090003o`0001<01?m00003o`0005@000?o0000 3@000ol0000F00Co@0000ol0000m0000MP000ol000090003o`0001L01_lj0003o`0005@000?o0000 3@000ol0000J00Ko>P000ol0000m0000M`000ol000070003o`0001h01olb0003o`0005H000?o0000 2`000ol0000Q00Ko<`000ol0000n0000N0000ol000050003o`0002H01_l[0003o`0005P000?o0000 2@000ol0000X00Ko;0000ol0000o0000N0000ol000050003o`0002`01_lU0003o`0005P000?o0000 20000ol0000_00Ko9@000ol000100000N@000ol000030003o`0003<01_lN0003o`0005X000?o0000 1P000ol0000f00Go7`000ol000110000N@000ol000030003o`0003T01_lH0003o`0005/000?o0000 10000ol0000l00Ko60000ol000120000NP001Ol0003o04801ol@0003o`0005d000?o00000P000ol0 001300Ko4@000ol000130000N`000ol0o`1:00Ko2@000ol0001N0005o`000?l0C006o`X000?o0000 A00007/000?o0?l0D006o`<000?o0000G`000ol0o`1C00Ko0`000ol000150000O0000ol0001E00?o H`000ol0001H00?oB0000?l0h@000?l0h@000?l0h@000?l0h@0001<01Ol>00?o7005o`L01OlI00?o 0P05o`060?l0o`3o0P04o`030?oo00;o?`03o`801Ol01P3o0?l0o`801?l00`3oo`02odH02_l200;o 0`05o`801Ol00`3oo`02oc/02_l200;o0`05o`801Ol00`3oo`02ocL0000E0003o`0000l000?o0000 7@000ol000090003o`0001T000Co003o0`002ol0003o0?l0o`3o00P000?o0000?@001?l00?l3000; o`000?l0o`3o0?l020000ol000130005o`000?l00`000ol0000200;o1@001Ol0003o00<000?o0?l0 ?P001Ol0003o00<000?o00000P02o`D000Go0000o`030003o`3o03/0000E0003o`0000P01Ol20003 o`0001d000?o00002@000ol0000I0003o`0000@000[o0000o`3o0?l01Ol00`3oo`02ocl000?o0000 10002_l0003o0?l0o`05o`030?oo00;oA@001Ol0003o00<000Ko0000o`02o`@000Go0000o`030003 o`3o00Co>P001Ol0003o00<000Ko0000o`02o`@000Go0000o`030003o`3o00Co=`0001D000?o0000 3`000ol0000M0003o`0000T000?o00006@000ol00004000;o`000?l0o`3o0?l00`000ol0o`120003 o`0000@000_o0000o`3o0?l0o`030003o`3o04P000Go0000o`030005o`000?l00P000ol000020005 o`000?l00`000ol0o`030003o`0003P000Go0000o`030005o`000?l00P000ol000020005o`000?l0 0`000ol0o`030003o`0003D0000D00;o4@000ol0000L00;o2P02oaX01?l300;o0P06o`800ol200Co ?P04o`<00_l200Ko0P03o`801?m600Co0P02o`800_l200;o0P02o`@01?l200?o?004o`800_l200;o 0P02o`800_l400Co0P03ocP0000V00;oA`000ol0001G0003o`00064000?o00005@000ol000120003 o`0001D000?o0000>`0001D000?o0000;`000ol000090003o`0001T000?o000010000ol0001@0003 o`0000@000?o0000F@02o`<000?o00002@000ol0000400;o@`02o`<000?o00002@000ol0000400;o ?@000?l0h@000?l0h@000?l0h@0001D000?o00003@000ol0000O0003o`0000T000?o00009P05oe@0 0_mS00GoE`02odP0000F0003o`0000`000?o00007`000ol000090003o`0002/01om;00;oJP07odh0 0_m:00005`000ol0000:0003o`00024000?o00001`000ol0000c00Oo@P02og<01om400?oC00001P0 00?o000020000ol0000S0003o`0000D000?o0000>`07ocT00_ml00Oo>`02odl0000I0003o`0000L0 00?o00008`000ol000050003o`0004801ol`00;oQ@07oc800_mA00006P000ol000050003o`0002D0 00?o00000`000ol0001:00Oo:0000ol0002<00Oo:@02oe<0000K0003o`0000@000?o00009@000ol0 00030003o`0005401olO00;oUP07ob000_mE000070000ol000020003o`0002L000Go0000o`1K00Oo 5P02oil01olF00?oE`0001d000Co003o:`000ol0o`1S00Oo3@02ojP01ol=00;oFP0001h000?o0?l0 :`000ol0o`1Z00Oo1002ok401ol400;oG00001l000?o0000:`000ol0001`00Co^P04oeh0003o0>40 003o0>40003o0>40003o0>40000800Co0P05o`030?oo00;o0`03o`801?l200Go0P03o`<00ol:00?o 0P05o`060?l0o`3o0P04o`030?oo00;oD@04o`801Ol00`3oo`02o`<00ol200Co0P05o`800ol300?o T004o`801Ol00`3oo`02o`<00ol200Co0P05o`800ol300?oB00000/000Co003o0P001?l00?l30004 o`00o`8000Co003o10001?l00?l20005o`000?l00P001?l00?l90004o`00o`<000_o0000o`3o0?l0 o`080003o`00058000Co003o0P001?l00?l30004o`00o`8000Co003o10001?l00?l20005o`000?l0 0P001?l00?nB0004o`00o`8000Co003o0`001?l00?l20004o`00o`@000Co003o0P001Ol0003o0080 00Co003oA`0000P01?l20004o`00o`8000Go0000o`020003o`0000<000?o00000P04o`8000?o0000 10000ol0000:0003o`0000@000[o0000o`3o0?l01Ol00`3oo`02oe401?l20004o`00o`8000Go0000 o`020003o`0000<000?o00000P04o`8000?o000010000ol0002@00Co0P001?l00?l20005o`000?l0 0P000ol000030003o`0000801?l20003o`0000@000?o0000B00000P000?o00000`001?l00?l20005 o`000?l00P000ol0000300;o1P001?l00?l30004o`00o``000?o000010002ol0003o0?l0o`3o00<0 00?o0?l0E0000ol000030004o`00o`8000Go0000o`020003o`0000<00_l60004o`00o`<000Co003o TP000ol000030004o`00o`8000Go0000o`020003o`0000<00_l60004o`00o`<000Co003oBP0000P0 1?l0103oo`02o`801?l200Co0P02o`030?oo00800ol300Co00<0ool00_l900Co0`02o`801_l200?o 0P04oe401?l0103oo`02o`801?l200Co0P02o`030?oo00800ol300Co00<0ool00_n@00Co00@0ool0 0_l200Co0P04o`800_l00`3oo`0200?o0`04o`030?oo00;oB00001@000?o000010000ol0000E0003 o`0000X000?o0000M@000ol000040003o`0001D000?o0000W0000ol000040003o`0001D000?o0000 B00001<00_l60003o`0001D000?o00002P000ol000040003o`0006d00_l60003o`0001D000?o0000 V`02o`H000?o00005@000ol000180000o`3Q0000o`3Q0000o`3Q00007`02ob/00_me00Ko/`06oeh0 000Q00;o9P03ogd02_nP00WoI00002<00_lQ00?oRP09ohh02Om]00009@000ol0000K00?oUP0:ogX0 2_mf00009P02oaP00onS00[oI`09oh00000X00;o5002ok002OmE00WoR@0002X00_l?00?o^`0:od80 2OnB0000;002o`X00oo800[o;P0:oi/0000^0003o`0000@00ooE00Wo7009ojD0000_00;o00@0oooo h@0:o`T02On^0000<@000ol0003/00Wo]`000?l0h@000?l0h@0002D01?oo0;P0000V0003o`000?l0 ^00002H01?l200Go00<0ool00ol00`3oo`02om401?l200Go00<0ool00_l300?o0P04o`801Ol200?o 0`03ojD0000V0005o`000?l00`001Ol0003o008000?o00000`000ol0003B0004o`00o`8000Co003o 0`001?l00?l20004o`00o`@000Co003o0P001Ol0003o008000Co003oY00002H000Go0000o`030005 o`000?l00P000ol00004om401?l20004o`00o`8000Go0000o`020003o`0000<000?o00000P04o`80 00?o000010000ol0002U00009P001Ol0003o00<000Go0000o`020004o`00om@000?o00000`001?l0 0?l20005o`000?l00P000ol0000300;o1P001?l00?l30004o`00ojL0000U00Go10000ol00002o`03 0?oo00801?oA00Co00@0ool00_l200Co0P04o`800_l00`3oo`0200?o0`04o`030?oo00;oY@0002h0 00?o0000j0000ol000040003o`0001D000?o0000Y@0002`00ooY00;o1P000ol0000E0003o`000:D0 003o0>40003o0>40003o0>40000a00_oiP03ok/0000l01?ocP05okh0001?01?o]P05ol<0001R01Co W@05olP0001f01?oQ@05old0002901?oK@05om80002L01?oE@05omL0002_01Co?005om`0003301?o 9005on40003F01?o3005onH0003Y00coj`000?l0h@000?l0h@000?l0h@000?l0h@000>D00ol200Go 00H0o`3o0?l200Co00<0ool00_oP0000i@001?l00?l3000;o`000?l0o`3o0?l020000ol0003N0000 i@000ol00004000:o`000?l0o`3o00Go00<0ool00_oP0000i@000ol00004000;o`000?l0o`3o0?l0 0`000ol0o`3S0000i004o`<00_l200Ko0P03o`801?oP0000i@000ol0003h0000i@000ol000040003 o`000?40003o0>40003o0>40003o0>40003o0>40003o0>40003o0>40003o0>40003o0>40003o0>40 003o0>40003o0>40003o0>40003o0>400000\ \>"], ImageRangeCache->{{{0, 479}, {209, 0}} -> {-39.0005, -15.4001, 0.160753, 0.0803835}}]}, Open]], Cell[TextData[{ StyleBox["FIGURE 5.", Evaluatable->False, PageBreakAbove->False, AspectRatioFixed->True, FontWeight->"Bold"], StyleBox[" The best fitting expression found by ", Evaluatable->False, PageBreakAbove->False, AspectRatioFixed->True], StyleBox["GeneticProgram", Evaluatable->False, PageBreakAbove->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[".", Evaluatable->False, PageBreakAbove->False, AspectRatioFixed->True, FontSize->12] }], "Special1", Evaluatable->False, PageBreakAbove->False, AspectRatioFixed->True], Cell[TextData["Here is the simplified form of the expression:"], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{Cell[BoxData[ \(be = Eval[Last[b]]\)], "Input", AspectRatioFixed->True], Cell[BoxData[ \(\((1 + i + i\^2)\)\ \((i\^2 - PDivide[\(-1\), i] + PDivide[\(-1\), i\ \((1 + i + i\^2)\)]) \)\)], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[BoxData[ \(bestFit = Together[Expand[be /. PDivide \[Rule] Divide]]\)], "Input", AspectRatioFixed->True], Cell[BoxData[ \(1 + i + i\^2 + i\^3 + i\^4\)], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[TextData[{ StyleBox[ "Now, let's look at the runners up. Sometimes the numerically best solution \ does not make good physical, chemical, or biological sense for the problem, \ so it is always a good idea to examine plausible alternatives. In the \ real-world where experimental error lurks, these second- and third-best \ answers may well be better than the best fit solution when one also takes \ into account parsimony, the physical interpretation of the GP-determined \ expressions, and test cases that were not used in training (", Evaluatable->False, AspectRatioFixed->True], StyleBox["i.e.", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox[", validation).", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{Cell[BoxData[{ \(\(fp = Sort[Transpose[{FinalFit, FinalPop} /. result]]; \)\), \(First/@Take[fp, 5]\)}], "Input", AspectRatioFixed->True], Cell[BoxData[ \({0, 1.527422052154195, 1.527422052154195, 1.527422052154195, 1.527422052154195}\)], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[TextData[ "Here is the second best fitting expression and its depth:"], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{Cell[BoxData[ \(sb = fp\[LeftDoubleBracket]2\[RightDoubleBracket]\)], "Input", AspectRatioFixed->True], Cell[BoxData[ \({1.527422052154195, times[plus[subtract[i, \(-1\)], subtract[times[i, i], times[\(-3\), subtract[ times[0, divide[times[\(-3\), 0], divide[\(-1\), i]], i, \(-1\), i, i], times[0, i]]]]], subtract[ subtract[times[i, i], times[0, divide[times[\(-3\), i], divide[\(-3\), i]]]], subtract[divide[\(-1\), i], times[0, i]]]]}\)], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[BoxData[ \(DepthExpression[Last[sb]]\)], "Input", AspectRatioFixed->True], Cell[BoxData[ \(8\)], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[TextData["Here is the simplified form of the expression:"], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{Cell[BoxData[ \(sbe = Eval[Last[sb]]\)], "Input", AspectRatioFixed->True], Cell[BoxData[ \(\((1 + i + i\^2)\)\ \((i\^2 - PDivide[\(-1\), i])\)\)], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[BoxData[ \(secondBestFit = Together[Expand[sbe /. PDivide \[Rule] Divide]]\)], "Input", AspectRatioFixed->True], Cell[BoxData[ \(\(1 + i + i\^2 + i\^3 + i\^4 + i\^5\)\/i\)], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]]}, Open]], Cell[CellGroupData[{Cell[TextData[" Validating the solutions"], "Subsection", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[{ StyleBox[ "Suppose now that we are given the next four entries in the series to test \ our results. (If one cannot obtain new data with which to validate ones \ result, then one should hold back a portion of the data from the fitting \ process for this purpose.) Thus, we have 7381, 11111, 16105, and 22621 for ", Evaluatable->False, AspectRatioFixed->True], StyleBox["i", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox[" = 9, 10, 11, and 12.", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{Cell[BoxData[ \(\((bestFit /. i \[Rule] #1&)\)/@Range[9, 12]\)], "Input", AspectRatioFixed->True], Cell[BoxData[ \({7381, 11111, 16105, 22621}\)], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[TextData[{ StyleBox["Viola", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox["! Still a perfect fit. Here is a comparison of the two results:", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{Cell[BoxData[ \(TableForm[ Transpose[{Range[12], \((bestFit /. i \[Rule] #1&)\)/@Range[12], \((N[secondBestFit /. i \[Rule] #1]&)\)/@Range[12]}], TableHeadings \[Rule] {None, {"\", "\", "\"}}, TableSpacing \[Rule] {0, 3}]\)], "Input", AspectRatioFixed->True], Cell[BoxData[ TagBox[GridBox[{ {"\<\"i\"\>", "\<\"best\"\>", "\<\"second best\"\>"}, {"1", "5", "6."}, {"2", "31", "31.5"}, {"3", "121", "121.3333333333333"}, {"4", "341", "341.25"}, {"5", "781", "781.2000000000001"}, {"6", "1555", "1555.166666666667"}, {"7", "2801", "2801.142857142858"}, {"8", "4681", "4681.125"}, {"9", "7381", "7381.111111111111"}, {"10", "11111", "11111.1"}, {"11", "16105", "16105.09090909091"}, {"12", "22621", "22621.08333333333"} }, RowSpacings->0, ColumnSpacings->3, RowAlignments->Baseline, ColumnAlignments->{Left}], (TableForm[ #, TableHeadings -> {None, {"i", "best", "second best"}}, TableSpacing -> {0, 3}]&)]], "Output", Evaluatable->False, LineSpacing->{1.25, 0}, AspectRatioFixed->True]}, Open]]}, Open]]}, Open]], Cell[CellGroupData[{Cell[TextData["Closing Remarks"], "Section", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[{ StyleBox[ "All the functions described here as well as several others that should be \ useful have been collected and made into the standard [Maeder 1991] packages \ ", Evaluatable->False, AspectRatioFixed->True], StyleBox["GeneticProgramming.m", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[" and ", Evaluatable->False, AspectRatioFixed->True], StyleBox["SymbolicRegression.m", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[ ". The options and output have been expanded to include information that we \ have found helpful in deciding whether or not to continue a run or to start \ over with a new population. We have attempted to isolate the problem specific \ functions and definitions in ", Evaluatable->False, AspectRatioFixed->True], StyleBox["SymbolicRegression.m", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[" and to keep ", Evaluatable->False, AspectRatioFixed->True], StyleBox["GeneticProgramming.m", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[" as generic as possible.", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "Currently, we exploring ways to evolve parsimonious expressions, employ \ smaller but more diverse populations, and to incorporate analytic methods to \ determine the values for constants."], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "The author wishes to acknowledge several helpful suggestions from the \ editor, and advice from Alan DeGuzman and Robby Villegas at the technical \ support desk at Wolfram Research, Inc.. He also wishes to thank Mary Curran \ Nachbar, a high school student, for careful reading of the manuscript to \ identify vague and imprecise terms and phrases."], "Text", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[TextData["References"], "Section", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[{ StyleBox["Davis, L. 1991. ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Handbook of Genetic Algorithms.", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox[" Van Nostrand Reinhold, New York.", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[{ StyleBox["Freeman, J. 1993. Simulating a Basic Genetic Algorithm. ", Evaluatable->False, AspectRatioFixed->True], StyleBox["The Mathematica Journal", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox["3", Evaluatable->False, AspectRatioFixed->True, FontWeight->"Bold"], StyleBox[", 52-56.", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[{ StyleBox["Gaylord, R. J., Kamin, S. N., and Wellin, P. R. 1993. ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Introduction to Programming with Mathematica.", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox[" Telos, Santa Clara, California.", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[{ StyleBox["Goldberg, D. E. 1989. ", Evaluatable->False, AspectRatioFixed->True], StyleBox[ "Genetic Algorithms in Search, Optimization, and Machine Learning.", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox[" Addison-Wesley, Reading, Massachusetts.", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[{ StyleBox["Koza, J. R. 1992.", Evaluatable->False, AspectRatioFixed->True], StyleBox[ "Genetic Programming: On the Programming of Computers by Means of Natural \ Selection.", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox[" MIT Press, Cambridge, Massachusetts.", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData["Lee, G. Y. 1994. private communication."], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[{ StyleBox["Maeder, R. 1991. ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Programming in Mathematica, Second Edition", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox[". Addison-Wesley, Reading, Massachusetts.", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[{ StyleBox[ "Spencer, G. 1994. Automatic Generation of Programs for Crawling and \ Walking. ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Advances in Genetic Programming, ", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox[ " Kenneth E. Kinnear, Jr., ed. MIT Press, Cambridge, Massachusetts.", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[{ StyleBox[ "Robert B. Nachbar\nMerck Research Laboratories, R50S-100, P.O.Box 2000, \ Rahway, NJ 07065, (908)594-7795\n", CellFrame->True, Evaluatable->False, AspectRatioFixed->True], StyleBox["nachbar@merck.com\n\n", CellFrame->True, Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox["The electronic supplement contains packages ", CellFrame->True, Evaluatable->False, AspectRatioFixed->True], StyleBox["SymbolicRegression.m and", CellFrame->True, Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[" ", CellFrame->True, Evaluatable->False, AspectRatioFixed->True], StyleBox["GeneticProgramming.m", CellFrame->True, Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[" and the notebook ", CellFrame->True, Evaluatable->False, AspectRatioFixed->True], StyleBox["SymbolicRegression.ma", CellFrame->True, Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox[ ". The latter uses the packages for the example in the previous section.", CellFrame->True, Evaluatable->False, AspectRatioFixed->True] }], "Text", CellFrame->True, Evaluatable->False, AspectRatioFixed->True]}, Open]]}, Open]] }, FrontEndVersion->"Macintosh 3.0", ScreenRectangle->{{0, 800}, {0, 580}}, WindowToolbars->{}, Evaluator->"Local", CellGrouping->Manual, WindowSize->{520, 485}, WindowMargins->{{100, Automatic}, {Automatic, 28}}, PrivateNotebookOptions->{"ColorPalette"->{RGBColor, -1}}, ShowCellLabel->True, ShowCellTags->False, RenderingOptions->{"ObjectDithering"->True, "RasterDithering"->False}, MacintoshSystemPageSetup->"\<\ 00<0001804P000000]P2:?oQon82n@960dL5:0?l0080001804P000000]P2:001 0000I00000400`<300000BL?00400@0000000000000006P801T1T00000000000 00000000000000000000000000000000\>" ] (*********************************************************************** 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->{} *) (*CellTagsIndex CellTagsIndex->{} *) (*NotebookFileOutline Notebook[{ Cell[CellGroupData[{ Cell[1731, 51, 94, 2, 70, "Title", Evaluatable->False], Cell[1828, 55, 1591, 52, 70, "Special2", Evaluatable->False], Cell[3422, 109, 122, 4, 19, "Input", CellOpen->False, InitializationCell->True], Cell[3547, 115, 241, 8, 70, "Text", Evaluatable->False], Cell[3791, 125, 1773, 38, 70, "Text", Evaluatable->False], Cell[5567, 165, 707, 19, 70, "Text", Evaluatable->False], Cell[CellGroupData[{ Cell[6297, 186, 99, 2, 70, "Section", Evaluatable->False], Cell[6399, 190, 1563, 34, 70, "Text", Evaluatable->False], Cell[7965, 226, 958, 14, 70, "Text", Evaluatable->False], Cell[CellGroupData[{ Cell[8946, 242, 162, 5, 19, "Input", Evaluatable->False, CellOpen->False], Cell[9111, 249, 4799, 124, 112, 1026, 72, "GraphicsData", "PostScript", "Graphics", Evaluatable->False] }, Open ]], Cell[13922, 375, 511, 19, 70, "Special1", Evaluatable->False, PageBreakAbove->False], Cell[14436, 396, 232, 5, 70, "Text", Evaluatable->False], Cell[14671, 403, 242, 5, 70, "Text", Evaluatable->False], Cell[14916, 410, 666, 20, 70, "Text", Evaluatable->False] }, Open ]], Cell[CellGroupData[{ Cell[15614, 432, 86, 2, 70, "Section", Evaluatable->False], Cell[15703, 436, 2864, 95, 70, "Text", Evaluatable->False] }, Open ]], Cell[CellGroupData[{ Cell[18599, 533, 93, 2, 70, "Section", Evaluatable->False], Cell[CellGroupData[{ Cell[18715, 537, 103, 2, 70, "Subsection", Evaluatable->False], Cell[18821, 541, 786, 23, 70, "Text", Evaluatable->False], Cell[CellGroupData[{ Cell[19630, 566, 93, 2, 27, "Input"], Cell[19726, 570, 241, 7, 26, "Output", Evaluatable->False] }, Open ]], Cell[19979, 579, 2034, 76, 70, "Text", Evaluatable->False], Cell[22016, 657, 924, 30, 70, "Text", Evaluatable->False], Cell[22943, 689, 1647, 57, 70, "Text", Evaluatable->False], Cell[CellGroupData[{ Cell[24613, 748, 73, 2, 27, "Input"], Cell[24689, 752, 208, 7, 26, "Output", Evaluatable->False] }, Open ]], Cell[CellGroupData[{ Cell[24929, 761, 73, 2, 42, "Input"], Cell[25005, 765, 223, 7, 26, "Output", Evaluatable->False] }, Open ]], Cell[25240, 774, 594, 17, 70, "Text", Evaluatable->False], Cell[25837, 793, 254, 5, 70, "Text", Evaluatable->False], Cell[CellGroupData[{ Cell[26114, 800, 83, 2, 27, "Input"], Cell[26200, 804, 197, 7, 26, "Output", Evaluatable->False] }, Open ]], Cell[26409, 813, 2391, 80, 70, "Text", Evaluatable->False], Cell[28803, 895, 221, 4, 59, "Input"], Cell[29027, 901, 103, 2, 70, "Text", Evaluatable->False], Cell[CellGroupData[{ Cell[29153, 905, 92, 2, 27, "Input"], Cell[29248, 909, 115, 3, 26, "Output", Evaluatable->False] }, Open ]], Cell[CellGroupData[{ Cell[29395, 914, 66, 2, 27, "Input"], Cell[29464, 918, 106, 3, 26, "Output", Evaluatable->False] }, Open ]], Cell[CellGroupData[{ Cell[29602, 923, 70, 2, 27, "Input"], Cell[29675, 927, 93, 3, 26, "Output", Evaluatable->False] }, Open ]], Cell[CellGroupData[{ Cell[29800, 932, 66, 2, 27, "Input"], Cell[29869, 936, 86, 3, 28, "Output", Evaluatable->False] }, Open ]], Cell[CellGroupData[{ Cell[29987, 941, 71, 2, 27, "Input"], Cell[30061, 945, 94, 3, 26, "Output", Evaluatable->False] }, Open ]], Cell[CellGroupData[{ Cell[30187, 950, 66, 2, 27, "Input"], Cell[30256, 954, 86, 3, 42, "Output", Evaluatable->False] }, Open ]], Cell[CellGroupData[{ Cell[30374, 959, 79, 2, 27, "Input"], Cell[30456, 963, 102, 3, 26, "Output", Evaluatable->False] }, Open ]], Cell[CellGroupData[{ Cell[30590, 968, 66, 2, 27, "Input"], Cell[30659, 972, 84, 3, 26, "Output", Evaluatable->False] }, Open ]], Cell[30755, 977, 1289, 37, 70, "Text", Evaluatable->False], Cell[CellGroupData[{ Cell[32067, 1016, 88, 2, 27, "Input"], Cell[32158, 1020, 210, 7, 26, "Output", Evaluatable->False] }, Open ]], Cell[32380, 1029, 123, 2, 70, "Text", Evaluatable->False], Cell[CellGroupData[{ Cell[32526, 1033, 100, 2, 27, "Input"], Cell[32629, 1037, 109, 2, 70, "Message", Evaluatable->False], Cell[32741, 1041, 157, 4, 70, "Message", Evaluatable->False], Cell[32901, 1047, 208, 7, 26, "Output", Evaluatable->False] }, Open ]], Cell[33121, 1056, 2437, 78, 70, "Text", Evaluatable->False], Cell[35561, 1136, 424, 10, 170, "Input"], Cell[CellGroupData[{ Cell[36008, 1148, 140, 4, 43, "Input"], Cell[36151, 1154, 180, 4, 41, "Output", Evaluatable->False] }, Open ]], Cell[CellGroupData[{ Cell[36363, 1160, 90, 2, 27, "Input"], Cell[36456, 1164, 101, 3, 26, "Output", Evaluatable->False] }, Open ]], Cell[36569, 1169, 501, 16, 70, "Text", Evaluatable->False], Cell[CellGroupData[{ Cell[37093, 1187, 90, 2, 27, "Input"], Cell[37186, 1191, 104, 3, 26, "Output", Evaluatable->False] }, Open ]], Cell[37302, 1196, 753, 17, 70, "Text", Evaluatable->False] }, Open ]], Cell[CellGroupData[{ Cell[38087, 1215, 101, 2, 70, "Subsection", Evaluatable->False], Cell[38191, 1219, 1300, 41, 70, "Text", Evaluatable->False], Cell[39494, 1262, 192, 4, 59, "Input"], Cell[CellGroupData[{ Cell[39709, 1268, 82, 2, 27, "Input"], Cell[39794, 1272, 83, 3, 26, "Output", Evaluatable->False] }, Open ]], Cell[CellGroupData[{ Cell[39909, 1277, 77, 2, 27, "Input"], Cell[39989, 1281, 83, 3, 26, "Output", Evaluatable->False] }, Open ]], Cell[40084, 1286, 1856, 66, 70, "Text", Evaluatable->False] }, Open ]], Cell[CellGroupData[{ Cell[41972, 1354, 98, 2, 70, "Subsection", Evaluatable->False], Cell[42073, 1358, 331, 6, 70, "Text", Evaluatable->False], Cell[CellGroupData[{ Cell[42427, 1366, 75, 2, 27, "Input"], Cell[42505, 1370, 86, 3, 26, "Output", Evaluatable->False] }, Open ]], Cell[42603, 1375, 260, 5, 70, "Text", Evaluatable->False], Cell[CellGroupData[{ Cell[42886, 1382, 129, 3, 43, "Input"], Cell[43018, 1387, 99, 3, 26, "Output", Evaluatable->False] }, Open ]], Cell[CellGroupData[{ Cell[43149, 1392, 70, 2, 40, "Input"], Cell[43222, 1396, 99, 3, 26, "Output", Evaluatable->False] }, Open ]], Cell[43333, 1401, 671, 17, 70, "Text", Evaluatable->False], Cell[44007, 1420, 101, 2, 27, "Input"], Cell[CellGroupData[{ Cell[44131, 1424, 84, 2, 27, "Input"], Cell[44218, 1428, 204, 4, 56, "Output", Evaluatable->False] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell[44463, 1434, 104, 2, 70, "Subsection", Evaluatable->False], Cell[44570, 1438, 547, 16, 70, "Text", Evaluatable->False], Cell[CellGroupData[{ Cell[45140, 1456, 88, 2, 42, "Input"], Cell[45231, 1460, 87, 3, 26, "Output", Evaluatable->False] }, Open ]], Cell[45330, 1465, 82, 2, 70, "Text", Evaluatable->False], Cell[CellGroupData[{ Cell[45435, 1469, 112, 2, 27, "Input"], Cell[45550, 1473, 135, 3, 26, "Output", Evaluatable->False] }, Open ]], Cell[45697, 1478, 857, 24, 70, "Text", Evaluatable->False], Cell[46557, 1504, 947, 31, 70, "Text", Evaluatable->False], Cell[CellGroupData[{ Cell[47527, 1537, 88, 2, 27, "Input"], Cell[47618, 1541, 111, 3, 26, "Output", Evaluatable->False] }, Open ]], Cell[47741, 1546, 283, 7, 107, "Input"], Cell[CellGroupData[{ Cell[48047, 1555, 88, 2, 27, "Input"], Cell[48138, 1559, 105, 3, 26, "Output", Evaluatable->False] }, Open ]], Cell[48255, 1564, 772, 25, 70, "Text", Evaluatable->False], Cell[49030, 1591, 420, 11, 171, "Input"], Cell[49453, 1604, 107, 2, 70, "Text", Evaluatable->False], Cell[CellGroupData[{ Cell[49583, 1608, 112, 2, 27, "Input"], Cell[49698, 1612, 113, 3, 26, "Output", Evaluatable->False] }, Open ]] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell[49861, 1617, 87, 2, 70, "Section", Evaluatable->False], Cell[49951, 1621, 1523, 47, 70, "Text", Evaluatable->False], Cell[51477, 1670, 181, 3, 59, "Input"], Cell[51661, 1675, 696, 23, 70, "Text", Evaluatable->False], Cell[52360, 1700, 180, 4, 43, "Input"], Cell[52543, 1706, 371, 7, 123, "Input"], Cell[CellGroupData[{ Cell[52937, 1715, 114, 3, 27, "Input", Evaluatable->False], Cell[53054, 1720, 113, 3, 26, "Output", Evaluatable->False] }, Open ]], Cell[53179, 1725, 477, 8, 70, "Text", Evaluatable->False], Cell[53659, 1735, 106, 2, 27, "Input"], Cell[CellGroupData[{ Cell[53788, 1739, 118, 3, 27, "Input", Evaluatable->False], Cell[53909, 1744, 132, 3, 26, "Output", Evaluatable->False] }, Open ]], Cell[54053, 1749, 142, 4, 19, "Input", CellOpen->False], Cell[54198, 1755, 327, 6, 70, "Text", Evaluatable->False], Cell[54528, 1763, 163, 3, 59, "Input"], Cell[54694, 1768, 165, 3, 59, "Input"], Cell[CellGroupData[{ Cell[54882, 1773, 77, 2, 27, "Input"], Cell[54962, 1777, 84, 3, 26, "Output", Evaluatable->False] }, Open ]], Cell[55058, 1782, 1042, 32, 70, "Text", Evaluatable->False], Cell[56103, 1816, 605, 11, 248, "Input"], Cell[56711, 1829, 100, 2, 27, "Input"], Cell[56814, 1833, 1710, 59, 70, "Text", Evaluatable->False], Cell[58527, 1894, 106, 2, 27, "Input"], Cell[CellGroupData[{ Cell[58656, 1898, 336, 7, 107, "Input"], Cell[58995, 1907, 523, 17, 74, "Output", Evaluatable->False] }, Open ]], Cell[CellGroupData[{ Cell[59550, 1926, 479, 9, 155, "Input"], Cell[60032, 1937, 1055, 28, 184, "Output", Evaluatable->False] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell[61128, 1967, 88, 2, 70, "Section", Evaluatable->False], Cell[61219, 1971, 823, 12, 70, "Text", Evaluatable->False], Cell[CellGroupData[{ Cell[62065, 1985, 89, 2, 70, "Subsection", Evaluatable->False], Cell[62157, 1989, 343, 6, 70, "Text", Evaluatable->False], Cell[62503, 1997, 949, 27, 70, "Text", Evaluatable->False], Cell[CellGroupData[{ Cell[63475, 2026, 121, 3, 27, "Input", Evaluatable->False], Cell[63599, 2031, 113, 3, 26, "Output", Evaluatable->False] }, Open ]], Cell[63724, 2036, 154, 4, 19, "Input", CellOpen->False], Cell[CellGroupData[{ Cell[63901, 2042, 101, 2, 27, "Input"], Cell[64005, 2046, 128, 3, 26, "Output", Evaluatable->False] }, Open ]], Cell[64145, 2051, 840, 24, 70, "Text", Evaluatable->False], Cell[CellGroupData[{ Cell[65008, 2077, 176, 5, 27, "Input"], Cell[65187, 2084, 93, 3, 26, "Output", Evaluatable->False] }, Open ]], Cell[65292, 2089, 602, 17, 70, "Text", Evaluatable->False], Cell[65897, 2108, 172, 4, 59, "Input"], Cell[66072, 2114, 411, 9, 91, "Input"], Cell[66486, 2125, 899, 34, 70, "Text", Evaluatable->False], Cell[CellGroupData[{ Cell[67408, 2161, 120, 3, 27, "Input", Evaluatable->False], Cell[67531, 2166, 166, 4, 41, "Output", Evaluatable->False] }, Open ]], Cell[67709, 2172, 215, 6, 19, "Input", CellOpen->False], Cell[67927, 2180, 102, 2, 27, "Input"], Cell[CellGroupData[{ Cell[68052, 2184, 85, 3, 27, "Input", Evaluatable->False], Cell[68140, 2189, 103, 3, 26, "Output", Evaluatable->False] }, Open ]], Cell[68255, 2194, 144, 4, 19, "Input", CellOpen->False], Cell[CellGroupData[{ Cell[68422, 2200, 85, 3, 27, "Input", Evaluatable->False], Cell[68510, 2205, 176, 4, 41, "Output", Evaluatable->False] }, Open ]], Cell[68698, 2211, 226, 6, 19, "Input", CellOpen->False], Cell[68927, 2219, 896, 34, 70, "Text", Evaluatable->False], Cell[CellGroupData[{ Cell[69846, 2255, 1438, 28, 19, "Input", Evaluatable->False, CellOpen->False], Cell[71287, 2285, 21752, 633, 304, 6074, 433, "GraphicsData", "PostScript", "Graphics", Evaluatable->False] }, Open ]], Cell[93051, 2920, 1268, 50, 70, "Special1", Evaluatable->False, PageBreakAbove->False], Cell[94322, 2972, 1373, 27, 70, "Text", Evaluatable->False], Cell[95698, 3001, 604, 13, 171, "Input"] }, Open ]], Cell[CellGroupData[{ Cell[96334, 3016, 88, 2, 70, "Subsection", Evaluatable->False], Cell[96425, 3020, 841, 21, 70, "Text", Evaluatable->False], Cell[97269, 3043, 456, 9, 166, "Input"], Cell[97728, 3054, 607, 21, 70, "Text", Evaluatable->False], Cell[CellGroupData[{ Cell[98358, 3077, 122, 3, 27, "Input", Evaluatable->False], Cell[98483, 3082, 117, 3, 26, "Output", Evaluatable->False] }, Open ]], Cell[98612, 3087, 159, 4, 19, "Input", CellOpen->False], Cell[CellGroupData[{ Cell[98794, 3093, 117, 3, 27, "Input", Evaluatable->False], Cell[98914, 3098, 127, 3, 26, "Output", Evaluatable->False] }, Open ]], Cell[99053, 3103, 171, 5, 19, "Input", CellOpen->False], Cell[CellGroupData[{ Cell[99247, 3110, 701, 15, 19, "Input", Evaluatable->False, CellOpen->False], Cell[99951, 3127, 11317, 327, 311, 3067, 220, "GraphicsData", "PostScript", "Graphics", Evaluatable->False] }, Open ]], Cell[111282, 3457, 818, 32, 70, "Special1", Evaluatable->False, PageBreakAbove->False] }, Open ]], Cell[CellGroupData[{ Cell[112132, 3491, 101, 2, 70, "Subsection", Evaluatable->False], Cell[112236, 3495, 666, 18, 70, "Text", Evaluatable->False], Cell[112905, 3515, 107, 2, 27, "Input"], Cell[CellGroupData[{ Cell[113035, 3519, 121, 3, 27, "Input", Evaluatable->False], Cell[113159, 3524, 176, 4, 41, "Output", Evaluatable->False] }, Open ]], Cell[113347, 3530, 233, 6, 19, "Input", CellOpen->False], Cell[CellGroupData[{ Cell[113603, 3538, 89, 2, 27, "Input"], Cell[113695, 3542, 131, 3, 26, "Output", Evaluatable->False] }, Open ]], Cell[CellGroupData[{ Cell[113858, 3547, 134, 3, 27, "Input"], Cell[113995, 3552, 107, 3, 26, "Output", Evaluatable->False] }, Open ]], Cell[114114, 3557, 1369, 50, 70, "Text", Evaluatable->False], Cell[115486, 3609, 418, 8, 139, "Input"], Cell[115907, 3619, 433, 9, 139, "Input"], Cell[116343, 3630, 582, 21, 70, "Text", Evaluatable->False], Cell[CellGroupData[{ Cell[116948, 3653, 101, 3, 27, "Input", Evaluatable->False], Cell[117052, 3658, 176, 4, 41, "Output", Evaluatable->False] }, Open ]], Cell[117240, 3664, 226, 6, 19, "Input", CellOpen->False], Cell[CellGroupData[{ Cell[117489, 3672, 703, 15, 19, "Input", Evaluatable->False, CellOpen->False], Cell[118195, 3689, 14640, 423, 229, 4000, 286, "GraphicsData", "PostScript", "Graphics", Evaluatable->False] }, Open ]], Cell[132847, 4114, 820, 32, 70, "Special1", Evaluatable->False, PageBreakAbove->False] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell[133708, 4148, 96, 2, 70, "Section", Evaluatable->False], Cell[133807, 4152, 293, 6, 70, "Text", Evaluatable->False], Cell[134103, 4160, 249, 5, 75, "Input"], Cell[134355, 4167, 2177, 73, 70, "Text", Evaluatable->False], Cell[136535, 4242, 196, 4, 59, "Input"], Cell[136734, 4248, 199, 4, 59, "Input"], Cell[136936, 4254, 193, 4, 75, "Input"], Cell[137132, 4260, 121, 3, 27, "Input", Evaluatable->False], Cell[137256, 4265, 2350, 48, 19, "Input", CellOpen->False], Cell[139609, 4315, 381, 13, 70, "Text", Evaluatable->False], Cell[CellGroupData[{ Cell[140013, 4330, 102, 2, 27, "Input"], Cell[140118, 4334, 251, 5, 73, "Output", Evaluatable->False] }, Open ]], Cell[140381, 4341, 708, 11, 70, "Text", Evaluatable->False], Cell[141092, 4354, 557, 17, 70, "Text", Evaluatable->False], Cell[141652, 4373, 93, 2, 27, "Input"], Cell[CellGroupData[{ Cell[141768, 4377, 93, 2, 27, "Input"], Cell[141864, 4381, 251, 5, 73, "Output", Evaluatable->False] }, Open ]], Cell[142127, 4388, 599, 18, 70, "Text", Evaluatable->False], Cell[142729, 4408, 187, 4, 43, "Input", Evaluatable->False], Cell[142919, 4414, 381, 13, 70, "Text", Evaluatable->False], Cell[143303, 4429, 104, 2, 42, "Input"], Cell[CellGroupData[{ Cell[143430, 4433, 89, 2, 27, "Input"], Cell[143522, 4437, 340, 6, 131, "Output", Evaluatable->False] }, Open ]], Cell[143874, 4445, 916, 27, 70, "Text", Evaluatable->False], Cell[CellGroupData[{ Cell[144813, 4474, 531, 12, 181, "Input", Evaluatable->False], Cell[145347, 4488, 1945, 37, 241, "Output", Evaluatable->False] }, Open ]], Cell[147304, 4527, 625, 17, 70, "Text", Evaluatable->False], Cell[CellGroupData[{ Cell[147952, 4546, 99, 2, 27, "Input"], Cell[148054, 4550, 333, 6, 86, "Output", Evaluatable->False] }, Open ]], Cell[148399, 4558, 520, 16, 70, "Text", Evaluatable->False], Cell[148922, 4576, 246, 5, 43, "Input"], Cell[CellGroupData[{ Cell[149191, 4583, 76, 2, 27, "Input"], Cell[149270, 4587, 83, 3, 26, "Output", Evaluatable->False] }, Open ]], Cell[CellGroupData[{ Cell[149385, 4592, 104, 2, 27, "Input"], Cell[149492, 4596, 128, 3, 26, "Output", Evaluatable->False] }, Open ]], Cell[149632, 4601, 1628, 56, 70, "Text", Evaluatable->False], Cell[151263, 4659, 149, 3, 43, "Input"], Cell[CellGroupData[{ Cell[151435, 4664, 146, 3, 43, "Input"], Cell[151584, 4669, 107, 3, 26, "Output", Evaluatable->False] }, Open ]], Cell[151703, 4674, 453, 9, 135, "Input"], Cell[CellGroupData[{ Cell[152179, 4685, 146, 3, 43, "Input"], Cell[152328, 4690, 107, 3, 26, "Output", Evaluatable->False] }, Open ]], Cell[CellGroupData[{ Cell[152467, 4695, 65, 2, 42, "Input"], Cell[152535, 4699, 99, 3, 26, "Output", Evaluatable->False] }, Open ]], Cell[152646, 4704, 855, 24, 70, "Text", Evaluatable->False], Cell[153504, 4730, 452, 9, 150, "Input"], Cell[CellGroupData[{ Cell[153979, 4741, 76, 2, 27, "Input"], Cell[154058, 4745, 133, 3, 26, "Output", Evaluatable->False] }, Open ]], Cell[154203, 4750, 424, 15, 70, "Text", Evaluatable->False], Cell[CellGroupData[{ Cell[154650, 4767, 94, 2, 27, "Input"], Cell[154747, 4771, 143, 4, 26, "Output", Evaluatable->False] }, Open ]], Cell[154902, 4777, 466, 15, 70, "Text", Evaluatable->False] }, Open ]], Cell[CellGroupData[{ Cell[155400, 4794, 100, 2, 70, "Section", Evaluatable->False], Cell[155503, 4798, 683, 18, 70, "Text", Evaluatable->False], Cell[156189, 4818, 159, 4, 27, "Input", Evaluatable->False], Cell[156351, 4824, 550, 16, 70, "Text", Evaluatable->False], Cell[156904, 4842, 429, 8, 107, "Input"], Cell[157336, 4852, 594, 23, 70, "Special1", Evaluatable->False, PageBreakAbove->False], Cell[157933, 4877, 4463, 76, 1030, "Input"], Cell[162399, 4955, 328, 13, 70, "Special1", Evaluatable->False, PageBreakAbove->False], Cell[162730, 4970, 1674, 49, 70, "Text", Evaluatable->False], Cell[164407, 5021, 364, 8, 91, "Input", Evaluatable->False], Cell[164774, 5031, 465, 8, 70, "Text", Evaluatable->False], Cell[165242, 5041, 1569, 48, 70, "Text", Evaluatable->False] }, Open ]], Cell[CellGroupData[{ Cell[166843, 5091, 90, 2, 70, "Section", Evaluatable->False], Cell[CellGroupData[{ Cell[166956, 5095, 102, 2, 70, "Subsection", Evaluatable->False], Cell[167061, 5099, 225, 5, 70, "Text", Evaluatable->False], Cell[167289, 5106, 164, 3, 43, "Input"], Cell[167456, 5111, 217, 4, 70, "Text", Evaluatable->False], Cell[167676, 5117, 177, 3, 59, "Input"], Cell[167856, 5122, 174, 4, 70, "Text", Evaluatable->False], Cell[168033, 5128, 92, 2, 27, "Input"], Cell[168128, 5132, 123, 3, 27, "Input"], Cell[168254, 5137, 478, 8, 70, "Text", Evaluatable->False], Cell[168735, 5147, 711, 12, 19, "Input", CellOpen->False], Cell[CellGroupData[{ Cell[169469, 5161, 252, 5, 59, "Input"], Cell[169724, 5168, 316, 6, 70, "Print", Evaluatable->False] }, Open ]], Cell[170052, 5176, 124, 2, 70, "Text", Evaluatable->False], Cell[CellGroupData[{ Cell[170199, 5180, 82, 2, 27, "Input"], Cell[170284, 5184, 454, 13, 101, "Output", Evaluatable->False] }, Open ]], Cell[CellGroupData[{ Cell[170770, 5199, 83, 2, 27, "Input"], Cell[170856, 5203, 83, 3, 26, "Output", Evaluatable->False] }, Open ]], Cell[CellGroupData[{ Cell[170971, 5208, 161, 5, 19, "Input", Evaluatable->False, CellOpen->False], Cell[171135, 5215, 16708, 407, 218, 3309, 236, "GraphicsData", "PostScript", "Graphics", Evaluatable->False] }, Open ]], Cell[187855, 5624, 614, 23, 70, "Special1", Evaluatable->False, PageBreakAbove->False], Cell[188472, 5649, 120, 2, 70, "Text", Evaluatable->False], Cell[CellGroupData[{ Cell[188615, 5653, 77, 2, 27, "Input"], Cell[188695, 5657, 190, 5, 28, "Output", Evaluatable->False] }, Open ]], Cell[CellGroupData[{ Cell[188917, 5664, 115, 2, 27, "Input"], Cell[189035, 5668, 108, 3, 28, "Output", Evaluatable->False] }, Open ]], Cell[189155, 5673, 836, 20, 70, "Text", Evaluatable->False], Cell[CellGroupData[{ Cell[190014, 5695, 148, 3, 43, "Input"], Cell[190165, 5700, 168, 4, 41, "Output", Evaluatable->False] }, Open ]], Cell[190345, 5706, 132, 3, 70, "Text", Evaluatable->False], Cell[CellGroupData[{ Cell[190500, 5711, 108, 2, 27, "Input"], Cell[190611, 5715, 524, 13, 116, "Output", Evaluatable->False] }, Open ]], Cell[CellGroupData[{ Cell[191167, 5730, 84, 2, 27, "Input"], Cell[191254, 5734, 83, 3, 26, "Output", Evaluatable->False] }, Open ]], Cell[191349, 5739, 120, 2, 70, "Text", Evaluatable->False], Cell[CellGroupData[{ Cell[191492, 5743, 79, 2, 27, "Input"], Cell[191574, 5747, 133, 3, 28, "Output", Evaluatable->False] }, Open ]], Cell[CellGroupData[{ Cell[191739, 5752, 125, 3, 43, "Input"], Cell[191867, 5757, 122, 3, 44, "Output", Evaluatable->False] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell[192030, 5762, 106, 2, 70, "Subsection", Evaluatable->False], Cell[192139, 5766, 628, 17, 70, "Text", Evaluatable->False], Cell[CellGroupData[{ Cell[192790, 5785, 103, 2, 27, "Input"], Cell[192896, 5789, 109, 3, 26, "Output", Evaluatable->False] }, Open ]], Cell[193017, 5794, 303, 10, 70, "Text", Evaluatable->False], Cell[CellGroupData[{ Cell[193343, 5806, 320, 6, 91, "Input"], Cell[193666, 5814, 919, 24, 144, "Output", Evaluatable->False] }, Open ]] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell[194635, 5840, 92, 2, 70, "Section", Evaluatable->False], Cell[194730, 5844, 1342, 41, 70, "Text", Evaluatable->False], Cell[196075, 5887, 263, 5, 70, "Text", Evaluatable->False], Cell[196341, 5894, 423, 7, 70, "Text", Evaluatable->False] }, Open ]], Cell[CellGroupData[{ Cell[196796, 5903, 87, 2, 70, "Section", Evaluatable->False], Cell[196886, 5907, 383, 13, 70, "Text", Evaluatable->False], Cell[197272, 5922, 483, 17, 70, "Text", Evaluatable->False], Cell[197758, 5941, 434, 13, 70, "Text", Evaluatable->False], Cell[198195, 5956, 433, 14, 70, "Text", Evaluatable->False], Cell[198631, 5972, 445, 15, 70, "Text", Evaluatable->False], Cell[199079, 5989, 113, 2, 70, "Text", Evaluatable->False], Cell[199195, 5993, 403, 13, 70, "Text", Evaluatable->False], Cell[199601, 6008, 487, 16, 70, "Text", Evaluatable->False], Cell[200091, 6026, 1335, 47, 70, "Text", Evaluatable->False] }, Open ]] }, Open ]] } ] *) (*********************************************************************** End of Mathematica Notebook file. ***********************************************************************)