(* Content-type: application/mathematica *) (*** Wolfram Notebook File ***) (* http://www.wolfram.com/nb *) (* CreatedBy='Mathematica 6.0' *) (*CacheID: 234*) (* Internal cache information: NotebookFileLineBreakTest NotebookFileLineBreakTest NotebookDataPosition[ 145, 7] NotebookDataLength[ 93014, 2973] NotebookOptionsPosition[ 81043, 2624] NotebookOutlinePosition[ 83199, 2695] CellTagsIndexPosition[ 82954, 2684] WindowFrame->Normal ContainsDynamic->False*) (* Beginning of Notebook Content *) Notebook[{ Cell[CellGroupData[{ Cell[TextData[{ "Introduction to ", StyleBox["Mathematica \[MathematicaIcon]", FontSlant->"Italic"] }], "Title"], Cell["4. Data, Statistics, Optimization", "Subtitle"], Cell["\<\ P. S. Cally, School of Mathematical Sciences, Monash University\ \>", "Author"], Cell[CellGroupData[{ Cell["Fitting Data", "Section"], Cell["Here is some noisy data generated from a quadratic.", "Text"], Cell[BoxData[ RowBox[{"data", "=", RowBox[{"Table", "[", RowBox[{ RowBox[{"{", RowBox[{"x", ",", RowBox[{ RowBox[{"(", RowBox[{"1", "-", RowBox[{"3", " ", "x"}], "+", SuperscriptBox["x", "2"]}], ")"}], "+", RowBox[{"RandomReal", "[", RowBox[{"{", RowBox[{ RowBox[{"-", "10"}], ",", "10"}], "}"}], "]"}]}]}], "}"}], ",", RowBox[{"{", RowBox[{"x", ",", "0.1", ",", "10", ",", "0.1"}], "}"}]}], "]"}]}]], "Input", CellChangeTimes->{{3.40140305108289*^9, 3.4014030524911823`*^9}}], Cell["Plot it with ListPlot.", "Text"], Cell[BoxData[ RowBox[{"lp", "=", RowBox[{"ListPlot", "[", "data", "]"}]}]], "Input"], Cell["\<\ The basic utility Fit takes a linear combination of any set of given \ functions (not necessarily powers) and obtains a least-squares fit.\ \>", "Text"], Cell[BoxData[ RowBox[{ RowBox[{"p", "[", "x_", "]"}], "=", RowBox[{"Fit", "[", RowBox[{"data", ",", RowBox[{"{", RowBox[{"1", ",", "x", ",", SuperscriptBox["x", "2"]}], "}"}], ",", "x"}], "]"}]}]], "Input", CellChangeTimes->{{3.401403552715765*^9, 3.4014035533622913`*^9}}], Cell["which can be evaluated anywhere.", "Text"], Cell[BoxData[ RowBox[{"p", "[", "2.37", "]"}]], "Input"], Cell[TextData[{ StyleBox["Mathematica", FontSlant->"Italic"], " also has a utility for nonlinear fitting. For example, let's fit a simple \ rational function to the same data:" }], "Text"], Cell[BoxData[ RowBox[{ RowBox[{"ff", "[", "x_", "]"}], "=", RowBox[{ FractionBox[ RowBox[{"a", "+", RowBox[{"b", " ", "x"}]}], RowBox[{"1", "+", RowBox[{"c", " ", "x"}]}]], "/.", RowBox[{"FindFit", "[", RowBox[{"data", ",", FractionBox[ RowBox[{"a", "+", RowBox[{"b", " ", "x"}]}], RowBox[{"1", "+", RowBox[{"c", " ", "x"}]}]], ",", RowBox[{"{", RowBox[{"a", ",", "b", ",", "c"}], "}"}], ",", "x"}], "]"}]}]}]], "Input"], Cell["Plot the two and compare:", "Text"], Cell[BoxData[ RowBox[{ RowBox[{"fplts", "=", RowBox[{"Plot", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"p", "[", "x", "]"}], ",", RowBox[{"ff", "[", "x", "]"}]}], "}"}], ",", RowBox[{"{", RowBox[{"x", ",", "0", ",", "10"}], "}"}], ",", RowBox[{"PlotStyle", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"{", "Red", "}"}], ",", RowBox[{"{", "Blue", "}"}]}], "}"}]}]}], "]"}]}], ";"}]], "Input", CellChangeTimes->{{3.40140372134125*^9, 3.401403745939189*^9}, { 3.401403789849614*^9, 3.401403791794894*^9}}], Cell["\<\ (The semicolon just stops the graph from displaying, though it is created and \ stored in fplts.)\ \>", "Text", CellChangeTimes->{{3.401403772411386*^9, 3.401403775057309*^9}}], Cell[BoxData[ RowBox[{"Show", "[", RowBox[{"lp", ",", "fplts"}], "]"}]], "Input"], Cell[BoxData[ RowBox[{"Clear", "[", RowBox[{"data", ",", "p", ",", "ff", ",", "fplts", ",", "lp"}], "]"}]], "Input", CellChangeTimes->{{3.401403815863749*^9, 3.4014038166262703`*^9}}] }, Closed]], Cell[CellGroupData[{ Cell["Interpolating Data", "Section"], Cell["\<\ We must distinguish between fitting data and interpolating it. Interpolation \ returns a curve (often a spline) which passes through all the data points, \ whereas fitting generally finds the \"best\" fit of a particular form, where \ the number of free parameters is (much) less than the number of points, so in \ general it is not possible to exactly fit the data points. Let's make a table of data:\ \>", "Text"], Cell[BoxData[ RowBox[{ RowBox[{"f", "[", "x_", "]"}], ":=", FractionBox[ RowBox[{"Cos", "[", RowBox[{"x", "+", SuperscriptBox["x", "2"]}], "]"}], RowBox[{"1", "+", "x"}]]}]], "Input"], Cell[BoxData[ RowBox[{"tb", "=", RowBox[{"Table", "[", RowBox[{ RowBox[{"{", RowBox[{"x", ",", RowBox[{"f", "[", "x", "]"}]}], "}"}], ",", RowBox[{"{", RowBox[{"x", ",", "0", ",", "4", ",", ".2"}], "}"}]}], "]"}]}]], "Input"], Cell[BoxData[ RowBox[{"pts", "=", RowBox[{"ListPlot", "[", RowBox[{"tb", ",", RowBox[{"PlotStyle", "\[Rule]", RowBox[{"{", RowBox[{"Red", ",", RowBox[{"PointSize", "[", "0.018", "]"}]}], "}"}]}]}], "]"}]}]], "Input", CellChangeTimes->{3.401403869956958*^9}], Cell["Interpolating tbis is trivial:", "Text", CellChangeTimes->{{3.4014134701949167`*^9, 3.401413471080344*^9}}], Cell[BoxData[ RowBox[{"F", "=", RowBox[{"Interpolation", "[", "tb", "]"}]}]], "Input"], Cell[BoxData[ RowBox[{"Plot", "[", RowBox[{ RowBox[{"F", "[", "x", "]"}], ",", RowBox[{"{", RowBox[{"x", ",", "0", ",", "4"}], "}"}], ",", RowBox[{"Epilog", "\[Rule]", RowBox[{"First", "[", "pts", "]"}]}]}], "]"}]], "Input"], Cell["Note that Interpolation takes a couple of options:", "Text"], Cell[BoxData[ RowBox[{"Options", "[", "Interpolation", "]"}]], "Input"], Cell["\<\ By default, Interpolation gives piecewise cubic polynomials, but we can force \ any other order, e.g., piecewise constant or piecewise linear.\ \>", "Text", CellChangeTimes->{{3.401403926363563*^9, 3.401403939201395*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"F0", "=", RowBox[{"Interpolation", "[", RowBox[{"tb", ",", RowBox[{"InterpolationOrder", "\[Rule]", "0"}]}], "]"}]}], ";"}]], "Input"], Cell[BoxData[ RowBox[{ RowBox[{"F1", "=", RowBox[{"Interpolation", "[", RowBox[{"tb", ",", RowBox[{"InterpolationOrder", "\[Rule]", "1"}]}], "]"}]}], ";"}]], "Input"], Cell[BoxData[ RowBox[{"Plot", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"F0", "[", "x", "]"}], ",", RowBox[{"F1", "[", "x", "]"}]}], "}"}], ",", RowBox[{"{", RowBox[{"x", ",", "0", ",", "4"}], "}"}], ",", RowBox[{"PlotStyle", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"{", "}"}], ",", RowBox[{"{", "Green", "}"}]}], "}"}]}], ",", RowBox[{"Epilog", "\[Rule]", RowBox[{"First", "[", "pts", "]"}]}], ",", RowBox[{"PlotPoints", "\[Rule]", "1000"}]}], "]"}]], "Input"], Cell[TextData[{ "Alternatively, you may actually have a function f rather than a set of data \ that you might want to fit a spline to, perhaps because f is expensive to \ evaluate and you will need to do so many times, or because f is already a \ combination of InterpolatingFunction objects you wish to simplify to just \ one. ", StyleBox["Mathematica", FontSlant->"Italic"], " can use FunctionInterpolation to do this:" }], "Text"], Cell[BoxData[ RowBox[{"FF", "=", RowBox[{"FunctionInterpolation", "[", RowBox[{ RowBox[{"f", "[", "x", "]"}], ",", RowBox[{"{", RowBox[{"x", ",", "0", ",", "4"}], "}"}]}], "]"}]}]], "Input"], Cell[BoxData[ RowBox[{"Fplt", "=", RowBox[{"Plot", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"F", "[", "x", "]"}], ",", RowBox[{"FF", "[", "x", "]"}]}], "}"}], ",", RowBox[{"{", RowBox[{"x", ",", "0", ",", "4"}], "}"}], ",", RowBox[{"PlotStyle", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"{", "Green", "}"}], ",", RowBox[{"{", RowBox[{"Blue", ",", RowBox[{"Dashing", "[", RowBox[{"{", RowBox[{"0.03", ",", "0.02"}], "}"}], "]"}]}], "}"}]}], "}"}]}], ",", RowBox[{"Epilog", "\[Rule]", RowBox[{"First", "[", "pts", "]"}]}], ",", RowBox[{"ImageSize", "\[Rule]", "450"}]}], "]"}]}]], "Input", CellChangeTimes->{{3.4014039880302563`*^9, 3.4014039898841047`*^9}}], Cell[BoxData[ RowBox[{"Clear", "[", RowBox[{ "F", ",", "tb", ",", "f", ",", "F0", ",", "F1", ",", "FF", ",", "Fplt"}], "]"}]], "Input"] }, Closed]], Cell[CellGroupData[{ Cell["Basic Statistics", "Section"], Cell[TextData[{ "The following basic statistical functions are built into ", StyleBox["Mathematica", FontSlant->"Italic"], ". " }], "Text", CellChangeTimes->{{3.40141365871297*^9, 3.4014136613844337`*^9}}], Cell[BoxData[GridBox[{ { RowBox[{ ButtonBox["Mean", BaseStyle->"Link", ButtonData->"paclet:ref/Mean"], "[", StyleBox["list", "TI"], "]"}], Cell["mean (average)", "TableText"]}, { RowBox[{ ButtonBox["Median", BaseStyle->"Link", ButtonData->"paclet:ref/Median"], "[", StyleBox["list", "TI"], "]"}], Cell[ "median (central value)", "TableText"]}, { RowBox[{ ButtonBox["Max", BaseStyle->"Link", ButtonData->"paclet:ref/Max"], "[", StyleBox["list", "TI"], "]"}], Cell["maximum value", "TableText"]}, { RowBox[{ ButtonBox["Variance", BaseStyle->"Link", ButtonData->"paclet:ref/Variance"], "[", StyleBox["list", "TI"], "]"}], Cell["variance", "TableText"]}, { RowBox[{ ButtonBox["StandardDeviation", BaseStyle->"Link", ButtonData->"paclet:ref/StandardDeviation"], "[", StyleBox["list", "TI"], "]"}], Cell["standard deviation", "TableText"]}, { RowBox[{ ButtonBox["Quantile", BaseStyle->"Link", ButtonData->"paclet:ref/Quantile"], "[", StyleBox["list", "TI"], ",", StyleBox["q", "TI"], "]"}], Cell[TextData[{ Cell[BoxData[ StyleBox["q", "TI"]], "InlineFormula"], Cell[BoxData[ FormBox[ SuperscriptBox["\[Null]", "th"], TraditionalForm]]], " quantile" }], "TableText"]}, { RowBox[{ ButtonBox["Total", BaseStyle->"Link", ButtonData->"paclet:ref/Total"], "[", StyleBox["list", "TI"], "]"}], Cell["total", "TableText"]} }]], "Text"], Cell["Click on the links for descriptions. For example, if", "Text", CellChangeTimes->{{3.4014136885627613`*^9, 3.401413699040317*^9}}], Cell["data = {4.3, 7.2, 8.4, 5.8, 9.2, 3.9}", "Input", CellTags->"S1.6.7"], Cell["then the mean is given by", "Text"], Cell["Mean[data]", "Input", CellTags->"S1.6.7"], Cell["and variance by", "Text", CellChangeTimes->{{3.401413709800334*^9, 3.401413710704246*^9}}], Cell["Variance[data]", "Input", CellTags->"S1.6.7"], Cell["\<\ Pretty basic! However, do not despair. There are several powerful packages.\ \>", "Text"] }, Closed]], Cell[CellGroupData[{ Cell["Statistics", "Section", CellChangeTimes->{{3.4014047827620497`*^9, 3.4014047907690496`*^9}}], Cell["\<\ Many more sophisticated statistical operations are available though inbuilt \ packages. Details can be found here (click to access):\ \>", "Text", CellChangeTimes->{{3.401406396881919*^9, 3.40140648094594*^9}}], Cell[BoxData[{ RowBox[{Cell[TextData[ButtonBox["Statistics", BaseStyle->"Link", ButtonData->"paclet:guide/Statistics"]], "SearchResultTitle"], " ", StyleBox[ RowBox[{"(", RowBox[{ StyleBox["Mathematica", FontSlant->"Italic"], " ", "Guide"}], ")"}], "SearchResultType"]}], "\n", StyleBox[ RowBox[{ RowBox[{ RowBox[{ StyleBox["Mathematica", FontSlant->"Italic"], " ", "provides", " ", "integrated", " ", "support", " ", "both", " ", "for", " ", "classical", " ", "statistics", " ", "and", " ", "for", " ", "modern", " ", "large"}], "-", RowBox[{"scale", " ", "data", " ", RowBox[{"analysis", ".", " ", "Its"}], " ", "symbolic", " ", "character", " ", "allows", " ", "broader", " ", "coverage"}]}], ",", " ", RowBox[{ RowBox[{"with", " ", "symbolic"}], " ", "..."}]}], "SearchResultSummary"]}], "Text"], Cell["\<\ As an example, here's something that uses the ANOVA package, which performs \ univariate Analysis of Variance. In this data set, the first element in each \ pair gives the value of the factor and the second element gives the response. \ There are four levels of the factor, each having five responses. \ \>", "Text", CellChangeTimes->{{3.4014046571335773`*^9, 3.40140465787362*^9}}], Cell[BoxData[ RowBox[{"<<", "ANOVA`"}]], "Input", CellChangeTimes->{{3.401404613785645*^9, 3.401404619777954*^9}}], Cell[BoxData[ RowBox[{"?", "ANOVA"}]], "Input", CellChangeTimes->{{3.401404086457312*^9, 3.401404088833775*^9}}], Cell["\<\ Click on the \">>\" link above for a complete description. And here's an \ example:\ \>", "Text", CellChangeTimes->{{3.401413770853578*^9, 3.401413808912187*^9}}], Cell["\<\ onewaydata = {{1,7.0}, {1,5.3}, {1,5.9}, {1,6.6}, {1,4.9}, {2,4.4}, {2,6.8}, \ {2,7.7}, {2,8.3}, {2,6.6}, {3,8.1}, {3,10.4}, {3,8.0}, {3,6.8}, {3,9.2}, \ {4,5.7}, {4,3.9}, {4,6.2}, {4,5.5}, {4,6.2}};\ \>", "Input", CellTags->"S5.95.1"], Cell["ANOVA[onewaydata]", "Input", CellTags->"S5.95.1"] }, Closed]], Cell[CellGroupData[{ Cell["Import and Export", "Section"], Cell[CellGroupData[{ Cell["Graphics", "Subsection"], Cell[TextData[{ "We have seen how to make graphics, and even animations in ", StyleBox["Mathematica", FontSlant->"Italic"], ". But how do we get them off the screen and into a page or file? For single \ frames, the easiest method involves saving as an encapsulated postscript file \ (.eps). These are readily incorporated into ", Cell[BoxData[ StyleBox[ RowBox[{"L", StyleBox[ AdjustmentBox["A", BoxBaselineShift->-0.2, BoxMargins->{{-0.36, -0.1}, {0, 0}}], FontSize->Smaller], "T", AdjustmentBox["E", BoxBaselineShift->0.5, BoxMargins->{{-0.075, -0.085}, {0, 0}}], "X"}]]]], " documents. Saving as eps is most conveniently done from the Edit>Save \ Selection As>EPS... menu item. Give it a try; save this as peanut.eps:" }], "Text"], Cell[BoxData[ RowBox[{ RowBox[{"peanut", "[", RowBox[{"a_", ",", "opts___"}], "]"}], ":=", RowBox[{"ParametricPlot3D", "[", RowBox[{ FractionBox[ RowBox[{ RowBox[{"(", RowBox[{"a", "+", RowBox[{"2", " ", SuperscriptBox[ RowBox[{"Cos", "[", "\[Theta]", "]"}], "2"]}]}], ")"}], " ", RowBox[{"{", RowBox[{ RowBox[{ RowBox[{"Sin", "[", "\[Theta]", "]"}], " ", RowBox[{"Cos", "[", "\[Phi]", "]"}]}], ",", RowBox[{ RowBox[{"Sin", "[", "\[Theta]", "]"}], " ", RowBox[{"Sin", "[", "\[Phi]", "]"}]}], ",", RowBox[{"Cos", "[", "\[Theta]", "]"}]}], "}"}]}], RowBox[{"2", "+", "a"}]], ",", RowBox[{"{", RowBox[{"\[Theta]", ",", "0", ",", "\[Pi]"}], "}"}], ",", RowBox[{"{", RowBox[{"\[Phi]", ",", "0", ",", RowBox[{"2", " ", "\[Pi]"}]}], "}"}], ",", "opts", ",", RowBox[{"ViewPoint", "\[Rule]", RowBox[{"{", RowBox[{"0.5", ",", "2.3", ",", "0"}], "}"}]}], ",", RowBox[{"AxesLabel", "\[Rule]", RowBox[{"{", RowBox[{"x", ",", "y", ",", "z"}], "}"}]}], ",", RowBox[{"PlotLabel", "\[Rule]", RowBox[{"\"\\"", "<>", RowBox[{"ToString", "[", "a", "]"}]}]}]}], "]"}]}]], "Input", CellChangeTimes->{{3.401406534817635*^9, 3.401406537477684*^9}}], Cell[BoxData[ RowBox[{"pnt", "=", RowBox[{"peanut", "[", "1", "]"}]}]], "Input", CellChangeTimes->{3.4014065553134336`*^9}], Cell[TextData[{ "Edit>Save Selection As ... also allows you to save in many other formats.\n\ However, we may also save with a ", StyleBox["Mathematica", FontSlant->"Italic"], " command. First, check where ", StyleBox["Mathematica", FontSlant->"Italic"], " will put it by determining your working directory:" }], "Text", CellChangeTimes->{{3.401414168922903*^9, 3.401414204224312*^9}, { 3.401414498106674*^9, 3.401414546937516*^9}}], Cell[BoxData[ RowBox[{"Directory", "[", "]"}]], "Input", CellChangeTimes->{{3.401414043957897*^9, 3.4014140471609993`*^9}}], Cell["You can change this using", "Text", CellChangeTimes->{{3.401414207916974*^9, 3.40141422139225*^9}}], Cell[BoxData[ RowBox[{"SetDirectory", "[", "\"\<~/MathematicaCourse\>\"", "]"}]], "Input", CellChangeTimes->{{3.4014142252820187`*^9, 3.401414243081223*^9}}], Cell["\<\ Make sure you chose a directory which exists! Now this saves the picture as a \ gif file in the working directory. Of course, you could also specify the \ complete path in the Export command.\ \>", "Text", CellChangeTimes->{{3.401414264078127*^9, 3.401414277264283*^9}, { 3.401414315322755*^9, 3.401414372528413*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"Export", "[", RowBox[{"\"\\"", ",", "pnt"}], "]"}], ";"}]], "Input", CellChangeTimes->{{3.401406567628729*^9, 3.401406571294156*^9}}], Cell["\<\ There are very many available formats: eps, pdf, gif, jpeg, png, tiff, fits, \ \[Ellipsis]. See Help for details on Export and its available formats, or do \ this to see what's available on your system (may vary between platforms):\ \>", "Text"], Cell[BoxData["$ExportFormats"], "Input"], Cell["I hope that's enough for you. Of course, we can also Import.", "Text", CellChangeTimes->{{3.401414567995081*^9, 3.4014145762085238`*^9}}], Cell[BoxData[ RowBox[{"pn", "=", RowBox[{"Import", "[", "\"\\"", "]"}]}]], "Input", CellChangeTimes->{3.401406591693262*^9}], Cell[BoxData[ RowBox[{"Clear", "[", RowBox[{"pn", ",", "pnt"}], "]"}]], "Input", CellChangeTimes->{{3.401414589231275*^9, 3.401414605881218*^9}}] }, Closed]], Cell[CellGroupData[{ Cell["Manipulate and Animations", "Subsection", CellChangeTimes->{{3.401439534536261*^9, 3.401439538467716*^9}}], Cell["\<\ We have already seen the Animation[] utility for creating and viewing movies. \ A related function is Manipulate, which allows us to easily explore how \ things change as parameters are varied.\ \>", "Text", CellChangeTimes->{{3.401417249444222*^9, 3.401417365696766*^9}}], Cell[BoxData[ RowBox[{"peas", "=", RowBox[{"Manipulate", "[", RowBox[{ RowBox[{"peanut", "[", RowBox[{"a", ",", RowBox[{"Boxed", "\[Rule]", "False"}], ",", RowBox[{"Axes", "\[Rule]", "False"}], ",", RowBox[{"PlotRange", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"-", "1"}], ",", "1"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "1"}], ",", "1"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "1"}], ",", "1"}], "}"}]}], "}"}]}]}], "]"}], ",", RowBox[{"{", RowBox[{"a", ",", "0", ",", "10", ",", ".2"}], "}"}]}], "]"}]}]], "Input",\ CellChangeTimes->{{3.401407684239431*^9, 3.401407689922329*^9}, { 3.401407773991165*^9, 3.4014077834932423`*^9}, {3.401414673590958*^9, 3.401414698586739*^9}, {3.401414794117392*^9, 3.401414803810511*^9}, { 3.4014148610774403`*^9, 3.4014148990425177`*^9}, {3.401417405731642*^9, 3.401417406435075*^9}, {3.401417914536599*^9, 3.401417923644433*^9}}], Cell["\<\ You can run it as a movie by clicking on the small \"+\" to the right of the \ slider. However, this picture is sufficiently complicated that your computer \ will not have time to render it properly unless you slow the movie down \ considerably. Manipulate can have many different kinds of selectors. For example, if there \ are only a few choices\ \>", "Text", CellChangeTimes->{{3.401415016378889*^9, 3.40141510029627*^9}, 3.401418902257037*^9, {3.4014393740716133`*^9, 3.4014394217155437`*^9}}], Cell[BoxData[ RowBox[{"peas", "=", RowBox[{"Manipulate", "[", RowBox[{ RowBox[{"peanut", "[", RowBox[{"a", ",", RowBox[{"Boxed", "\[Rule]", "False"}], ",", RowBox[{"Axes", "\[Rule]", "False"}], ",", RowBox[{"PlotRange", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"-", "1"}], ",", "1"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "1"}], ",", "1"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "1"}], ",", "1"}], "}"}]}], "}"}]}]}], "]"}], ",", RowBox[{"{", RowBox[{"a", ",", RowBox[{"{", RowBox[{"0", ",", "0.1", ",", "1", ",", "2", ",", "5"}], "}"}]}], "}"}]}], "]"}]}]], "Input", CellChangeTimes->{{3.401407684239431*^9, 3.401407689922329*^9}, { 3.401407773991165*^9, 3.4014077834932423`*^9}, {3.401414673590958*^9, 3.401414698586739*^9}, {3.401414794117392*^9, 3.401414803810511*^9}, { 3.4014148610774403`*^9, 3.4014148990425177`*^9}, {3.401417405731642*^9, 3.401417406435075*^9}, {3.401417914536599*^9, 3.401417923644433*^9}, { 3.401439294609314*^9, 3.401439331889572*^9}}], Cell[TextData[{ "If you export this to a movie file (e.g., avi), you will see the peanut in \ the Manipulate frame as ", StyleBox["a", FontSlant->"Italic"], " increases from 0 to 10 and then decreases to 0 again." }], "Text", CellChangeTimes->{{3.401418385155528*^9, 3.401418469456875*^9}}], Cell[BoxData[ RowBox[{"Export", "[", RowBox[{"\"\\"", ",", "peas"}], "]"}]], "Input", CellChangeTimes->{{3.401417930897797*^9, 3.401417943265874*^9}, { 3.4014183375008698`*^9, 3.40141834467415*^9}}], Cell["\<\ If you want to export the movie without the Manipulate paraphernalia, you \ could do this:\ \>", "Text", CellChangeTimes->{{3.4014189405423307`*^9, 3.401418966976881*^9}, { 3.401419250091497*^9, 3.401419266208989*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"peanuts", "=", RowBox[{"Table", "[", RowBox[{ RowBox[{"peanut", "[", RowBox[{"a", ",", RowBox[{"Boxed", "\[Rule]", "False"}], ",", RowBox[{"Axes", "\[Rule]", "False"}], ",", RowBox[{"PlotRange", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"-", "1"}], ",", "1"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "1"}], ",", "1"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "1"}], ",", "1"}], "}"}]}], "}"}]}]}], "]"}], ",", RowBox[{"{", RowBox[{"a", ",", "0", ",", "10", ",", ".2"}], "}"}]}], "]"}]}], ";"}]], "Input", CellChangeTimes->{{3.4014192779627943`*^9, 3.401419318811512*^9}}], Cell[BoxData[ RowBox[{"Export", "[", RowBox[{"\"\\"", ",", "peanuts"}], "]"}]], "Input"], Cell["And as an avi:", "Text"], Cell[BoxData[ RowBox[{"Export", "[", RowBox[{"\"\\"", ",", "peanuts"}], "]"}]], "Input"], Cell["\<\ Check them out using your favourite viewer (xanim, animate, xine, quicktime \ player, \[Ellipsis]). For gifs, you can use a web browser if you like. Export takes a vast array of options as well, through ConversionOptions, \ mostly taylored to the specific format. For example, for gif we could do \ this:\ \>", "Text", CellChangeTimes->{{3.40141946234065*^9, 3.4014194786414137`*^9}, { 3.401420603967904*^9, 3.401420609745428*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"Export", "[", RowBox[{"\"\\"", ",", "peanuts", ",", RowBox[{"\"\\"", "\[Rule]", ".1"}], ",", RowBox[{"\"\\"", "\[Rule]", "1"}]}], "]"}], ";"}]], "Input", CellChangeTimes->{{3.401419560845873*^9, 3.401419563211134*^9}, { 3.4014198066987133`*^9, 3.401419851611265*^9}, {3.40141992817117*^9, 3.401419935218892*^9}, {3.401419992447431*^9, 3.401419994067099*^9}, 3.401420243342938*^9, {3.4014203013346987`*^9, 3.401420304227191*^9}, { 3.401420531567498*^9, 3.401420531672894*^9}}], Cell[TextData[{ "DisplayDurations inserts extra time between frame to slow down the rate at \ which it plays. This is handy with some viewers which don't have speed \ control (e.g., web browsers). The equivalent for avi files is \"FrameRate\"\ \[Rule]", StyleBox["n", FontSlant->"Italic"], ", where ", StyleBox["n", FontSlant->"Italic"], " is the number of frames per second.\n\"AnimationRepititions\"\[Rule]", StyleBox["n", FontSlant->"Italic"], " tells the viewer to loop ", StyleBox["n", FontSlant->"Italic"], " times. You can set Infinity for a continuous loop. However, most viewers \ don't listen to this instruction, they just loop forever (they are very \ stupid)." }], "Text", CellChangeTimes->{{3.4014204052571507`*^9, 3.401420516361228*^9}}] }, Closed]], Cell[CellGroupData[{ Cell["Data", "Subsection"], Cell["Here is how we can export data. First make a table.", "Text"], Cell[BoxData[ RowBox[{"tb", "=", RowBox[{"Table", "[", RowBox[{ RowBox[{"N", "[", RowBox[{"{", RowBox[{"x", ",", RowBox[{"Sin", "[", RowBox[{"x", " ", "Degree"}], "]"}]}], "}"}], "]"}], ",", RowBox[{"{", RowBox[{"x", ",", "0", ",", "90", ",", "5"}], "}"}]}], "]"}]}]], "Input"], Cell["Then simply", "Text"], Cell[BoxData[ RowBox[{"Export", "[", RowBox[{"\"\\"", ",", "tb"}], "]"}]], "Input"], Cell["Have a look at it. Now try this instead; see the difference?", "Text"], Cell[BoxData[ RowBox[{"Export", "[", RowBox[{"\"\\"", ",", "tb", ",", "\"\\"", ",", RowBox[{"\"\\"", "\[Rule]", RowBox[{"{", RowBox[{"\"\\"", ",", " ", "\"\\""}], "}"}]}], ",", RowBox[{"\"\\"", "\[Rule]", "Left"}]}], "]"}]], "Input", CellChangeTimes->{{3.401420769012113*^9, 3.4014207739166317`*^9}, { 3.4014208678198233`*^9, 3.40142086904419*^9}, {3.401420962007208*^9, 3.401420993903417*^9}, {3.4014220609081593`*^9, 3.401422086628167*^9}, { 3.401422579847101*^9, 3.40142258233165*^9}}] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Optimization", "Section"], Cell[TextData[{ StyleBox["Mathematica", FontSlant->"Italic"], " has several different optimization routines. " }], "Text"], Cell[TextData[{ "Minimize (and Maximize) use exact methods (including exact linear \ programming methods for linear cases, and cylindrical algebraic decomposition \ for polynomials). It returns both the minimum and the point at which it is \ found. For linear and polynomial functions and constraints, exact ", StyleBox["global", FontSlant->"Italic"], " minima are found.\n", "\[FilledSmallSquare] ", StyleBox["Minimize[", "MR"], StyleBox["f", "TI"], StyleBox[",", "MR"], " ", StyleBox["{", "MR"], StyleBox["x", "TI"], StyleBox[",", "MR"], " ", StyleBox["y", "TI"], StyleBox[",", "MR"], " \[Ellipsis] ", StyleBox["}]", "MR"], " minimizes ", StyleBox["f", "TI"], " with respect to ", StyleBox["x", "TI"], ", ", StyleBox["y", "TI"], ", \[Ellipsis] . \n\[FilledSmallSquare] ", StyleBox["Minimize[{", "MR"], StyleBox["f", "TI"], StyleBox[",", "MR"], " ", StyleBox["cons", "TI"], StyleBox["},", "MR"], " ", StyleBox["{", "MR"], StyleBox["x", "TI"], StyleBox[",", "MR"], " ", StyleBox["y", "TI"], StyleBox[",", "MR"], " \[Ellipsis] ", StyleBox["}]", "MR"], " minimizes ", StyleBox["f", "TI"], " subject to the constraints ", StyleBox["cons", "TI"], ". " }], "Text"], Cell[BoxData[ RowBox[{"Minimize", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{ RowBox[{"\[ExponentialE]", " ", SuperscriptBox["x", "2"]}], "-", RowBox[{"\[Pi]", " ", "y"}]}], ",", RowBox[{ RowBox[{ SuperscriptBox["x", "2"], "+", RowBox[{ SqrtBox["2"], " ", SuperscriptBox["y", "2"]}]}], "\[LessEqual]", "\[Pi]"}]}], "}"}], ",", RowBox[{"{", RowBox[{"x", ",", "y"}], "}"}]}], "]"}]], "Input", CellTags->"Minimize"], Cell[BoxData[ RowBox[{"%", "//", "N"}]], "Input"], Cell[BoxData[ RowBox[{"Minimize", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{ RowBox[{ RowBox[{"-", "2"}], "a"}], "+", RowBox[{"7", "b"}], "+", "c", "+", RowBox[{"9", "d"}]}], ",", RowBox[{ RowBox[{ RowBox[{"6", "a"}], "-", "b", "+", "c"}], "\[LessEqual]", "10"}], ",", RowBox[{ RowBox[{"a", "+", RowBox[{"5", "b"}]}], "\[LessEqual]", "4"}], ",", RowBox[{ RowBox[{"a", "+", RowBox[{"5", "b"}], "+", "d"}], "==", "5"}], ",", RowBox[{"a", "\[GreaterEqual]", "0"}], ",", RowBox[{"b", "\[GreaterEqual]", "0"}], ",", RowBox[{"c", "\[GreaterEqual]", "0"}], ",", RowBox[{"d", "\[GreaterEqual]", "0"}]}], "}"}], ",", RowBox[{"{", RowBox[{"a", ",", "b", ",", "c", ",", "d"}], "}"}]}], "]"}]], "Input", CellTags->"Minimize"], Cell[BoxData[ RowBox[{"Minimize", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{ SuperscriptBox["\[ExponentialE]", "x"], "+", FractionBox["7.8", "x"]}], ",", RowBox[{"1", "\[LessEqual]", "x", "\[LessEqual]", "2"}]}], "}"}], ",", "x"}], "]"}]], "Input", CellTags->"Minimize"], Cell["\<\ NMinimize (and NMaximize) are similar, but proceed numerically. \[FilledSmallSquare]NMinimize[f, {x, y, \[Ellipsis] }]minimizesfnumerically \ with respect tox,y,\[Ellipsis] . \[FilledSmallSquare]NMinimize[{f, cons}, {x, y, \[Ellipsis] \ }]minimizesfnumerically subject to the constraintscons.\ \>", "Text"], Cell[BoxData[ RowBox[{"NMinimize", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{ RowBox[{"\[ExponentialE]", " ", SuperscriptBox["x", "2"]}], "-", RowBox[{"\[Pi]", " ", "y"}]}], ",", RowBox[{ RowBox[{ SuperscriptBox["x", "2"], "+", RowBox[{ SqrtBox["2"], " ", SuperscriptBox["y", "2"]}]}], "\[LessEqual]", "\[Pi]"}]}], "}"}], ",", RowBox[{"{", RowBox[{"x", ",", "y"}], "}"}]}], "]"}]], "Input", CellTags->"Minimize"], Cell[TextData[{ "Again, NMinimize and NMaximize look for ", StyleBox["global", FontSlant->"Italic"], " extrema." }], "Text"], Cell[TextData[{ "FindMinimum and FindMaximum are similar to FindRoot, and only find ", StyleBox["local", FontSlant->"Italic"], " extrema. \n", "\[FilledSmallSquare] ", StyleBox["FindMinimum[", "MR"], StyleBox["f", "TI"], StyleBox[",", "MR"], " ", StyleBox["{", "MR"], StyleBox["x", "TI"], StyleBox[",", "MR"], " ", Cell[BoxData[ FormBox[ SubscriptBox[ StyleBox["x", "TI"], "0"], TraditionalForm]], "InlineFormula"], StyleBox["}]", "MR"], " searches for a local minimum in ", StyleBox["f", "TI"], ", starting from the point ", StyleBox["x", "TI"], StyleBox["=", "MR"], Cell[BoxData[ FormBox[ SubscriptBox[ StyleBox["x", "TI"], "0"], TraditionalForm]], "InlineFormula"], ". \n\[FilledSmallSquare] ", StyleBox["FindMinimum[", "MR"], StyleBox["f", "TI"], StyleBox[",", "MR"], " ", StyleBox["{{", "MR"], StyleBox["x", "TI"], StyleBox[",", "MR"], " ", Cell[BoxData[ FormBox[ SubscriptBox[ StyleBox["x", "TI"], "0"], TraditionalForm]], "InlineFormula"], StyleBox["},", "MR"], " ", StyleBox["{", "MR"], StyleBox["y", "TI"], StyleBox[",", "MR"], " ", Cell[BoxData[ FormBox[ SubscriptBox[ StyleBox["y", "TI"], "0"], TraditionalForm]], "InlineFormula"], StyleBox["},", "MR"], " \[Ellipsis] ", StyleBox["}]", "MR"], " searches for a local minimum in a function of several variables. ", "\nHere is a simple example with two local minima." }], "Text"], Cell[BoxData[ RowBox[{ RowBox[{"f", "[", "x_", "]"}], ":=", RowBox[{ RowBox[{ RowBox[{"-", "7"}], " ", "x"}], "-", FractionBox[ SuperscriptBox["x", "2"], "2"], "+", FractionBox[ RowBox[{"4", " ", SuperscriptBox["x", "3"]}], "3"], "+", FractionBox[ SuperscriptBox["x", "4"], "4"]}]}]], "Input"], Cell[BoxData[ RowBox[{"Plot", "[", RowBox[{ RowBox[{"f", "[", "x", "]"}], ",", RowBox[{"{", RowBox[{"x", ",", RowBox[{"-", "6"}], ",", "3"}], "}"}]}], "]"}]], "Input"], Cell["\<\ Depending on our starting guess, we may or may not find the global minimum.\ \>", "Text"], Cell[BoxData[ RowBox[{"FindMinimum", "[", RowBox[{ RowBox[{"f", "[", "x", "]"}], ",", RowBox[{"{", RowBox[{"x", ",", RowBox[{"-", "2"}]}], "}"}]}], "]"}]], "Input"], Cell[BoxData[ RowBox[{"FindMinimum", "[", RowBox[{ RowBox[{"f", "[", "x", "]"}], ",", RowBox[{"{", RowBox[{"x", ",", "0"}], "}"}]}], "]"}]], "Input"], Cell[TextData[{ "However, NMinimize finds the ", StyleBox["global", FontSlant->"Italic"], " minimum." }], "Text"], Cell[BoxData[ RowBox[{"NMinimize", "[", RowBox[{ RowBox[{"f", "[", "x", "]"}], ",", "x"}], "]"}]], "Input"], Cell["\<\ Each of these extremization utilities can be used in multiple \ dimensions.NMinimize is particularly powerful. Here is a function defined on \ the unit disk.\ \>", "Text", CellChangeTimes->{{3.401423324379964*^9, 3.4014233436975603`*^9}}], Cell[BoxData[ RowBox[{"ContourPlot", "[", RowBox[{ RowBox[{"If", "[", RowBox[{ RowBox[{ RowBox[{ SuperscriptBox["x", "2"], "+", SuperscriptBox["y", "2"]}], "\[LessEqual]", "1"}], ",", RowBox[{ RowBox[{"100", " ", SuperscriptBox[ RowBox[{"(", RowBox[{"y", "-", SuperscriptBox["x", "2"]}], ")"}], "2"]}], "+", SuperscriptBox[ RowBox[{"(", RowBox[{"1", "-", "x"}], ")"}], "2"]}], ",", "150"}], "]"}], ",", RowBox[{"{", RowBox[{"x", ",", RowBox[{"-", "1"}], ",", "1"}], "}"}], ",", RowBox[{"{", RowBox[{"y", ",", RowBox[{"-", "1"}], ",", "1"}], "}"}], ",", RowBox[{"Contours", "\[Rule]", SuperscriptBox["\[ExponentialE]", RowBox[{"Range", "[", RowBox[{ RowBox[{"-", "1"}], ",", "5", ",", "0.333`"}], "]"}]]}], ",", RowBox[{"ColorFunction", "\[Rule]", "\"\\""}], ",", RowBox[{"PlotPoints", "\[Rule]", "100"}]}], "]"}]], "Input", CellChangeTimes->{ 3.401422743548708*^9, {3.401422784124955*^9, 3.4014227884568577`*^9}, { 3.40142286474669*^9, 3.401422904452824*^9}, {3.401423123800351*^9, 3.401423128595237*^9}, {3.401423174671688*^9, 3.401423197388701*^9}}, CellTags->{"NMinimize:Contents", "NMinimize"}], Cell["Some of the available colour schemes.", "Text", CellChangeTimes->{{3.401423352346251*^9, 3.401423361601486*^9}}], Cell[BoxData[ RowBox[{"ColorData", "[", "\"\\"", "]"}]], "Input", CellChangeTimes->{{3.401422834367347*^9, 3.401422844956744*^9}}], Cell[BoxData[ RowBox[{"NMinimize", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{ RowBox[{"100", SuperscriptBox[ RowBox[{"(", RowBox[{"y", "-", SuperscriptBox["x", "2"]}], ")"}], "2"]}], "+", SuperscriptBox[ RowBox[{"(", RowBox[{"1", "-", "x"}], ")"}], "2"]}], ",", " ", RowBox[{ RowBox[{ SuperscriptBox["x", "2"], "+", SuperscriptBox["y", "2"]}], "\[LessEqual]", "1"}]}], "}"}], ",", RowBox[{"{", RowBox[{"x", ",", "y"}], "}"}]}], "]"}]], "Input", CellTags->{"NMinimize:Contents", "NMinimize"}], Cell["Where in the disk is this minimum?", "Text", CellChangeTimes->{{3.401423391285177*^9, 3.4014233999299717`*^9}}], Cell[BoxData[ RowBox[{ SqrtBox[ RowBox[{ SuperscriptBox["x", "2"], "+", SuperscriptBox["y", "2"]}]], "/.", RowBox[{ "%", "\[LeftDoubleBracket]", "2", "\[RightDoubleBracket]"}]}]], "Input"], Cell["\<\ The minimum occurred on the boundary in this case. Try the exact routine. It \ returns an answer (albeit after some time), since the function and \ constraints are polynomial.\ \>", "Text"], Cell[BoxData[ RowBox[{"Minimize", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{ RowBox[{"100", SuperscriptBox[ RowBox[{"(", RowBox[{"y", "-", SuperscriptBox["x", "2"]}], ")"}], "2"]}], "+", SuperscriptBox[ RowBox[{"(", RowBox[{"1", "-", "x"}], ")"}], "2"]}], ",", " ", RowBox[{ RowBox[{ SuperscriptBox["x", "2"], "+", SuperscriptBox["y", "2"]}], "\[LessEqual]", "1"}]}], "}"}], ",", RowBox[{"{", RowBox[{"x", ",", "y"}], "}"}]}], "]"}]], "Input", CellTags->{"NMinimize:Contents", "NMinimize"}], Cell["This is the same as before:", "Text"], Cell[BoxData[ RowBox[{"%", "//", "N"}]], "Input"], Cell["\<\ NMinimize takes many options, most importantly Method. If you don't specify a \ method (i.e., Method\[Rule]Automatic), NMinimize will choose one itself, \ based on the problem you give it. However, sometimes you should enforce a \ particular Method: see the Advanced Documentation for NMinimize in Help.\ \>", "Text"], Cell[BoxData[ RowBox[{"Clear", "[", "f", "]"}]], "Input"] }, Closed]], Cell[CellGroupData[{ Cell["Example: Triangularization", "Section"], Cell["\<\ We may want to set up a triangularization of a plane given a set of nodes. \ For example, this is important when carrying out a finite element \ discretization of a computational domain. One common algorithm is the \ Delaunay triangularization, which gives in some sense an optimal solution. We read in a standard package.\ \>", "Text"], Cell[BoxData[ RowBox[{"<<", "\"\\""}]], "Input"], Cell["Here is a collection of points in the plane", "Text"], Cell["\<\ data2D = {{4.4, 14}, {6.7, 15.25}, {6.9, 12.8}, {2.1, 11.1}, {9.5, 14.9}, {13.2, 11.9}, {10.3, 12.3}, {6.8, 9.5}, {3.3, 7.7}, {0.6, 5.1}, {5.3, 2.4}, {8.45, 4.7}, {11.5, 9.6}, {13.8, 7.3}, {12.9, 3.1}, {11, 1.1}}\ \>", "Input", CellChangeTimes->{3.401408362009165*^9}, CellTags->"S5.19.1"], Cell["Look at them", "Text"], Cell[BoxData[ RowBox[{"pts", "=", RowBox[{"Show", "[", RowBox[{ RowBox[{"Graphics", "[", RowBox[{"PointSize", "[", "0.018`", "]"}], "]"}], ",", RowBox[{"Graphics", "[", RowBox[{"Hue", "[", "0", "]"}], "]"}], ",", RowBox[{"Graphics", "[", RowBox[{"Point", "/@", "data2D"}], "]"}], ",", RowBox[{"AspectRatio", "\[Rule]", "Automatic"}]}], "]"}]}]], "Input"], Cell["\<\ Now plot the Voronoi diagram, which shows the polygons consisting of points \ nearest to each of the points in data2D.\ \>", "Text"], Cell[BoxData[ RowBox[{"vor", "=", RowBox[{"DiagramPlot", "[", RowBox[{"data2D", ",", RowBox[{"BaseStyle", "\[Rule]", RowBox[{"{", RowBox[{"\"\\"", "\[Rule]", "18"}], "}"}]}], ",", RowBox[{"AspectRatio", "\[Rule]", "Automatic"}], ",", RowBox[{"BaseStyle", "\[Rule]", RowBox[{"{", "Cyan", "}"}]}]}], "]"}]}]], "Input"], Cell["Overlay:", "Text"], Cell[BoxData[ RowBox[{"Show", "[", RowBox[{"vor", ",", "pts"}], "]"}]], "Input"], Cell["\<\ The Delaunay triangularization connects points only if they are associated \ with Voronoi cells which have a common side. We see that point 1 is connected \ to points 4, 2, and 3; point 2 to 1,3, and 5, etc.\ \>", "Text"], Cell[BoxData[ RowBox[{"delval", "=", RowBox[{"DelaunayTriangulation", "[", "data2D", "]"}]}]], "Input"], Cell["Here's what it looks like:", "Text"], Cell[BoxData[ RowBox[{"delplt", "=", RowBox[{"PlanarGraphPlot", "[", RowBox[{"data2D", ",", RowBox[{"LabelPoints", "\[Rule]", "False"}]}], "]"}]}]], "Input"], Cell["\<\ Overlay the points, Voronoi diagram, and Delaunay triangularization.\ \>", "Text"], Cell[BoxData[ RowBox[{"Show", "[", RowBox[{"vor", ",", RowBox[{"Graphics", "[", RowBox[{"Darker", "[", "Green", "]"}], "]"}], ",", "delplt", ",", "pts", ",", RowBox[{"AspectRatio", "\[Rule]", "Automatic"}], ",", RowBox[{"ImageSize", "\[Rule]", "400"}], ",", RowBox[{"Background", "\[Rule]", RowBox[{"GrayLevel", "[", "0.6", "]"}]}]}], "]"}]], "Input", CellChangeTimes->{{3.401423699315802*^9, 3.401423774909223*^9}}] }, Closed]], Cell[CellGroupData[{ Cell["Example: Mesh generation (3rd party packages)", "Section"], Cell[TextData[{ "Triangularization is only one part of finite elements mesh generation. The \ more difficult part is deciding where to put the nodes in the first place. \ There are many methods, but none are currently built into ", StyleBox["Mathematica", FontSlant->"Italic"], " or a Standard Package. But there are literally thousands of third party ", StyleBox["Mathematica", FontSlant->"Italic"], " packages out there, many at the Wolfram Information Center (", StyleBox["http://library.wolfram.com/", FontFamily->"Courier"], "). Others may be found using a web search engine. Here we will use one of \ these, meshgenerator (", StyleBox["http://library.wolfram.com/infocenter/MathSource/5475/ ", FontFamily->"Courier"], ") written by Zhe Hu of the ", StyleBox["Illinois Institute of Technology", FontSlant->"Italic"], ". Assuming meshgenerator.m is sitting in your default directory, we read it \ in like this (assuming it is in your default directory):" }], "Text", CellChangeTimes->{{3.401426710690599*^9, 3.401426735170138*^9}}], Cell[BoxData[ RowBox[{"<<", "meshgenerator`"}]], "Input"], Cell["\<\ Lots of warning messages!!!! Don' t worry. That' s because the package is pre \ - V6, and many things have changed. It still works though.\ \>", "Text", CellChangeTimes->{3.401426694699255*^9}], Cell[BoxData[ RowBox[{"Directory", "[", "]"}]], "Input", CellChangeTimes->{{3.401423813707198*^9, 3.401423816506411*^9}}], Cell["This adds several new utilities:", "Text", CellChangeTimes->{{3.401426646654562*^9, 3.401426649418079*^9}}], Cell[BoxData[ RowBox[{"?", "MeshGenerator`*"}]], "Input"], Cell["\<\ We define the shape of the 2D region we want to model using ddiff:\ \>", "Text"], Cell[BoxData[ RowBox[{"?", "ddiff"}]], "Input"], Cell["A circle of radius 1 cut out of another of radius 4.", "Text"], Cell[BoxData[{ RowBox[{ RowBox[{ RowBox[{"d", "[", RowBox[{"{", RowBox[{"x_", ",", "y_"}], "}"}], "]"}], ":=", RowBox[{"ddiff", "[", RowBox[{ RowBox[{"dcircle", "[", RowBox[{ RowBox[{"{", RowBox[{"x", ",", "y"}], "}"}], ",", RowBox[{"{", RowBox[{"0", ",", "0", ",", "4"}], "}"}]}], "]"}], ",", RowBox[{"dcircle", "[", RowBox[{ RowBox[{"{", RowBox[{"x", ",", "y"}], "}"}], ",", RowBox[{"{", RowBox[{"0", ",", "2", ",", "1"}], "}"}]}], "]"}]}], "]"}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"h", "[", RowBox[{"{", RowBox[{"x_", ",", "y_"}], "}"}], "]"}], ":=", RowBox[{"0.1", "+", RowBox[{"0.4", SqrtBox[ RowBox[{ SuperscriptBox["x", "2"], "+", SuperscriptBox[ RowBox[{"(", RowBox[{"y", "-", "2"}], ")"}], "2"]}]]}]}]}], ";"}]}], "Input"], Cell["\<\ This routine generates the nodal points based on d[{x,y}], and on h[{x,y}] \ which specifies a nonuniform approximate spacing, allowing us to place more \ points near the small hole.\ \>", "Text"], Cell[BoxData[ RowBox[{ RowBox[{"p2", "=", RowBox[{"generateMesh", "[", RowBox[{"d", ",", "h", ",", "0.1", ",", RowBox[{"{", RowBox[{ RowBox[{"-", "4"}], ",", RowBox[{"-", "4"}], ",", "4", ",", "4"}], "}"}]}], "]"}]}], ";"}]], "Input"], Cell["Here are the nodal points.", "Text"], Cell[BoxData[ RowBox[{"ListPlot", "[", RowBox[{"p2", ",", RowBox[{"AspectRatio", "\[Rule]", "Automatic"}], ",", RowBox[{"Epilog", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"Hue", "[", "0", "]"}], ",", RowBox[{"Circle", "[", RowBox[{ RowBox[{"{", RowBox[{"0", ",", "0"}], "}"}], ",", "4"}], "]"}], ",", RowBox[{"Circle", "[", RowBox[{ RowBox[{"{", RowBox[{"0", ",", "2"}], "}"}], ",", "1"}], "]"}]}], "}"}]}]}], "]"}]], "Input"], Cell["Now we can triangularize", "Text"], Cell[BoxData[ RowBox[{ RowBox[{"delp2", "=", RowBox[{"DelaunayTriangulation", "[", "p2", "]"}]}], ";"}]], "Input"], Cell["and plot", "Text"], Cell[BoxData[ RowBox[{"PlanarGraphPlot", "[", RowBox[{"p2", ",", "delp2", ",", RowBox[{"LabelPoints", "\[Rule]", "False"}], ",", RowBox[{"Epilog", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"Hue", "[", "0", "]"}], ",", RowBox[{"Circle", "[", RowBox[{ RowBox[{"{", RowBox[{"0", ",", "0"}], "}"}], ",", "4"}], "]"}], ",", RowBox[{"Circle", "[", RowBox[{ RowBox[{"{", RowBox[{"0", ",", "2"}], "}"}], ",", "1"}], "]"}]}], "}"}]}]}], "]"}]], "Input"], Cell["\<\ We have a problem. Some elements are inside the small cutout! Let's remove \ them.\ \>", "Text"], Cell[BoxData[ RowBox[{ RowBox[{"meshbar", "[", "t_", "]"}], ":=", RowBox[{"Union", "[", RowBox[{"Sort", "/@", RowBox[{"(", RowBox[{ RowBox[{ RowBox[{ RowBox[{"Thread", "[", RowBox[{"List", "[", RowBox[{"Sequence", "@@", "#"}], "]"}], "]"}], "&"}], "/@", "t"}], "//", RowBox[{ RowBox[{"Flatten", "[", RowBox[{"#", ",", "1"}], "]"}], "&"}]}], ")"}]}], "]"}]}]], "Input"], Cell[BoxData[ RowBox[{ RowBox[{"bars", "=", RowBox[{"meshbar", "[", "delp2", "]"}]}], ";"}]], "Input"], Cell[BoxData[ RowBox[{ RowBox[{"meshbarPlot", "[", RowBox[{"p_", ",", "bar_List"}], "]"}], ":=", RowBox[{"Show", "[", RowBox[{ RowBox[{"Graphics", "[", RowBox[{"Line", "/@", RowBox[{"(", RowBox[{ RowBox[{ RowBox[{"Part", "[", RowBox[{"p", ",", "#"}], "]"}], "&"}], "/@", "bar"}], ")"}]}], "]"}], ",", RowBox[{"AspectRatio", "\[Rule]", "Automatic"}]}], "]"}]}]], "Input"], Cell[BoxData[ RowBox[{ RowBox[{"middlepoint", "[", RowBox[{"p_", ",", RowBox[{"{", RowBox[{"a_", ",", "b_"}], "}"}]}], "]"}], ":=", FractionBox[ RowBox[{ RowBox[{"p", "[", RowBox[{"[", "a", "]"}], "]"}], "+", RowBox[{"p", "[", RowBox[{"[", "b", "]"}], "]"}]}], "2"]}]], "Input"], Cell["\<\ This selects only those bars whose midpoints are in the computational domain.\ \ \>", "Text"], Cell[BoxData[ RowBox[{ RowBox[{"bars0", "=", RowBox[{"Select", "[", RowBox[{"bars", ",", RowBox[{ RowBox[{ RowBox[{"d", "[", RowBox[{"middlepoint", "[", RowBox[{"p2", ",", "#"}], "]"}], "]"}], "<", "0"}], "&"}]}], "]"}]}], ";"}]], "Input"], Cell[BoxData[ RowBox[{ RowBox[{"mbp", "=", RowBox[{"meshbarPlot", "[", RowBox[{"p2", ",", "bars0"}], "]"}]}], ";"}]], "Input"], Cell["So, here's our final mesh.", "Text"], Cell[BoxData[ RowBox[{"Show", "[", RowBox[{"mbp", ",", RowBox[{"Graphics", "[", RowBox[{"{", RowBox[{ RowBox[{"Hue", "[", "0", "]"}], ",", RowBox[{"Circle", "[", RowBox[{ RowBox[{"{", RowBox[{"0", ",", "0"}], "}"}], ",", "4"}], "]"}], ",", RowBox[{"Circle", "[", RowBox[{ RowBox[{"{", RowBox[{"0", ",", "2"}], "}"}], ",", "1"}], "]"}]}], "}"}], "]"}]}], "]"}]], "Input"], Cell[TextData[{ "Just one example of using ", StyleBox["Mathematica", FontSlant->"Italic"], " packages available off the net. Don't reinvent the wheel; you can \ sometimes find what you want with a little bit of searching." }], "Text"] }, Closed]], Cell[CellGroupData[{ Cell["Exercises", "Section", FontColor->RGBColor[0, 0, 1]], Cell["\<\ Do not look at the solution until you have completed the exercise!\ \>", "Text", TextAlignment->Center, FontFamily->"Helvetica", FontSize->18, FontWeight->"Bold", FontColor->RGBColor[1, 0, 0]], Cell[CellGroupData[{ Cell["Fitting Data", "Subsection"], Cell[TextData[{ "Find the best fit of the form ", Cell[BoxData[ FormBox[ RowBox[{ StyleBox["y", "TI"], "=", SubscriptBox["\[Theta]", "1"], SubscriptBox["\[Theta]", "3"], SubscriptBox[ StyleBox["x", "TI"], "1"], "/", RowBox[{"(", RowBox[{"1", "+", SubscriptBox["\[Theta]", "1"], SubscriptBox[ StyleBox["x", "TI"], "1"], "+", SubscriptBox["\[Theta]", "2"], SubscriptBox[ StyleBox["x", "TI"], "2"]}], ")"}]}], TraditionalForm]], GridBoxOptions->{ GridBoxItemSize->{ "Columns" -> {{Automatic}}, "ColumnsIndexed" -> {}, "Rows" -> {{1.}}, "RowsIndexed" -> {}}}], " to this data, where each point represents ", Cell[BoxData[ FormBox[ RowBox[{ RowBox[{"{", RowBox[{ SubscriptBox["x", "1"], ",", SubscriptBox["x", "2"], ",", "y"}], "}"}], "."}], TraditionalForm]]] }], "Text"], Cell["\<\ data = {{1.0, 1.0, .126}, {2.0, 1.0, .219}, {1.0, 2.0, .076}, {2.0, 2.0, .126}, {.1, .0, .186}};\ \>", "Input", CellTags->"S6.7.1"], Cell["\<\ Plot the resulting fitting function, and calculate the deviation between it \ and the data for all points.\ \>", "Text"], Cell[CellGroupData[{ Cell["Solution", "Subsubsection"], Cell[BoxData[ RowBox[{"ff", "=", RowBox[{"FindFit", "[", RowBox[{"data", ",", RowBox[{ SubscriptBox["\[Theta]", "1"], SubscriptBox["\[Theta]", "3"], RowBox[{ SubscriptBox["x", "1"], "/", RowBox[{"(", RowBox[{"1", "+", RowBox[{ SubscriptBox["\[Theta]", "1"], " ", SubscriptBox["x", "1"]}], "+", RowBox[{ SubscriptBox["\[Theta]", "2"], SubscriptBox["x", "2"]}]}], ")"}]}]}], ",", " ", RowBox[{"{", RowBox[{ SubscriptBox["\[Theta]", "1"], ",", SubscriptBox["\[Theta]", "2"], ",", SubscriptBox["\[Theta]", "3"]}], "}"}], ",", RowBox[{"{", RowBox[{ SubscriptBox["x", "1"], ",", SubscriptBox["x", "2"]}], "}"}]}], "]"}]}]], "Input"], Cell[BoxData[ RowBox[{"pplt", "=", RowBox[{"Show", "[", RowBox[{ RowBox[{"Graphics3D", "[", RowBox[{"{", RowBox[{ RowBox[{"PointSize", "[", ".025", "]"}], ",", "Red", ",", RowBox[{"Point", "/@", "data"}]}], "}"}], "]"}], ",", RowBox[{"AspectRatio", "\[Rule]", "Automatic"}], ",", RowBox[{"DisplayFunction", "\[Rule]", "Identity"}]}], "]"}]}]], "Input", CellChangeTimes->{3.40142680923881*^9}], Cell[BoxData[ RowBox[{"srf", "=", RowBox[{"Plot3D", "[", RowBox[{ RowBox[{"Evaluate", "[", RowBox[{ RowBox[{ SubscriptBox["\[Theta]", "1"], SubscriptBox["\[Theta]", "3"], RowBox[{ SubscriptBox["x", "1"], "/", RowBox[{"(", RowBox[{"1", "+", RowBox[{ SubscriptBox["\[Theta]", "1"], " ", SubscriptBox["x", "1"]}], "+", RowBox[{ SubscriptBox["\[Theta]", "2"], SubscriptBox["x", "2"]}]}], ")"}]}]}], "/.", "ff"}], "]"}], ",", RowBox[{"{", RowBox[{ SubscriptBox["x", "1"], ",", "0", ",", "2"}], "}"}], ",", RowBox[{"{", RowBox[{ SubscriptBox["x", "2"], ",", "0", ",", "2"}], "}"}], ",", RowBox[{"ViewPoint", "\[Rule]", RowBox[{"{", RowBox[{"1.3`", ",", "2.4`", ",", "2.`"}], "}"}]}], ",", RowBox[{"AxesLabel", "\[Rule]", RowBox[{"{", RowBox[{ "\"\<\!\(\*SubscriptBox[\(x\), \(1\)]\)\>\"", ",", "\"\<\!\(\*SubscriptBox[\(x\), \(2\)]\)\>\"", ",", "\"\\""}], "}"}]}], ",", RowBox[{"DisplayFunction", "\[Rule]", "Identity"}]}], "]"}]}]], "Input", CellChangeTimes->{3.401426820448852*^9}], Cell[BoxData[ RowBox[{"Show", "[", RowBox[{"srf", ",", "pplt", ",", RowBox[{"DisplayFunction", "\[Rule]", "$DisplayFunction"}]}], "]"}]], "Input"], Cell["Twist it around to see the fit.", "Text", CellChangeTimes->{{3.401426860141984*^9, 3.401426869658065*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"(", RowBox[{ RowBox[{ RowBox[{ RowBox[{ SubscriptBox["\[Theta]", "1"], SubscriptBox["\[Theta]", "3"], " ", RowBox[{ RowBox[{"#", "\[LeftDoubleBracket]", "1", "\[RightDoubleBracket]"}], "/", RowBox[{"(", RowBox[{"1", "+", RowBox[{ SubscriptBox["\[Theta]", "1"], " ", RowBox[{ "#", "\[LeftDoubleBracket]", "1", "\[RightDoubleBracket]"}]}], "+", RowBox[{ SubscriptBox["\[Theta]", "2"], " ", RowBox[{ "#", "\[LeftDoubleBracket]", "2", "\[RightDoubleBracket]"}]}]}], ")"}]}]}], "-", RowBox[{"#", "\[LeftDoubleBracket]", "3", "\[RightDoubleBracket]"}]}], "/.", "ff"}], "&"}], ")"}], "/@", "data"}]], "Input"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Interpolation Functions", "Subsection"], Cell[TextData[{ "Use NDSolve to solve the differential equation system u''+u=v, v''+x v=u' \ with initial conditions u(0)=u'(0)=v(0)=0, v'(0)=1 on 0\[LessEqual]x\ \[LessEqual]6. This will return solutions in the form of \ InterpolatingFunction objects. Defining ", "F(x)=u v'-v u'", ", time (using Timing[]) the plotting of F over (0,6) ", "using \"PlotPoints\[Rule]5000\"", ". Now find a ", StyleBox["single", FontWeight->"Bold"], " InterpolatingFunction object for F(x)=u v'-v u', and repeat the plotting \ (with timing). Compare.\nBy plotting ever higher derivatives of u over (2,4) \ say, determine the interpolating order of the InterpolatingFunction solutions \ NDSolve gave you" }], "Text"], Cell[CellGroupData[{ Cell["Solution", "Subsubsection"], Cell[BoxData[ RowBox[{"sol", "=", RowBox[{"First", "[", RowBox[{"NDSolve", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{ RowBox[{ RowBox[{ RowBox[{"u", "''"}], "[", "x", "]"}], "+", RowBox[{"u", "[", "x", "]"}]}], "\[Equal]", RowBox[{"v", "[", "x", "]"}]}], ",", RowBox[{ RowBox[{ RowBox[{ RowBox[{"v", "''"}], "[", "x", "]"}], "+", RowBox[{"x", " ", RowBox[{"v", "[", "x", "]"}]}]}], "\[Equal]", RowBox[{ RowBox[{"u", "'"}], "[", "x", "]"}]}], ",", RowBox[{ RowBox[{"u", "[", "0", "]"}], "\[Equal]", "0"}], ",", RowBox[{ RowBox[{ RowBox[{"u", "'"}], "[", "0", "]"}], "\[Equal]", "0"}], ",", RowBox[{ RowBox[{"v", "[", "0", "]"}], "\[Equal]", "0"}], ",", RowBox[{ RowBox[{ RowBox[{"v", "'"}], "[", "0", "]"}], "\[Equal]", "1"}]}], "}"}], ",", RowBox[{"{", RowBox[{"u", ",", "v"}], "}"}], ",", RowBox[{"{", RowBox[{"x", ",", "0", ",", "6"}], "}"}]}], "]"}], "]"}]}]], "Input"], Cell[BoxData[ RowBox[{"Plot", "[", RowBox[{ RowBox[{"Evaluate", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"u", "[", "x", "]"}], ",", RowBox[{"v", "[", "x", "]"}]}], "}"}], "/.", "\[InvisibleSpace]", "sol"}], "]"}], ",", RowBox[{"{", RowBox[{"x", ",", "0", ",", "6"}], "}"}], ",", RowBox[{"PlotStyle", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"{", "}"}], ",", RowBox[{"{", "Red", "}"}]}], "}"}]}]}], "]"}]], "Input"], Cell[BoxData[ RowBox[{ RowBox[{"F", "[", "x_", "]"}], "=", RowBox[{ RowBox[{ RowBox[{ RowBox[{"u", "[", "x", "]"}], RowBox[{ RowBox[{"v", "'"}], "[", "x", "]"}]}], "-", RowBox[{ RowBox[{"v", "[", "x", "]"}], RowBox[{ RowBox[{"u", "'"}], "[", "x", "]"}]}]}], "/.", "sol"}]}]], "Input"], Cell[BoxData[ RowBox[{"Timing", "[", RowBox[{"Plot", "[", RowBox[{ RowBox[{"F", "[", "x", "]"}], ",", RowBox[{"{", RowBox[{"x", ",", "0", ",", "6"}], "}"}], ",", RowBox[{"PlotPoints", "\[Rule]", "5000"}], ",", RowBox[{"ImageSize", "\[Rule]", "400"}], ",", RowBox[{ "PlotLabel", "\[Rule]", "\"\\""}]}], "]"}], "]"}]], "Input", CellChangeTimes->{{3.401426903767571*^9, 3.401426915812175*^9}}], Cell[BoxData[ RowBox[{"FI", "=", RowBox[{"FunctionInterpolation", "[", RowBox[{ RowBox[{"F", "[", "x", "]"}], ",", RowBox[{"{", RowBox[{"x", ",", "0", ",", "6"}], "}"}]}], "]"}]}]], "Input"], Cell[BoxData[ RowBox[{"Timing", "[", RowBox[{"Plot", "[", RowBox[{ RowBox[{"FI", "[", "x", "]"}], ",", RowBox[{"{", RowBox[{"x", ",", "0", ",", "6"}], "}"}], ",", RowBox[{"PlotPoints", "\[Rule]", "5000"}], ",", RowBox[{"PlotLabel", "\[Rule]", "\"\\""}]}], "]"}], "]"}]], "Input"], Cell["\<\ Much faster! What order are the InterpolatingFunction objects?\ \>", "Text"], Cell[BoxData[ RowBox[{"Plot", "[", RowBox[{ RowBox[{"Evaluate", "[", RowBox[{ RowBox[{ SuperscriptBox["u", "\[Prime]", MultilineFunction->None], "[", "x", "]"}], "/.", "\[InvisibleSpace]", "sol"}], "]"}], ",", RowBox[{"{", RowBox[{"x", ",", "2", ",", "4"}], "}"}]}], "]"}]], "Input"], Cell[BoxData[ RowBox[{"Plot", "[", RowBox[{ RowBox[{"Evaluate", "[", RowBox[{ RowBox[{ SuperscriptBox["u", "\[Prime]\[Prime]", MultilineFunction->None], "[", "x", "]"}], "/.", "\[InvisibleSpace]", "sol"}], "]"}], ",", RowBox[{"{", RowBox[{"x", ",", "2", ",", "4"}], "}"}]}], "]"}]], "Input"], Cell[BoxData[ RowBox[{"Plot", "[", RowBox[{ RowBox[{"Evaluate", "[", RowBox[{ RowBox[{ SuperscriptBox["u", TagBox[ RowBox[{"(", "3", ")"}], Derivative], MultilineFunction->None], "[", "x", "]"}], "/.", "\[InvisibleSpace]", "sol"}], "]"}], ",", RowBox[{"{", RowBox[{"x", ",", "2", ",", "4"}], "}"}]}], "]"}]], "Input"], Cell[BoxData[ RowBox[{"Plot", "[", RowBox[{ RowBox[{"Evaluate", "[", RowBox[{ RowBox[{ SuperscriptBox["u", TagBox[ RowBox[{"(", "4", ")"}], Derivative], MultilineFunction->None], "[", "x", "]"}], "/.", "\[InvisibleSpace]", "sol"}], "]"}], ",", RowBox[{"{", RowBox[{"x", ",", "2", ",", "4"}], "}"}]}], "]"}]], "Input"], Cell[BoxData[ RowBox[{"Plot", "[", RowBox[{ RowBox[{"Evaluate", "[", RowBox[{ RowBox[{ SuperscriptBox["u", TagBox[ RowBox[{"(", "5", ")"}], Derivative], MultilineFunction->None], "[", "x", "]"}], "/.", "\[InvisibleSpace]", "sol"}], "]"}], ",", RowBox[{"{", RowBox[{"x", ",", "2", ",", "4"}], "}"}]}], "]"}]], "Input"], Cell[TextData[{ "Clearly, the InterpolatingFunction for u is a ", Cell[BoxData[ FormBox[ SuperscriptBox[ StyleBox["C", FontFamily->"Chancery l"], "4"], TraditionalForm]]], "function ", StyleBox["in this case", FontWeight->"Bold"], ", i.e., it has continuous 4th derivative, but discontinuous 5th \ derivative." }], "Text"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Exporting Graphics", "Subsection"], Cell[TextData[{ "Here is a ", StyleBox["Mathematica", FontSlant->"Italic"], " program (see Chapter 5) which numerically integrates the 3-body problem in \ the plane for three gravitationally interacting point masses. It's arguments \ are the time duration of the integration T, the gravitational constant G, the \ three masses, M1, M2, and M3, the initial x- and y-positions of the three \ points Xs and Ys, and the initial velocities Us (x-components) and Ys \ (y-components). The default values hardwired into this definition correspond \ to the strange ", StyleBox["choreographic solution ", FontSlant->"Italic"], " recently discovered for three equal masses." }], "Text"], Cell[BoxData[ RowBox[{ RowBox[{"threeBody", "[", RowBox[{"T_", ",", RowBox[{"G_:", "1"}], ",", RowBox[{"M1_:", "1"}], ",", RowBox[{"M2_:", "1"}], ",", RowBox[{"M3_:", "1"}], ",", "\[IndentingNewLine]", RowBox[{"Xs_:", RowBox[{"{", RowBox[{"0.97000436", ",", RowBox[{"-", "0.97000436"}], ",", "0"}], "}"}]}], ",", "\[IndentingNewLine]", RowBox[{"Ys_:", RowBox[{"{", RowBox[{ RowBox[{"-", "0.24308753"}], ",", "0.24308753", ",", "0"}], "}"}]}], ",", "\[IndentingNewLine]", RowBox[{"Us_:", RowBox[{"{", RowBox[{ RowBox[{"0.93240737", "/", "2"}], ",", RowBox[{"0.93240737", "/", "2"}], ",", RowBox[{"-", "0.93240737"}]}], "}"}]}], ",", "\[IndentingNewLine]", RowBox[{"Vs_:", RowBox[{"{", RowBox[{ RowBox[{"0.86473146", "/", "2"}], ",", RowBox[{"0.86473146", "/", "2"}], ",", RowBox[{"-", "0.86473146"}]}], "}"}]}]}], "]"}], ":=", "\[IndentingNewLine]", RowBox[{"Module", "[", RowBox[{ RowBox[{"{", RowBox[{"sol", ",", "D12", ",", "D13", ",", "D23"}], "}"}], ",", "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"{", RowBox[{"x1s", ",", "x2s", ",", "x3s"}], "}"}], "=", "Xs"}], ";", "\[IndentingNewLine]", RowBox[{ RowBox[{"{", RowBox[{"y1s", ",", "y2s", ",", "y3s"}], "}"}], "=", "Ys"}], ";", "\[IndentingNewLine]", RowBox[{ RowBox[{"{", RowBox[{"u1s", ",", "u2s", ",", "u3s"}], "}"}], "=", "Us"}], ";", "\[IndentingNewLine]", RowBox[{ RowBox[{"{", RowBox[{"v1s", ",", "v2s", ",", "v3s"}], "}"}], "=", "Vs"}], ";", "\[IndentingNewLine]", RowBox[{"sol", "=", RowBox[{"NDSolve", "[", "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{ RowBox[{"D12", "[", "t_", "]"}], "=", SqrtBox[ RowBox[{ SuperscriptBox[ RowBox[{"(", RowBox[{ RowBox[{"x1", "[", "t", "]"}], "-", RowBox[{"x2", "[", "t", "]"}]}], ")"}], "2"], "+", SuperscriptBox[ RowBox[{"(", RowBox[{ RowBox[{"y1", "[", "t", "]"}], "-", RowBox[{"y2", "[", "t", "]"}]}], ")"}], "2"]}]]}], ";", RowBox[{ RowBox[{"D13", "[", "t_", "]"}], "=", SqrtBox[ RowBox[{ SuperscriptBox[ RowBox[{"(", RowBox[{ RowBox[{"x1", "[", "t", "]"}], "-", RowBox[{"x3", "[", "t", "]"}]}], ")"}], "2"], "+", SuperscriptBox[ RowBox[{"(", RowBox[{ RowBox[{"y1", "[", "t", "]"}], "-", RowBox[{"y3", "[", "t", "]"}]}], ")"}], "2"]}]]}], ";", "\[IndentingNewLine]", RowBox[{ RowBox[{"D23", "[", "t_", "]"}], "=", SqrtBox[ RowBox[{ SuperscriptBox[ RowBox[{"(", RowBox[{ RowBox[{"x2", "[", "t", "]"}], "-", RowBox[{"x3", "[", "t", "]"}]}], ")"}], "2"], "+", SuperscriptBox[ RowBox[{"(", RowBox[{ RowBox[{"y2", "[", "t", "]"}], "-", RowBox[{"y3", "[", "t", "]"}]}], ")"}], "2"]}]]}], ";", "\[IndentingNewLine]", RowBox[{"{", RowBox[{ RowBox[{ RowBox[{ RowBox[{"x1", "''"}], "[", "t", "]"}], "\[Equal]", RowBox[{ RowBox[{"-", "G"}], " ", RowBox[{"(", RowBox[{ FractionBox[ RowBox[{"M2", RowBox[{"(", RowBox[{ RowBox[{"x1", "[", "t", "]"}], "-", RowBox[{"x2", "[", "t", "]"}]}], ")"}]}], SuperscriptBox[ RowBox[{"D12", "[", "t", "]"}], "3"]], "+", FractionBox[ RowBox[{"M3", RowBox[{"(", RowBox[{ RowBox[{"x1", "[", "t", "]"}], "-", RowBox[{"x3", "[", "t", "]"}]}], ")"}]}], SuperscriptBox[ RowBox[{"D13", "[", "t", "]"}], "3"]]}], ")"}]}]}], ",", "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"x2", "''"}], "[", "t", "]"}], "\[Equal]", RowBox[{ RowBox[{"-", "G"}], " ", RowBox[{"(", RowBox[{ FractionBox[ RowBox[{"M1", RowBox[{"(", RowBox[{ RowBox[{"x2", "[", "t", "]"}], "-", RowBox[{"x1", "[", "t", "]"}]}], ")"}]}], SuperscriptBox[ RowBox[{"D12", "[", "t", "]"}], "3"]], "+", FractionBox[ RowBox[{"M3", RowBox[{"(", RowBox[{ RowBox[{"x2", "[", "t", "]"}], "-", RowBox[{"x3", "[", "t", "]"}]}], ")"}]}], SuperscriptBox[ RowBox[{"D23", "[", "t", "]"}], "3"]]}], ")"}]}]}], ",", "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"x3", "''"}], "[", "t", "]"}], "==", RowBox[{ RowBox[{"-", "G"}], " ", RowBox[{"(", RowBox[{ FractionBox[ RowBox[{"M1", RowBox[{"(", RowBox[{ RowBox[{"x3", "[", "t", "]"}], "-", RowBox[{"x1", "[", "t", "]"}]}], ")"}]}], SuperscriptBox[ RowBox[{"D13", "[", "t", "]"}], "3"]], "+", FractionBox[ RowBox[{"M2", RowBox[{"(", RowBox[{ RowBox[{"x3", "[", "t", "]"}], "-", RowBox[{"x2", "[", "t", "]"}]}], ")"}]}], SuperscriptBox[ RowBox[{"D23", "[", "t", "]"}], "3"]]}], ")"}]}]}], ",", "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"y1", "''"}], "[", "t", "]"}], "\[Equal]", RowBox[{ RowBox[{"-", "G"}], " ", RowBox[{"(", RowBox[{ FractionBox[ RowBox[{"M2", RowBox[{"(", RowBox[{ RowBox[{"y1", "[", "t", "]"}], "-", RowBox[{"y2", "[", "t", "]"}]}], ")"}]}], SuperscriptBox[ RowBox[{"D12", "[", "t", "]"}], "3"]], "+", FractionBox[ RowBox[{"M3", RowBox[{"(", RowBox[{ RowBox[{"y1", "[", "t", "]"}], "-", RowBox[{"y3", "[", "t", "]"}]}], ")"}]}], SuperscriptBox[ RowBox[{"D13", "[", "t", "]"}], "3"]]}], ")"}]}]}], ",", "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"y2", "''"}], "[", "t", "]"}], "\[Equal]", RowBox[{ RowBox[{"-", "G"}], " ", RowBox[{"(", RowBox[{ FractionBox[ RowBox[{"M1", RowBox[{"(", RowBox[{ RowBox[{"y2", "[", "t", "]"}], "-", RowBox[{"y1", "[", "t", "]"}]}], ")"}]}], SuperscriptBox[ RowBox[{"D12", "[", "t", "]"}], "3"]], "+", FractionBox[ RowBox[{"M3", RowBox[{"(", RowBox[{ RowBox[{"y2", "[", "t", "]"}], "-", RowBox[{"y3", "[", "t", "]"}]}], ")"}]}], SuperscriptBox[ RowBox[{"D23", "[", "t", "]"}], "3"]]}], ")"}]}]}], ",", "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"y3", "''"}], "[", "t", "]"}], "==", RowBox[{ RowBox[{"-", "G"}], " ", RowBox[{"(", RowBox[{ FractionBox[ RowBox[{"M1", RowBox[{"(", RowBox[{ RowBox[{"y3", "[", "t", "]"}], "-", RowBox[{"y1", "[", "t", "]"}]}], ")"}]}], SuperscriptBox[ RowBox[{"D13", "[", "t", "]"}], "3"]], "+", FractionBox[ RowBox[{"M2", RowBox[{"(", RowBox[{ RowBox[{"y3", "[", "t", "]"}], "-", RowBox[{"y2", "[", "t", "]"}]}], ")"}]}], SuperscriptBox[ RowBox[{"D23", "[", "t", "]"}], "3"]]}], ")"}]}]}], ",", "\[IndentingNewLine]", RowBox[{ RowBox[{"x1", "[", "0", "]"}], "\[Equal]", "x1s"}], ",", RowBox[{ RowBox[{"y1", "[", "0", "]"}], "\[Equal]", "y1s"}], ",", RowBox[{ RowBox[{ RowBox[{"x1", "'"}], "[", "0", "]"}], "\[Equal]", "u1s"}], ",", RowBox[{ RowBox[{ RowBox[{"y1", "'"}], "[", "0", "]"}], "\[Equal]", "v1s"}], ",", "\[IndentingNewLine]", RowBox[{ RowBox[{"x2", "[", "0", "]"}], "\[Equal]", "x2s"}], ",", RowBox[{ RowBox[{"y2", "[", "0", "]"}], "\[Equal]", "y2s"}], ",", RowBox[{ RowBox[{ RowBox[{"x2", "'"}], "[", "0", "]"}], "\[Equal]", "u2s"}], ",", RowBox[{ RowBox[{ RowBox[{"y2", "'"}], "[", "0", "]"}], "\[Equal]", "v2s"}], ",", "\[IndentingNewLine]", RowBox[{ RowBox[{"x3", "[", "0", "]"}], "\[Equal]", "x3s"}], ",", RowBox[{ RowBox[{"y3", "[", "0", "]"}], "\[Equal]", "y3s"}], ",", RowBox[{ RowBox[{ RowBox[{"x3", "'"}], "[", "0", "]"}], "\[Equal]", "u3s"}], ",", RowBox[{ RowBox[{ RowBox[{"y3", "'"}], "[", "0", "]"}], "\[Equal]", "v3s"}]}], "}"}]}], ",", RowBox[{"{", RowBox[{ "x1", ",", "y1", ",", "x2", ",", "y2", ",", "x3", ",", "y3"}], "}"}], ",", RowBox[{"{", RowBox[{"t", ",", "0", ",", "T"}], "}"}]}], "]"}]}], ";", RowBox[{"First", "[", "sol", "]"}]}]}], "]"}]}]], "Input"], Cell[TextData[{ "Integrate the choreographic solution for T=10 and make a movie. Save that \ movie as an animated gif, and view it using a web browser to make sure it \ would work properly on a web page. [Your movie should display time ", StyleBox["t ", FontSlant->"Italic"], "on each frame. It should also have a fixed frame size, so that it is not \ zooming in and out as the points move. Colour each of the three points \ differently, and place them on a black background.] Also make a \ ParametricPlot of the motion of the three points, with the curves similarly \ colour-coded, and save this as an encapsulated postscript file.", "\nRepeat the exercise for the case where M3 is changed to 0.9, but \ everything else stays the same.\n[Note: threeBody is a fairly unsophisticated \ implementation. Higher accuracy could be achieved by, for example, choosing \ to conserve certain invariants such as energy and angular momentum. ", StyleBox["Mathematica", FontSlant->"Italic"], "'s Projection method allows us to do this inside NDSolve.]" }], "Text"], Cell[CellGroupData[{ Cell["Solution", "Subsubsection"], Cell[BoxData[ RowBox[{"solchor", "=", RowBox[{"threeBody", "[", "10", "]"}]}]], "Input", CellChangeTimes->{{3.401432982299059*^9, 3.401432982916112*^9}, { 3.401433862678708*^9, 3.4014338629960957`*^9}}], Cell[BoxData[ RowBox[{"sol", "=", RowBox[{"threeBody", "[", RowBox[{"10", ",", "1", ",", "1", ",", "1", ",", ".9"}], "]"}]}]], "Input",\ CellChangeTimes->{{3.401432988703362*^9, 3.40143298936415*^9}, { 3.401433867039221*^9, 3.4014338686443157`*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"p", "[", RowBox[{"sol_", ",", "t_", ",", RowBox[{"PR_:", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"-", "1.50001"}], ",", "1.5"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "1.50001"}], ",", "1.5"}], "}"}]}], "}"}]}]}], "]"}], ":=", RowBox[{"Show", "[", RowBox[{ RowBox[{"Graphics", "[", RowBox[{"{", RowBox[{ RowBox[{"PointSize", "[", ".025", "]"}], ",", "Red", ",", RowBox[{"Point", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"x1", "[", "t", "]"}], ",", RowBox[{"y1", "[", "t", "]"}]}], "}"}], "/.", "sol"}], "]"}]}], "}"}], "]"}], ",", RowBox[{"Graphics", "[", RowBox[{"{", RowBox[{ RowBox[{"PointSize", "[", ".025", "]"}], ",", "Blue", ",", RowBox[{"Point", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"x2", "[", "t", "]"}], ",", RowBox[{"y2", "[", "t", "]"}]}], "}"}], "/.", "sol"}], "]"}]}], "}"}], "]"}], ",", RowBox[{"Graphics", "[", RowBox[{"{", RowBox[{ RowBox[{"PointSize", "[", ".025", "]"}], ",", "Green", ",", RowBox[{"Point", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"x3", "[", "t", "]"}], ",", RowBox[{"y3", "[", "t", "]"}]}], "}"}], "/.", "sol"}], "]"}]}], "}"}], "]"}], ",", RowBox[{"Frame", "\[Rule]", "False"}], ",", RowBox[{"FrameLabel", "\[Rule]", RowBox[{"{", RowBox[{"\"\\"", ",", "\"\\""}], "}"}]}], ",", RowBox[{"PlotRange", "\[Rule]", "PR"}], ",", RowBox[{"AspectRatio", "\[Rule]", "Automatic"}], ",", RowBox[{"Background", "\[Rule]", "Black"}], ",", RowBox[{"PlotLabel", "->", RowBox[{"\"\\"", "<>", RowBox[{"ToString", "[", RowBox[{"PaddedForm", "[", RowBox[{"t", ",", RowBox[{"{", RowBox[{"4", ",", "2"}], "}"}]}], "]"}], "]"}]}]}], ",", RowBox[{"BaseStyle", "\[Rule]", "White"}]}], "]"}]}]], "Input", CellChangeTimes->{{3.4014337961027718`*^9, 3.4014338021251717`*^9}, { 3.401433835532343*^9, 3.401433838908661*^9}}], Cell[BoxData[ RowBox[{"ParametricPlot", "[", RowBox[{ RowBox[{"Evaluate", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"x1", "[", "t", "]"}], ",", RowBox[{"y1", "[", "t", "]"}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"x2", "[", "t", "]"}], ",", RowBox[{"y2", "[", "t", "]"}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"x3", "[", "t", "]"}], ",", RowBox[{"y3", "[", "t", "]"}]}], "}"}]}], "}"}], "/.", "\[InvisibleSpace]", "solchor"}], "]"}], ",", RowBox[{"{", RowBox[{"t", ",", "0", ",", "10"}], "}"}], ",", RowBox[{"PlotStyle", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"{", "Red", "}"}], ",", RowBox[{"{", "Blue", "}"}], ",", RowBox[{"{", "Green", "}"}]}], "}"}]}], ",", RowBox[{"Frame", "\[Rule]", "True"}]}], "]"}]], "Input"], Cell[BoxData[ RowBox[{"Animate", "[", RowBox[{ RowBox[{"p", "[", RowBox[{"solchor", ",", "t"}], "]"}], ",", RowBox[{"{", RowBox[{"t", ",", "0", ",", "10", ",", ".1"}], "}"}]}], "]"}]], "Input", CellChangeTimes->{{3.401432710359975*^9, 3.401432717420465*^9}, 3.401433965813368*^9}], Cell[BoxData[ RowBox[{ RowBox[{"anim3BobyChor", "=", RowBox[{"Table", "[", RowBox[{ RowBox[{"p", "[", RowBox[{"solchor", ",", "t"}], "]"}], ",", RowBox[{"{", RowBox[{"t", ",", "0", ",", "10", ",", ".1"}], "}"}]}], "]"}]}], ";"}]], "Input", CellChangeTimes->{{3.401432710359975*^9, 3.401432717420465*^9}, { 3.401433450179668*^9, 3.4014334539979897`*^9}, {3.401433605681994*^9, 3.401433608259018*^9}, {3.401433648419243*^9, 3.401433654732242*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"Export", "[", RowBox[{"\"\\"", ",", "anim3BobyChor"}], "]"}], ";"}]], "Input", CellChangeTimes->{3.401433062123724*^9}], Cell[BoxData[ RowBox[{"ParametricPlot", "[", RowBox[{ RowBox[{"Evaluate", "[", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"x1", "[", "t", "]"}], ",", RowBox[{"y1", "[", "t", "]"}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"x2", "[", "t", "]"}], ",", RowBox[{"y2", "[", "t", "]"}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"x3", "[", "t", "]"}], ",", RowBox[{"y3", "[", "t", "]"}]}], "}"}]}], "}"}], "/.", "\[InvisibleSpace]", "sol"}], "]"}], ",", RowBox[{"{", RowBox[{"t", ",", "0", ",", "10"}], "}"}], ",", RowBox[{"PlotStyle", "\[Rule]", RowBox[{"{", RowBox[{ RowBox[{"{", "Red", "}"}], ",", RowBox[{"{", "Blue", "}"}], ",", RowBox[{"{", "Green", "}"}]}], "}"}]}], ",", RowBox[{"Frame", "\[Rule]", "True"}]}], "]"}]], "Input"], Cell[BoxData[ RowBox[{"Animate", "[", RowBox[{ RowBox[{"p", "[", RowBox[{"sol", ",", "t", ",", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"-", "2.5"}], ",", "2.5"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "2.5"}], ",", "2.5"}], "}"}]}], "}"}]}], "]"}], ",", RowBox[{"{", RowBox[{"t", ",", "0", ",", "10", ",", ".1"}], "}"}]}], "]"}]], "Input", CellChangeTimes->{{3.401432893127473*^9, 3.40143290147703*^9}, 3.401433958363378*^9}], Cell[BoxData[ RowBox[{ RowBox[{"anim3Body", "=", RowBox[{"Table", "[", RowBox[{ RowBox[{"p", "[", RowBox[{"sol", ",", "t", ",", RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{"-", "2.5"}], ",", "2.5"}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{"-", "2.5"}], ",", "2.5"}], "}"}]}], "}"}]}], "]"}], ",", RowBox[{"{", RowBox[{"t", ",", "0", ",", "10", ",", ".1"}], "}"}]}], "]"}]}], ";"}]], "Input", CellChangeTimes->{{3.4014339303684072`*^9, 3.401433936958417*^9}}], Cell[BoxData[ RowBox[{ RowBox[{"Export", "[", RowBox[{"\"\<3Body.gif\>\"", ",", "anim3Body"}], "]"}], ";"}]], "Input", CellChangeTimes->{3.401433947185121*^9}], Cell[BoxData[ RowBox[{"Clear", "[", RowBox[{ "sol", ",", "solchor", ",", "anim3BobyChor", ",", "anim3Body", ",", "p"}], "]"}]], "Input"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Optimization", "Subsection"], Cell["Plot the function", "Text"], Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{"f", "[", RowBox[{"x_", ",", "y_"}], "]"}], "=", RowBox[{ SuperscriptBox["\[ExponentialE]", RowBox[{"Sin", "[", RowBox[{"50", " ", "x"}], "]"}]], "+", RowBox[{"Sin", "[", RowBox[{"60", " ", SuperscriptBox["\[ExponentialE]", "y"]}], "]"}], "+", RowBox[{"Sin", "[", RowBox[{"70", " ", RowBox[{"Sin", "[", "x", "]"}]}], "]"}], "+", RowBox[{"Sin", "[", RowBox[{"Sin", "[", RowBox[{"80", " ", "y"}], "]"}], "]"}], "-", RowBox[{"Sin", "[", RowBox[{"10", " ", RowBox[{"(", RowBox[{"x", "+", "y"}], ")"}]}], "]"}], "+", RowBox[{ FractionBox["1", "4"], " ", RowBox[{"(", RowBox[{ SuperscriptBox["x", "2"], "+", SuperscriptBox["y", "2"]}], ")"}]}]}]}], ";"}]], "Input"], Cell[TextData[{ "over -1\[LessEqual]x\[LessEqual]1, -1\[LessEqual]y\[LessEqual]1. Wow! Find \ the global minimum of ", StyleBox["f", FontSlant->"Italic"], ", correct to 10 decimal places. [Hint: try a genetic algorithm (see the \ options to NMinimize), and use at least 32 for WorkingPrecision. See the \ options of NMinimize.]" }], "Text", CellChangeTimes->{{3.401436365886135*^9, 3.4014363772679*^9}}], Cell[CellGroupData[{ Cell["Solution", "Subsubsection"], Cell[BoxData[ RowBox[{"Plot3D", "[", RowBox[{ RowBox[{"Evaluate", "[", RowBox[{"f", "[", RowBox[{"x", ",", "y"}], "]"}], "]"}], ",", RowBox[{"{", RowBox[{"x", ",", RowBox[{"-", "1"}], ",", "1"}], "}"}], ",", RowBox[{"{", RowBox[{"y", ",", RowBox[{"-", "1"}], ",", "1"}], "}"}], ",", RowBox[{"PlotPoints", "\[Rule]", "60"}], ",", RowBox[{"Mesh", "\[Rule]", "False"}]}], "]"}]], "Input", CellChangeTimes->{{3.401434371678336*^9, 3.401434389861027*^9}, 3.4014353561050253`*^9, {3.40143606292015*^9, 3.4014360635576143`*^9}}], Cell[BoxData[ RowBox[{"N", "[", RowBox[{ RowBox[{"NMinimize", "[", RowBox[{ RowBox[{"f", "[", RowBox[{"x", ",", "y"}], "]"}], ",", " ", RowBox[{"{", RowBox[{"x", ",", "y"}], "}"}], ",", " ", RowBox[{"Method", "->", "\"\\""}], ",", " ", RowBox[{"WorkingPrecision", "\[Rule]", "32"}]}], "]"}], ",", "10"}], "]"}]], "Input"] }, Closed]] }, Closed]] }, Closed]] }, Open ]] }, WindowSize->{853, 851}, WindowMargins->{{0, Automatic}, {Automatic, 0}}, DockedCells->(FrontEndExecute[{ FrontEnd`NotebookApply[ FrontEnd`InputNotebook[], #, Placeholder]}]& ), ShowSelection->True, Magnification->1., FrontEndVersion->"6.0 for Mac OS X x86 (32-bit) (June 19, 2007)", StyleDefinitions->FrontEnd`FileName[{"Creative"}, "NaturalColor.nb", CharacterEncoding -> "UTF-8"] ] (* End of Notebook Content *) (* Internal cache information *) (*CellTagsOutline CellTagsIndex->{ "S1.6.7"->{ Cell[10762, 376, 75, 1, 44, "Input", CellTags->"S1.6.7"], Cell[10884, 381, 48, 1, 44, "Input", CellTags->"S1.6.7"], Cell[11035, 387, 52, 1, 44, "Input", CellTags->"S1.6.7"]}, "S5.95.1"->{ Cell[13257, 453, 246, 5, 44, "Input", CellTags->"S5.95.1"], Cell[13506, 460, 56, 1, 44, "Input", CellTags->"S5.95.1"]}, "Minimize"->{ Cell[27684, 887, 509, 18, 55, "Input", CellTags->"Minimize"], Cell[28249, 910, 858, 26, 60, "Input", CellTags->"Minimize"], Cell[29110, 938, 313, 10, 61, "Input", CellTags->"Minimize"], Cell[29745, 958, 510, 18, 55, "Input", CellTags->"Minimize"]}, "NMinimize:Contents"->{ Cell[33290, 1103, 1296, 35, 112, "Input", CellTags->{"NMinimize:Contents", "NMinimize"}], Cell[34858, 1147, 613, 20, 68, "Input", CellTags->{"NMinimize:Contents", "NMinimize"}], Cell[36008, 1187, 612, 20, 68, "Input", CellTags->{"NMinimize:Contents", "NMinimize"}]}, "NMinimize"->{ Cell[33290, 1103, 1296, 35, 112, "Input", CellTags->{"NMinimize:Contents", "NMinimize"}], Cell[34858, 1147, 613, 20, 68, "Input", CellTags->{"NMinimize:Contents", "NMinimize"}], Cell[36008, 1187, 612, 20, 68, "Input", CellTags->{"NMinimize:Contents", "NMinimize"}]}, "S5.19.1"->{ Cell[37683, 1242, 306, 9, 122, "Input", CellTags->"S5.19.1"]}, "S6.7.1"->{ Cell[48884, 1636, 142, 4, 40, "Input", CellTags->"S6.7.1"]} } *) (*CellTagsIndex CellTagsIndex->{ {"S1.6.7", 81547, 2640}, {"S5.95.1", 81751, 2647}, {"Minimize", 81896, 2652}, {"NMinimize:Contents", 82190, 2661}, {"NMinimize", 82488, 2668}, {"S5.19.1", 82784, 2675}, {"S6.7.1", 82865, 2678} } *) (*NotebookFileOutline Notebook[{ Cell[CellGroupData[{ Cell[590, 23, 118, 4, 66, "Title"], Cell[711, 29, 53, 0, 31, "Subtitle"], Cell[767, 31, 89, 2, 20, "Author"], Cell[CellGroupData[{ Cell[881, 37, 31, 0, 72, "Section"], Cell[915, 39, 67, 0, 21, "Text"], Cell[985, 41, 590, 18, 49, "Input"], Cell[1578, 61, 38, 0, 21, "Text"], Cell[1619, 63, 88, 2, 44, "Input"], Cell[1710, 67, 162, 3, 21, "Text"], Cell[1875, 72, 302, 8, 49, "Input"], Cell[2180, 82, 48, 0, 21, "Text"], Cell[2231, 84, 57, 1, 44, "Input"], Cell[2291, 87, 192, 5, 21, "Text"], Cell[2486, 94, 512, 18, 64, "Input"], Cell[3001, 114, 41, 0, 21, "Text"], Cell[3045, 116, 594, 17, 44, "Input"], Cell[3642, 135, 187, 4, 21, "Text"], Cell[3832, 141, 85, 2, 44, "Input"], Cell[3920, 145, 191, 4, 44, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[4148, 154, 37, 0, 42, "Section"], Cell[4188, 156, 425, 7, 78, "Text"], Cell[4616, 165, 207, 7, 66, "Input"], Cell[4826, 174, 261, 8, 44, "Input"], Cell[5090, 184, 296, 9, 44, "Input"], Cell[5389, 195, 114, 1, 21, "Text"], Cell[5506, 198, 90, 2, 44, "Input"], Cell[5599, 202, 249, 7, 44, "Input"], Cell[5851, 211, 66, 0, 21, "Text"], Cell[5920, 213, 72, 1, 44, "Input"], Cell[5995, 216, 232, 4, 21, "Text"], Cell[6230, 222, 187, 6, 44, "Input"], Cell[6420, 230, 187, 6, 44, "Input"], Cell[6610, 238, 537, 16, 60, "Input"], Cell[7150, 256, 438, 9, 52, "Text"], Cell[7591, 267, 213, 6, 44, "Input"], Cell[7807, 275, 797, 23, 60, "Input"], Cell[8607, 300, 144, 4, 44, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[8788, 309, 35, 0, 42, "Section"], Cell[8826, 311, 211, 6, 21, "Text"], Cell[9040, 319, 1580, 52, 129, "Text"], Cell[10623, 373, 136, 1, 21, "Text"], Cell[10762, 376, 75, 1, 44, "Input", CellTags->"S1.6.7"], Cell[10840, 379, 41, 0, 21, "Text"], Cell[10884, 381, 48, 1, 44, "Input", CellTags->"S1.6.7"], Cell[10935, 384, 97, 1, 21, "Text"], Cell[11035, 387, 52, 1, 44, "Input", CellTags->"S1.6.7"], Cell[11090, 390, 99, 2, 21, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[11226, 397, 99, 1, 42, "Section"], Cell[11328, 400, 221, 4, 21, "Text"], Cell[11552, 406, 894, 23, 52, "Text"], Cell[12449, 431, 393, 6, 36, "Text"], Cell[12845, 439, 116, 2, 44, "Input"], Cell[12964, 443, 114, 2, 44, "Input"], Cell[13081, 447, 173, 4, 21, "Text"], Cell[13257, 453, 246, 5, 44, "Input", CellTags->"S5.95.1"], Cell[13506, 460, 56, 1, 44, "Input", CellTags->"S5.95.1"] }, Closed]], Cell[CellGroupData[{ Cell[13599, 466, 36, 0, 42, "Section"], Cell[CellGroupData[{ Cell[13660, 470, 30, 0, 40, "Subsection"], Cell[13693, 472, 788, 20, 67, "Text"], Cell[14484, 494, 1366, 37, 126, "Input"], Cell[15853, 533, 128, 3, 44, "Input"], Cell[15984, 538, 444, 11, 61, "Text"], Cell[16431, 551, 125, 2, 44, "Input"], Cell[16559, 555, 106, 1, 21, "Text"], Cell[16668, 558, 159, 2, 44, "Input"], Cell[16830, 562, 330, 6, 36, "Text"], Cell[17163, 570, 186, 4, 44, "Input"], Cell[17352, 576, 255, 4, 36, "Text"], Cell[17610, 582, 40, 0, 44, "Input"], Cell[17653, 584, 144, 1, 21, "Text"], Cell[17800, 587, 142, 3, 44, "Input"], Cell[17945, 592, 150, 3, 44, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[18132, 600, 113, 1, 24, "Subsection"], Cell[18248, 603, 283, 5, 36, "Text"], Cell[18534, 610, 1082, 27, 60, "Input"], Cell[19619, 639, 512, 9, 61, "Text"], Cell[20134, 650, 1200, 30, 60, "Input"], Cell[21337, 682, 296, 7, 36, "Text"], Cell[21636, 691, 223, 4, 44, "Input"], Cell[21862, 697, 231, 5, 21, "Text"], Cell[22096, 704, 827, 24, 75, "Input"], Cell[22926, 730, 106, 2, 44, "Input"], Cell[23035, 734, 30, 0, 21, "Text"], Cell[23068, 736, 106, 2, 44, "Input"], Cell[23177, 740, 444, 8, 76, "Text"], Cell[23624, 750, 598, 11, 60, "Input"], Cell[24225, 763, 771, 20, 91, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[25033, 788, 26, 0, 24, "Subsection"], Cell[25062, 790, 67, 0, 21, "Text"], Cell[25132, 792, 330, 10, 44, "Input"], Cell[25465, 804, 27, 0, 21, "Text"], Cell[25495, 806, 97, 2, 44, "Input"], Cell[25595, 810, 76, 0, 21, "Text"], Cell[25674, 812, 591, 11, 60, "Input"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[26314, 829, 31, 0, 42, "Section"], Cell[26348, 831, 126, 4, 21, "Text"], Cell[26477, 837, 1204, 48, 100, "Text"], Cell[27684, 887, 509, 18, 55, "Input", CellTags->"Minimize"], Cell[28196, 907, 50, 1, 44, "Input"], Cell[28249, 910, 858, 26, 60, "Input", CellTags->"Minimize"], Cell[29110, 938, 313, 10, 61, "Input", CellTags->"Minimize"], Cell[29426, 950, 316, 6, 71, "Text"], Cell[29745, 958, 510, 18, 55, "Input", CellTags->"Minimize"], Cell[30258, 978, 129, 5, 21, "Text"], Cell[30390, 985, 1417, 56, 98, "Text"], Cell[31810, 1043, 336, 12, 64, "Input"], Cell[32149, 1057, 189, 6, 44, "Input"], Cell[32341, 1065, 99, 2, 21, "Text"], Cell[32443, 1069, 186, 6, 44, "Input"], Cell[32632, 1077, 165, 5, 44, "Input"], Cell[32800, 1084, 118, 5, 21, "Text"], Cell[32921, 1091, 114, 3, 44, "Input"], Cell[33038, 1096, 249, 5, 36, "Text"], Cell[33290, 1103, 1296, 35, 112, "Input", CellTags->{"NMinimize:Contents", "NMinimize"}], Cell[34589, 1140, 119, 1, 21, "Text"], Cell[34711, 1143, 144, 2, 44, "Input"], Cell[34858, 1147, 613, 20, 68, "Input", CellTags->{"NMinimize:Contents", "NMinimize"}], Cell[35474, 1169, 118, 1, 21, "Text"], Cell[35595, 1172, 208, 7, 68, "Input"], Cell[35806, 1181, 199, 4, 36, "Text"], Cell[36008, 1187, 612, 20, 68, "Input", CellTags->{"NMinimize:Contents", "NMinimize"}], Cell[36623, 1209, 43, 0, 21, "Text"], Cell[36669, 1211, 50, 1, 56, "Input"], Cell[36722, 1214, 327, 5, 52, "Text"], Cell[37052, 1221, 58, 1, 56, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[37147, 1227, 45, 0, 42, "Section"], Cell[37195, 1229, 346, 6, 76, "Text"], Cell[37544, 1237, 74, 1, 56, "Input"], Cell[37621, 1240, 59, 0, 21, "Text"], Cell[37683, 1242, 306, 9, 122, "Input", CellTags->"S5.19.1"], Cell[37992, 1253, 28, 0, 21, "Text"], Cell[38023, 1255, 399, 10, 72, "Input"], Cell[38425, 1267, 142, 3, 21, "Text"], Cell[38570, 1272, 369, 9, 72, "Input"], Cell[38942, 1283, 24, 0, 21, "Text"], Cell[38969, 1285, 84, 2, 56, "Input"], Cell[39056, 1289, 231, 4, 36, "Text"], Cell[39290, 1295, 107, 2, 56, "Input"], Cell[39400, 1299, 42, 0, 21, "Text"], Cell[39445, 1301, 170, 4, 56, "Input"], Cell[39618, 1307, 92, 2, 21, "Text"], Cell[39713, 1311, 451, 10, 72, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[40201, 1326, 64, 0, 42, "Section"], Cell[40268, 1328, 1057, 22, 110, "Text"], Cell[41328, 1352, 58, 1, 26, "Input"], Cell[41389, 1355, 204, 4, 35, "Text"], Cell[41596, 1361, 123, 2, 26, "Input"], Cell[41722, 1365, 114, 1, 20, "Text"], Cell[41839, 1368, 58, 1, 26, "Input"], Cell[41900, 1371, 90, 2, 20, "Text"], Cell[41993, 1375, 48, 1, 26, "Input"], Cell[42044, 1378, 68, 0, 20, "Text"], Cell[42115, 1380, 947, 33, 52, "Input"], Cell[43065, 1415, 206, 4, 35, "Text"], Cell[43274, 1421, 277, 9, 26, "Input"], Cell[43554, 1432, 42, 0, 20, "Text"], Cell[43599, 1434, 524, 16, 42, "Input"], Cell[44126, 1452, 40, 0, 20, "Text"], Cell[44169, 1454, 121, 3, 26, "Input"], Cell[44293, 1459, 24, 0, 20, "Text"], Cell[44320, 1461, 541, 16, 42, "Input"], Cell[44864, 1479, 106, 3, 20, "Text"], Cell[44973, 1484, 461, 15, 26, "Input"], Cell[45437, 1501, 109, 3, 26, "Input"], Cell[45549, 1506, 448, 14, 42, "Input"], Cell[46000, 1522, 323, 11, 44, "Input"], Cell[46326, 1535, 103, 3, 20, "Text"], Cell[46432, 1540, 292, 10, 26, "Input"], Cell[46727, 1552, 138, 4, 26, "Input"], Cell[46868, 1558, 42, 0, 20, "Text"], Cell[46913, 1560, 464, 15, 26, "Input"], Cell[47380, 1577, 240, 6, 35, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[47657, 1588, 59, 1, 42, "Section"], Cell[47719, 1591, 207, 7, 25, "Text"], Cell[CellGroupData[{ Cell[47951, 1602, 34, 0, 30, "Subsection"], Cell[47988, 1604, 893, 30, 20, "Text"], Cell[48884, 1636, 142, 4, 40, "Input", CellTags->"S6.7.1"], Cell[49029, 1642, 130, 3, 20, "Text"], Cell[CellGroupData[{ Cell[49184, 1649, 33, 0, 16, "Subsubsection"], Cell[49220, 1651, 788, 25, 26, "Input"], Cell[50011, 1678, 443, 11, 42, "Input"], Cell[50457, 1691, 1220, 35, 57, "Input"], Cell[51680, 1728, 157, 4, 26, "Input"], Cell[51840, 1734, 113, 1, 20, "Text"], Cell[51956, 1737, 839, 25, 26, "Input"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[52844, 1768, 45, 0, 22, "Subsection"], Cell[52892, 1770, 706, 15, 95, "Text"], Cell[CellGroupData[{ Cell[53623, 1789, 33, 0, 16, "Subsubsection"], Cell[53659, 1791, 1140, 35, 57, "Input"], Cell[54802, 1828, 499, 16, 26, "Input"], Cell[55304, 1846, 336, 12, 26, "Input"], Cell[55643, 1860, 483, 13, 42, "Input"], Cell[56129, 1875, 213, 6, 26, "Input"], Cell[56345, 1883, 340, 9, 42, "Input"], Cell[56688, 1894, 86, 3, 35, "Text"], Cell[56777, 1899, 328, 10, 28, "Input"], Cell[57108, 1911, 336, 10, 28, "Input"], Cell[57447, 1923, 386, 13, 33, "Input"], Cell[57836, 1938, 386, 13, 33, "Input"], Cell[58225, 1953, 386, 13, 32, "Input"], Cell[58614, 1968, 343, 12, 38, "Text"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[59006, 1986, 40, 0, 22, "Subsection"], Cell[59049, 1988, 684, 14, 80, "Text"], Cell[59736, 2004, 10628, 286, 600, "Input"], Cell[70367, 2292, 1062, 18, 140, "Text"], Cell[CellGroupData[{ Cell[71454, 2314, 33, 0, 16, "Subsubsection"], Cell[71490, 2316, 209, 4, 26, "Input"], Cell[71702, 2322, 261, 6, 26, "Input"], Cell[71966, 2330, 2276, 65, 118, "Input"], Cell[74245, 2397, 941, 28, 57, "Input"], Cell[75189, 2427, 306, 8, 26, "Input"], Cell[75498, 2437, 491, 12, 26, "Input"], Cell[75992, 2451, 182, 5, 26, "Input"], Cell[76177, 2458, 937, 28, 57, "Input"], Cell[77117, 2488, 536, 16, 26, "Input"], Cell[77656, 2506, 590, 18, 26, "Input"], Cell[78249, 2526, 167, 4, 26, "Input"], Cell[78419, 2532, 145, 4, 26, "Input"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[78613, 2542, 34, 0, 22, "Subsection"], Cell[78650, 2544, 33, 0, 20, "Text"], Cell[78686, 2546, 849, 27, 66, "Input"], Cell[79538, 2575, 410, 9, 35, "Text"], Cell[CellGroupData[{ Cell[79973, 2588, 33, 0, 16, "Subsubsection"], Cell[80009, 2590, 582, 15, 42, "Input"], Cell[80594, 2607, 397, 11, 42, "Input"] }, Closed]] }, Closed]] }, Closed]] }, Open ]] } ] *) (* End of internal cache information *)