(*********************************************************************** 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[ 15410, 593]*) (*NotebookOutlinePosition[ 16379, 625]*) (* CellTagsIndexPosition[ 16335, 621]*) (*WindowFrame->Normal*) Notebook[{ Cell[CellGroupData[{ Cell["Demo 5.2", "Subsubtitle", FontWeight->"Bold", FontSlant->"Plain", FontTracking->"Extended", FontVariations->{"Underline"->True}], Cell[CellGroupData[{ Cell["Series Solutions near an ordinary point.", "Section", Evaluatable->False, AspectRatioFixed->True, FontSize->12], Cell[TextData[{ "We consider the equation P(x)y'' + Q(x)y' +R(x)y = 0. We seek a series \ solution near ", Cell[BoxData[ \(x\_0\)]], ". We will begin by assuming that ", Cell[BoxData[ \(x\_0\ = \ 0. \)]], " We first define a generic power series with terms up to order n. \nThe \ last term stands for terms with powers of x higher than n. " }], "Text"], Cell[BoxData[ \(s[n_] := \[Sum]\+\(i = 0\)\%n\( a\_i\) x\^i + O[x]\^\(n + 1\)\)], "Input", AspectRatioFixed->True], Cell[BoxData[ \(s[5]\)], "Input"], Cell["\<\ Notice that taking the derivative causes the order (that is the \ highest exponent of the polynomial given explicitely) to drop.\ \>", "Text", Evaluatable->False, AspectRatioFixed->True], Cell["\<\ Define for abbreviation the derivatives of first and second order \ as follows. \ \>", "Text"], Cell[BoxData[ \(D1[F_, x_] := D[F, {x, 1}]; \nD2[F_, x_] := D[F, {x, 2}]\)], "Input"], Cell[BoxData[ \(D1[s[5], x]\)], "Input"], Cell["And this is the second derivative. ", "Text"], Cell[BoxData[ \(D2[\ s[5], x]\)], "Input"], Cell["The following is the first few terms of s + s''.", "Text"], Cell[BoxData[ \(s[5] + D2[\ s[5], x]\)], "Input"], Cell[CellGroupData[{ Cell[TextData[{ "Example 1. ", StyleBox["y'' + xy' + y = 0", FontFamily->"Courier New"] }], "Subsection", Evaluatable->False, AspectRatioFixed->True, FontSize->12], Cell["The coefficients of the equation are", "Text"], Cell[BoxData[ \({P[x_], Q[x_], R[x_]} = {1, x, 1}\)], "Input", AspectRatioFixed->True], Cell["\<\ We want to substitute s[n] into the differential equation. We use \ the sign := because we can't evaluate until we give a value to n.\ \>", "Text",\ Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(eqn[n_] := \ P[x]*D2[s[n], x]\n\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ + Q[x]*D1[s[n], x] + R[x]*s[n] == 0\)], "Input", AspectRatioFixed->True], Cell[BoxData[ \(eqn[4]\)], "Input", AspectRatioFixed->True], Cell[TextData[{ "Note that, since ", Cell[BoxData[ RowBox[{" ", RowBox[{"D2", "[", StyleBox[\(s[n], x\), FontSize->10], StyleBox["]", FontSize->10]}]}]]], " is of order n-2, eqn[n] shows the terms up to power n-2 of x. " }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[{ "We want to set the coefficients equal to 0, and get relations among the ", Cell[BoxData[ \(a\_i\)]], ". The following command LogicalExpand does this. \nColumnForm writes the \ output as a column of equations. " }], "Text"], Cell[BoxData[ \(ColumnForm[LogicalExpand[eqn[4]]]\)], "Input", AspectRatioFixed->True], Cell[BoxData[ \(relations[n_] := ColumnForm[LogicalExpand[eqn[n]]]\)], "Input"], Cell[BoxData[ \(relations[7]\)], "Input", AspectRatioFixed->True], Cell[TextData[{ "Let's solve these equations for ", Cell[BoxData[ \(a\_5, a\_4, a\_3, and\ \ a\_2\)]], " in terms of ", Cell[BoxData[ \(a\_0\)]], " and ", Cell[BoxData[ \(a\_1\)]], ". We don't need the relations , but can do this directly with the output \ of \"eqn\". " }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(Solve[eqn[5], {a\_5, a\_4, a\_3, a\_2}]\)], "Input", AspectRatioFixed->True], Cell[TextData[{ "In general we want to solve eqn[n] for ", Cell[BoxData[ \(a\_n, \ a\_\(n - 1\), ... , \ a\_2\)]], " in terms of ", Cell[BoxData[ \(a\_0\)]], " and ", Cell[BoxData[ \(a\_1\)]], ".\nLet's store the result in a list." }], "Text"], Cell[BoxData[ \(coeffs[n_] := Simplify[Solve[eqn[n], Table[a\_\(n - i\), {i, 0, n - 2}]]]\)], "Input",\ AspectRatioFixed->True], Cell[BoxData[ \(coeffs[7]\)], "Input", AspectRatioFixed->True], Cell[TextData[{ "We will next substitute these values of the coefficients in terms of ", Cell[BoxData[ \(a\_0\)]], " and ", Cell[BoxData[ \(a\_1\)]], " into s[n] to get an nth order approximation to the general solution. " }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(y[x_, n_] := s[n] /. First[coeffs[n]]\)], "Input"], Cell[BoxData[ \(y[x, 7]\)], "Input"], Cell[TextData[{ "This would be better if we could collect the coefficients of ", Cell[BoxData[ \(\(a\_0\ \)\)]], "and ", Cell[BoxData[ \(a\_1\)]], ". In fact there is a command which does this for us, and, if there is a \ term ", Cell[BoxData[ \(O[x]\^n\)]], ", it keeps only the polynomial terms of order less than n. This is \ accomplished by the command Collect." }], "Text"], Cell["Here is the final form of y[x,n]", "Text"], Cell[BoxData[ \(y[x_, n_] := Collect[s[n] /. First[coeffs[n]], {a\_0, a\_1}]\)], "Input",\ AspectRatioFixed->True], Cell[BoxData[ \(y[x, 7]\)], "Input"], Cell[TextData[{ "Recall that ", Cell[BoxData[ \(a\_0\)]], "=y[0], and ", Cell[BoxData[ \(a\_1\)]], "=y'[0]. Then, for example, the approximate solution for the initial value \ problem\n ", StyleBox[" ", FontSize->14], "y'' + xy' + y = 0, y[0]=2, y'[0]=3 \nis given by" }], "Text"], Cell[BoxData[ \(yy[x_, n_] := y[x, n] /. {a\_0 -> 2, a\_1 -> 3}\)], "Input"], Cell[BoxData[ \(yy[x, 5]\)], "Input"], Cell["\<\ Finally we find nth order approximations to the usual fundamental \ set of solutions.\ \>", "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(y1[x_, n_] := y[x, n] /. {a\_0 \[Rule] 1, a\_1 \[Rule] 0}\)], "Input", AspectRatioFixed->True], Cell[BoxData[ \(y2[x_, n_] := y[x, n] /. {a\_0 \[Rule] 0, a\_1 \[Rule] 1}\)], "Input", AspectRatioFixed->True], Cell[BoxData[ \(y1[x, 7]\)], "Input", AspectRatioFixed->True], Cell[BoxData[ \(y2[x, 7]\)], "Input", AspectRatioFixed->True], Cell["We can now use all these functions as we wish. For example,", "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(Plot[Evaluate[{y2[x, 4], y2[x, 10], y2[x, 30]}], {x, \(-5\), 5}, AspectRatio -> 1]\)], "Input", AspectRatioFixed->True], Cell[CellGroupData[{ Cell[TextData[{ "What if ", Cell[BoxData[ \(x\_0\ \[NotEqual] \ \(0?\)\)]] }], "Subsubsection"], Cell[TextData[{ "As we did in class, we set t = ", Cell[BoxData[ \(x - x\_0\)]], ", and x = t+", Cell[BoxData[ \(x\_0\)]], ", and solve about the point ", Cell[BoxData[ \(t\_0\)]], "=0. Afterwards we replace again t by x-", Cell[BoxData[ \(x\_0\)]], ". " }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell["Now the procedure is as follows:", "Text"], Cell["A palette to enter the data:", "Text"], Cell[BoxData[GridBox[{ { ButtonBox[\(Equation\ Data\)]}, { ButtonBox[\(Clear[P, Q, R, s, a, eqn, coeffs, x, y, t]; \n \t{P[x_], Q[x_], R[x_], x\_0} = {\[SelectionPlaceholder], \[SelectionPlaceholder], \[SelectionPlaceholder], \[SelectionPlaceholder]}\)]} }, RowSpacings->0, ColumnSpacings->0, GridFrame->True, GridDefaultElement:>ButtonBox[ "\\[Placeholder]"]]], "Input"] }, Open ]], Cell[CellGroupData[{ Cell[TextData[{ "Example 2. ", StyleBox["y'' - xy = 0 near the point 1. ", FontFamily->"Courier New"] }], "Subsubsection"], Cell["\<\ Thus, we have to replace x by t + 1. But this can also be \ implemented in the commands. \ \>", "Text"], Cell[BoxData[ \(Clear[P, Q, R, s, a, eqn, coeffs, x, y, t]; \n{P[x_], Q[x_], R[x_], x\_0} = {1, 0, \(-x\), 1}\)], "Input"], Cell[BoxData[ \(s[n_] := \[Sum]\+\(i = 0\)\%n\( a\_i\) t\^i + O[t]\^\(n + 1\)\)], "Input", InitializationCell->True, AspectRatioFixed->True], Cell[BoxData[ \(eqn[n_] := \n\t\ \ \ \ P[t + x\_0]*D2[s[n], t] + Q[t + x\_0]*D1[s[n], t] + R[t + x\_0]\ s[n] == 0\)], "Input", InitializationCell->True, AspectRatioFixed->True], Cell[BoxData[ \(coeffs[n_] := Simplify[Solve[eqn[n], Table[a\_\(n - i\), {i, 0, n - 2}]]]\)], "Input",\ InitializationCell->True, AspectRatioFixed->True], Cell[BoxData[ \(y[x_, n_] := Collect[s[n] /. First[coeffs[n]], {a\_\(0\ \), a\_1}] /. { t \[Rule] x - x\_0}\)], "Input", InitializationCell->True, AspectRatioFixed->True], Cell[BoxData[ \(y1[x_, n_] := y[x, n] /. {a\_0 \[Rule] 1, a\_1 \[Rule] 0}\)], "Input", InitializationCell->True, AspectRatioFixed->True], Cell[BoxData[ \(y2[x_, n_] := y[x, n] /. {a\_0 \[Rule] 0, a\_1 \[Rule] 1}\)], "Input", InitializationCell->True, AspectRatioFixed->True], Cell["\<\ This is the general procedure for getting the expressions for the \ solution as a power series.\ \>", "Text"], Cell["\<\ Notice the little vertical line in the cell brackets for the last \ seven cells. We have used the \"Cell Properties\" command under the Cell \ menu to make these into \"Initialization Cells.\" You can evaluate all of \ them at once by choosing \"Evaluate Initialization \" from the \ Kernel/Evaluation menu. Once we have these cells evaluated, we can use the resulting data as we like.\ \ \>", "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(y[x, 7]\)], "Input"], Cell[BoxData[ \(y1[x, 5]\)], "Input"], Cell["\<\ The next plot shows some of the lower term approximations to the \ solution which has y(1) = 1 and y'(1) = 0. \ \>", "Text"], Cell[BoxData[ \(Plot[ Evaluate[Table[y1[x, n], {n, 3, 45, 3}], {x, \(-8\), 2}, \ AspectRatio\ -> 1]]\)], "Input"], Cell["\<\ Once we have finished the discussion of one equation, we clear, \ enter new coefficients and a new starting point, and then we can calculate \ again for the new data...\ \>", "Text"] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell[TextData[StyleBox["Problem 5.2/18", FontSize->12]], "Subsection"], Cell[TextData[StyleBox[ " (1-x) y'' + x y' - y = 0, \n y(0) = -3, y'(0) = 2 \ near the origin", FontFamily->"Courier New", FontSize->12]], "Text"], Cell["\<\ In this problem we are asked to find the first five nonzero terms \ in the solution and to plot the four-term and the five-term approximations to \ the solution in one graph. From the plot we shall estimate the interval in \ which the four-term approximation is reasonably accurate. \ \>", "Text"], Cell[BoxData[ \(Clear[P, Q, R, s, a, eqn, coeffs, x, y, t]; \n \t{P[x_], Q[x_], R[x_], x\_0} = {1 - x, x, \(-1\), 0}\)], "Input"], Cell[TextData[{ "After entering the data we simply choose ", StyleBox["Evaluate Initialization", FontColor->RGBColor[1, 0, 0]], " from the ", StyleBox["Kernel/Evaluation", FontColor->RGBColor[1, 0, 0]], " menu and then we can ask for all expressions -- if we like. \n\nAlthough \ you may not have seen anything happen, the seven evaluation cells were \ evaluated.\n\nLet's first ask for the general 5th order approximation. " }], "Text"], Cell[BoxData[ \(y[x, 5]\)], "Input"], Cell["The approximation which has 5 nonzero terms is therefore ", "Text"], Cell[BoxData[ \(y[x, 4]\)], "Input"], Cell["\<\ We can also ask for the underlying set of equations or \ coefficients.\ \>", "Text"], Cell[BoxData[ \(eqn[5]\)], "Input"], Cell[BoxData[ \(coeffs[5]\)], "Input"], Cell["\<\ This is the 7th order approximation to the solution which has y(0) \ = 0 and y'(0) = 1.\ \>", "Text"], Cell[BoxData[ \(y2[x, 7]\)], "Input"], Cell["\<\ Here are the required approximations to the solution of the initial \ value problem. \ \>", "Text"], Cell[BoxData[ \(y[x, 4] /. {a\_0 -> \(-3\), a\_1 -> 2}\)], "Input"], Cell[BoxData[ \(y[x, 3] /. {a\_0 -> \(-3\), a\_1 -> 2}\)], "Input"], Cell["\<\ We plot both, the 5 term and the 4 term, approximation in one \ graph. \ \>", "Text"], Cell[BoxData[ \(\(Plot[ Evaluate[Table[y[x, n], {n, 3, 4, 1}] /. {a\_0 \[Rule] \(-3\), a\_1 \[Rule] 2}], {x, \(-2\), 2}, \ AspectRatio\ -> \ 1]\ \)\)], "Input"], Cell["\<\ The five-term approximation is the lower one. The four-term approximation is reasonably accurate (that is as good as the \ five-term appr.) for roughly |x| < 0.8. \ \>", "Text"], Cell["\<\ The above method works even with non-polynomial, but analytic \ coefficients.\ \>", "Text"] }, Open ]], Cell[CellGroupData[{ Cell[TextData[StyleBox[ "Problem 5.3/11 y'' + (sin x) y = 0 about the origin ", FontSize->12]], "Subsection"], Cell[BoxData[ \(Clear[P, Q, R, s, a, eqn, coeffs, x, y, t]; \n \t{P[x_], Q[x_], R[x_], x\_0} = {1, 0, Sin[x], 0}\)], "Input"], Cell[BoxData[ \(y[x, 10]\)], "Input"], Cell[BoxData[ \(eqn[5]\)], "Input"], Cell[TextData[{ StyleBox["Mathematica", FontSlant->"Italic"], " uses the Taylor series for the sine function and calculates as many \ coefficients as desired. " }], "Text"], Cell["\<\ The next plot shows the first approximations to the solution which \ goes through the origin and has slope 1 at that point., i. e. y(0) = 0 and \ y'(0) = 1. \ \>", "Text"], Cell[BoxData[ \(Plot[ Evaluate[Table[y2[x, n], {n, 1, 10, 1}], {x, \(-3\), 3}, \ AspectRatio\ -> 1]]\)], "Input"] }, Open ]] }, Open ]] }, Open ]] }, FrontEndVersion->"Macintosh 3.0", ScreenRectangle->{{0, 1024}, {0, 748}}, AutoGeneratedPackage->None, WindowToolbars->"EditBar", WindowSize->{614, 536}, WindowMargins->{{5, Automatic}, {Automatic, 5}}, PrintingCopies->1, PrintingPageRange->{1, Automatic}, Magnification->1.25, MacintoshSystemPageSetup->"\<\ 00<0004/0B`000002n88o?mooh<" ] (*********************************************************************** Cached data follows. If you edit this Notebook file directly, not using Mathematica, you must remove the line containing CacheID at the top of the file. The cache data will then be recreated when you save this file from within Mathematica. ***********************************************************************) (*CellTagsOutline CellTagsIndex->{} *) (*CellTagsIndex CellTagsIndex->{} *) (*NotebookFileOutline Notebook[{ Cell[CellGroupData[{ Cell[1731, 51, 142, 4, 66, "Subsubtitle"], Cell[CellGroupData[{ Cell[1898, 59, 123, 3, 57, "Section", Evaluatable->False], Cell[2024, 64, 382, 10, 93, "Text"], Cell[2409, 76, 123, 3, 63, "Input"], Cell[2535, 81, 37, 1, 33, "Input"], Cell[2575, 84, 201, 5, 55, "Text", Evaluatable->False], Cell[2779, 91, 104, 3, 36, "Text"], Cell[2886, 96, 89, 1, 52, "Input"], Cell[2978, 99, 44, 1, 33, "Input"], Cell[3025, 102, 51, 0, 36, "Text"], Cell[3079, 104, 46, 1, 33, "Input"], Cell[3128, 107, 65, 0, 25, "Text"], Cell[3196, 109, 53, 1, 22, "Input"], Cell[CellGroupData[{ Cell[3274, 114, 191, 7, 42, "Subsection", Evaluatable->False], Cell[3468, 123, 52, 0, 25, "Text"], Cell[3523, 125, 92, 2, 22, "Input"], Cell[3618, 129, 208, 6, 38, "Text", Evaluatable->False], Cell[3829, 137, 184, 4, 32, "Input"], Cell[4016, 143, 65, 2, 22, "Input"], Cell[4084, 147, 349, 12, 25, "Text", Evaluatable->False], Cell[4436, 161, 252, 6, 38, "Text"], Cell[4691, 169, 92, 2, 22, "Input"], Cell[4786, 173, 83, 1, 22, "Input"], Cell[4872, 176, 71, 2, 22, "Input"], Cell[4946, 180, 367, 14, 38, "Text", Evaluatable->False], Cell[5316, 196, 98, 2, 22, "Input"], Cell[5417, 200, 279, 11, 38, "Text"], Cell[5699, 213, 141, 4, 22, "Input"], Cell[5843, 219, 68, 2, 22, "Input"], Cell[5914, 223, 304, 10, 38, "Text", Evaluatable->False], Cell[6221, 235, 70, 1, 22, "Input"], Cell[6294, 238, 40, 1, 22, "Input"], Cell[6337, 241, 411, 13, 51, "Text"], Cell[6751, 256, 48, 0, 25, "Text"], Cell[6802, 258, 121, 3, 22, "Input"], Cell[6926, 263, 40, 1, 22, "Input"], Cell[6969, 266, 332, 12, 55, "Text"], Cell[7304, 280, 80, 1, 22, "Input"], Cell[7387, 283, 41, 1, 22, "Input"], Cell[7431, 286, 157, 5, 25, "Text", Evaluatable->False], Cell[7591, 293, 116, 2, 22, "Input"], Cell[7710, 297, 116, 2, 22, "Input"], Cell[7829, 301, 67, 2, 22, "Input"], Cell[7899, 305, 67, 2, 22, "Input"], Cell[7969, 309, 124, 2, 25, "Text", Evaluatable->False], Cell[8096, 313, 148, 3, 22, "Input"], Cell[CellGroupData[{ Cell[8269, 320, 106, 4, 33, "Subsubsection"], Cell[8378, 326, 357, 16, 25, "Text", Evaluatable->False], Cell[8738, 344, 48, 0, 25, "Text"], Cell[8789, 346, 45, 0, 25, "Text"], Cell[8837, 348, 496, 13, 59, "Input"] }, Open ]], Cell[CellGroupData[{ Cell[9370, 366, 134, 4, 33, "Subsubsection"], Cell[9507, 372, 115, 3, 25, "Text"], Cell[9625, 377, 131, 2, 32, "Input"], Cell[9759, 381, 151, 4, 38, "Input", InitializationCell->True], Cell[9913, 387, 202, 5, 32, "Input", InitializationCell->True], Cell[10118, 394, 169, 5, 22, "Input", InitializationCell->True], Cell[10290, 401, 195, 5, 22, "Input", InitializationCell->True], Cell[10488, 408, 144, 3, 22, "Input", InitializationCell->True], Cell[10635, 413, 144, 3, 22, "Input", InitializationCell->True], Cell[10782, 418, 119, 3, 25, "Text"], Cell[10904, 423, 462, 11, 77, "Text", Evaluatable->False], Cell[11369, 436, 40, 1, 22, "Input"], Cell[11412, 439, 41, 1, 22, "Input"], Cell[11456, 442, 134, 3, 25, "Text"], Cell[11593, 447, 133, 3, 22, "Input"], Cell[11729, 452, 192, 4, 38, "Text"] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell[11970, 462, 72, 1, 42, "Subsection"], Cell[12045, 465, 173, 4, 42, "Text"], Cell[12221, 471, 308, 5, 51, "Text"], Cell[12532, 478, 137, 2, 32, "Input"], Cell[12672, 482, 456, 10, 150, "Text"], Cell[13131, 494, 40, 1, 33, "Input"], Cell[13174, 497, 73, 0, 36, "Text"], Cell[13250, 499, 40, 1, 33, "Input"], Cell[13293, 502, 94, 3, 36, "Text"], Cell[13390, 507, 39, 1, 33, "Input"], Cell[13432, 510, 42, 1, 33, "Input"], Cell[13477, 513, 111, 3, 36, "Text"], Cell[13591, 518, 41, 1, 33, "Input"], Cell[13635, 521, 109, 3, 36, "Text"], Cell[13747, 526, 71, 1, 33, "Input"], Cell[13821, 529, 71, 1, 33, "Input"], Cell[13895, 532, 95, 3, 25, "Text"], Cell[13993, 537, 187, 4, 32, "Input"], Cell[14183, 543, 189, 5, 51, "Text"], Cell[14375, 550, 101, 3, 25, "Text"] }, Open ]], Cell[CellGroupData[{ Cell[14513, 558, 130, 2, 42, "Subsection"], Cell[14646, 562, 133, 2, 32, "Input"], Cell[14782, 566, 41, 1, 22, "Input"], Cell[14826, 569, 39, 1, 22, "Input"], Cell[14868, 572, 182, 5, 25, "Text"], Cell[15053, 579, 181, 4, 38, "Text"], Cell[15237, 585, 133, 3, 22, "Input"] }, Open ]] }, Open ]] }, Open ]] } ] *) (*********************************************************************** End of Mathematica Notebook file. ***********************************************************************)