(************** Content-type: application/mathematica ************** Mathematica-Compatible Notebook This notebook can be used with any Mathematica-compatible application, such as Mathematica, MathReader or Publicon. The data for the notebook starts with the line containing stars above. To get the notebook into a Mathematica-compatible application, do one of the following: * Save the data starting with the line of stars above into a file with a name ending in .nb, then open the file inside the application; * Copy the data starting with the line of stars above to the clipboard, then use the Paste menu command inside the application. Data for notebooks contains only printable 7-bit ASCII and can be sent directly in email or through ftp in text mode. Newlines can be CR, LF or CRLF (Unix, Macintosh or MS-DOS style). NOTE: If you modify the data for this notebook not in a Mathematica- compatible application, you must delete the line below containing the word CacheID, otherwise Mathematica-compatible applications may try to use invalid cache data. For more information on notebooks and Mathematica-compatible applications, contact Wolfram Research: web: http://www.wolfram.com email: info@wolfram.com phone: +1-217-398-0700 (U.S.) Notebook reader applications are available free of charge from Wolfram Research. *******************************************************************) (*CacheID: 232*) (*NotebookFileLineBreakTest NotebookFileLineBreakTest*) (*NotebookOptionsPosition[ 31960, 964]*) (*NotebookOutlinePosition[ 32847, 994]*) (* CellTagsIndexPosition[ 32803, 990]*) (*WindowFrame->Normal*) Notebook[{ Cell[CellGroupData[{ Cell["Finding Roots of Functions", "Title", Evaluatable->False, TextAlignment->Center, AspectRatioFixed->True, Background->RGBColor[0, 1, 0]], Cell["\<\ This notebook is by Steven Amgott. Please send any questions or \ comments to samgott1@swarthmore.edu. Feel free to use and distribute this \ notebook, but keep this author information in any copy you use or distribute.\ \ \>", "SmallText"], Cell[TextData[{ "This notebook looks at a few methods to approximate roots (zeros) of a \ continuous function. In most cases, the method approximates the roots, \ although we will also consider ", StyleBox["Mathematica", FontSlant->"Italic"], " routines that (sometimes) find exact roots." }], "Text"], Cell[TextData[{ "The first cell in the first section is an initialization cell. It will be \ automatically evaluated the first time you evaluate any cell in the notebook, \ provided you answer \"Yes\" to the initialization request. If you wish to \ use this notebook with a function other than the polynomial ", Cell[BoxData[ StyleBox[\(3\ x\^4 - 16 x\^3 + 6\ x\^2 + 24\ x + 1\), FontColor->RGBColor[1, 0, 1]]], AspectRatioFixed->True], ", be sure to change it in that cell to the function you want, and \ re-evaluate the cell. In general, anything in ", StyleBox["magenta", FontColor->RGBColor[1, 0, 1]], " is something you can, and possibly should, change." }], "Text"], Cell[CellGroupData[{ Cell["The function and its graph.", "Section", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[{ "We are going to hunt for as many roots as possible for the polynomial ", Cell[BoxData[ \(3\ x\^4 - 16 x\^3 + 6\ x\^2 + 24\ x + 1\)], AspectRatioFixed->True], ". Since it is a polynomial of degree 4, we know that there are at most 4 \ roots, but it might have fewer. We also know that since it has even degree \ and the leading coefficient is positive, the polynomial values go to \ \[Infinity] as x\[Rule]\[Infinity] and as x\[Rule]-\[Infinity]. We need to \ make sure to include a large enough interval to see this behavior." }], "Text"], Cell[BoxData[{\(Clear[f, x];\), "\n", RowBox[{ RowBox[{\(f[x_]\), ":=", StyleBox[\(3\ x\^4 - 16 x\^3 + 6\ x\^2 + 24\ x + 1\), FontColor->RGBColor[1, 0, 1]]}], ";"}], "\n", RowBox[{ RowBox[{"Plot", "[", RowBox[{\(f[x]\), ",", RowBox[{"{", RowBox[{"x", ",", StyleBox[\(-1.5\), FontColor->RGBColor[1, 0, 1]], ",", StyleBox["4.75", FontColor->RGBColor[1, 0, 1]]}], "}"}]}], "]"}], ";"}]}], "Input", InitializationCell->True, AspectRatioFixed->True], Cell["\<\ We're in luck. We've got an interval which contains 4 roots, which \ is all the polynomial can have. Although we are initially using this \ polynomial in the rest of the notebook, you can change it to any function \ (not just a polynomial) and still do the following. If you change the \ function, you will probably have to adjust the interval as well in order to \ find roots to approximate.\ \>", "Text"] }, Closed]], Cell[CellGroupData[{ Cell["Decisection (modified bisection)", "Section", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[{ "The cell below will draw a graph of the function on an interval, initially \ of length 1, and will divide the interval into ten even pieces. We can use \ this to find the \"next decimal\" in an approximation to the root of the \ function. You have to specify the function\[NonBreakingSpace]in the section \ above, and the interval in the next cell by giving its left endpoint as ", StyleBox["a", FontColor->RGBColor[1, 0, 0]], " and right endpoint as ", StyleBox["b", FontColor->RGBColor[1, 0, 0]], ". The initial values of ", StyleBox["a", FontColor->RGBColor[1, 0, 0]], " and ", StyleBox["b", FontColor->RGBColor[1, 0, 0]], " here allow us to search for the leftmost root of the polynomial ", Cell[BoxData[ \(3\ x\^4 - 16 x\^3 + 6\ x\^2 + 24\ x + 1\)], AspectRatioFixed->True], ", whose graph we drew above. You will need to change them to search for \ other roots or to use this with other functions. ", StyleBox["Evaluate the next cell to draw the new graph.", FontColor->RGBColor[1, 0, 1]] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[{\(Clear[a, b, x, k]\), "\[IndentingNewLine]", RowBox[{ RowBox[{"a", "=", StyleBox[\(-1\), FontColor->RGBColor[1, 0, 1]]}], ";"}], "\n", RowBox[{ RowBox[{"b", "=", StyleBox["0", FontColor->RGBColor[1, 0, 1]]}], ";"}], "\n", \(Plot[f[x], {x, a, b}, Ticks \[Rule] {Table[a + \((b - a)\)\ k\ .1, {k, 0, 10}], Automatic}];\)}], "Input", AspectRatioFixed->True], Cell["\<\ Once you have the graph, you can inspect it to see which of the ten \ subintervals contain roots. You can then repeat this process (changing the \ values of a and b to be the endpoints of a subinterval containing a root). \ Each time you do so, you get one additional decimal place of accuracy in the \ approximation. Do so until you obtain a three decimal place approximation to \ the leftmost root. How many times do you have to do the process to obtain \ this accuracy? How many times would you have to do it to get ten decimal \ place accuracy?\ \>", "Text"], Cell["\<\ If you were to program a computer or a calculator to do this \ method, it would not be able to \"look at the graph\" to find the location of \ roots. Instead, you initially pick an interval on which the function values \ change from positive to negative or vice-versa. The interval is divided into \ the ten pieces, and the function is evaluated at the endpoints of the \ subintervals. When the sign of the function value changes between two \ adjacent endpoints, we (and the computer or calculator) know that a root \ exists between those endpoints. These two endpoints are then used in the \ next iteration.\ \>", "Text"] }, Closed]], Cell[CellGroupData[{ Cell["Newton's Method", "Section", Evaluatable->False, AspectRatioFixed->True], Cell["\<\ Newton's method uses tangent approximations to approximate roots of \ a function. The basic idea is to choose a point (hopefully not too far from \ a root), find the tangent line to the function at that point, and then find \ the point where that line intersects the x-axis. That is your next \ approximation for the root. You then repeat the process starting at this \ point.\ \>", "Text"], Cell[TextData[{ "If we do this at a point ", Cell[BoxData[ FormBox[ SubscriptBox[ StyleBox["x", FontSlant->"Plain"], StyleBox["k", FontSlant->"Plain"]], TraditionalForm]]], ", then ", Cell[BoxData[ FormBox[ SubscriptBox[ StyleBox["x", FontSlant->"Plain"], RowBox[{"(", RowBox[{ StyleBox["k", FontSlant->"Plain"], "+", "1"}], ")"}]], TraditionalForm]]], " is the point on the x-axis where the y-coordinate of the tangent line is \ zero. Remember that an equation of the tangent line at ", Cell[BoxData[ FormBox[ SubscriptBox[ StyleBox["x", FontSlant->"Plain"], StyleBox["k", FontSlant->"Plain"]], TraditionalForm]]], " is" }], "Text"], Cell[TextData[{ "y = f(", Cell[BoxData[ FormBox[ SubscriptBox[ StyleBox["x", FontSlant->"Plain"], StyleBox["k", FontSlant->"Plain"]], TraditionalForm]]], ") + f '(", Cell[BoxData[ FormBox[ SubscriptBox[ StyleBox["x", FontSlant->"Plain"], StyleBox["k", FontSlant->"Plain"]], TraditionalForm]]], ") (x - ", Cell[BoxData[ FormBox[ SubscriptBox[ StyleBox["x", FontSlant->"Plain"], StyleBox["k", FontSlant->"Plain"]], TraditionalForm]]], ")." }], "Text", TextAlignment->Center, TextJustification->0], Cell[TextData[{ "The point ", Cell[BoxData[ FormBox[ SubscriptBox[ StyleBox["x", FontSlant->"Plain"], RowBox[{"(", RowBox[{ StyleBox["k", FontSlant->"Plain"], "+", "1"}], ")"}]], TraditionalForm]]], " is where y = 0, so" }], "Text"], Cell[TextData[{ "0 = f(", Cell[BoxData[ FormBox[ SubscriptBox[ StyleBox["x", FontSlant->"Plain"], StyleBox["k", FontSlant->"Plain"]], TraditionalForm]]], ") + f '(", Cell[BoxData[ FormBox[ SubscriptBox[ StyleBox["x", FontSlant->"Plain"], StyleBox["k", FontSlant->"Plain"]], TraditionalForm]]], ") (", Cell[BoxData[ FormBox[ SubscriptBox[ StyleBox["x", FontSlant->"Plain"], RowBox[{"(", RowBox[{ StyleBox["k", FontSlant->"Plain"], "+", "1"}], ")"}]], TraditionalForm]]], " - ", Cell[BoxData[ FormBox[ SubscriptBox[ StyleBox["x", FontSlant->"Plain"], StyleBox["k", FontSlant->"Plain"]], TraditionalForm]]], ")." }], "Text", TextAlignment->Center, TextJustification->0], Cell[TextData[{ "Solving for ", Cell[BoxData[ FormBox[ SubscriptBox[ StyleBox["x", FontSlant->"Plain"], RowBox[{"(", RowBox[{ StyleBox["k", FontSlant->"Plain"], "+", "1"}], ")"}]], TraditionalForm]]], ", we get" }], "Text"], Cell[TextData[{ Cell[BoxData[ FormBox[ SubscriptBox[ StyleBox["x", FontSlant->"Plain"], RowBox[{"(", RowBox[{ StyleBox["k", FontSlant->"Plain"], "+", "1"}], ")"}]], TraditionalForm]]], " = ", Cell[BoxData[ FormBox[ SubscriptBox[ StyleBox["x", FontSlant->"Plain"], StyleBox["k", FontSlant->"Plain"]], TraditionalForm]]], " - ", Cell[BoxData[ FormBox[ FractionBox[ RowBox[{ StyleBox["f", FontSlant->"Plain"], "(", FormBox[ SubscriptBox[ StyleBox["x", FontSlant->"Plain"], StyleBox["k", FontSlant->"Plain"]], "TraditionalForm"], ")"}], RowBox[{ RowBox[{ StyleBox["f", FontSlant->"Plain"], StyleBox[" ", FontSlant->"Plain"], "'"}], RowBox[{"(", FormBox[ SubscriptBox[ StyleBox["x", FontSlant->"Plain"], StyleBox["k", FontSlant->"Plain"]], "TraditionalForm"], ")"}]}]], TraditionalForm]]], "." }], "Text", TextAlignment->Center, TextJustification->0], Cell[TextData[{ "Here's a picture to illustrate this. The function is in ", StyleBox["blue", FontColor->RGBColor[0, 0, 1]], ", the tangent line is in ", StyleBox["red", FontColor->RGBColor[1, 0, 0]], ", and we have placed a ", StyleBox["red", FontColor->RGBColor[1, 0, 0]], " dot at ", Cell[BoxData[ FormBox[ SubscriptBox[ StyleBox["x", FontSlant->"Plain"], StyleBox["k", FontSlant->"Plain"]], TraditionalForm]]], ", a ", StyleBox["red", FontColor->RGBColor[1, 0, 0]], " line segment connecting that point to the point of tangency, and a ", StyleBox["green", FontColor->RGBColor[0, 1, 0]], " dot at ", Cell[BoxData[ FormBox[ SubscriptBox[ StyleBox["x", FontSlant->"Plain"], RowBox[{"(", RowBox[{ StyleBox["k", FontSlant->"Plain"], "+", "1"}], ")"}]], TraditionalForm]]], ". If you changed the function above, you will probably need to change ", StyleBox["xk", FontColor->RGBColor[1, 0, 0]], ". (You may want to change it anyway to see what happens.)" }], "Text"], Cell[BoxData[{\(Clear[x, xk]\), "\[IndentingNewLine]", RowBox[{ RowBox[{"xk", "=", StyleBox[\(-2\), FontColor->RGBColor[1, 0, 1]]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"Plot", "[", RowBox[{\({f[x], f[xk] + \(f'\)[xk] \((x - xk)\)}\), ",", RowBox[{"{", RowBox[{"x", ",", RowBox[{"xk", "-", StyleBox["1", FontColor->RGBColor[1, 0, 1]]}], ",", RowBox[{"xk", "+", StyleBox["1", FontColor->RGBColor[1, 0, 1]]}]}], "}"}], ",", \(PlotStyle \[Rule] {RGBColor[0, 0, 1], RGBColor[1, 0, 0]}\), ",", \(Epilog \[Rule] {RGBColor[1, 0, 0], Line[{{xk, 0}, {xk, f[xk]}}], PointSize[ .02], Point[{xk, 0}], PointSize[ .02], RGBColor[0, 1, 0], Point[{xk - f[xk]\/\(f'\)[xk], 0}]}\)}], "]"}], ";"}]}], "Input"], Cell[TextData[{ "The cell below does Newton's method for ", StyleBox["n", FontColor->RGBColor[1, 0, 0]], " (initially ", StyleBox["10", FontColor->RGBColor[1, 0, 1]], ") iterations, and places the results in a table. The default value ", StyleBox["-1", FontColor->RGBColor[1, 0, 1]], " for ", StyleBox["x[0]", FontColor->RGBColor[1, 0, 0]], " allows us to search for the leftmost root of our polynomial ", Cell[BoxData[ \(3\ x\^4 - 16 x\^3 + 6\ x\^2 + 24\ x + 1\)], AspectRatioFixed->True], ". You will need to change it to search for other roots, or to use this \ method with other functions. The ", StyleBox["N[ ]", FontColor->RGBColor[1, 0, 0]], " around the value simply makes ", StyleBox["Mathematica", FontSlant->"Italic"], " use numerical arithmetic, rather than exact, to speed things up. Finally \ ", StyleBox["sigDigits", FontColor->RGBColor[1, 0, 0]], " is the number of digits you want to keep in the computations (", StyleBox["not necessarily the final accuracy", FontSlant->"Italic"], "). The ", StyleBox["Mathematica", FontSlant->"Italic"], " command ", StyleBox["SetAccuracy", FontColor->RGBColor[1, 0, 0]], " is being used to display this number of digits. (This is not its \ intended purpose, but is the only way I have been able to get around in this \ cell the 6 displayed digit default that is new to ", StyleBox["Mathematica", FontSlant->"Italic"], " 4.0.)" }], "Text"], Cell[BoxData[{\(Clear[n, x, k]\), "\[IndentingNewLine]", RowBox[{ RowBox[{"n", "=", StyleBox["10", FontColor->RGBColor[1, 0, 1]]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{\(x[0]\), "=", RowBox[{"N", "[", StyleBox[\(-2\), FontColor->RGBColor[1, 0, 1]], "]"}]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"sigDigits", "=", StyleBox["10", FontColor->RGBColor[1, 0, 1]]}], ";"}], "\n", RowBox[{ RowBox[{"Table", "[", RowBox[{ RowBox[{\(x[k + 1]\), "=", RowBox[{"SetAccuracy", "[", RowBox[{ RowBox[{\(x[k]\), "-", FractionBox[\(f[x[k]]\), RowBox[{ SuperscriptBox["f", "\[Prime]", MultilineFunction->None], "[", \(x[k]\), "]"}]]}], ",", "sigDigits"}], "]"}]}], ",", \({k, 0, n - 1}\)}], "]"}], ";"}], "\n", \(TableForm[Table[{k, x[k]}, {k, 0, n}]]\)}], "Input", AspectRatioFixed->True], Cell[CellGroupData[{ Cell["A few interesting cases", "Subsection"], Cell[CellGroupData[{ Cell["Which root do we get?", "Subsubsection"], Cell["\<\ You might think that Newton's method will find the root nearest the \ place we start. An example with our original polynomial shows this is not \ always the case. From the very first picture, we saw that the polynomial has \ four real roots, one each near (but not at!) -1, 0, 2, and 4.5. You would \ think that starting at 1.1 we would end up approximating either the root near \ 0 or the root near 2. Evaluate the next cell to see what happens. The \ output will be a table of iteration values, and a graph showing the first \ iteration.\ \>", "Text"], Cell[BoxData[{\(Clear[n, x, x0, k]\), "\[IndentingNewLine]", RowBox[{\(g[x_] := 3\ x\^4 - 16 x\^3 + 6\ x\^2 + 24\ x + 1\), StyleBox[";", FontColor->GrayLevel[0]]}], "\n", RowBox[{ RowBox[{"n", "=", StyleBox["10", FontColor->RGBColor[1, 0, 1]]}], ";"}], "\n", RowBox[{ RowBox[{\(x[0]\), "=", RowBox[{"x0", "=", StyleBox["1.1", FontColor->RGBColor[1, 0, 1]]}]}], ";"}], "\n", RowBox[{ RowBox[{"sigDigits", "=", StyleBox["10", FontColor->RGBColor[1, 0, 1]]}], ";"}], "\n", RowBox[{ RowBox[{"Table", "[", RowBox[{ RowBox[{\(x[k + 1]\), "=", RowBox[{"SetAccuracy", "[", RowBox[{ RowBox[{\(x[k]\), "-", FractionBox[\(f[x[k]]\), RowBox[{ SuperscriptBox["f", "\[Prime]", MultilineFunction->None], "[", \(x[k]\), "]"}]]}], ",", "sigDigits"}], "]"}]}], ",", \({k, 0, n - 1}\)}], "]"}], ";"}], "\n", \(TableForm[ Table[{k, x[k]}, {k, 0, n}]]\), "\[IndentingNewLine]", \(Plot[{g[x], g[x0] + \(f'\)[x0] \((x - x0)\)}, {x, \(-1\), 5}, PlotStyle \[Rule] {RGBColor[0, 0, 1], RGBColor[1, 0, 0]}, Epilog \[Rule] {RGBColor[1, 0, 0], Line[{{x0, 0}, {x0, f[x0]}}], PointSize[ .02], Point[{x0, 0}], PointSize[ .02], RGBColor[0, 1, 0], Point[{x0 - f[x0]\/\(f'\)[x0], 0}]}];\)}], "Input"], Cell[TextData[{ "It looks like we are approximating the root near 4.5! Why this happens is \ not hard to see from the graph. You might change the value of ", StyleBox["x0", FontColor->RGBColor[1, 0, 0]], " slightly a few times, and see what effect that has on which root is \ found. In particular, be sure to try ", StyleBox["x0", FontColor->RGBColor[1, 0, 0]], " = 1.2." }], "Text"], Cell["\<\ The problem here is that we are starting near a place where g '(x) \ = 0. The tangent line we first draw is near horizontal, and intersects the \ x-axis relatively far from our starting point. The moral is to avoid \ starting near critical points whenever possible while hunting for nearby \ roots.\ \>", "Text"] }, Closed]], Cell[CellGroupData[{ Cell["Wild oscillations", "Subsubsection"], Cell[TextData[{ "A bit more serious problem occurs with the function g(x) = ", Cell[BoxData[ FormBox[ SuperscriptBox[ StyleBox["x", FontSlant->"Plain"], \(1\/3\)], TraditionalForm]]], ", as you can see below. (We even have ", StyleBox["Mathematica", FontSlant->"Italic"], " doing exact arithmetic here, so the problem is with the method, not \ numerical precision.) You can change ", StyleBox["x[0]", FontColor->RGBColor[1, 0, 0]], " and see what happens. " }], "Text"], Cell[BoxData[{\(Clear[n, g, x, k]\), "\[IndentingNewLine]", RowBox[{ RowBox[{"n", "=", StyleBox["10", FontColor->RGBColor[1, 0, 1]]}], ";"}], "\[IndentingNewLine]", \(g[x_] := x\^\(1\/3\)\), "\[IndentingNewLine]", RowBox[{ RowBox[{\(x[0]\), "=", StyleBox["1", FontColor->RGBColor[1, 0, 1]]}], ";"}], "\n", \(Table[ x[k + 1] = x[k] - g[x[k]]\/\(g'\)[x[k]], {k, 0, n - 1}];\), "\n", \(TableForm[ Table[{k, x[k]}, {k, 0, n}]]\)}], "Input", AspectRatioFixed->True], Cell[TextData[{ "Why is Newton's method behaving this way? (Hint: Find the derivative, \ and see what Newton's method gives for ", Cell[BoxData[ FormBox[ StyleBox[ SubscriptBox[ StyleBox["x", FontSlant->"Plain"], RowBox[{"(", StyleBox[\(k + 1\), FontSlant->"Plain"], ")"}]], FontSlant->"Italic"], TraditionalForm]]], " in terms of ", Cell[BoxData[ FormBox[ SubscriptBox[ StyleBox["x", FontSlant->"Plain"], StyleBox["k", FontSlant->"Plain"]], TraditionalForm]]], ".) " }], "Text"], Cell["\<\ Fortunately, we don't need any computation to find the actual real \ root here. (What is it?) \ \>", "Text"], Cell["\<\ Here's a picture showing the first two steps of the iteration \ starting with x[0] = 1. The definition of g[x] is complicated by complex \ variable issues which will not be discussed here.\ \>", "Text"], Cell[BoxData[{ \(Clear[g, x, xk]\), "\[IndentingNewLine]", \(g[x_] := If[x \[GreaterEqual] 0, x\^\(1\/3\), \(-\((\(-x\))\)\^\(1\/3\)\)]\), "\[IndentingNewLine]", \(\(Plot[{g[x], g[1] + \(g'\)[1] \((x - 1)\), g[\(-2\)] + \(g'\)[\(-2\)] \((x + 2)\)}, {x, \(-5\), 5}, PlotStyle \[Rule] {RGBColor[0, 0, 1], RGBColor[1, 0, 0], RGBColor[0, 1, 0]}, Epilog \[Rule] {RGBColor[1, 0, 0], Line[{{1, 0}, {1, g[1]}}], PointSize[ .02], Point[{1, 0}], RGBColor[0, 1, 0], Line[{{\(-2\), 0}, {\(-2\), g[\(-2\)]}}], PointSize[ .02], Point[{\(-2\), 0}]}];\)\)}], "Input"] }, Closed]], Cell[CellGroupData[{ Cell["Bouncing back and forth", "Subsubsection"], Cell["\<\ Here's an example where the iterations from Newton's method bounce \ back and forth between two numbers.\ \>", "Text"], Cell[BoxData[{\(Clear[n, g, x, k]\), "\[IndentingNewLine]", RowBox[{ RowBox[{"n", "=", StyleBox["10", FontColor->RGBColor[1, 0, 1]]}], ";"}], "\[IndentingNewLine]", \(g[x_] := x\^3 - 10\ x\^2 + 22\ x + 6\), "\[IndentingNewLine]", RowBox[{ RowBox[{\(x[0]\), "=", StyleBox["2", FontColor->RGBColor[1, 0, 1]]}], ";"}], "\n", \(Table[ x[k + 1] = x[k] - g[x[k]]\/\(g'\)[x[k]], {k, 0, n - 1}];\), "\n", \(TableForm[ Table[{k, x[k]}, {k, 0, n}]]\)}], "Input", AspectRatioFixed->True], Cell[TextData[{ "What do you think will happen if ", StyleBox["x[0]", FontColor->RGBColor[1, 0, 0]], " = ", StyleBox["5", FontColor->RGBColor[1, 0, 1]], "? (Try to answer this before drawing the graphs below.) ", StyleBox["Note that ", "Output", FontFamily->"Times New Roman"], StyleBox["t", "Output"], "here is no real problem in this example, as we can change ", StyleBox["x[0]", FontColor->RGBColor[1, 0, 0]], " slightly. See what happens if you make ", StyleBox["x[0]", FontColor->RGBColor[1, 0, 0]], " = ", StyleBox["2.1", FontColor->RGBColor[1, 0, 1]], "." }], "Text"], Cell[TextData[{ "Here is a picture to show what is happening. The process beginning at 2 \ is in ", StyleBox["red", FontColor->RGBColor[1, 0, 0]], ", and beginning at 5 is in ", StyleBox["green", FontColor->RGBColor[0, 1, 0]], "." }], "Text"], Cell[BoxData[{ \(Clear[g, x, xk]\), "\[IndentingNewLine]", \(g[x_] := x\^3 - 10\ x\^2 + 22\ x + 6\), "\[IndentingNewLine]", \(\(Plot[{g[x], g[2] + \(g'\)[2] \((x - 2)\), g[5] + \(g'\)[5] \((x - 5)\)}, {x, 1, 6}, PlotStyle \[Rule] {RGBColor[0, 0, 1], RGBColor[1, 0, 0], RGBColor[0, 1, 0]}, Epilog \[Rule] {RGBColor[1, 0, 0], Line[{{2, 0}, {2, g[2]}}], PointSize[ .02], Point[{2, 0}], RGBColor[0, 1, 0], Line[{{5, 0}, {5, g[5]}}], PointSize[ .02], Point[{5, 0}]}];\)\)}], "Input"], Cell["\<\ As you can see, for this function, if we start at either 2 or 5, we \ simply end up going back and forth between those two values.\ \>", "Text"] }, Closed]] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Comparing the two methods", "Section"], Cell["\<\ You might have noticed that Newton's method did not take too many \ iterations to get \"8 decimal place\" accuracy (stopping when the first 8 \ decimal places always remain the same) or higher, while decisection would \ take 8 iterations (or more for more accuracy). This difference becomes even \ greater when the accuracy desired gets higher. (For instance, most graphing \ calculators try for 15 or more decimal place accuracy, and display 12.) From \ this, it would seem that Newton's method would be the method of choice. In \ fact, a modified Newton's method is behind the Solve button on many \ calculators.\ \>", "Text"], Cell["\<\ There are, however, a few problems with Newton's method. First, it \ fails if any iteration ends at a critical point of f (a place where f '(x) = \ 0 or undefined). (Why?) This is not a big problem, as we can usually adjust \ our starting point a bit to get away from the critical point. A second \ problem is that the method may fail to find the root we want from a \ particular starting point, as we saw above. Again, an adjustment of the \ starting point may be all that is needed. \ \>", "Text"], Cell["\<\ The primary problem with Newton's method is that you are never \ quite sure of the accuracy. That is the one major advantage to decisection. \ Simply knowing the length of the starting interval containing the root \ (chosen so the function has opposite signs at the endpoints) and the number \ of iterations, we can compute the accuracy. Conversely, knowing the desired \ accuracy, we can fix beforehand the number of iterations we need. The major \ disadvantage to decisection is the higher number of iterations needed to get \ that accuracy.\ \>", "Text"], Cell["\<\ Which to use? Most graphing calculators (and many computer \ programs) try to choose a method that works most of the time (providing error \ messages when it doesn't), and does so quickly. Newton's method (or a small \ modification) is then usually the choice. There are also programs that use \ decisection (or a variant) as their method, sacrificing speed for fewer \ complications and guaranteed accuracy.\ \>", "Text"] }, Closed]], Cell[CellGroupData[{ Cell[TextData[{ "Built-in ", StyleBox["Mathematica", FontSlant->"Italic"], " commands" }], "Section"], Cell[TextData[{ "There are several built-in ", StyleBox["Mathematica", FontSlant->"Italic"], " commands to help with root finding. Some are symbolic, some numeric. \ The next few input cells contain some of these commands. The function being \ used is the one from the first section of this notebook, unless you defined \ f(x) somewhere else." }], "Text"], Cell[TextData[{ "The ", StyleBox["Solve", FontColor->RGBColor[1, 0, 0]], " command tries to solve equations symbolically for x. Note the double \ equal sign in the equation. It is there because ", StyleBox["Mathematica", FontSlant->"Italic"], " uses a single equal sign to assign values to variables. This command may \ not always work (since most equations cannot be solved symbolically), in \ which case it is returned unevaluated. It may also warn you if it is unsure \ that it found all the solutions." }], "Text"], Cell[BoxData[ \(Solve[f[x] \[Equal] 0, x]\)], "Input"], Cell[TextData[{ "The ", StyleBox["NSolve", FontColor->RGBColor[1, 0, 0]], " command tries to solve equations involving only polynomials. We can \ adjust the number of displayed digits (in ", StyleBox["magenta", FontColor->RGBColor[1, 0, 1]], ")" }], "Text"], Cell[BoxData[ RowBox[{"NumberForm", "[", RowBox[{\(NSolve[f[x] \[Equal] 0, x]\), ",", StyleBox["10", FontColor->RGBColor[1, 0, 1]]}], "]"}]], "Input"], Cell[TextData[{ "To find out more about ", StyleBox["NumberForm", FontColor->RGBColor[1, 0, 0]], ", you can do a couple of things. First we can evaluate either" }], "Text"], Cell[BoxData[ \(\(?NumberForm\)\)], "Input"], Cell["or", "Text"], Cell[BoxData[ \(?? NumberForm\)], "Input"], Cell[TextData[{ "Perhaps the best way is to highlight the word ", StyleBox["NumberForm", FontColor->RGBColor[1, 0, 0]], " (just the word, not anything else in the cell), and use the ", StyleBox["Help...Find Selected Function", FontColor->RGBColor[0, 0, 1]], " menu item. ", StyleBox["Try it in this cell or the cell above.", FontColor->RGBColor[1, 0, 1]] }], "Text"], Cell[TextData[{ StyleBox["NumberForm", FontColor->RGBColor[1, 0, 0]], " only affects the display of the number, not the accuracy of the \ computation. For more about accuracy, use the ", StyleBox["Help", FontColor->RGBColor[0, 0, 1]], " menu item to look up ", StyleBox["Numerical Precision ", FontColor->RGBColor[1, 0, 0]], "under ", StyleBox["Numerical Computation", FontColor->RGBColor[1, 0, 0]], "." }], "Text"], Cell[TextData[{ "The ", StyleBox["Factor", FontColor->RGBColor[1, 0, 0]], " command tries to factor a polynomial f(x). It will not work with other \ functions. It may not always work, in which case it is returned \ unevaluated." }], "Text"], Cell[BoxData[ \(Factor[f[x]]\)], "Input"], Cell[TextData[{ "Finally, the ", StyleBox["FindRoot", FontColor->RGBColor[1, 0, 0]], " command tries to solve the equation f(x) = 0 numerically for x. This \ works for any equation, not just those involving polynomials. It requires \ you to put in a starting guess for the root, and then runs a variant on \ Newton's method together with two other methods to arrive at an answer. We \ can adjust the number of displayed digits (in ", StyleBox["magenta", FontColor->RGBColor[1, 0, 1]], ")" }], "Text"], Cell[BoxData[ RowBox[{"NumberForm", "[", RowBox[{\(FindRoot[f[x] \[Equal] 0, {x, \(-1\)}]\), ",", StyleBox["10", FontColor->RGBColor[1, 0, 1]]}], "]"}]], "Input"] }, Closed]] }, Open ]] }, FrontEndVersion->"4.1 for Microsoft Windows", ScreenRectangle->{{0, 1024}, {0, 722}}, AutoGeneratedPackage->None, WindowToolbars->"EditBar", WindowSize->{603, 526}, WindowMargins->{{5, Automatic}, {Automatic, 0}}, PrivateNotebookOptions->{"ColorPalette"->{RGBColor, -1}}, ShowCellLabel->True, ShowCellTags->False, RenderingOptions->{"ObjectDithering"->True, "RasterDithering"->False}, Magnification->1 ] (******************************************************************* Cached data follows. If you edit this Notebook file directly, not using Mathematica, you must remove the line containing CacheID at the top of the file. The cache data will then be recreated when you save this file from within Mathematica. *******************************************************************) (*CellTagsOutline CellTagsIndex->{} *) (*CellTagsIndex CellTagsIndex->{} *) (*NotebookFileOutline Notebook[{ Cell[CellGroupData[{ Cell[1727, 52, 149, 4, 131, "Title", Evaluatable->False], Cell[1879, 58, 252, 5, 44, "SmallText"], Cell[2134, 65, 312, 7, 71, "Text"], Cell[2449, 74, 707, 14, 109, "Text"], Cell[CellGroupData[{ Cell[3181, 92, 94, 2, 59, "Section", Evaluatable->False], Cell[3278, 96, 575, 10, 90, "Text"], Cell[3856, 108, 592, 16, 70, "Input", InitializationCell->True], Cell[4451, 126, 419, 7, 90, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[4907, 138, 99, 2, 39, "Section", Evaluatable->False], Cell[5009, 142, 1131, 27, 128, "Text", Evaluatable->False], Cell[6143, 171, 461, 12, 110, "Input"], Cell[6607, 185, 577, 9, 109, "Text"], Cell[7187, 196, 637, 10, 128, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[7861, 211, 82, 2, 39, "Section", Evaluatable->False], Cell[7946, 215, 403, 7, 78, "Text"], Cell[8352, 224, 856, 29, 46, "Text"], Cell[9211, 255, 689, 28, 30, "Text"], Cell[9903, 285, 328, 12, 30, "Text"], Cell[10234, 299, 955, 38, 30, "Text"], Cell[11192, 339, 319, 12, 30, "Text"], Cell[11514, 353, 1391, 49, 38, "Text"], Cell[12908, 404, 1172, 38, 78, "Text"], Cell[14083, 444, 942, 20, 150, "Input"], Cell[15028, 466, 1502, 43, 152, "Text"], Cell[16533, 511, 1088, 28, 147, "Input"], Cell[CellGroupData[{ Cell[17646, 543, 45, 0, 46, "Subsection"], Cell[CellGroupData[{ Cell[17716, 547, 46, 0, 43, "Subsubsection"], Cell[17765, 549, 569, 9, 109, "Text"], Cell[18337, 560, 1546, 36, 304, "Input"], Cell[19886, 598, 404, 10, 71, "Text"], Cell[20293, 610, 324, 6, 71, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[20654, 621, 42, 0, 29, "Subsubsection"], Cell[20699, 623, 529, 15, 77, "Text"], Cell[21231, 640, 568, 15, 153, "Input"], Cell[21802, 657, 654, 22, 52, "Text"], Cell[22459, 681, 121, 3, 33, "Text"], Cell[22583, 686, 213, 4, 52, "Text"], Cell[22799, 692, 662, 12, 158, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[23498, 709, 48, 0, 29, "Subsubsection"], Cell[23549, 711, 128, 3, 33, "Text"], Cell[23680, 716, 584, 15, 146, "Input"], Cell[24267, 733, 629, 21, 71, "Text"], Cell[24899, 756, 261, 9, 52, "Text"], Cell[25163, 767, 573, 10, 150, "Input"], Cell[25739, 779, 154, 3, 52, "Text"] }, Closed]] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[25954, 789, 44, 0, 39, "Section"], Cell[26001, 791, 642, 10, 128, "Text"], Cell[26646, 803, 515, 8, 109, "Text"], Cell[27164, 813, 571, 9, 109, "Text"], Cell[27738, 824, 435, 7, 90, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[28210, 836, 111, 5, 39, "Section"], Cell[28324, 843, 368, 8, 71, "Text"], Cell[28695, 853, 540, 12, 90, "Text"], Cell[29238, 867, 58, 1, 30, "Input"], Cell[29299, 870, 276, 9, 52, "Text"], Cell[29578, 881, 180, 4, 30, "Input"], Cell[29761, 887, 183, 5, 33, "Text"], Cell[29947, 894, 48, 1, 30, "Input"], Cell[29998, 897, 18, 0, 33, "Text"], Cell[30019, 899, 46, 1, 30, "Input"], Cell[30068, 902, 391, 10, 52, "Text"], Cell[30462, 914, 448, 14, 52, "Text"], Cell[30913, 930, 252, 7, 52, "Text"], Cell[31168, 939, 45, 1, 30, "Input"], Cell[31216, 942, 521, 12, 90, "Text"], Cell[31740, 956, 192, 4, 30, "Input"] }, Closed]] }, Open ]] } ] *) (******************************************************************* End of Mathematica Notebook file. *******************************************************************)