(*********************************************************************** 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[ 32720, 815]*) (*NotebookOutlinePosition[ 56833, 1688]*) (* CellTagsIndexPosition[ 56789, 1684]*) (*WindowFrame->Normal*) Notebook[{ Cell[TextData[{ StyleBox[ "Numerical Methods: Mathematica 3.0 Notebooks\n(c) John H. Mathews, 1998", FontSize->18, FontColor->RGBColor[1, 0, 1]], StyleBox["\n", FontSize->18], StyleBox["To accompany the text:", FontColor->RGBColor[1, 0, 0]], "\n", StyleBox[ "Numerical Methods: for Mathematics, \nScience, and Engineering, 2", FontSize->18, FontColor->RGBColor[0, 0, 1]], StyleBox["nd", FontSize->14, FontColor->RGBColor[0, 0, 1], FontVariations->{"CompatibilityType"->"Superscript"}], StyleBox[" Ed, 1992", FontSize->18, FontColor->RGBColor[0, 0, 1]], StyleBox["\n", FontSize->18], StyleBox[ "Prentice Hall, Inc.\nSimon & Schuster, One Lake Street\nUpper Saddle \ River, New Jersey 07458 U.S.A.", FontSize->18, FontColor->RGBColor[0, 1, 1]], StyleBox["\n", FontSize->18], StyleBox[ "Prentice Hall, Inc.; USA, Canada, Mexico ISBN 0-13-624990-6\nPrentice \ Hall, International Editions: ISBN 0-13-625047-5\nwww.Prenhall.com", FontSize->14, FontColor->RGBColor[0, 1, 0]], StyleBox["\n", FontSize->14], StyleBox[ "This free software is compliments of the author.\nE-mail address: in%\ \"mathews@fullerton.edu\"", FontSize->14, FontColor->RGBColor[1, 0, 1]] }], "Text", Evaluatable->False, TextAlignment->Center, AspectRatioFixed->True], Cell[TextData[StyleBox["CONTENTS", FontSize->18, FontWeight->"Bold", FontColor->RGBColor[0, 0, 1]]], "Text", Evaluatable->False, TextAlignment->Center, AspectRatioFixed->True], Cell[TextData[{ StyleBox["Chapter 8. Numerical Optimization", FontWeight->"Bold"], "\n\t", StyleBox["Algorithm 8.1 ", FontWeight->"Bold"], StyleBox["Golden Search for a Minimum", FontColor->RGBColor[1, 0, 1]], ".\n\t", StyleBox["Algorithm 8.2 ", FontWeight->"Bold"], StyleBox["Nelder-Mead's Minimization Method", FontColor->RGBColor[1, 0, 1]], ".\n\t", StyleBox["Algorithm 8.3 ", FontWeight->"Bold"], StyleBox["Local Minimum Search Using Quadratic Interpolation", FontColor->RGBColor[1, 0, 1]], ".\n\t", StyleBox["Algorithm 8.4 ", FontWeight->"Bold"], StyleBox["Steepest Descent or Gradient Method", FontColor->RGBColor[1, 0, 1]], "." }], "Text", Evaluatable->False, AspectRatioFixed->True, FontColor->RGBColor[0, 0, 1]], Cell[BoxData[{ RowBox[{ StyleBox[\(Clear["\"]\), "MR"], StyleBox[";", "MR"], "\n", \(Off[General::"\"]\), ";", "\n", \(Clear[a, a0, b, b0, c, count, Cv, d, delta, epsilon, Ev, f, f0, GoldenSearch, GradSearch, h, Hi, Ho, j, k, Li, Lo, max, min, M, n, Nelder, p, QuadraticSearch, rone, rtwo, R, sum, V0, x0, X0, Y, Ya, Yb, Yc, Yd, Yp, YC, YE, YR]\)}], \(On[General::"\"]; \)}], "Input", InitializationCell->True], Cell[TextData[{ StyleBox["Algorithm 8.1 ", FontWeight->"Bold"], StyleBox["Golden Search for a Minimum", FontWeight->"Bold", FontColor->RGBColor[1, 0, 1]], StyleBox[".", FontWeight->"Bold"], " To numerically approximate the minimum of ", Cell[BoxData[ \(f \((x)\)\)]], " on the interval ", Cell[BoxData[ \(\([a, b]\)\)]], " by using a golden search. Proceed with the method only if ", Cell[BoxData[ \(f \((x)\)\)]], " is a unimodal function on the interval ", Cell[BoxData[ \(\([a, b]\)\)]], ".\n", StyleBox["Section 8.1 Minimization of a Function Page 413", FontWeight->"Bold"] }], "Text", CellFrame->True, Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{ Cell[TextData[{ StyleBox["Execute this cell to activate", FontWeight->"Bold", FontColor->RGBColor[0, 1, 0]], " ", StyleBox["Golden Search for a Minimum", FontWeight->"Bold", FontColor->RGBColor[1, 0, 1]], StyleBox[".\n", FontWeight->"Bold"], StyleBox[ "GoldenSearch[f0_,a0_,b0_,delta_,epsilon_]\nf0_ is the function f(x),\na0_ \ is the left endpoint,\nb0_ is the right endpoint,\ndelta_ is the tolerance \ for the abscissa,\nepsilon_ is the tolerance for the ordinate.", FontColor->RGBColor[1, 0, 0]] }], "Text"], Cell[BoxData[{ \(\(Off[General::"\"]; \)\), \(\(Clear[GoldenSearch, f0, a0, b0, delta, epsilon, p, Yp]; \)\), \(GoldenSearch[f0_, a0_, b0_, delta_, epsilon_] := \n\t Module[{f, a, b, c, d, h, k, rone, rtwo, Ya, Yb, Yc, Yd}, \n\t\t Set@@{f[x_], f0}; \n\t\ta = a0; \n\t\tb = b0; \n\t\t rone = N[1\/2\ \((\@5 - 1)\)]; \n\t\trtwo = rone\^2; \n\t\th = b - a; \n\t\tYa = N[f[a]]; \n\t\tPrint[{N[a, 14], N[Ya, 14]}]; \n\t\t Yb = N[f[b]]; \n\t\tPrint[{N[b, 14], N[Yb, 14]}]; \n\t\t c = a + rtwo\ h; \n\t\td = a + rone\ h; \n\t\tYc = N[f[c]]; \n\t\t Print[{N[c, 14], N[Yc, 14]}]; \n\t\tYd = N[f[d]]; \n\t\t Print[{N[d, 14], N[Yd, 14]}]; \n\t\tk = 1; \n\t\t While[Abs[Yb - Ya] > epsilon || h > delta, \n\t\t\t If[Yc < Yd, \n\t\t\t\t Module[{}, \n\t\t\t\t\tb = d; \n\t\t\t\t\tYb = Yd; \n\t\t\t\t\t d = c; \n\t\t\t\t\tYd = Yc; \n\t\t\t\t\th = b - a; \n\t\t\t\t\t c = a + rtwo\ h; \n\t\t\t\t\tYc = f[c]; \n\t\t\t\t\t Print[{N[c, 14], N[Yc, 14]}]; ], \n\t\t\t\t \(Module[{}, \n\t\t\t\t\ta = c; \n\t\t\t\t\tYa = Yc; \n\t\t\t\t\t c = d; \n\t\t\t\t\tYc = Yd; \n\t\t\t\t\th = b - a; \n\t\t\t\t\t d = a + rone\ h; \n\t\t\t\t\tYd = f[d]; \n\t\t\t\t\t Print[{N[d, 14], N[Yd, 14]}]; ]; \)]; \n\t\t\tk = k + 1]; \n\t\t p = a; \n\t\tYp = Ya; \n\t\tIf[Yb < Ya, p = b; Yp = Yb]; \n\t\t Print["\< \>"]; \n\t\tPrint["\", f[x]]; \n \t\tPrint["\"]; \n\t\t Print["\< p = \>", N[p, 14]]; \n\t\t Print["\", N[Yp, 14]]; ]; \nOn[General::"\"]; \)}], "Input", InitializationCell->True, AspectRatioFixed->False] }, Closed]], Cell[TextData[{ "\n", StyleBox["Chapter 8, Example 8.2, Page 404.", FontWeight->"Bold"], "\nFind the minimum of the function ", Cell[BoxData[ \(f \((x)\) = x\^2 - sin \((x)\)\)]], " over ", Cell[BoxData[ \(\([0, 1]\)\)]], "." }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(Clear[f, x]; \nf[x_] = x\^2 - Sin[x]; \n Plot[f[x], {x, 0, 1}, PlotStyle \[Rule] RGBColor[1, 0, 0]]; \n Print["\", f[x]]; \)], "Input", AspectRatioFixed->True], Cell[BoxData[ \(\(GoldenSearch[f[x], 0, 1, 0.0000000001, 0.0000000001]; \)\)], "Input", AspectRatioFixed->False], Cell[TextData[{ "Let us compare this answer with ", StyleBox["Mathematica", FontSlant->"Italic"], "'s subroutine FindMinimum." }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(sol = FindMinimum[f[x], {x, 0.5}]; \nPrint["\", f[x]]; \n Print["\< p = \>", N[sol\[LeftDoubleBracket]2, 1, 2\[RightDoubleBracket], 14]]; \n Print["\", N[sol\[LeftDoubleBracket]1\[RightDoubleBracket], 14]]; \)], "Input"], Cell[TextData[{ StyleBox["Algorithm 8.2 ", FontWeight->"Bold"], StyleBox["Nelder-Mead's Minimization Method", FontWeight->"Bold", FontColor->RGBColor[1, 0, 1]], StyleBox[".", FontWeight->"Bold"], " \nTo approximate a local minimum of ", Cell[BoxData[ \(f \((x\_1, x\_2, \[CenterEllipsis], x\_n)\)\)]], ", where ", Cell[BoxData[ RowBox[{"f", RowBox[{"(", StyleBox["X", FontWeight->"Bold"], ")"}]}]]], " is a continuous function of n real variables, and given the ", Cell[BoxData[ \(n + 1\)]], " initial starting points ", Cell[BoxData[ RowBox[{ SubscriptBox[ StyleBox["V", FontWeight->"Bold"], "k"], " ", "=", " ", \((v\_\(k, 1\), v\_\(k, 2\), \[CenterEllipsis], v\_\(k, n\))\)}]]], " for k = 0, 1, \[CenterEllipsis], n.\n", StyleBox["Section 8.1 Minimization of a Function Page 414", FontWeight->"Bold"] }], "Text", CellFrame->True, Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{ Cell[TextData[{ StyleBox["Execute this cell to activate", FontWeight->"Bold", FontColor->RGBColor[0, 1, 0]], " ", StyleBox["Nelder-Mead's Minimization Method", FontWeight->"Bold", FontColor->RGBColor[1, 0, 1]], StyleBox[".\n", FontWeight->"Bold"], StyleBox[ "Nelder[V0_,epsilon_]\nV0_ is the starting point,\nepsilon_ is the \ tolerance.", FontColor->RGBColor[1, 0, 0]] }], "Text"], Cell[BoxData[{ \(\(Off[General::"\"]; \)\), \(Clear[Nelder, V0, Y, epsilon, n, Lo, Hi, Li, Ho, Cv, Ev, M, R, YC, YE, YR, max, min, count]; \n Nelder[V0_, epsilon_] := \n\t Module[{n}, \n\t\t size := Module[{j, k, sum}, \n\t\t\t\tnorm = 0; \n\t\t\t\t For[j = 0, j \[LessEqual] n, \(j++\), \n\t\t\t\t\tsum = 0; \n \t\t\t\t\t For[k = 1, k \[LessEqual] n, \(k++\), \n\t\t\t\t\t\t sum = sum + \((V\[LeftDoubleBracket]Lo + 1, k\[RightDoubleBracket] - V\[LeftDoubleBracket]j + 1, k\[RightDoubleBracket]) \)\^2]; \n\t\t\t\t\tIf[sum > norm, norm = sum]; ]; \n \t\t\t\tnorm = \@norm; \n\t\t\t\tReturn[norm]; ]; \n\t\t order := Module[{j}, \n\t\t\t\tLo = 0; \n\t\t\t\tHi = 0; \n\t\t\t\t For[j = 1, j \[LessEqual] n, \(j++\), \n\t\t\t\t\t If[Y\[LeftDoubleBracket]j + 1\[RightDoubleBracket] < Y\[LeftDoubleBracket]Lo + 1\[RightDoubleBracket], Lo = j]; \n\t\t\t\t\t If[Y\[LeftDoubleBracket]j + 1\[RightDoubleBracket] > Y\[LeftDoubleBracket]Hi + 1\[RightDoubleBracket], Hi = j]; ]; \n\t\t\t\tLi = Hi; \n\t\t\t\tHo = Lo; \n\t\t\t\t For[j = 0, j \[LessEqual] n, \(j++\), \n\t\t\t\t\t If[j \[NotEqual] Lo && Y\[LeftDoubleBracket]j + 1\[RightDoubleBracket] < Y\[LeftDoubleBracket]Li + 1\[RightDoubleBracket], Li = j]; \n\t\t\t\t\t If[j \[NotEqual] Hi && Y\[LeftDoubleBracket]j + 1\[RightDoubleBracket] > Y\[LeftDoubleBracket]Ho + 1\[RightDoubleBracket], Ho = j]; ]; ]; \n\t\t newpoints := \n\t\t\t Module[{j, sum}, \n\t\t\t\t sum = \(-V\[LeftDoubleBracket]Hi + 1\[RightDoubleBracket]\); \n \t\t\t\tFor[j = 0, j \[LessEqual] n, \(j++\), \n\t\t\t\t\t \(sum = sum + V\[LeftDoubleBracket]j + 1\[RightDoubleBracket]; \)]; \n\t\t\t\tM = sum\/n; \n\t\t\t\t R = 2\ M - V\[LeftDoubleBracket]Hi + 1\[RightDoubleBracket]; \n \t\t\t\tYR = f[R]]; \n\t\t shrink := \n\t\t\t Module[{j}, \n\t\t\t\t \(For[j = 0, j \[LessEqual] n, \(j++\), \n\t\t\t\t\t \(If[j + 1 \[NotEqual] Lo + 1, \n\t\t\t\t\t\t V\[LeftDoubleBracket]j + 1\[RightDoubleBracket] = 1\/2\ \((V\[LeftDoubleBracket]j + 1\[RightDoubleBracket] + V\[LeftDoubleBracket]Lo + 1\[RightDoubleBracket])\); \n\t\t\t\t\t\t Y\[LeftDoubleBracket]j + 1\[RightDoubleBracket] = f[V\[LeftDoubleBracket]j + 1\[RightDoubleBracket]]; ]; \)]; \)]; \n\t\t replace := Module[{}, V\[LeftDoubleBracket]Hi + 1\[RightDoubleBracket] = R; Y\[LeftDoubleBracket]Hi + 1\[RightDoubleBracket] = YR]; \n\t\t improve := \n\t\t\t Module[{}, \n\t\t\t\t \(If[YR < Y\[LeftDoubleBracket]Ho + 1\[RightDoubleBracket], \n \t\t\t\t\t Module[{}, \n\t\t\t\t\t\t \(If[Y\[LeftDoubleBracket]Li + 1\[RightDoubleBracket] < YR, replace, \n\t\t\t\t\t\t\t \(Module[{}, \n\t\t\t\t\t\t\t\tEv = 2\ R - M; \n \t\t\t\t\t\t\t\tYE = f[Ev]; If[YE < Y\[LeftDoubleBracket]Li + 1\[RightDoubleBracket], \n\t\t\t\t\t\t\t\t\t V\[LeftDoubleBracket]Hi + 1\[RightDoubleBracket] = Ev; \n\t\t\t\t\t\t\t\t\t Y\[LeftDoubleBracket]Hi + 1\[RightDoubleBracket] = YE, \n\t\t\t\t\t\t\t\t\treplace]; ]; \)]; \)], \n\t\t\t\t\t \(Module[{}, If[YR < Y\[LeftDoubleBracket]Hi + 1\[RightDoubleBracket], replace]; \n\t\t\t\t\t\t Cv = 1\/2\ \((V\[LeftDoubleBracket]Hi + 1\[RightDoubleBracket] + M) \); \n\t\t\t\t\t\tYC = f[Cv]; If[YC < Y\[LeftDoubleBracket]Hi + 1\[RightDoubleBracket], V\[LeftDoubleBracket]Hi + 1\[RightDoubleBracket] = Cv; \n \t\t\t\t\t\t\t Y\[LeftDoubleBracket]Hi + 1\[RightDoubleBracket] = YC, shrink]; ]; \)]; \)]; \n\t\tV = V0; \n\t\t n = Length[V\[LeftDoubleBracket]1\[RightDoubleBracket]]; \n\t\t Y = Table[0, {n + 1}]; \n\t\t For[k = 0, k \[LessEqual] n, \(k++\), \(Y\[LeftDoubleBracket]k + 1\[RightDoubleBracket] = f[V\[LeftDoubleBracket]k + 1\[RightDoubleBracket]]; \)]; \n\t\t min = 2; \n\t\tmax = 55; \n\t\tcount = 0; \n\t\torder; \n\t\t While[Y\[LeftDoubleBracket]Hi + 1\[RightDoubleBracket] > Y\[LeftDoubleBracket]Lo + 1\[RightDoubleBracket] + epsilon && count < max || count < min, \n\t\t\tnewpoints; \n\t\t\timprove; \n\t\t\tcount = count + 1; \n\t\t\torder; \n\t\t\t Print[{N[Y\[LeftDoubleBracket]Lo + 1\[RightDoubleBracket], 12], N[V\[LeftDoubleBracket]Lo + 1\[RightDoubleBracket], 12]}]; ]; \n \t\tsize; \n\t\tPrint["\< \>"]; \n\t\t Print["\", f[{x, y}]]; \n\t\t Print["\"]; \n\t\t Print["\< P = \>", N[V\[LeftDoubleBracket]Lo + 1\[RightDoubleBracket], 12]]; \n\t\t Print["\", N[Y\[LeftDoubleBracket]Lo + 1\[RightDoubleBracket], 12]]; ]; \n \(On[General::"\"]; \)\)}], "Input", InitializationCell->True, AspectRatioFixed->False] }, Closed]], Cell[TextData[{ "\n", StyleBox["Chapter 9, Example 8.4, Page 409.", FontWeight->"Bold"], " Use the Nelder-Mead method \nto find the minimum of ", Cell[BoxData[ \(f \((x, y)\)\ = \ 100\ \((y - x\^2)\)\^2 + \((1 - x)\)\^2\)]], ",\nRosenbrock's parabolic valley, circa 1960." }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(Clear[f, x, y, V]; \n f[{x_, y_}] = 100\ \((y - x\^2)\)\^2 + \((1 - x)\)\^2; \n Plot3D[f[{x, y}], {x, 0.5, 1.5}, {y, 0.5, 1.5}, AxesLabel \[Rule] {"\", "\", "\"}, ViewPoint \[Rule] {1, 3, 1}]; \nPrint["\", f[{x, y}]]; \)], "Input", AspectRatioFixed->False], Cell[BoxData[ \(V = {{0.9, 0.9}, {0.9, 1.1}, {1.1, 0.9}}; \nNelder[V, 0.0000000001]; \)], "Input", AspectRatioFixed->False], Cell[TextData[{ "Let us compare this answer with ", StyleBox["Mathematica", FontSlant->"Italic"], "'s subroutine FindMinimum." }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(sol = FindMinimum[f[{x, y}], {x, 1.8}, {y, 1.2}]; \n Print["\", f[{x, y}]]; Print["\< P = \>", N[{sol\[LeftDoubleBracket]2, 1, 2\[RightDoubleBracket], sol\[LeftDoubleBracket]2, 2, 2\[RightDoubleBracket]}, 12]]; Print["\", N[sol\[LeftDoubleBracket]1\[RightDoubleBracket], 12]]; \)], "Input"], Cell[TextData[{ StyleBox["Algorithm 8.3 ", FontWeight->"Bold"], StyleBox["Local Minimum Search Using Quadratic Interpolation", FontWeight->"Bold", FontColor->RGBColor[1, 0, 1]], StyleBox[".", FontWeight->"Bold"], " \nTo find a local minimum of the function ", Cell[BoxData[ \(f \((x)\)\)]], " over the interval ", Cell[BoxData[ \(\([a, b]\)\)]], ", by starting with one initial approximation ", Cell[BoxData[ \(p\_0\)]], " and then searching the intervals ", Cell[BoxData[ \(\([a, p\_0]\)\)]], ", and ", Cell[BoxData[ \(\([p\_0, b]\)\)]], ".\n", StyleBox["Section 8.1 Minimization of a Function Page 416", FontWeight->"Bold"] }], "Text", CellFrame->True, Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{ Cell[TextData[{ StyleBox["Execute this cell to activate", FontWeight->"Bold", FontColor->RGBColor[0, 1, 0]], " ", StyleBox["Local Minimum Search Using Quadratic Interpolation", FontWeight->"Bold", FontColor->RGBColor[1, 0, 1]], StyleBox[".\n", FontWeight->"Bold"], StyleBox[ "QuadraticSearch[f0_,x0_,delta_,epsilon_]\nf0_ is the function f(x),\nx0_ \ is the starting value,\ndelta_ is the tolerance for the abscissa,\nepsilon_ \ is the tolerance for the ordinate.", FontColor->RGBColor[1, 0, 0]] }], "Text"], Cell[BoxData[{\(Off[General::"\"]; \), \(Clear[QuadraticSearch, f0, x0, delta, epsilon]; \), RowBox[{ RowBox[{ \(QuadraticSearch[f0_, x0_, delta_, epsilon_]\), ":=", "\n", "\t", RowBox[{"Module", "[", RowBox[{\({f}\), ",", "\n", "\t\t", RowBox[{ \(Set@@{f[x_], f0}\), ";", "\n", "\t\t", \(p0 = x0\), ";", "\n", "\t\t", \(Jmax = 50\), ";", "\n", "\t\t", \(Kmax = 50\), ";", "\n", "\t\t", \(big = N[10\^9]\), ";", "\n", "\t\t", \(k = 0\), ";", "\n", "\t\t", \(Err = 1.0\), ";", "\n", "\t\t", \(cond = 0\), ";", "\n", "\t\t", \(h = 1.0\), ";", "\n", "\t\t", \(If[Abs[p0] > 10000.0, h = N[Abs[p0]\/10000]]\), ";", "\n", "\t\t", RowBox[{"While", "[", RowBox[{ \(k < Kmax && Err > epsilon && cond \[NotEqual] 5\), ",", "\n", "\t\t\t", RowBox[{ RowBox[{"If", "[", RowBox[{ RowBox[{\((N > 0)\), "[", RowBox[{ SuperscriptBox["f", "\[Prime]", MultilineFunction->None], "[", "p0", "]"}], "]"}], ",", "\n", "\t\t\t\t", \(h = \(-Abs[h]\)\)}], "]"}], ";", "\n", "\t\t\t", \(p1 = p0 + h\), ";", "\n", "\t\t\t", \(p2 = p0 + 2\ h\), ";", "\n", "\t\t\t", \(Pmin = p0\), ";", "\n", "\t\t\t", \(Y0 = f[p0]\), ";", "\n", "\t\t\t", \(Print[{N[p0, 14], N[Y0, 14]}]\), ";", "\n", "\t\t\t", \(Y1 = f[p1]\), ";", "\n", "\t\t\t", \(Print[{N[p1, 14], N[Y1, 14]}]\), ";", "\n", "\t\t\t", \(Y2 = f[p2]\), ";", "\n", "\t\t\t", \(Print[{N[p2, 14], N[Y2, 14]}]\), ";", "\n", "\t\t\t", \(Ymin = Y0\), ";", "\n", "\t\t\t", \(cond = 0\), ";", "\n", "\t\t\t", \(j = 0\), ";", "\n", "\t\t\t", \(While[j < Jmax && Abs[h] > delta && cond == 0, \n \t\t\t\tIf[Y0 \[LessEqual] Y1, \n\t\t\t\t\t Module[{}, \n\t\t\t\t\t\tp2 = p1; \n\t\t\t\t\t\t Y2 = Y1; \n\t\t\t\t\t\th = h\/2; \n\t\t\t\t\t\t p1 = p0 + h; \n\t\t\t\t\t\tY1 = f[p1]; \n \t\t\t\t\t\tPrint[{N[p1, 14], N[Y1, 14]}]; ], \n \t\t\t\t\t Module[{}, \n\t\t\t\t\t\t If[Y2 < Y1, \n\t\t\t\t\t\t\t Module[{}, \n\t\t\t\t\t\t\t\tp1 = p2; \n \t\t\t\t\t\t\t\tY1 = Y2; \n\t\t\t\t\t\t\t\t h = 2\ h; \n\t\t\t\t\t\t\t\tp2 = p0 + 2\ h; \n \t\t\t\t\t\t\t\tY2 = f[p2]; \n\t\t\t\t\t\t\t\t Print[{N[p2, 14], N[Y2, 14]}]; ], cond = \(-1\)]]]; \n\t\t\t\tj = j + 1; \n\t\t\t\t If[Abs[h] > big || Abs[P0] > big, cond = 5]]\), ";", "\n", "\t\t\t", \(If[cond == 5, Pmin = p1; Ymin = f[p1]; \n\t\t\t\t Print[{N[Pmin, 14], N[Ymin, 14]}]; \n\t\t\t\t Goto[getout]]\), ";", "\n", "\t\t\t", \(d = N[4\ Y1 - 2\ Y0 - 2\ Y2]\), ";", "\n", "\t\t\t", \(If[d < 0, hmin = \(h\ \((4\ Y1 - 3\ Y0 - Y2)\)\)\/d, hmin = h\/3; cond = 4]\), ";", "\n", "\t\t\t", \(Pmin = p0 + hmin\), ";", "\n", "\t\t\t", \(Ymin = f[Pmin]\), ";", "\n", "\t\t\t", \(Print[{N[Pmin, 14], N[Ymin, 14]}]\), ";", "\n", "\t\t\t", \(h = Abs[h]\), ";", "\n", "\t\t\t", \(h0 = Abs[hmin]\), ";", "\n", "\t\t\t", \(h1 = Abs[hmin - h]\), ";", "\n", "\t\t\t", \(h2 = Abs[hmin - 2\ h]\), ";", "\n", "\t\t\t", \(If[h0 < h, h = h0]\), ";", "\n", "\t\t\t", \(If[h1 < h, h = h1]\), ";", "\n", "\t\t\t", \(If[h2 < h, h = h2]\), ";", "\n", "\t\t\t", \(If[h == 0, h = hmin]\), ";", "\n", "\t\t\t", \(If[h < delta, cond = 1]\), ";", "\n", "\t\t\t", \(If[Abs[h] > big || Abs[Pmin] > big, cond = 5]\), ";", "\n", "\t\t\t", \(E0 = Abs[Y0 - Ymin]\), ";", "\n", "\t\t\t", \(E1 = Abs[Y1 - Ymin]\), ";", "\n", "\t\t\t", \(E2 = Abs[Y2 - Ymin]\), ";", "\n", "\t\t\t", \(If[E0 \[NotEqual] 0 && E0 < Err, Err = E0]\), ";", "\n", "\t\t\t", \(If[E1 \[NotEqual] 0 && E1 < Err, Err = E1]\), ";", "\n", "\t\t\t", \(If[E2 \[NotEqual] 0 && E2 < Err, Err = E2]\), ";", "\n", "\t\t\t", \(If[E0 == 0 && E1 == 0 && E2 == 0, Err = 0]\), ";", "\n", "\t\t\t", \(If[Err < epsilon, cond = 2]\), ";", "\n", "\t\t\t", \(p0 = Pmin\), ";", "\n", "\t\t\t", \(k = k + 1\), ";", "\n", "\t\t\t", \(Label[getout]\)}]}], "]"}], ";", "\n", "\t\t", \(If[cond == 2 && h < delta, cond = 3]\), ";", "\n", "\t\t", \(Print["\< \>"]\), ";", "\n", "\t\t", \(Print["\", f[x]]\), ";", "\n", "\t\t", \(Print["\"]\), ";", "\n", "\t\t", \(Print["\< p = \>", N[Pmin, 14]]\), ";", "\n", "\t\t", \(Print["\", N[Ymin, 14]]\), ";"}]}], "]"}]}], ";", "\n", \(On[General::"\"]\), ";"}]}], "Input", InitializationCell->True, AspectRatioFixed->False] }, Closed]], Cell[TextData[{ "\n", StyleBox["Chapter 8, Exercise 4, Page 420.", FontWeight->"Bold"], "\nFind the minimum of the function ", Cell[BoxData[ \(f \((x)\) = 3\ x\^2 - 2\ x + 5\)]], " over ", Cell[BoxData[ \(\([0, 1]\)\)]], "." }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(Clear[f, x]; \nf[x_] = 3\ x\^2 - 2\ x + 5; \n Plot[f[x], {x, 0, 1}, PlotStyle \[Rule] RGBColor[1, 0, 0]]; \n Print["\", f[x]]; \)], "Input", AspectRatioFixed->True], Cell[BoxData[ \(\(QuadraticSearch[f[x], 0.5, 0.001, 0.001]; \)\)], "Input", AspectRatioFixed->False], Cell[TextData[{ "Let us compare this answer with ", StyleBox["Mathematica", FontSlant->"Italic"], "'s routine." }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(sol = FindMinimum[f[x], {x, 0.5}]; \nPrint["\", f[x]]; \n Print["\< p = \>", N[sol\[LeftDoubleBracket]2, 1, 2\[RightDoubleBracket], 14]]; \n Print["\", N[sol\[LeftDoubleBracket]1\[RightDoubleBracket], 14]]; \)], "Input"], Cell[TextData[{ StyleBox["Algorithm 8.4 ", FontWeight->"Bold"], StyleBox["Steepest Descent or Gradient Method", FontWeight->"Bold", FontColor->RGBColor[1, 0, 1]], StyleBox[".", FontWeight->"Bold"], " To numerically approximate a local minimum of f(", StyleBox["X", FontWeight->"Bold"], "), where f is a continuous function of n real variables and ", Cell[BoxData[ RowBox[{ StyleBox["X", FontWeight->"Bold"], " ", "=", " ", \((x\_1, x\_2, \[CenterEllipsis], x\_n)\)}]]], " by starting with one point ", Cell[BoxData[ SubscriptBox[ StyleBox["P", FontWeight->"Bold"], "0"]]], " and using the gradient method.\n", StyleBox["Section 8.1 Minimization of a Function Page 418", FontWeight->"Bold"] }], "Text", CellFrame->True, Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{ Cell[TextData[{ StyleBox["Execute this cell to activate", FontWeight->"Bold", FontColor->RGBColor[0, 1, 0]], " ", StyleBox["Steepest Descent or Gradient Method", FontWeight->"Bold", FontColor->RGBColor[1, 0, 1]], StyleBox[".", FontWeight->"Bold"], " ", StyleBox["\n", FontWeight->"Bold"], StyleBox[ "GradSearch[X0_,delta_,epsilon_]\nX0_ is the starting point,\ndelta_ is the \ tolerance for the point,\nepsilon_ is the tolerance for the function value.", FontColor->RGBColor[1, 0, 0]] }], "Text"], Cell[BoxData[{ \(\(Off[General::"\"]; \)\), \(\(Clear[GradSearch, X0, delta, epsilon]; \)\), \(GradSearch[X0_, delta_, epsilon_] := \n\t Module[{}, \n\t\t Qmin := \n\t\t\t Block[{}, \n\t\t\t\tbig = N[10\^8]; \n\t\t\t\tjmax = 15; \n\t\t\t\t P0 = N[P0]; \n\t\t\t\tP1 = N[P0 + h\ S0]; \n\t\t\t\t P2 = N[P0 + 2\ h\ S0]; \n\t\t\t\tY0 = N[f[P0]]; \n\t\t\t\t Print[{N[Y0, 14], N[P0, 14]}]; \n\t\t\t\tY1 = N[f[P1]]; \n\t\t\t\t Print[{N[Y1, 14], N[P1, 14]}]; \n\t\t\t\tY2 = N[f[P2]]; \n\t\t\t\t Print[{N[Y2, 14], N[P2, 14]}]; \n\t\t\t\tcond = 0; \n\t\t\t\t j = 0; \n\t\t\t\t While[j < jmax && cond == 0, length = norm[P0]; \n\t\t\t\t\t If[Y0 \[LessEqual] Y1, \n\t\t\t\t\t\t Module[{}, \n\t\t\t\t\t\t\tP2 = P1; \n\t\t\t\t\t\t\tY2 = Y1; \n\t\t\t\t\t\t\th = h\/2; \n\t\t\t\t\t\t\tP1 = P0 + h\ S0; \n\t\t\t\t\t\t\tY1 = f[P1]; ], \n\t\t\t\t\t\t Module[{}, \n\t\t\t\t\t\t\t If[Y2 < Y1, \n\t\t\t\t\t\t\t\t Module[{}, \n\t\t\t\t\t\t\t\t\tP1 = P2; \n \t\t\t\t\t\t\t\t\tY1 = Y2; \n\t\t\t\t\t\t\t\t\t h = 2\ h; \n\t\t\t\t\t\t\t\t\tP2 = P0 + 2\ h\ S0; \n \t\t\t\t\t\t\t\t\tY2 = f[P2]; ], \n\t\t\t\t\t\t\t\t cond = \(-1\)]]]; \n\t\t\t\t\tj = j + 1; \n\t\t\t\t\t If[h < delta, cond = 1]; \n\t\t\t\t\t If[Abs[h] > big || length > big, cond = 5]]; \n\t\t\t\t count = count + j; \n\t\t\t\t If[cond == 5, Pmin = P1; Ymin = Y1; Goto[getout]]; \n\t\t\t\t d = 4\ Y1 - 2\ Y0 - 2\ Y2; \n\t\t\t\t If[d < 0, hmin = \(h\ \((4\ Y1 - 3\ Y0 - Y2)\)\)\/d, hmin = h\/3; cond = 4]; \n\t\t\t\tPmin = P0 + hmin\ S0; \n\t\t\t\t Ymin = f[Pmin]; \n\t\t\t\th0 = Abs[hmin]; \n\t\t\t\t h1 = Abs[hmin - h]; \n\t\t\t\th2 = Abs[hmin - 2\ h]; \n\t\t\t\t If[h0 < h, h = h0]; \n\t\t\t\tIf[h1 < h, h = h1]; \n\t\t\t\t If[h2 < h, h = h2]; \n\t\t\t\tIf[h == 0, h = hmin]; \n\t\t\t\t If[h < delta, cond = 1]; \n\t\t\t\tE0 = Abs[Y0 - Ymin]; \n\t\t\t\t E1 = Abs[Y1 - Ymin]; \n\t\t\t\tE2 = Abs[Y2 - Ymin]; \n\t\t\t\t If[E0 \[NotEqual] 0 && E0 < Err, Err = E0]; \n\t\t\t\t If[E1 \[NotEqual] 0 && E1 < Err, Err = E1]; \n\t\t\t\t If[E2 \[NotEqual] 0 && E2 < Err, Err = E2]; \n\t\t\t\t If[E0 == 0 && E1 == 0 && E2 == 0, Err = 0]; \n\t\t\t\t If[Err < epsilon, cond = 2]; \n\t\t\t\t If[cond == 2 && h < delta, cond = 3]; \n\t\t\t\tLabel[getout]]; \n \t\tP0 = X0; \n\t\tmax = 60; \n\t\th = 1; \n\t\tlength = norm[P0]; \n \t\tIf[N[length > 10\^4], h = length\/10\^4]; \n\t\tErr = 1; \n\t\t count = 0; \n\t\tcond = 0; \n\t\t While[count < max && cond \[NotEqual] 5 && \((h > delta || Err > epsilon)\), \n\t\t\t Module[{}, \n\t\t\t\tS0 = s[P0]; \n\t\t\t\tQmin; \n\t\t\t\t P0 = Pmin; \n\t\t\t\tY0 = Ymin; \n\t\t\t\t Print[{N[Ymin, 12], N[Pmin, 12]}]; \n\t\t\t\tcount = count + 1]]; \n\t\tPrint["\< \>"]; \n\t\tPrint["\", f[{x, y}]]; \n \t\tPrint["\"]; \n\t\t Print["\< P = \>", N[Pmin, 12]]; \n\t\t Print["\", N[Ymin, 12]]; ]; \n\(On[General::"\"]; \)\)}], "Input", InitializationCell->True, AspectRatioFixed->False] }, Closed]], Cell[TextData[{ "\n", StyleBox["Chapter 9, Example 8.4, Page 409.", FontWeight->"Bold"], " Use the gradient method to find \nthe minimum of ", Cell[BoxData[ \(f \((x, y)\)\ = \ 100\ \((y - x\^2)\)\^2 + \((1 - x)\)\^2\)]], "\nRosenbrock's parabolic valley, circa 1960." }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(Clear[f, x, y, grad, g, s, norm, V, P0]; \n f[{x_, y_}] = 100\ \((y - x\^2)\)\^2 + \((1 - x)\)\^2; \n Plot3D[f[{x, y}], {x, 0.5, 1.5}, {y, 0.5, 1.5}, AxesLabel \[Rule] {"\", "\", "\"}, ViewPoint \[Rule] {1, 3, 1}]; \nPrint["\", f[{x, y}]]; \)], "Input", AspectRatioFixed->False], Cell[BoxData[{ \(grad = {\[PartialD]\_x\ f[{x, y}], \[PartialD]\_y\ f[{x, y}]}; \n g[{x_, y_}] = grad; \nnorm[V_] := N[\@\(V\^2 /. List \[Rule] Plus\)]; \n \(s[{x_, y_}] = \(-\(g[{x, y}]\/norm[grad]\)\); \)\), \(P0 = {0.99, 1.01}; \nGradSearch[P0, 0.0000000001, 0.0000000001]; \)}], "Input", AspectRatioFixed->False], Cell[TextData[{ "Let us compare this answer with ", StyleBox["Mathematica", FontSlant->"Italic"], "'s routine." }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(sol = FindMinimum[f[{x, y}], {x, 1.8}, {y, 1.2}]; \n Print["\", f[{x, y}]]; Print["\< P = \>", N[{sol\[LeftDoubleBracket]2, 1, 2\[RightDoubleBracket], sol\[LeftDoubleBracket]2, 2, 2\[RightDoubleBracket]}, 14]]; Print["\", N[sol\[LeftDoubleBracket]1\[RightDoubleBracket], 14]]; \)], "Input"] }, FrontEndVersion->"Microsoft Windows 3.0", ScreenRectangle->{{0, 640}, {0, 452}}, AutoGeneratedPackage->None, WindowToolbars->{}, CellGrouping->Manual, WindowSize->{520, 301}, WindowMargins->{{1, Automatic}, {Automatic, 5}}, PrivateNotebookOptions->{"ColorPalette"->{RGBColor, 128}}, ShowCellLabel->True, ShowCellTags->False, RenderingOptions->{"ObjectDithering"->True, "RasterDithering"->False}, CharacterEncoding->"MacintoshAutomaticEncoding", StyleDefinitions -> Notebook[{ Cell[CellGroupData[{ Cell["Style Definitions", "Subtitle"], Cell["\<\ Modify the definitions below to change the default appearance of all cells in \ a given style. Make modifications to any definition using commands in the \ Format menu.\ \>", "Text"], Cell[CellGroupData[{ Cell["Style Environment Names", "Section"], Cell[StyleData[All, "Working"], PageWidth->WindowWidth, ScriptMinSize->9], Cell[StyleData[All, "Presentation"], PageWidth->WindowWidth, ScriptMinSize->12, FontSize->16], Cell[StyleData[All, "Condensed"], PageWidth->WindowWidth, CellBracketOptions->{"Margins"->{1, 1}, "Widths"->{0, 5}}, ScriptMinSize->8, FontSize->11], Cell[StyleData[All, "Printout"], PageWidth->PaperWidth, ScriptMinSize->5, FontSize->10, PrivateFontOptions->{"FontType"->"Outline"}] }, Closed]], Cell[CellGroupData[{ Cell["Notebook Options", "Section"], Cell["\<\ The options defined for the style below will be used at the Notebook level.\ \>", "Text"], Cell[StyleData["Notebook"], PageHeaders->{{Cell[ TextData[ { CounterBox[ "Page"]}], "PageNumber"], None, Cell[ TextData[ { ValueBox[ "FileName"]}], "Header"]}, {Cell[ TextData[ { ValueBox[ "FileName"]}], "Header"], None, Cell[ TextData[ { CounterBox[ "Page"]}], "PageNumber"]}}, CellFrameLabelMargins->6, StyleMenuListing->None] }, Closed]], Cell[CellGroupData[{ Cell["Styles for Headings", "Section"], Cell[CellGroupData[{ Cell[StyleData["Title"], CellMargins->{{12, Inherited}, {20, 40}}, CellGroupingRules->{"TitleGrouping", 0}, PageBreakBelow->False, CounterIncrements->"Title", CounterAssignments->{{"Section", 0}, {"Equation", 0}, {"Figure", 0}, { "Subtitle", 0}, {"Subsubtitle", 0}}, FontFamily->"Helvetica", FontSize->36, FontWeight->"Bold"], Cell[StyleData["Title", "Presentation"], CellMargins->{{24, 10}, {20, 40}}, LineSpacing->{1, 0}, FontSize->44], Cell[StyleData["Title", "Condensed"], CellMargins->{{8, 10}, {4, 8}}, FontSize->20], Cell[StyleData["Title", "Printout"], CellMargins->{{2, 10}, {15, 30}}, FontSize->24] }, Closed]], Cell[CellGroupData[{ Cell[StyleData["Subtitle"], CellMargins->{{12, Inherited}, {10, 15}}, CellGroupingRules->{"TitleGrouping", 10}, PageBreakBelow->False, CounterIncrements->"Subtitle", CounterAssignments->{{"Section", 0}, {"Equation", 0}, {"Figure", 0}, { "Subsubtitle", 0}}, FontFamily->"Helvetica", FontSize->24], Cell[StyleData["Subtitle", "Presentation"], CellMargins->{{24, 10}, {15, 20}}, LineSpacing->{1, 0}, FontSize->36], Cell[StyleData["Subtitle", "Condensed"], CellMargins->{{8, 10}, {4, 4}}, FontSize->14], Cell[StyleData["Subtitle", "Printout"], CellMargins->{{2, 10}, {10, 15}}, FontSize->18] }, Closed]], Cell[CellGroupData[{ Cell[StyleData["Subsubtitle"], CellMargins->{{12, Inherited}, {10, 20}}, CellGroupingRules->{"TitleGrouping", 20}, PageBreakBelow->False, CounterIncrements->"Subsubtitle", CounterAssignments->{{"Section", 0}, {"Equation", 0}, {"Figure", 0}}, FontFamily->"Helvetica", FontSize->14, FontSlant->"Italic"], Cell[StyleData["Subsubtitle", "Presentation"], CellMargins->{{24, 10}, {10, 20}}, LineSpacing->{1, 0}, FontSize->24], Cell[StyleData["Subsubtitle", "Condensed"], CellMargins->{{8, 10}, {8, 12}}, FontSize->12], Cell[StyleData["Subsubtitle", "Printout"], CellMargins->{{2, 10}, {8, 10}}, FontSize->14] }, Closed]], Cell[CellGroupData[{ Cell[StyleData["Section"], CellDingbat->"\[FilledSquare]", CellMargins->{{25, Inherited}, {8, 24}}, CellGroupingRules->{"SectionGrouping", 30}, PageBreakBelow->False, CounterIncrements->"Section", CounterAssignments->{{"Subsection", 0}, {"Subsubsection", 0}}, FontFamily->"Helvetica", FontSize->16, FontWeight->"Bold"], Cell[StyleData["Section", "Presentation"], CellMargins->{{40, 10}, {11, 32}}, LineSpacing->{1, 0}, FontSize->24], Cell[StyleData["Section", "Condensed"], CellMargins->{{18, Inherited}, {6, 12}}, FontSize->12], Cell[StyleData["Section", "Printout"], CellMargins->{{13, 0}, {7, 22}}, FontSize->14] }, Closed]], Cell[CellGroupData[{ Cell[StyleData["Subsection"], CellDingbat->"\[FilledSmallSquare]", CellMargins->{{22, Inherited}, {8, 20}}, CellGroupingRules->{"SectionGrouping", 40}, PageBreakBelow->False, CounterIncrements->"Subsection", CounterAssignments->{{"Subsubsection", 0}}, FontSize->14, FontWeight->"Bold"], Cell[StyleData["Subsection", "Presentation"], CellMargins->{{36, 10}, {11, 32}}, LineSpacing->{1, 0}, FontSize->22], Cell[StyleData["Subsection", "Condensed"], CellMargins->{{16, Inherited}, {6, 12}}, FontSize->12], Cell[StyleData["Subsection", "Printout"], CellMargins->{{9, 0}, {7, 22}}, FontSize->12] }, Closed]], Cell[CellGroupData[{ Cell[StyleData["Subsubsection"], CellDingbat->"\[FilledSmallSquare]", CellMargins->{{22, Inherited}, {8, 18}}, CellGroupingRules->{"SectionGrouping", 50}, PageBreakBelow->False, CounterIncrements->"Subsubsection", FontWeight->"Bold"], Cell[StyleData["Subsubsection", "Presentation"], CellMargins->{{34, 10}, {11, 26}}, LineSpacing->{1, 0}, FontSize->18], Cell[StyleData["Subsubsection", "Condensed"], CellMargins->{{17, Inherited}, {6, 12}}, FontSize->10], Cell[StyleData["Subsubsection", "Printout"], CellMargins->{{9, 0}, {7, 14}}, FontSize->11] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Styles for Body Text", "Section"], Cell[CellGroupData[{ Cell[StyleData["Text"], CellMargins->{{12, 10}, {7, 7}}, LineSpacing->{1, 3}, CounterIncrements->"Text"], Cell[StyleData["Text", "Presentation"], CellMargins->{{24, 10}, {10, 10}}, LineSpacing->{1, 5}], Cell[StyleData["Text", "Condensed"], CellMargins->{{8, 10}, {6, 6}}, LineSpacing->{1, 1}], Cell[StyleData["Text", "Printout"], CellMargins->{{2, 2}, {6, 6}}] }, Closed]], Cell[CellGroupData[{ Cell[StyleData["SmallText"], CellMargins->{{12, 10}, {6, 6}}, LineSpacing->{1, 3}, CounterIncrements->"SmallText", FontFamily->"Helvetica", FontSize->9], Cell[StyleData["SmallText", "Presentation"], CellMargins->{{24, 10}, {8, 8}}, LineSpacing->{1, 5}, FontSize->12], Cell[StyleData["SmallText", "Condensed"], CellMargins->{{8, 10}, {5, 5}}, LineSpacing->{1, 2}, FontSize->9], Cell[StyleData["SmallText", "Printout"], CellMargins->{{2, 2}, {5, 5}}, FontSize->7] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Styles for Input/Output", "Section"], Cell["\<\ The cells in this section define styles used for input and output to the \ kernel. Be careful when modifying, renaming, or removing these styles, \ because the front end associates special meanings with these style names.\ \>", "Text"], Cell[CellGroupData[{ Cell[StyleData["Input"], CellMargins->{{45, 10}, {5, 7}}, Evaluatable->True, CellGroupingRules->"InputGrouping", CellHorizontalScrolling->True, PageBreakWithin->False, GroupPageBreakWithin->False, CellLabelMargins->{{11, Inherited}, {Inherited, Inherited}}, DefaultFormatType->DefaultInputFormatType, AutoItalicWords->{}, FormatType->InputForm, ShowStringCharacters->True, NumberMarks->True, CounterIncrements->"Input", FontWeight->"Bold", FontColor->RGBColor[1, 0, 0]], Cell[StyleData["Input", "Presentation"], CellMargins->{{72, Inherited}, {8, 10}}, LineSpacing->{1, 0}], Cell[StyleData["Input", "Condensed"], CellMargins->{{40, 10}, {2, 3}}], Cell[StyleData["Input", "Printout"], CellMargins->{{39, 0}, {4, 6}}, FontSize->9] }, Closed]], Cell[StyleData["InputOnly"], Evaluatable->True, CellGroupingRules->"InputGrouping", CellHorizontalScrolling->True, DefaultFormatType->DefaultInputFormatType, AutoItalicWords->{}, FormatType->InputForm, ShowStringCharacters->True, NumberMarks->True, CounterIncrements->"Input", StyleMenuListing->None, FontWeight->"Bold"], Cell[CellGroupData[{ Cell[StyleData["Output"], CellMargins->{{47, 10}, {7, 5}}, CellEditDuplicate->True, CellGroupingRules->"OutputGrouping", CellHorizontalScrolling->True, PageBreakWithin->False, GroupPageBreakWithin->False, GeneratedCell->True, CellAutoOverwrite->True, CellLabelMargins->{{11, Inherited}, {Inherited, Inherited}}, DefaultFormatType->DefaultOutputFormatType, AutoItalicWords->{}, FormatType->InputForm, CounterIncrements->"Output", FontColor->RGBColor[0, 0, 1]], Cell[StyleData["Output", "Presentation"], CellMargins->{{72, Inherited}, {10, 8}}, LineSpacing->{1, 0}], Cell[StyleData["Output", "Condensed"], CellMargins->{{41, Inherited}, {3, 2}}], Cell[StyleData["Output", "Printout"], CellMargins->{{39, 0}, {6, 4}}, FontSize->9] }, Closed]], Cell[CellGroupData[{ Cell[StyleData["Message"], CellMargins->{{45, Inherited}, {Inherited, Inherited}}, CellGroupingRules->"OutputGrouping", PageBreakWithin->False, GroupPageBreakWithin->False, GeneratedCell->True, CellAutoOverwrite->True, ShowCellLabel->False, CellLabelMargins->{{11, Inherited}, {Inherited, Inherited}}, DefaultFormatType->DefaultOutputFormatType, AutoItalicWords->{}, FormatType->InputForm, CounterIncrements->"Message", StyleMenuListing->None, FontColor->RGBColor[0, 0, 1]], Cell[StyleData["Message", "Presentation"], CellMargins->{{72, Inherited}, {Inherited, Inherited}}, LineSpacing->{1, 0}], Cell[StyleData["Message", "Condensed"], CellMargins->{{41, Inherited}, {Inherited, Inherited}}], Cell[StyleData["Message", "Printout"], CellMargins->{{39, Inherited}, {Inherited, Inherited}}, FontSize->8, FontColor->GrayLevel[0]] }, Closed]], Cell[CellGroupData[{ Cell[StyleData["Print"], CellMargins->{{45, Inherited}, {Inherited, Inherited}}, CellGroupingRules->"OutputGrouping", CellHorizontalScrolling->True, PageBreakWithin->False, GroupPageBreakWithin->False, GeneratedCell->True, CellAutoOverwrite->True, ShowCellLabel->False, CellLabelMargins->{{11, Inherited}, {Inherited, Inherited}}, DefaultFormatType->DefaultOutputFormatType, AutoItalicWords->{}, FormatType->InputForm, CounterIncrements->"Print", StyleMenuListing->None, FontColor->RGBColor[0, 0, 1]], Cell[StyleData["Print", "Presentation"], CellMargins->{{72, Inherited}, {Inherited, Inherited}}, LineSpacing->{1, 0}], Cell[StyleData["Print", "Condensed"], CellMargins->{{41, Inherited}, {Inherited, Inherited}}], Cell[StyleData["Print", "Printout"], CellMargins->{{39, Inherited}, {Inherited, Inherited}}, FontSize->8] }, Closed]], Cell[CellGroupData[{ Cell[StyleData["Graphics"], CellMargins->{{4, Inherited}, {Inherited, Inherited}}, CellGroupingRules->"GraphicsGrouping", CellHorizontalScrolling->True, PageBreakWithin->False, GeneratedCell->True, CellAutoOverwrite->True, ShowCellLabel->False, DefaultFormatType->DefaultOutputFormatType, FormatType->InputForm, CounterIncrements->"Graphics", ImageMargins->{{43, Inherited}, {Inherited, 0}}, StyleMenuListing->None], Cell[StyleData["Graphics", "Presentation"], ImageMargins->{{62, Inherited}, {Inherited, 0}}], Cell[StyleData["Graphics", "Condensed"], ImageSize->{175, 175}, ImageMargins->{{38, Inherited}, {Inherited, 0}}], Cell[StyleData["Graphics", "Printout"], ImageSize->{250, 250}, ImageMargins->{{30, Inherited}, {Inherited, 0}}, FontSize->9] }, Closed]], Cell[CellGroupData[{ Cell[StyleData["CellLabel"], StyleMenuListing->None, FontFamily->"Helvetica", FontSize->9, FontColor->RGBColor[0, 0, 1]], Cell[StyleData["CellLabel", "Presentation"], FontSize->12], Cell[StyleData["CellLabel", "Condensed"], FontSize->9], Cell[StyleData["CellLabel", "Printout"], FontFamily->"Courier", FontSize->8, FontSlant->"Italic", FontColor->GrayLevel[0]] }, Closed]] }, Open ]], Cell[CellGroupData[{ Cell["Formulas and Programming", "Section"], Cell[CellGroupData[{ Cell[StyleData["InlineFormula"], CellMargins->{{10, 4}, {0, 8}}, CellHorizontalScrolling->True, ScriptLevel->1, SingleLetterItalics->True], Cell[StyleData["InlineFormula", "Presentation"], CellMargins->{{24, 10}, {10, 10}}, LineSpacing->{1, 5}], Cell[StyleData["InlineFormula", "Condensed"], CellMargins->{{8, 10}, {6, 6}}, LineSpacing->{1, 1}], Cell[StyleData["InlineFormula", "Printout"], CellMargins->{{2, 0}, {6, 6}}] }, Closed]], Cell[CellGroupData[{ Cell[StyleData["DisplayFormula"], CellMargins->{{42, Inherited}, {Inherited, Inherited}}, CellHorizontalScrolling->True, ScriptLevel->0, SingleLetterItalics->True, StyleMenuListing->None, UnderoverscriptBoxOptions->{LimitsPositioning->True}], Cell[StyleData["DisplayFormula", "Presentation"], LineSpacing->{1, 5}], Cell[StyleData["DisplayFormula", "Condensed"], LineSpacing->{1, 1}], Cell[StyleData["DisplayFormula", "Printout"]] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Styles for Headers and Footers", "Section"], Cell[StyleData["Header"], CellMargins->{{0, 0}, {4, 1}}, StyleMenuListing->None, FontSize->10, FontSlant->"Italic"], Cell[StyleData["Footer"], CellMargins->{{0, 0}, {0, 4}}, StyleMenuListing->None, FontSize->9, FontSlant->"Italic"], Cell[StyleData["PageNumber"], CellMargins->{{0, 0}, {4, 1}}, StyleMenuListing->None, FontFamily->"Times", FontSize->10] }, Closed]], Cell[CellGroupData[{ Cell["Palette Styles", "Section"], Cell["\<\ The cells below define styles that define standard ButtonFunctions, for use \ in palette buttons.\ \>", "Text"], Cell[StyleData["Paste"], StyleMenuListing->None, ButtonStyleMenuListing->Automatic, ButtonBoxOptions->{ButtonFunction:>(FrontEndExecute[ { FrontEnd`NotebookApply[ FrontEnd`InputNotebook[ ], #, After]}]&)}], Cell[StyleData["Evaluate"], StyleMenuListing->None, ButtonStyleMenuListing->Automatic, ButtonBoxOptions->{ButtonFunction:>(FrontEndExecute[ { FrontEnd`NotebookApply[ FrontEnd`InputNotebook[ ], #, All], SelectionEvaluate[ FrontEnd`InputNotebook[ ], All]}]&)}], Cell[StyleData["EvaluateCell"], StyleMenuListing->None, ButtonStyleMenuListing->Automatic, ButtonBoxOptions->{ButtonFunction:>(FrontEndExecute[ { FrontEnd`NotebookApply[ FrontEnd`InputNotebook[ ], #, All], FrontEnd`SelectionMove[ FrontEnd`InputNotebook[ ], All, Cell, 1], FrontEnd`SelectionEvaluateCreateCell[ FrontEnd`InputNotebook[ ], All]}]&)}], Cell[StyleData["CopyEvaluate"], StyleMenuListing->None, ButtonStyleMenuListing->Automatic, ButtonBoxOptions->{ButtonFunction:>(FrontEndExecute[ { FrontEnd`SelectionCreateCell[ FrontEnd`InputNotebook[ ], All], FrontEnd`NotebookApply[ FrontEnd`InputNotebook[ ], #, All], FrontEnd`SelectionEvaluate[ FrontEnd`InputNotebook[ ], All]}]&)}], Cell[StyleData["CopyEvaluateCell"], StyleMenuListing->None, ButtonStyleMenuListing->Automatic, ButtonBoxOptions->{ButtonFunction:>(FrontEndExecute[ { FrontEnd`SelectionCreateCell[ FrontEnd`InputNotebook[ ], All], FrontEnd`NotebookApply[ FrontEnd`InputNotebook[ ], #, All], FrontEnd`SelectionEvaluateCreateCell[ FrontEnd`InputNotebook[ ], All]}]&)}] }, Closed]], Cell[CellGroupData[{ Cell["Hyperlink Styles", "Section"], Cell["\<\ The cells below define styles useful for making hypertext ButtonBoxes. The \ \"Hyperlink\" style is for links within the same Notebook, or between \ Notebooks.\ \>", "Text"], Cell[CellGroupData[{ Cell[StyleData["Hyperlink"], StyleMenuListing->None, ButtonStyleMenuListing->Automatic, FontColor->RGBColor[0, 0, 1], FontVariations->{"Underline"->True}, ButtonBoxOptions->{ButtonFunction:>(FrontEndExecute[ { FrontEnd`NotebookLocate[ #2]}]&), Active->True, ButtonNote->ButtonData}], Cell[StyleData["Hyperlink", "Presentation"]], Cell[StyleData["Hyperlink", "Condensed"]], Cell[StyleData["Hyperlink", "Printout"], FontColor->GrayLevel[0], FontVariations->{"Underline"->False}] }, Closed]], Cell["\<\ The following styles are for linking automatically to the on-line help \ system.\ \>", "Text"], Cell[CellGroupData[{ Cell[StyleData["MainBookLink"], StyleMenuListing->None, ButtonStyleMenuListing->Automatic, FontColor->RGBColor[0, 0, 1], FontVariations->{"Underline"->True}, ButtonBoxOptions->{ButtonFunction:>(FrontEndExecute[ { FrontEnd`HelpBrowserLookup[ "MainBook", #]}]&), Active->True, ButtonFrame->"None"}], Cell[StyleData["MainBookLink", "Presentation"]], Cell[StyleData["MainBookLink", "Condensed"]], Cell[StyleData["MainBookLink", "Printout"], FontColor->GrayLevel[0], FontVariations->{"Underline"->False}] }, Closed]], Cell[CellGroupData[{ Cell[StyleData["AddOnsLink"], StyleMenuListing->None, ButtonStyleMenuListing->Automatic, FontFamily->"Courier", FontColor->RGBColor[0, 0, 1], FontVariations->{"Underline"->True}, ButtonBoxOptions->{ButtonFunction:>(FrontEndExecute[ { FrontEnd`HelpBrowserLookup[ "AddOns", #]}]&), Active->True, ButtonFrame->"None"}], Cell[StyleData["AddOnsLink", "Presentation"]], Cell[StyleData["AddOnsLink", "Condensed"]], Cell[StyleData["AddOnLink", "Printout"], FontColor->GrayLevel[0], FontVariations->{"Underline"->False}] }, Closed]], Cell[CellGroupData[{ Cell[StyleData["RefGuideLink"], StyleMenuListing->None, ButtonStyleMenuListing->Automatic, FontFamily->"Courier", FontColor->RGBColor[0, 0, 1], FontVariations->{"Underline"->True}, ButtonBoxOptions->{ButtonFunction:>(FrontEndExecute[ { FrontEnd`HelpBrowserLookup[ "RefGuideLink", #]}]&), Active->True, ButtonFrame->"None"}], Cell[StyleData["RefGuideLink", "Presentation"]], Cell[StyleData["RefGuideLink", "Condensed"]], Cell[StyleData["RefGuideLink", "Printout"], FontColor->GrayLevel[0], FontVariations->{"Underline"->False}] }, Closed]], Cell[CellGroupData[{ Cell[StyleData["GettingStartedLink"], StyleMenuListing->None, ButtonStyleMenuListing->Automatic, FontColor->RGBColor[0, 0, 1], FontVariations->{"Underline"->True}, ButtonBoxOptions->{ButtonFunction:>(FrontEndExecute[ { FrontEnd`HelpBrowserLookup[ "GettingStarted", #]}]&), Active->True, ButtonFrame->"None"}], Cell[StyleData["GettingStartedLink", "Presentation"]], Cell[StyleData["GettingStartedLink", "Condensed"]], Cell[StyleData["GettingStartedLink", "Printout"], FontColor->GrayLevel[0], FontVariations->{"Underline"->False}] }, Closed]], Cell[CellGroupData[{ Cell[StyleData["OtherInformationLink"], StyleMenuListing->None, ButtonStyleMenuListing->Automatic, FontColor->RGBColor[0, 0, 1], FontVariations->{"Underline"->True}, ButtonBoxOptions->{ButtonFunction:>(FrontEndExecute[ { FrontEnd`HelpBrowserLookup[ "OtherInformation", #]}]&), Active->True, ButtonFrame->"None"}], Cell[StyleData["OtherInformationLink", "Presentation"]], Cell[StyleData["OtherInformationLink", "Condensed"]], Cell[StyleData["OtherInformationLink", "Printout"], FontColor->GrayLevel[0], FontVariations->{"Underline"->False}] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Placeholder Styles", "Section"], Cell["\<\ The cells below define styles useful for making placeholder objects in \ palette templates.\ \>", "Text"], Cell[CellGroupData[{ Cell[StyleData["Placeholder"], Editable->False, Selectable->False, StyleBoxAutoDelete->True, Placeholder->True, StyleMenuListing->None], Cell[StyleData["Placeholder", "Presentation"]], Cell[StyleData["Placeholder", "Condensed"]], Cell[StyleData["Placeholder", "Printout"]] }, Closed]], Cell[CellGroupData[{ Cell[StyleData["SelectionPlaceholder"], Editable->False, Selectable->False, StyleBoxAutoDelete->True, Placeholder->Primary, StyleMenuListing->None, DrawHighlighted->True], Cell[StyleData["SelectionPlaceholder", "Presentation"]], Cell[StyleData["SelectionPlaceholder", "Condensed"]], Cell[StyleData["SelectionPlaceholder", "Printout"]] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["FormatType Styles", "Section"], Cell["\<\ The cells below define styles that are mixed in with the styles of most \ cells. If a cell's FormatType matches the name of one of the styles defined \ below, then that style is applied between the cell's style and its own \ options.\ \>", "Text"], Cell[StyleData["CellExpression"], PageWidth->Infinity, CellMargins->{{6, Inherited}, {Inherited, Inherited}}, ShowCellLabel->False, ShowSpecialCharacters->False, AllowInlineCells->False, AutoItalicWords->{}, StyleMenuListing->None, FontFamily->"Courier", Background->GrayLevel[1]], Cell[StyleData["InputForm"], AllowInlineCells->False, StyleMenuListing->None, FontFamily->"Courier"], Cell[StyleData["OutputForm"], PageWidth->Infinity, TextAlignment->Left, LineSpacing->{1, -5}, StyleMenuListing->None, FontFamily->"Courier"], Cell[StyleData["StandardForm"], LineSpacing->{1.25, 0}, StyleMenuListing->None, FontFamily->"Courier"], Cell[StyleData["TraditionalForm"], LineSpacing->{1.25, 0}, SingleLetterItalics->True, TraditionalFunctionNotation->True, DelimiterMatching->None, StyleMenuListing->None], Cell["\<\ The style defined below is mixed in to any cell that is in an inline cell \ within another.\ \>", "Text"], Cell[StyleData["InlineCell"], TextAlignment->Left, ScriptLevel->1, StyleMenuListing->None], Cell[StyleData["InlineCellEditing"], StyleMenuListing->None, Background->RGBColor[1, 0.749996, 0.8]] }, Closed]] }, Open ]] }] ] (*********************************************************************** 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[1709, 49, 1367, 45, 307, "Text"], Cell[3079, 96, 187, 6, 38, "Text"], Cell[3269, 104, 796, 27, 109, "Text"], Cell[4068, 133, 511, 11, 150, "Input", InitializationCell->True], Cell[4582, 146, 742, 26, 106, "Text"], Cell[CellGroupData[{ Cell[5349, 176, 548, 15, 147, "Text"], Cell[5900, 193, 1810, 29, 1046, "Input", InitializationCell->True] }, Closed]], Cell[7725, 225, 318, 13, 68, "Text"], Cell[8046, 240, 203, 4, 90, "Input"], Cell[8252, 246, 118, 2, 30, "Input"], Cell[8373, 250, 196, 7, 33, "Text"], Cell[8572, 259, 284, 5, 90, "Input"], Cell[8859, 266, 1042, 33, 125, "Text"], Cell[CellGroupData[{ Cell[9926, 303, 417, 14, 90, "Text"], Cell[10346, 319, 5821, 103, 1590, "Input", InitializationCell->True] }, Closed]], Cell[16182, 425, 357, 10, 87, "Text"], Cell[16542, 437, 333, 7, 112, "Input"], Cell[16878, 446, 134, 3, 50, "Input"], Cell[17015, 451, 196, 7, 33, "Text"], Cell[17214, 460, 375, 7, 90, "Input"], Cell[17592, 469, 800, 29, 106, "Text"], Cell[CellGroupData[{ Cell[18417, 502, 543, 15, 128, "Text"], Cell[18963, 519, 5927, 93, 1763, "Input", InitializationCell->True] }, Closed]], Cell[24905, 615, 317, 13, 68, "Text"], Cell[25225, 630, 208, 4, 90, "Input"], Cell[25436, 636, 106, 2, 30, "Input"], Cell[25545, 640, 181, 7, 33, "Text"], Cell[25729, 649, 284, 5, 90, "Input"], Cell[26016, 656, 892, 28, 106, "Text"], Cell[CellGroupData[{ Cell[26933, 688, 541, 17, 109, "Text"], Cell[27477, 707, 3607, 58, 1763, "Input", InitializationCell->True] }, Closed]], Cell[31099, 768, 356, 10, 87, "Text"], Cell[31458, 780, 355, 7, 112, "Input"], Cell[31816, 789, 338, 6, 151, "Input"], Cell[32157, 797, 181, 7, 33, "Text"], Cell[32341, 806, 375, 7, 90, "Input"] } ] *) (*********************************************************************** End of Mathematica Notebook file. ***********************************************************************)