(*********************************************************************** Mathematica-Compatible Notebook This notebook can be used on any computer system with Mathematica 4.0, MathReader 4.0, or any compatible application. 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[ 56494, 1469]*) (*NotebookOutlinePosition[ 57238, 1495]*) (* CellTagsIndexPosition[ 57194, 1491]*) (*WindowFrame->Normal*) Notebook[{ Cell[CellGroupData[{ Cell["Riemann, Trapezoids, and Simpson", "Title", PageWidth->PaperWidth], Cell["Chapter 4, Section 7", "Text", PageWidth->PaperWidth, FontFamily->"Arial", FontSize->16, FontWeight->"Bold"], Cell[BoxData[{ \(\(<< Graphics`FilledPlot`;\)\), "\n", \(\(Off[General::spell];\)\), "\[IndentingNewLine]", \(\(Off[General::spell1];\)\), "\n", \(\(Off[NIntegrate::ploss];\)\), "\n", \(\(Off[NIntegrate::ncvb];\)\), "\n", \(\(Off[$MaxExtraPrecision::meprec];\)\n\), "\n", \(\(Clear[riemannsum];\)\), "\n", \(\(riemannsum[fnc_, tind_, to_, tf_, nint_, rtorlt_, fncicin_: Automatic] := Block[{}, If[fncicin === Automatic, fncic = 0, fncic = fncicin]; \[IndentingNewLine]\n f[t_] = fnc /. tind -> t; \n\t\t\n F[t_] = \(NDSolve[{\(y'\)[t] == f[t], y[to] == fncic}, y[t], {t, to - 0.1*\((tf - to)\), tf + 0.1*\((tf - to)\)}]\)[\([1, 1, 2]\)]; \n\n h = \((tf - to)\)/nint; \n If[rtorlt == "\", discvalues = Table[f[t] // N, {t, to, tf - h, h}], discvalues = Table[f[t] // N, {t, to + h, tf, h}]]; \n\n Fdiscvalues = Table[{to + k*h, fncic + Sum[discvalues[\([i]\)]*h, {i, 1, k}]}, {k, 1, nint}]; \n\t\tFdiscvalues = Prepend[Fdiscvalues, {to, fncic}]; \n\t\n fvalues = Table[f[t], {t, to, tf, \((tf - to)\)/500}]; \n Fvalues = Table[F[t], {t, to, tf, \((tf - to)\)/500}]; \n Fmax = Max[ Flatten[{Fvalues, Table[Fdiscvalues[\([i, 2]\)], {i, 1, nint}]}]]; \n Fmin = Min[ Flatten[{Fvalues, Table[Fdiscvalues[\([i, 2]\)], {i, 1, nint}]}]]; \n\n fmaxt = Max[fvalues]; \nfmint = Min[fvalues]; \nfmin = fmint; \n fmax = fmaxt; \n\nchangesign = {}; \n Do[If[Sign[discvalues[\([k]\)]] != Sign[discvalues[\([k + 1]\)]], changesign = Append[changesign, to + k*h]], {k, 1, nint - 1}]; \nchangesign = Prepend[changesign, to]; \n changesign = Append[changesign, tf]; \n\t\nsize = 7; \t\t\n steprat = 0.020; \n\t\thrange = If[Fmax <= 0, {1.1*Fmin, 0}, If[Fmin >= 0, {0, 1.1*Fmax}, {1.1*Fmin, 1.1*Fmax}]]; \n\t\tfrange = If[fmax <= 0, {1.1*fmin, 0}, If[fmin >= 0, {0, 1.1*fmax}, {1.1*fmin, 1.1*fmax}]]; \n\t\t\n p1 = Plot[f[t], {t, to, tf}, PlotRange -> {{to, tf}, frange}, AspectRatio -> 1, PlotStyle -> {RGBColor[0, 0, 0], Thickness[0.008]}, ImageSize -> {72*size, 72*size/3}, PlotRegion -> {{0, 1}, {0, 1}}, DisplayFunction -> Identity]; \n\t\t\n\t p2t = {}; \n\t\t\n\t\t\t\tDo[ If[discvalues[\([k]\)] > 0, fillcolor = RGBColor[1, 0, 0], fillcolor = RGBColor[0, 0, 1]]; \n\t\t\t\t\tpinter = FilledPlot[ discvalues[\([k]\)], {t, to + \((k - 1)\)*h, to + k*h}, PlotRange -> {{to, tf}, frange}, PlotStyle -> {RGBColor[0, 0, 0], Thickness[0.008]}, Fills -> {fillcolor}, AxesFront -> True, Curves -> None, ImageSize -> {72*size, 72*size/3}, PlotRegion -> {{0, 1}, {0, 1}}, DisplayFunction -> Identity]; \n\t\t\t\t\tp2t = Append[p2t, pinter], {k, 1, nint}]; \n\t\t\n\t\tp2t = Append[p2t, p1]; \n\t\t\n p2 = Show[p2t, ImageSize -> {72*size, 72*size/3}, PlotRegion -> {{0, 1}, {0, 1}}, AxesLabel \[Rule] {x, fnc}, \ DisplayFunction -> Identity]; \n\t\t\n p3 = Plot[F[t], {t, to, tf}, PlotRange -> hrange, ImageSize -> {72*size, 72*size/3}, PlotRegion -> {{0, 1}, {0, 1}}, DisplayFunction -> Identity]; \n p4 = ListPlot[Fdiscvalues, PlotRange -> hrange, PlotStyle -> {PointSize[0.02], RGBColor[0.398444, \ 0.847669, \ 0.347662]}, ImageSize -> {72*size, 72*size/3}, PlotRegion -> {{0, 1}, {0, 1}}, DisplayFunction -> Identity]; \n p5 = Show[{p4, p3}, ImageSize -> {72*size, 72*size/3}, PlotRegion -> {{0, 1}, {0, 1}}, \ DisplayFunction -> Identity]; \n\np6t = {}; \n\t\t\n Do[If[discvalues[\([k]\)] - f[to + \((k - 0.5)\)*h] > 0, fillcolor = RGBColor[1, 0, 0], fillcolor = RGBColor[0, 0, 1]]; \n\t\t\t\t\tpinter = FilledPlot[{discvalues[\([k]\)], f[t]}, {t, to + \((k - 1)\)*h, to + k*h}, PlotRange -> {{to, tf}, frange}, PlotStyle -> {RGBColor[0, 0, 0], Thickness[0.008]}, Fills -> {fillcolor}, AxesFront -> True, Curves -> None, ImageSize -> {72*size, 72*size/3}, PlotRegion -> {{0, 1}, {0, 1}}, DisplayFunction -> Identity]; \n\t\t\t\t\tp6t = Append[p6t, pinter], {k, 1, nint}]; \n\t\t\n (*\(p6t = Append[p6t, p1];\)*) \n\t\t\n p6 = Show[p6t, ImageSize -> {72*size, 72*size/3}, PlotRegion -> {{0, 1}, {0, 1}}, AxesLabel \[Rule] {x, "\"}, \ DisplayFunction -> Identity]; \n\n accumerror = Table[{to + \((k - 1)\)*h, Fdiscvalues[\([k, 2]\)] - F[to + \((k - 1)\)*h]}, {k, 1, nint}]; \t\t\n p7 = ListPlot[accumerror, PlotStyle -> {PointSize[0.020]}, AxesLabel \[Rule] {x, f}, DisplayFunction -> Identity]; \t\n\t\t\t\t\t\t\n Show[GraphicsArray[{p2, p6}], ImageSize -> {72*size, 72*size/2}, DisplayFunction -> $DisplayFunction];\n\n\t\t\n\t\t\t\t\t\t\t\t\t\ \t];\)\)}], "Input", Editable->False, PageWidth->PaperWidth, CellOpen->False, InitializationCell->True], Cell[CellGroupData[{ Cell["Introduction", "Section", PageWidth->PaperWidth], Cell["\<\ OBJECTIVE: To visualize the process of using Riemann sums, the trapezoid \ rule, and Simpson's rule for approximating definite integrals, and to \ understand the error associated with each method. To evaluate a definite integral, it is often necessary to use a numerical \ estimate of the integral in place of an exact value. This occurs in three \ instances: 1) when there is no simple formula for an antiderivative of the \ integrand; 2) when the antiderivative of the integrand is difficult to \ determine and/or evaluate; and, 3) when the integrand function is represented \ by a table of numeric values rather than by a formula. In this module, we \ investigate several numerical methods for estimating definite integrals.\ \>", "Text", PageWidth->PaperWidth], Cell[CellGroupData[{ Cell["Technology Guidelines", "Subsection", PageWidth->PaperWidth, CellDingbat->"\[LightBulb]"], Cell[TextData[{ StyleBox["NOTE: If you have just finished a module, restart ", CellFrame->True, Background->None], StyleBox["Mathematica", CellFrame->True, FontSlant->"Italic", Background->None], StyleBox[" before executing a new module.\nTO OPEN CELLS, put your cursor \ on the right cell bracket and double click.", CellFrame->True, Background->None], "\nINITIALIZATION CELLS\n\tWhen asked if you want to \". . . automatically \ evaluate all the initialization cells in the \tnotebook . . . ,\" respond by \ pressing the \"Yes\" button.\nTO STOP AN EXECUTION\n\tSelect the ", StyleBox["Kernel", FontSlant->"Italic"], " pull-down menu and click on ", StyleBox["Abort Evaluation.\n", FontSlant->"Italic"], "ORDER OF EXECUTION\n\tExecute cells in the order given. Do not skip any \ Input cells within a given notebook.\nSAVING NOTEBOOKS\n\tYou can save \ anytime to any directory you choose, and it is wise to save often.\n\t \ However, before you do your final save, delete all your output by selecting \ the \n\t ", StyleBox["Delete All Output", FontSlant->"Italic"], " selection under the ", StyleBox["Kernel", FontSlant->"Italic"], " pull-down menu.\nEXPERIENCING MAJOR PROBLEMS\n\tSave if appropriate, and \ then shut down ", StyleBox["Mathematica", FontSlant->"Italic"], " and start it up again." }], "Text", PageWidth->PaperWidth] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Part I: Riemann Sums and Errors", "Section", PageWidth->PaperWidth], Cell[TextData[{ "The most direct method for estimating a definite integral is to replace it \ with a Riemann sum. That is, we estimate the integral as follows: ", Cell[BoxData[ \(TraditionalForm\`\[Integral]\_a\%b\( f( x)\) \[DifferentialD]x \[TildeTilde] \[Sum]\+\(i = 1\)\%n\( f( c\_i)\) h\)]], ", where the interval [", StyleBox["a", FontSlant->"Italic"], ", ", StyleBox["b", FontSlant->"Italic"], "] is divided into ", StyleBox["n", FontSlant->"Italic"], " subintervals, each of length ", Cell[BoxData[ \(TraditionalForm\`h = \(b - a\)\/n\)]], ", and where ", Cell[BoxData[ \(TraditionalForm\`c\_i\)]], " is any value of ", StyleBox["x", FontSlant->"Italic"], " taken from the ", Cell[BoxData[ \(TraditionalForm\`i\^th\)]], " subinterval. To assess the error in the approximation, we will perform a \ numerical experiment wherein we use a Riemann sum to estimate an integral for \ which we know the exact value. (You should keep in mind, however, that \ numerical integration is primarily used for estimating integrals in \ situations where we can't determine a decimal or fraction representation for \ the exact value of the integral.) Our first goal is to determine what factors \ affect the error when we use left- or right-hand Riemann sums to estimate the \ exact value of an integral.\n\nThe integral we choose for our experiment is \ ", Cell[BoxData[ \(TraditionalForm\`\[Integral]\_0\%\(\[Pi]\/2\)cos\ x \[DifferentialD]x \ = 1\)]], ". First, we look at a graphical depiction of the situation. For this, we \ include a specially designed command that shows the areas of the rectangles \ that are accumulated in the Riemann sum and the errors in the estimate. The \ command is ", StyleBox["riemannsum[f_, x_, a_, b_, n_, rightleft_]", FontWeight->"Bold"], ". The arguments are the function, ", StyleBox["f", FontWeight->"Bold"], ", the independent variable, ", StyleBox["x", FontWeight->"Bold"], ", the lower bound on the integral, ", StyleBox["a", FontWeight->"Bold"], ", the upper bound, ", StyleBox["b", FontWeight->"Bold"], ", the number of rectangles, ", StyleBox["n", FontWeight->"Bold"], ", and a \"right\" or \"left\" sum indicator. Red areas are positive, and \ blue areas are negative. The error is taken as the Riemann estimate minus the \ exact value of the integral.\n\nThe special command ", StyleBox["riemannsum[ ]", FontWeight->"Bold"], " is only available in this module and is not a built-in ", StyleBox["Mathematica", FontSlant->"Italic"], " command. Here's how it works.\n" }], "Text", PageWidth->PaperWidth], Cell[BoxData[{ \(\(n = 5;\)\), "\n", \(\(riemannsum[Cos[x], x, 0, Pi/2, n, "\"];\)\), "\n", \(\(riemannsum[Cos[x], x, 0, Pi/2, n, "\"];\)\)}], "Input", PageWidth->PaperWidth], Cell[TextData[{ "The area of each small triangular-shaped region on the error graph is the \ local error associated with each rectangle in the Riemann sum. The sum of the \ areas of these triangular-shaped regions is the global or total error in the \ estimate of the integral. \n\nIn general, the areas can be positive, \ negative, or 0. In the graphs generated by ", StyleBox["riemannsum[ ]", FontWeight->"Bold"], ",", StyleBox[" ", FontWeight->"Bold"], "positive areas are red, and negative areas are blue. Because the areas are \ signed, we will refer to them hereafter as \"signed areas.\"" }], "Text", PageWidth->PaperWidth] }, Closed]], Cell[CellGroupData[{ Cell["You Try It: Visualizing the Errors", "Section", PageWidth->PaperWidth], Cell[TextData[{ "Use the ", StyleBox["riemansumm[ ]", FontWeight->"Bold"], " command in the preceding cell (copied below) to respond to the items that \ follow." }], "Text", PageWidth->PaperWidth], Cell[BoxData[{ RowBox[{ RowBox[{"n", "=", StyleBox["5", FontColor->RGBColor[1, 0, 0]]}], ";"}], "\n", RowBox[{ RowBox[{"riemannsum", "[", RowBox[{ StyleBox[\(Cos[x]\), FontColor->RGBColor[0, 0, 1]], ",", "x", ",", StyleBox["0", FontColor->RGBColor[0, 1, 0]], ",", StyleBox[\(Pi/2\), FontColor->RGBColor[0, 1, 0]], ",", "n", ",", "\"\\""}], "]"}], ";"}], "\n", RowBox[{ RowBox[{"riemannsum", "[", RowBox[{ StyleBox[\(Cos[x]\), FontColor->RGBColor[0, 0, 1]], ",", "x", ",", StyleBox["0", FontColor->RGBColor[0, 1, 0]], ",", StyleBox[\(Pi/2\), FontColor->RGBColor[0, 1, 0]], ",", "n", ",", "\"\\""}], "]"}], ";"}]}], "Input", PageWidth->PaperWidth], Cell[TextData[{ "a) Increase the number of rectangles, highlighted in red, in the \ preceding input cell, and describe qualitatively what happens to the error in \ the estimate of the integral each time you double the number of rectangles.\n\ \nb) What effect does the slope of the function have on the error?\n\nc) \ The function ", Cell[BoxData[ \(TraditionalForm\`cos\ x\)]], " decreases on the interval from 0 to ", Cell[BoxData[ \(TraditionalForm\`\[Pi]\/2\)]], ", and its first derivative is negative. In this case, the right-hand \ Riemann sum underestimates the integral (i.e., the error is negative), and \ the left-hand sum overestimates the integral (i.e., the error is positive). \ Describe what happens to the error when we use left- and right-hand Riemann \ sums to estimate ", Cell[BoxData[ FormBox[ RowBox[{\(\[Integral]\_0\%\(\[Pi]\/2\)\), RowBox[{ StyleBox["sin", FontColor->RGBColor[0, 0, 1]], StyleBox[" ", FontColor->RGBColor[0, 0, 1]], StyleBox["x", FontColor->RGBColor[0, 0, 1]], \(\[DifferentialD]x\)}]}], TraditionalForm]]], ".\n\nd) While the error for each rectangle (i.e., the local error) on the \ left-hand sum appears to be nearly equal in magnitude to the local error for \ each corresponding rectangle on the right-hand sum, they aren't exactly the \ same because the graph of the function curves. Where does the difference in \ the local errors appear to be largest, and how is the difference in the local \ errors related to the second derivative of the function? (To see this effect \ more dramatically, try using ", StyleBox["two", FontColor->RGBColor[1, 0, 0]], " and/or ", StyleBox["three", FontColor->RGBColor[1, 0, 0]], " rectangles in the ", StyleBox["riemannsum[ ] ", FontWeight->"Bold"], "command.)\n\ne) Based on your observations in part (d), specify two \ different ways in which you could use Riemann sums to improve the estimate of \ the integral by reducing the errors. The trick is to look for ways to \ estimate the integrals so that the local errors nearly cancel. For your \ improved methods, which feature of the integrand function would you expect to \ have the most significant effect on the error?\n\nf) Try the ", StyleBox["riemannsum[ ] ", FontWeight->"Bold"], "command on a function that we can't integrate exactly. Two examples are ", Cell[BoxData[ FormBox[ RowBox[{ SubsuperscriptBox["\[Integral]", StyleBox["1", FontColor->RGBColor[0, 1, 0]], StyleBox["2", FontColor->RGBColor[0, 1, 0]]], RowBox[{ StyleBox[\(1\/x\), FontColor->RGBColor[0, 0, 1]], \(\[DifferentialD]x\)}]}], TraditionalForm]]], " and ", Cell[BoxData[ FormBox[ RowBox[{ SubsuperscriptBox["\[Integral]", StyleBox["0", FontColor->RGBColor[0, 1, 0]], StyleBox["4", FontColor->RGBColor[0, 1, 0]]], RowBox[{ StyleBox[\(e\^\(-x\^2\)\), FontColor->RGBColor[0, 0, 1]], \(\[DifferentialD]x\)}]}], TraditionalForm]]], "." }], "Text", PageWidth->PaperWidth] }, Closed]], Cell[CellGroupData[{ Cell["Part II: Analyzing the Errors", "Section", PageWidth->PaperWidth], Cell[TextData[{ "Now that we have made some qualitative observations about Riemann \ estimates of an integral and the associated errors, we are ready to be more \ quantitative in our analysis. For this we write the following ", StyleBox["riemSumLeft[f_,x_,a_,b_,n_] ", FontWeight->"Bold"], "and", StyleBox[" riemSumRight[f_,x_,a_,b_,n_] ", FontWeight->"Bold"], "commands to calculate left-hand and right-hand Riemann sums. The arguments \ are ", StyleBox["f", FontWeight->"Bold"], ", the integrand function, ", StyleBox["x", FontWeight->"Bold"], ", the independent variable, ", StyleBox["a", FontWeight->"Bold"], ", the lower bound, ", StyleBox["b", FontWeight->"Bold"], ", the upper bound, and ", StyleBox["n", FontWeight->"Bold"], ", the number of subintervals." }], "Text", PageWidth->PaperWidth], Cell[BoxData[{ \(\(riemSumLeft[f_, x_, a_, b_, n_] := Sum[\((f /. x \[Rule] \((a + \((i - 1)\)*\((b - a)\)/n)\))\)*\((b - a)\)/ n, {i, 1, n}];\)\n\), "\n", \(\(riemSumRight[f_, x_, a_, b_, n_] := Sum[\((f /. x \[Rule] \((a + i*\((b - a)\)/n)\))\)*\((b - a)\)/n, {i, 1, n}];\)\)}], "Input", PageWidth->PaperWidth], Cell[TextData[{ "Note that ", Cell[BoxData[ \(TraditionalForm\`h = \((b - a)\)/n\)]], " and, for left-hand sums, ", Cell[BoxData[ \(TraditionalForm\`c\_i = \(a + \((i - 1)\) h = a + \((i - 1)\) \((b - a)\)/n\)\)]], ", whereas for right-hand sums, ", Cell[BoxData[ \(TraditionalForm\`c\_i = \(a + i\ h = a + \(i(b - a)\)/n\)\)]], ".", StyleBox[" ", FontWeight->"Bold"], "Inside the", StyleBox[" Sum[ ]", FontWeight->"Bold"], " command for the left-hand sum, the code ", StyleBox["f/.x\[Rule](a+(i-1)*(b-a)/n)) ", FontWeight->"Bold"], "means that the value of ", StyleBox["f", FontWeight->"Bold"], StyleBox[" ", FontWeight->"Bold", FontSlant->"Italic"], "should be used with ", StyleBox["x", FontWeight->"Bold"], " replaced with ", StyleBox["(a+(i-1)*(b-a)/n)) ", FontWeight->"Bold"], "which is ", Cell[BoxData[ \(TraditionalForm\`c\_i\)]], ". Similarly, ", StyleBox["x", FontWeight->"Bold"], " is replaced with ", StyleBox["(a+i*(b-a)/n))*(b-a)/n ", FontWeight->"Bold"], "for the right-hand sum.\n\nNow we use these commands, together with the \ fact that the exact value of the integral ", Cell[BoxData[ \(TraditionalForm\`\[Integral]\_0\%\(\[Pi]\/2\)cos\ x \[DifferentialD]x\ \)]], " is 1, to build a table of values that includes the step size ", StyleBox["h", FontWeight->"Bold"], ", the numerical estimates of the integral, ", StyleBox["RleftI ", FontWeight->"Bold"], "and ", StyleBox["RrightI", FontWeight->"Bold"], ", and the errors in the estimates, ", Cell[BoxData[ FormBox[ RowBox[{ StyleBox["Eleft", FontWeight->"Bold", FontSlant->"Italic"], StyleBox["=", FontWeight->"Bold"], StyleBox[\(\(RleftI\)\(-\)\), FontWeight->"Bold"]}], TraditionalForm]]], "1 and ", Cell[BoxData[ FormBox[ RowBox[{ StyleBox["Eright", FontWeight->"Bold", FontSlant->"Italic"], StyleBox["=", FontWeight->"Bold"], StyleBox[\(\(RrightI\)\(-\)\), FontWeight->"Bold"]}], TraditionalForm]]], "1. We start with two rectangles and double the number of rectangles ten \ times." }], "Text", PageWidth->PaperWidth], Cell[BoxData[{ \(\[IndentingNewLine]\(f[x_] = Cos[x];\)\), "\[IndentingNewLine]", \(\(a = 0;\)\), "\[IndentingNewLine]", \(\(b = \[Pi]\/2;\)\), "\[IndentingNewLine]", \(\(exactvalue = \[Integral]\_a\%b f[ x] \[DifferentialD]x;\)\), "\[IndentingNewLine]", \(\(Print["\", exactvalue];\)\[IndentingNewLine]\), "\[IndentingNewLine]", \(\(t1 = Table[{2^i, \(\[Pi]/2\)/2^i, RleftI = riemSumLeft[f[x], x, a, b, 2^i] // N, RrightI = riemSumRight[f[x], x, a, b, 2^i] // N, RleftI - exactvalue, RrightI - exactvalue}, {i, 1, 11}];\)\n\), "\n", \(TableForm[t1, TableHeadings \[Rule] {None, {"\", "\", "\", \ "\", "\", "\"}}]\)}], "Input", PageWidth->PaperWidth], Cell[TextData[{ "The data in the table should confirm your qualitative observations from \ \"", "You Try It: Visualizing Errors\" ", "above, but now we can be more specific. We make the following quantitative \ observations.\n\n1) As the number of rectangles increases, the error \ decreases, and, in fact, each time we double the number of rectangles or cut \ ", StyleBox["h", FontSlant->"Italic"], " in half, we cut the error roughly in half. A numerical estimate that \ exhibits this characteristic is said to have an error of order ", StyleBox["h", FontSlant->"Italic"], ", and we designate this as ", Cell[BoxData[ \(TraditionalForm\`O(h)\)]], ". \n\n2) The left-hand sum overestimates the integral, whereas the \ right-hand some underestimates it, and, for the same number of rectangles, \ the errors are roughly equal in magnitude.\n\n3) When the number of \ rectangles is small, the difference between the errors for the left- and \ right-hand estimates is larger, showing the effect of the second derivative \ and the concavity of the graph on the difference in errors.\n\nThe one effect \ that is not evident from the numeric data is that the local error is larger \ when the magnitude of the first derivative, that is, the magnitude of the \ slope of the graph, is larger. We explore this effect further in Part III \ below." }], "Text", PageWidth->PaperWidth] }, Closed]], Cell[CellGroupData[{ Cell["You Try It: On Another Function", "Section", PageWidth->PaperWidth], Cell[TextData[{ "Perform a numerical experiment like the one in Part II on the integral ", Cell[BoxData[ FormBox[ RowBox[{\(\[Integral]\_0\%\(\[Pi]\/2\)\), RowBox[{ StyleBox[\(sin\^2\), FontColor->RGBColor[1, 0, 0]], StyleBox["x", FontColor->RGBColor[1, 0, 0]], \(\[DifferentialD]x\)}]}], TraditionalForm]]], ", and then answer the questions that follow. To help, we include the \ commands to generate the table of values like the one in Part II." }], "Text", PageWidth->PaperWidth], Cell[BoxData[{ RowBox[{"\[IndentingNewLine]", RowBox[{ RowBox[{\(f[x_]\), "=", StyleBox[\(Cos[x]\), FontColor->RGBColor[1, 0, 0]]}], ";"}]}], "\[IndentingNewLine]", \(a = 0;\), "\[IndentingNewLine]", \(b = \[Pi]\/2;\), \ "\[IndentingNewLine]", \(exactvalue = \[Integral]\_a\%b f[ x] \[DifferentialD]x;\), "\[IndentingNewLine]", RowBox[{\(Print["\", exactvalue];\), "\[IndentingNewLine]"}], "\[IndentingNewLine]", RowBox[{\(t1 = Table[{2^i, \(\[Pi]/2\)/2^i, RleftI = riemSumLeft[f[x], x, a, b, 2^i] // N, RrightI = riemSumRight[f[x], x, a, b, 2^i] // N, RleftI - exactvalue, RrightI - exactvalue}, {i, 1, 11}];\), "\n"}], "\n", \(TableForm[t1, TableHeadings \[Rule] {None, {"\", "\", "\", \ "\", "\", "\"}}]\)}], "Input", PageWidth->PaperWidth], Cell["\<\ 1. What happens to the errors each time the number of rectangles is doubled? \ What is the order of the error for each Riemann sum estimate of the integral? 2. Does the left-hand Riemann sum overestimate or underestimate the \ integral? What about the right-hand Riemann sum? 3. What effect does the second derivative of the integrand have on the \ difference of the errors for the left and right Riemann sums?\ \>", "Text", PageWidth->PaperWidth] }, Closed]], Cell[CellGroupData[{ Cell[TextData[{ "Part III: The Effect of ", Cell[BoxData[ \(TraditionalForm\`f\^\[Prime]\)]], "on the Error" }], "Section", PageWidth->PaperWidth], Cell[TextData[{ "To quantify the effect of the slope on the error, we investigate \ straight-line functions, ", Cell[BoxData[ \(TraditionalForm\`f(x) = m\ x\)]], ", with varying slopes. First, let's look at a graphical depiction." }], "Text", PageWidth->PaperWidth], Cell[BoxData[{ \(\(n = 5;\)\), "\n", \(\(m = 2;\)\), "\n", \(\(riemannsum[m*x, x, 0, 5, n, "\"];\)\), "\n", \(\(riemannsum[m*x, x, 0, 5, n, "\"];\)\)}], "Input", PageWidth->PaperWidth], Cell[TextData[{ "Now we set up a table of numeric values, but in this case we keep the \ number of rectangles fixed at 100 and change ", StyleBox["m", FontSlant->"Italic"], ", the slope of the straight-line graph, starting with ", Cell[BoxData[ \(TraditionalForm\`m = 0.1\)]], " and doubling it ten times. The exact values of the integrals are ", Cell[BoxData[ \(TraditionalForm\`\(25 m\)\/2\)]], "." }], "Text", PageWidth->PaperWidth], Cell[BoxData[{ \(\(Clear[m];\)\), "\n", \(\(m[i_] = 0.1*2^i;\)\), "\n", \(\(f[x_] = m[i]\ \ x;\)\), "\[IndentingNewLine]", \(\(a = 0;\)\), "\[IndentingNewLine]", \(\(b = 5;\)\[IndentingNewLine]\), "\[IndentingNewLine]", \(\(exactvalue = \[Integral]\_a\%b f[ x] \[DifferentialD]x;\)\), "\[IndentingNewLine]", \(\(Print["\", exactvalue];\)\[IndentingNewLine]\), "\[IndentingNewLine]", \(\(t2 = Table[{m[i], exactvalue, RleftI = riemSumLeft[f[x], x, a, b, 100] // N, RrightI = riemSumRight[f[x], x, a, b, 100] // N, RleftI - exactvalue, RrightI - exactvalue}, {i, 0, 10}];\)\n\), "\n", \(TableForm[t2, TableHeadings \[Rule] {None, {"\", "\", "\", "\", "\", "\"}}]\)}], "Input", PageWidth->PaperWidth], Cell["\<\ What happens to the error each time you double the slope of the line? Note that for nonlinear functions, the effect of the slope on the error is \ local in that it varies from point to point on the graph. But if we double \ all of the slopes, we would also double the error in using a left- or \ right-hand Riemann sum to estimate the integral. Note also that the differences in the magnitudes of the errors are all 0. \ This supports the observation that the difference in the errors is dependent \ upon the second derivative or the concavity of the graph. One method for \ improving our numerical estimate of the integral is to add the left- and \ right-hand estimates and then divide the result by two. The idea that \ motivates this is that the errors for the two estimates will nearly cancel \ each other out when we add the left- and right-hand sums together. For linear \ functions, the second derivative is zero, and the graph has no concavity; \ therefore, this improvement will give the exact value of the integral.\ \>", "Text", PageWidth->PaperWidth] }, Closed]], Cell[CellGroupData[{ Cell[TextData[{ "You Try It: The Effect of ", Cell[BoxData[ \(TraditionalForm\`f\^\[DoublePrime]\)]], "on the Error Difference" }], "Section", PageWidth->PaperWidth], Cell["\<\ Design a numerical experiment like the one in Part III to demonstrate the \ effect of the value of the second derivative on the difference between the \ errors in the estimate of the integral that are obtained using right- and \ left-hand Riemann sums. To do this, select a simple function that has a \ constant second derivative, is easy to integrate, and allows you to change \ the value of the second derivative. Generate a table of numerical values that \ shows the values of the second derivative and the difference in the errors \ for the left and right Riemann sums. Take 1 as the starting value of the \ second derivative, and double its value ten times. Try functions that are \ concave down as well as ones that are concave up, and summarize the results \ of your investigation. (We have put the solution for this problem in the next \ input cell with the code hidden. Try to do it on your own, and then look at \ our solution. To reveal the hidden code, select the small cell bracket to the \ right, pull down the Cell menu, select Cell Properties, and click on Cell \ Open.)\ \>", "Text", PageWidth->PaperWidth], Cell[BoxData[{ \(\(Clear[ac];\)\), "\n", \(\(ac[i_] = 2^i;\)\), "\n", \(\(f[x_] = \(1\/2\) ac[i]\ x\^2;\)\), "\[IndentingNewLine]", \(\(a = 0;\)\), "\[IndentingNewLine]", \(\(b = 5;\)\), "\[IndentingNewLine]", \(\(exactvalue = \[Integral]\_a\%b f[ x] \[DifferentialD]x;\)\), "\[IndentingNewLine]", \(\(Print["\", exactvalue];\)\[IndentingNewLine]\), "\[IndentingNewLine]", \(\(t2 = Table[{ac[i], exactvalue // N, RleftI = riemSumLeft[f[x], x, a, b, 100] // N, RrightI = riemSumRight[f[x], x, a, b, 100] // N, RleftI - exactvalue, RrightI - exactvalue, \((RleftI - exactvalue)\) - \((RrightI - exactvalue)\)}, {i, 0, 10}];\)\n\), "\n", \(TableForm[t2, TableHeadings \[Rule] {None, {\*"\"\<\!\(f\^\[DoublePrime]\)(x)\>\"", "\ \", "\", "\", "\", \ "\", "\"}}]\)}], "Input", PageWidth->PaperWidth, CellOpen->False] }, Closed]], Cell[CellGroupData[{ Cell["Part IV: Trapezoids and Midpoint Riemann Sums", "Section", PageWidth->PaperWidth], Cell["\<\ In this part, we investigate two ways to improve the efficiency of numerical \ estimates of definite integrals.\ \>", "Text", PageWidth->PaperWidth], Cell[CellGroupData[{ Cell["Trapezoids", "Subsection", PageWidth->PaperWidth], Cell[TextData[{ "We achieve the first improvement by adding together the left and right \ Riemann sum estimates of the integral and dividing by two. The motivation for \ this approach is that the errors in the left and right sums should nearly \ cancel each other out. In the next cell, we form the new function ", StyleBox["trapezoid[ ]", FontWeight->"Bold"], " that does this. \n" }], "Text", PageWidth->PaperWidth], Cell[BoxData[ \(\(trapezoid[f_, x_, a_, b_, n_] := \((riemSumLeft[f, x, a, b, n] + riemSumRight[f, x, a, b, n])\)/2;\)\)], "Input", PageWidth->PaperWidth], Cell[TextData[{ "(The trapezoid method gets its name from the signed area of a trapezoid in \ each subinterval that results from adding the signed areas of the left and \ right rectangles in each subinterval and dividing by 2. That is, ", Cell[BoxData[ \(TraditionalForm\`\((\(f(c\_left)\) h + \(f(c\_right)\) h)\)/ 2 = \(\(f(c\_left) + f(c\_right)\)\/2\) h\)]], ", the area of a trapezoid, where ", Cell[BoxData[ \(TraditionalForm\`f(c\_left)\)]], " is the length of one parallel side, ", Cell[BoxData[ \(TraditionalForm\`f(c\_right)\)]], " is the length of the other parallel side, and ", StyleBox["h", FontSlant->"Italic"], " is the distance between the two sides.)\n\nNow we use ", StyleBox["trapezoid[ ]", FontWeight->"Bold"], " to estimate ", Cell[BoxData[ \(TraditionalForm\`\[Integral]\_0\%\(\[Pi]\/2\)cos\ x \[DifferentialD]x\ \)]], " with ten subintervals and compare the result with the left- and \ right-hand Riemann sums. First, we calculate the exact value of the \ integral." }], "Text", PageWidth->PaperWidth], Cell[BoxData[{ \(\(f[x_] = Cos[x];\)\), "\[IndentingNewLine]", \(\(a = 0;\)\), "\[IndentingNewLine]", \(\(b = \[Pi]\/2;\)\), "\[IndentingNewLine]", \(\(exactvalue = \[Integral]\_a\%b f[ x] \[DifferentialD]x;\)\), "\[IndentingNewLine]", \(\(Print["\", exactvalue];\)\)}], "Input", PageWidth->PaperWidth], Cell["Now we calculate the estimates of the integral.", "Text", PageWidth->PaperWidth], Cell[BoxData[{ \(\(n = 10;\)\), "\[IndentingNewLine]", \(trapezoid[f[x], x, a, b, n] // N\), "\n", \(riemSumLeft[f[x], x, a, b, n] // N\), "\n", \(riemSumRight[f[x], x, a, b, n] // N\)}], "Input", PageWidth->PaperWidth], Cell["And we compute the errors.", "Text", PageWidth->PaperWidth], Cell[BoxData[{ \(\((trapezoid[f[x], x, a, b, n] // N)\) - exactvalue\), "\n", \(\((riemSumLeft[f[x], x, a, b, n] // N)\) - exactvalue\), "\n", \(\((riemSumRight[f[x], x, a, b, n] // N)\) - exactvalue\)}], "Input", PageWidth->PaperWidth], Cell["\<\ For the same number of subintervals, we get a much more precise estimate of \ the integral from the trapezoid method.\ \>", "Text", PageWidth->PaperWidth] }, Closed]], Cell[CellGroupData[{ Cell["Midpoint Riemann Sums", "Subsection", PageWidth->PaperWidth], Cell[TextData[{ "The second improvement we consider is to use the midpoint of each \ subinterval in a Riemann sum. The effect of doing this is to nearly cancel \ the error on either side of each midpoint in each subinterval. If the \ function we integrate is increasing over a subinterval, then the midpoint \ rectangle will overestimate the actual area on the left side of the midpoint \ and will underestimate, by nearly the same amount, the actual area on the \ right side of the midpoint. Again we expect that these errors will nearly \ cancel each other out. Here is the ", StyleBox["midpoint[ ]", FontWeight->"Bold"], " command." }], "Text", PageWidth->PaperWidth], Cell[BoxData[ \(\(riemSumMid[f_, x_, a_, b_, n_] := Sum[\((f /. x \[Rule] \((a + \((i - 1/2)\)*\((b - a)\)/n)\))\)*\((b - a)\)/n, {i, 1, n}];\)\)], "Input", PageWidth->PaperWidth], Cell["\<\ Let's try it on our old friend and compare the result with left and right \ Riemann sums and with the trapezoid estimate. First, we calculate the exact \ value of the integral.\ \>", "Text", PageWidth->PaperWidth], Cell[BoxData[{ \(\(f[x_] = Cos[x];\)\), "\[IndentingNewLine]", \(\(a = 0;\)\), "\[IndentingNewLine]", \(\(b = \[Pi]\/2;\)\), "\[IndentingNewLine]", \(\(exactvalue = \[Integral]\_a\%b f[ x] \[DifferentialD]x;\)\), "\[IndentingNewLine]", \(\(Print["\", exactvalue];\)\)}], "Input", PageWidth->PaperWidth], Cell["Now we calculate the estimates of the integral.", "Text", PageWidth->PaperWidth], Cell[BoxData[{ \(\(n = 10;\)\), "\[IndentingNewLine]", \(riemSumMid[f[x], x, a, b, n] // N\), "\[IndentingNewLine]", \(trapezoid[f[x], x, a, b, n] // N\), "\n", \(riemSumLeft[f[x], x, a, b, n] // N\), "\n", \(riemSumRight[f[x], x, a, b, n] // N\)}], "Input", PageWidth->PaperWidth], Cell["Again, we compute the errors.", "Text", PageWidth->PaperWidth], Cell[BoxData[{ \(\((riemSumMid[f[x], x, a, b, n] // N)\) - exactvalue\), "\[IndentingNewLine]", \(\((trapezoid[f[x], x, a, b, n] // N)\) - exactvalue\), "\n", \(\((riemSumLeft[f[x], x, a, b, n] // N)\) - exactvalue\), "\n", \(\((riemSumRight[f[x], x, a, b, n] // N)\) - exactvalue\)}], "Input", PageWidth->PaperWidth], Cell["\<\ For the same number of intervals, we get a much more precise estimate of the \ integral using the midpoint rule; it is even more precise than the estimate \ given by the trapezoid rule. What relationship does the error for the \ midpoint estimate seem to have with that for the trapezoid estimate?\ \>", "Text", PageWidth->PaperWidth] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["You Try It: On Some Other Functions", "Section", PageWidth->PaperWidth], Cell[TextData[{ "Compare the Riemann left, Riemann right, trapezoid, and midpoint estimates \ of some integrals that you pick. How does the error for the midpoint rule \ compare with the error for the trapezoid rule with the same number of \ subdivisions? Also, try increasing the number of subintervals, highlighted in \ blue. What happens to the errors when you double the number of subintervals? \ \n\nHere are some integrals that you might want to try: ", Cell[BoxData[ FormBox[ RowBox[{ SubsuperscriptBox["\[Integral]", StyleBox["0", FontColor->RGBColor[0, 1, 0]], StyleBox[\(\[Pi]\/2\), FontColor->RGBColor[0, 1, 0]]], RowBox[{ StyleBox["sin", FontColor->RGBColor[1, 0, 0]], StyleBox[" ", FontColor->RGBColor[1, 0, 0]], StyleBox["x", FontColor->RGBColor[1, 0, 0]], StyleBox[\(\[DifferentialD]x\), FontColor->GrayLevel[0]]}]}], TraditionalForm]]], ", ", Cell[BoxData[ FormBox[ RowBox[{ SubsuperscriptBox["\[Integral]", StyleBox[\(-1\), FontColor->RGBColor[0, 1, 0]], StyleBox["1", FontColor->RGBColor[0, 1, 0]]], RowBox[{ StyleBox[\(e\^x\), FontColor->RGBColor[1, 0, 0]], \(\[DifferentialD]x\)}]}], TraditionalForm]]], ", ", Cell[BoxData[ FormBox[ RowBox[{ SubsuperscriptBox["\[Integral]", StyleBox["0", FontColor->RGBColor[0, 1, 0]], StyleBox["1", FontColor->RGBColor[0, 1, 0]]], RowBox[{ StyleBox[\(\@\(1 - x\^2\)\), FontColor->RGBColor[1, 0, 0]], \(\[DifferentialD]x\)}]}], TraditionalForm]]], ". To help you out, we provide some commands in the two cells that follow. \ " }], "Text", PageWidth->PaperWidth], Cell[BoxData[{ RowBox[{ RowBox[{\(f[x_]\), "=", StyleBox[\(Cos[x]\), FontColor->RGBColor[1, 0, 0]]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"a", "=", StyleBox["0", FontColor->RGBColor[0, 1, 0]]}], ";"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"b", "=", StyleBox[ FractionBox[ StyleBox["\[Pi]", FontColor->RGBColor[0, 1, 0]], "2"], FontColor->RGBColor[0, 1, 0]]}], ";"}], "\n", \(exactvalue = \[Integral]\_a\%b f[ x] \[DifferentialD]x;\), "\[IndentingNewLine]", RowBox[{ RowBox[{ RowBox[{"n", "=", StyleBox["10", FontColor->RGBColor[0, 0, 1]]}], ";"}], "\[IndentingNewLine]"}], "\n", \(Print["\", exactvalue];\), "\n", \(Print["\", riemSumMid[f[x], x, a, b, n] // N];\), "\[IndentingNewLine]", \(Print["\", trapezoid[f[x], x, a, b, n] // N];\), "\n", \(Print["\", riemSumLeft[f[x], x, a, b, n] // N];\), "\n", \(Print["\", riemSumRight[f[x], x, a, b, n] // N];\)}], "Input", PageWidth->PaperWidth], Cell[BoxData[{ \(\(Print["\", \((riemSumMid[f[x], x, a, b, n] - exactvalue)\) // N];\)\), "\n", \(\(Print["\", \((trapezoid[f[x], x, a, b, n] - exactvalue)\) // N];\)\), "\[IndentingNewLine]", \(\(Print["\", \((riemSumLeft[f[x], x, a, b, n] - exactvalue)\) // N];\)\), "\n", \(\(Print["\", \((riemSumRight[f[x], x, a, b, n] - exactvalue)\) // N];\)\)}], "Input", PageWidth->PaperWidth] }, Closed]], Cell[CellGroupData[{ Cell["Part V: Experiment with Trapezoids and Midpoints", "Section", PageWidth->PaperWidth], Cell["\<\ In this part, we do some numerical experiments to determine what factors \ affect the errors when we use trapezoids and midpoint Riemann sums to \ estimate a definite integral. \ \>", "Text", PageWidth->PaperWidth], Cell[CellGroupData[{ Cell["The Effect of the Step Size on the Error", "Subsection", PageWidth->PaperWidth], Cell[TextData[{ "First, we would like to determine the effect of the step size ", StyleBox["h", FontSlant->"Italic"], " on the error. We build a table similar to the one in Part II." }], "Text", PageWidth->PaperWidth], Cell[BoxData[{ \(\(f[x_] = Cos[x];\)\), "\[IndentingNewLine]", \(\(a = 0;\)\), "\[IndentingNewLine]", \(\(b = \[Pi]\/2;\)\), "\[IndentingNewLine]", \(\(exactvalue = \[Integral]\_a\%b f[ x] \[DifferentialD]x;\)\), "\[IndentingNewLine]", \(\(Print["\", exactvalue];\)\[IndentingNewLine]\), "\[IndentingNewLine]", \(\(t1 = Table[{2^i, \(\[Pi]/2\)/2^i, trap = trapezoid[f[x], x, a, b, 2^i] // N, mid = riemSumMid[f[x], x, a, b, 2^i] // N, trap - exactvalue, mid - exactvalue}, {i, 1, 11}];\)\n\), "\n", \(TableForm[t1, TableHeadings \[Rule] {None, {"\", "\", "\", \ "\", "\", "\"}}]\)}], "Input", PageWidth->PaperWidth] }, Closed]], Cell[CellGroupData[{ Cell[TextData[{ "The Effect of ", Cell[BoxData[ \(TraditionalForm\`f\^\[DoublePrime]\)]], " on the Error" }], "Subsection", PageWidth->PaperWidth], Cell[TextData[{ "Based on the observations made in Parts II, III, and IV, we conjecture \ that the error for these methods depends on the magnitude of the second \ derivative of the integrand function. We test our conjecture by comparing the \ error in estimating the area under the quadratic functions of the form ", Cell[BoxData[ \(TraditionalForm\`f(x) = \(a\ x\^2\)\/2\)]], " between ", Cell[BoxData[ \(TraditionalForm\`x = 0\)]], " and ", Cell[BoxData[ \(TraditionalForm\`x = 5\)]], " for various values of ", StyleBox["a", FontSlant->"Italic"], ". The exact values of the integrals are ", Cell[BoxData[ \(TraditionalForm\`\[Integral]\_0\%5\(\( a\ x\^2\)\/2\) \[DifferentialD]x = \(125 a\)\/6\)]], ", and the second derivative of ", Cell[BoxData[ \(TraditionalForm\`\(\(f(x)\)\(\ \)\)\)]], "is equal to ", StyleBox["a", FontSlant->"Italic"], ". We set up a table in which ", StyleBox["a", FontSlant->"Italic"], " starts at 0.1 and doubles ten times. The number of subintervals is kept \ constant at 100. " }], "Text", PageWidth->PaperWidth], Cell[BoxData[{ \(\(Clear[ac];\)\), "\n", \(\(ac[i_] = 0.1*2^i;\)\), "\[IndentingNewLine]", \(\(f[x_] = \(ac[i]\ x\^2\)\/2;\)\), "\[IndentingNewLine]", \(\(a = 0;\)\), "\[IndentingNewLine]", \(\(b = 5;\)\), "\[IndentingNewLine]", \(\(exactvalue = \[Integral]\_a\%b f[ x] \[DifferentialD]x;\)\), "\[IndentingNewLine]", \(\(Print["\", exactvalue];\)\[IndentingNewLine]\), "\n", \(\(t2 = Table[{ac[i], exactvalue, trap = trapezoid[f[x], x, a, b, 100] // N, mid = riemSumMid[f[x], x, a, b, 100] // N, trap - exactvalue, mid - exactvalue}, {i, 0, 10}];\)\n\), "\n", \(TableForm[t2, TableHeadings \[Rule] {None, {\*"\"\<\!\(f\^\[DoublePrime]\)(x)\>\"", "\ \", "\", "\", "\", "\"}}]\)}], "Input", PageWidth->PaperWidth], Cell["\<\ In \"You Try It\" below, we ask you to summarize the results of these \ experiments.\ \>", "Text", PageWidth->PaperWidth] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["You Try It: Summarize the Experiment's Results", "Section", PageWidth->PaperWidth], Cell[TextData[{ "Summarize the results of the numerical experiments in Part V. In your \ summary, address the following items.\n\na) How is the error for each method \ related to the number of subintervals ", StyleBox["n", FontSlant->"Italic"], " and the interval width ", StyleBox["h", FontSlant->"Italic"], "? What is the order of the error for each method? (Note: If cutting the \ interval width in half reduces the error by a factor of ", Cell[BoxData[ FormBox[ SuperscriptBox[ FormBox[\((1\/2)\), "TraditionalForm"], "n"], TraditionalForm]]], ", then the error is of order ", Cell[BoxData[ \(TraditionalForm\`h\^n\)]], ", and we designate this by ", Cell[BoxData[ \(TraditionalForm\`O(h\^n)\)]], ".)\n\nb) How is the error for the trapezoid method related to the error \ for the midpoint Riemann sum?\n\nc) How is the error related to the second \ derivative of the integrand function? (To answer this completely, repeat the \ second experiment in Part V for negative values of ", StyleBox["a", FontSlant->"Italic"], ". \n\nd) Are your conclusions consistent with the trapezoid error formula \ that is found in the text?\n\ne) From the pattern of errors for the \ trapezoid method and the midpoint Riemann sum method, specify how you might \ combine these two estimates of the integral so that the errors will nearly \ cancel each other. Compare your idea for combining the estimates with those \ of other students." }], "Text", PageWidth->PaperWidth] }, Closed]], Cell[CellGroupData[{ Cell["Part VI: Simpson's Method", "Section", PageWidth->PaperWidth], Cell[TextData[{ "Noting that the magnitude of the error for the trapezoid method is \ approximately two times the magnitude of the error for a midpoint Riemann sum \ with the same number of subintervals, we can make yet another improvement in \ the efficiency of our numerical estimations of the integrals. If we add two \ midpoint estimates and one trapezoid estimate and divide the result by three, \ the errors for the two methods should nearly cancel. The result of this \ combination is called Simpson's method.\n\nTo illustrate this, consider the \ following estimates of the integral ", Cell[BoxData[ \(TraditionalForm\`\[Integral]\_0\%\(\[Pi]\/2\)cos\ x \[DifferentialD]x\ \)]], ". Using 10 subintervals, we compare the midpoint and trapezoid estimates \ and their errors, and then we combine them as indicated above and calculate \ the error for the new estimate." }], "Text", PageWidth->PaperWidth], Cell[BoxData[{ \(\(f[x_] = Cos[x];\)\), "\[IndentingNewLine]", \(\(a = 0;\)\), "\[IndentingNewLine]", \(\(b = \[Pi]\/2;\)\), "\[IndentingNewLine]", \(\(n = 10;\)\), "\[IndentingNewLine]", \(\(exactvalue = \[Integral]\_a\%b f[ x] \[DifferentialD]x;\)\), "\[IndentingNewLine]", \(\(trap = trapezoid[f[x], x, a, b, n] // N;\)\), "\[IndentingNewLine]", \(\(mid = riemSumMid[f[x], x, a, b, n] // N;\)\[IndentingNewLine]\), "\[IndentingNewLine]", \(\(simps = \((2*mid + trap)\)/ 3;\)\[IndentingNewLine]\), "\[IndentingNewLine]", \(\(Print["\", exactvalue];\)\), "\[IndentingNewLine]", \(\(Print["\", trap];\)\), "\[IndentingNewLine]", \(\(Print["\", \((trap - exactvalue)\) // N];\)\), "\n", \(\(Print["\", mid];\)\), "\[IndentingNewLine]", \(\(Print["\", \((mid - exactvalue)\) // N];\)\), "\[IndentingNewLine]", \(\(Print["\", simps];\)\), "\[IndentingNewLine]", \(\(Print["\", simps - exactvalue];\)\)}], "Input", PageWidth->PaperWidth], Cell["\<\ Since Simpson's method requires three function evaluations in each \ subinterval, one at each end point for the trapezoid plus one at the mid \ point, we count the number of subintervals differently. If we take the \ dividing points for the subintervals to be all of the places where the \ integrand function is evaluated, then there are actually twice as many \ subintervals for Simpson's method than there would be for the trapezoid \ method or the midpoint Riemann sum. One consequence of this is that we need \ an even number of subintervals for Simpson's method to work. In the next cell we write a command that gives the Simpson estimate of a \ definite integral. \ \>", "Text", PageWidth->PaperWidth], Cell[BoxData[ \(\(simpson[f_, x_, a_, b_, n_] := \((2*riemSumMid[f, x, a, b, n/2] + trapezoid[f, x, a, b, n/2])\)/3;\)\)], "Input", PageWidth->PaperWidth], Cell[TextData[{ "Let's use it to estimate ", Cell[BoxData[ \(TraditionalForm\`\[Integral]\_0\%\(\[Pi]\/2\)cos\ x \[DifferentialD]x \ = 1\)]], " and then calculate the errors, comparing the results with those obtained \ using trapezoids and midpoint Riemann sums." }], "Text", PageWidth->PaperWidth], Cell[BoxData[{ \(\(f[x_] = Cos[x];\)\), "\[IndentingNewLine]", \(\(a = 0;\)\), "\[IndentingNewLine]", \(\(b = \[Pi]\/2;\)\), "\[IndentingNewLine]", \(\(exactvalue = \[Integral]\_a\%b f[ x] \[DifferentialD]x;\)\), "\[IndentingNewLine]", \(\(Print["\", exactvalue];\)\), "\[IndentingNewLine]", \(\(Print["\", simpson[Cos[x], x, a, b, 6] // N];\)\), "\n", \(\(Print["\", trapezoid[Cos[x], x, a, b, 6] // N];\)\), "\n", \(\(Print["\", riemSumMid[Cos[x], x, a, b, 6] // N];\)\)}], "Input", PageWidth->PaperWidth], Cell["Now we compare the errors.", "Text", PageWidth->PaperWidth], Cell[BoxData[{ \(\(Print["\", \((simpson[Cos[x], x, a, b, 6] // N)\) - exactvalue];\)\), "\n", \(\(Print["\", \((trapezoid[ Cos[x], x, a, b, 6] // N)\) - exactvalue];\)\), "\n", \(\(Print["\", \((riemSumMid[ Cos[x], x, a, b, 6] // N)\) - exactvalue];\)\)}], "Input", PageWidth->PaperWidth], Cell["\<\ Using only six subintervals, Simpson's method gives very good results. \ \>", "Text", PageWidth->PaperWidth], Cell["\<\ While left and right Riemann sums integrate constant functions exactly, and \ the trapezoids and midpoint Riemann sums integrate linear functions exactly, \ we might conjecture that Simpson's rule integrates quadratic functions \ exactly. This conjecture is in fact correct, but it is even better than that. \ Simpson's method integrates cubic functions exactly. We show this in the \ following cell by applying Simpson's method to a general cubic function with \ only two subintervals and then comparing the result with the exact value. \ \>", "Text", PageWidth->PaperWidth], Cell[BoxData[{ \(\(Clear[fcubic, a, b];\)\), "\n", \(\(fcubic[x_] = c\ x\^3 + d\ x\^2 + e\ x\ + f;\)\), "\n", \(simpsonresult = simpson[fcubic[x], x, a, b, 2] // Expand\)}], "Input", PageWidth->PaperWidth], Cell[BoxData[ \(integralresult = Integrate[fcubic[x], {x, a, b}]\)], "Input", PageWidth->PaperWidth], Cell[BoxData[ \(simpsonresult \[Equal] integralresult\)], "Input", PageWidth->PaperWidth] }, Closed]], Cell[CellGroupData[{ Cell["You Try It: Experiment with Simpson", "Section", PageWidth->PaperWidth], Cell["\<\ Perform some numerical experiments like those in the preceding parts to show \ that the order of the error for Simpson's method is fourth. Also show that \ the local error is proportional to the fourth derivative of the integrand \ function. (We have put the solutions for this problem in the next two input \ cells with the code hidden. Try to do it on your own, and then look at our \ solutions. To reveal the hidden code, select the small cell bracket to the \ right of each cell, pull down the Cell menu, select Cell Properties, and \ click on Cell Open.)\ \>", "Text", PageWidth->PaperWidth], Cell[BoxData[{ \(\(f[x_] = Cos[x];\)\), "\[IndentingNewLine]", \(\(a = 0;\)\), "\[IndentingNewLine]", \(\(b = \[Pi]\/2;\)\), "\[IndentingNewLine]", \(\(exactvalue = \[Integral]\_a\%b f[ x] \[DifferentialD]x;\)\), "\[IndentingNewLine]", \(\(Print["\", exactvalue];\)\[IndentingNewLine]\), "\[IndentingNewLine]", \(\(t1 = Table[{2^i, \(\[Pi]/2\)/2^i, simps = N[simpson[f[x], x, a, b, 2^i], 20], simps - exactvalue}, {i, 1, 11}];\)\n\), "\n", \(TableForm[t1, TableHeadings \[Rule] {None, {"\", "\", "\", \ "\"}}]\)}], "Input", PageWidth->PaperWidth, CellOpen->False], Cell[BoxData[{ \(\(Clear[ac];\)\), "\n", \(\(ac[i_] = 0.1*2^i;\)\), "\[IndentingNewLine]", \(\(f[x_] = \(ac[i]\ x\^4\)\/\(4!\);\)\), "\[IndentingNewLine]", \(\(a = 0;\)\), "\[IndentingNewLine]", \(\(b = 5;\)\), "\[IndentingNewLine]", \(\(exactvalue = \[Integral]\_a\%b f[ x] \[DifferentialD]x;\)\), "\[IndentingNewLine]", \(\(Print["\", exactvalue];\)\[IndentingNewLine]\), "\n", \(\(t2 = Table[{ac[i], SetPrecision[exactvalue, 12], simps = SetPrecision[simpson[f[x], x, a, b, 100], 12], simps - exactvalue}, {i, 0, 10}];\)\n\), "\n", \(TableForm[t2, TableHeadings \[Rule] {None, {\*"\"\<\!\(f\^\((4)\)\)(x)\>\"", "\", "\", "\"}}]\)}], "Input", PageWidth->PaperWidth, CellOpen->False] }, Closed]] }, Open ]] }, FrontEndVersion->"4.0 for Microsoft Windows", ScreenRectangle->{{0, 1024}, {0, 695}}, AutoGeneratedPackage->None, WindowSize->{849, 595}, WindowMargins->{{29, Automatic}, {Automatic, 5}}, PrintingCopies->1, PrintingPageRange->{Automatic, Automatic} ] (*********************************************************************** 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[1739, 51, 74, 1, 150, "Title"], Cell[1816, 54, 122, 4, 37, "Text"], Cell[1941, 60, 5810, 108, 19, "Input", CellOpen->False, InitializationCell->True], Cell[CellGroupData[{ Cell[7776, 172, 56, 1, 53, "Section"], Cell[7835, 175, 777, 13, 185, "Text"], Cell[CellGroupData[{ Cell[8637, 192, 99, 2, 47, "Subsection"], Cell[8739, 196, 1415, 36, 299, "Text"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[10203, 238, 75, 1, 33, "Section"], Cell[10281, 241, 2717, 71, 423, "Text"], Cell[13001, 314, 205, 4, 70, "Input"], Cell[13209, 320, 650, 14, 147, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[13896, 339, 78, 1, 33, "Section"], Cell[13977, 342, 208, 7, 52, "Text"], Cell[14188, 351, 885, 25, 70, "Input"], Cell[15076, 378, 3312, 78, 523, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[18425, 461, 73, 1, 33, "Section"], Cell[18501, 464, 859, 27, 109, "Text"], Cell[19363, 493, 385, 8, 110, "Input"], Cell[19751, 503, 2348, 80, 211, "Text"], Cell[22102, 585, 883, 17, 376, "Input"], Cell[22988, 604, 1408, 28, 337, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[24433, 637, 75, 1, 33, "Section"], Cell[24511, 640, 577, 14, 78, "Text"], Cell[25091, 656, 1012, 20, 376, "Input"], Cell[26106, 678, 463, 10, 166, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[26606, 693, 160, 6, 33, "Section"], Cell[26769, 701, 280, 7, 52, "Text"], Cell[27052, 710, 220, 5, 90, "Input"], Cell[27275, 717, 468, 13, 74, "Text"], Cell[27746, 732, 952, 20, 404, "Input"], Cell[28701, 754, 1077, 18, 261, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[29815, 777, 179, 6, 33, "Section"], Cell[29997, 785, 1135, 17, 223, "Text"], Cell[31135, 804, 1108, 23, 19, "Input", CellOpen->False] }, Closed]], Cell[CellGroupData[{ Cell[32280, 832, 89, 1, 33, "Section"], Cell[32372, 835, 160, 4, 52, "Text"], Cell[CellGroupData[{ Cell[32557, 843, 57, 1, 47, "Subsection"], Cell[32617, 846, 429, 9, 109, "Text"], Cell[33049, 857, 186, 4, 50, "Input"], Cell[33238, 863, 1095, 27, 180, "Text"], Cell[34336, 892, 389, 8, 136, "Input"], Cell[34728, 902, 88, 1, 33, "Text"], Cell[34819, 905, 240, 5, 90, "Input"], Cell[35062, 912, 67, 1, 33, "Text"], Cell[35132, 915, 252, 4, 70, "Input"], Cell[35387, 921, 166, 4, 52, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[35590, 930, 68, 1, 47, "Subsection"], Cell[35661, 933, 682, 13, 128, "Text"], Cell[36346, 948, 230, 5, 50, "Input"], Cell[36579, 955, 225, 5, 52, "Text"], Cell[36807, 962, 389, 8, 136, "Input"], Cell[37199, 972, 88, 1, 33, "Text"], Cell[37290, 975, 307, 6, 110, "Input"], Cell[37600, 983, 70, 1, 33, "Text"], Cell[37673, 986, 345, 6, 90, "Input"], Cell[38021, 994, 346, 6, 71, "Text"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[38416, 1006, 79, 1, 33, "Section"], Cell[38498, 1009, 1975, 53, 154, "Text"], Cell[40476, 1064, 1336, 33, 336, "Input"], Cell[41815, 1099, 580, 9, 170, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[42432, 1113, 92, 1, 33, "Section"], Cell[42527, 1116, 226, 5, 52, "Text"], Cell[CellGroupData[{ Cell[42778, 1125, 87, 1, 47, "Subsection"], Cell[42868, 1128, 229, 6, 52, "Text"], Cell[43100, 1136, 831, 16, 336, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[43968, 1157, 160, 6, 47, "Subsection"], Cell[44131, 1165, 1143, 32, 146, "Text"], Cell[45277, 1199, 926, 18, 401, "Input"], Cell[46206, 1219, 133, 4, 33, "Text"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[46388, 1229, 90, 1, 33, "Section"], Cell[46481, 1232, 1549, 35, 340, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[48067, 1272, 69, 1, 33, "Section"], Cell[48139, 1275, 922, 16, 192, "Text"], Cell[49064, 1293, 1348, 27, 396, "Input"], Cell[50415, 1322, 721, 13, 166, "Text"], Cell[51139, 1337, 186, 4, 50, "Input"], Cell[51328, 1343, 312, 8, 59, "Text"], Cell[51643, 1353, 768, 14, 256, "Input"], Cell[52414, 1369, 67, 1, 33, "Text"], Cell[52484, 1372, 477, 7, 130, "Input"], Cell[52964, 1381, 120, 3, 33, "Text"], Cell[53087, 1386, 587, 9, 128, "Text"], Cell[53677, 1397, 222, 4, 70, "Input"], Cell[53902, 1403, 106, 2, 30, "Input"], Cell[54011, 1407, 95, 2, 30, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[54143, 1414, 79, 1, 33, "Section"], Cell[54225, 1417, 608, 10, 128, "Text"], Cell[54836, 1429, 747, 16, 19, "Input", CellOpen->False], Cell[55586, 1447, 880, 18, 19, "Input", CellOpen->False] }, Closed]] }, Open ]] } ] *) (*********************************************************************** End of Mathematica Notebook file. ***********************************************************************)