(************** Content-type: application/mathematica ************** CreatedBy='Mathematica 4.2' 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[ 53718, 1374]*) (*NotebookOutlinePosition[ 54416, 1398]*) (* CellTagsIndexPosition[ 54372, 1394]*) (*WindowFrame->Normal*) Notebook[{ Cell[CellGroupData[{ Cell["Numerical Integration", "Title", CellFrame->True, 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["\<\ This notebook uses special integration routines by Frank Beatrous \ of the University of Pittsburgh, the definitions of which are part of the \ initialization. These cells will be evaluated the first time you evaluate \ any other cell, provided you click on \"Yes\" when asked whether you want \ to initialize. If you do not click on \"Yes\", you will have to choose the \ Kernel..Evaluation..Evaluate Initialization Menu item before using any of the \ routines (LeftSum, MidSum, RightRectangles, etc.).\ \>", "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[{ "In any input cell containing ", StyleBox["xxx", FontColor->RGBColor[1, 0, 1]], " , you must replace it with your input before evaluating 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["\<\ Initialization (can be skipped, provided you answer Yes to the \ initialization prompt.\ \>", "Subsubsection", Evaluatable->False], Cell["\<\ The next cell loads the package used to create the \ animations.\ \>", "Text"], Cell[BoxData[ \(Needs["\"]\)], "Input", InitializationCell->True], Cell["\<\ The author of the following routines is Frank Beatrous of the \ University of Pittsburgh.\ \>", "Text"], Cell[BoxData[{\(Off[General::"\"];\), "\n", \(Off[ Plot::"\"];\), "\n", \(Needs["\"];\), "\n", \ \(BeginPackage["\"]\), "\n", \(LeftSum::"\" = \ "\";\), "\n", \ \(RightSum::"\" = "\";\), "\n", \(MidSum::"\" = \ "\";\), "\n", \ \(TrapSum::"\" = "\";\), "\n", \(Simpson::"\" = \ "\";\), "\n", \(LRSum::"\" = \ "\";\), "\n", \(SumTable::"\" = \ "\";\), "\n", \(ShowRight::"\" = "\True.\>";\), "\n", \(ShowLeft::"\" = \ "\True.\>";\), "\n", \(ShowMidPoint::"\" \ = "\False.\>";\), "\n", \(ShowTrap::"\ \" = "\False.\>";\), "\n", \ \(ShowSimpson::"\" = "\False.\>";\), "\n", \(LeftRectangles::"\" = \ "\";\), "\n", \ \(RightRectangles::"\" = "\";\), "\n", \(MidRectangles::"\" = "\";\), "\n", \(Trapezoids::"\" = \ "\";\), "\n", \(ListIntegrate::"\" = \ "\";\), "\n\ ", \(Begin["\"]\), "\n", RowBox[{\(LeftSum[y_, domain_, n_]\), ":=", RowBox[{"N", "[", RowBox[{"Module", "[", RowBox[{\({x, a, b, s, h}\), ",", RowBox[{\({x, a, b} = domain\), ";", \(h = \(b - a\)\/n\), ";", RowBox[{"h", " ", RowBox[{ UnderoverscriptBox["\[Sum]", GridBox[{ {\(s = a\)}, {\(\[CapitalDelta]\[MediumSpace]s = h\)} }], \(b - h\)], \((y /. x \[Rule] s)\)}]}]}]}], "]"}], "]"}]}], "\n", RowBox[{\(RightSum[y_, domain_, n_]\), ":=", RowBox[{"N", "[", RowBox[{"Module", "[", RowBox[{\({x, a, b, s, h}\), ",", RowBox[{\({x, a, b} = domain\), ";", \(h = \(b - a\)\/n\), ";", RowBox[{"h", " ", RowBox[{ UnderoverscriptBox["\[Sum]", GridBox[{ {\(s = a + h\)}, {\(\[CapitalDelta]\[MediumSpace]s = h\)} }], "b"], \((y /. x \[Rule] s)\)}]}]}]}], "]"}], "]"}]}], "\n", RowBox[{\(MidSum[y_, domain_, n_]\), ":=", RowBox[{"N", "[", RowBox[{"Module", "[", RowBox[{\({x, a, b, h, s}\), ",", RowBox[{\({x, a, b} = domain\), ";", \(h = \(b - a\)\/n\), ";", RowBox[{ RowBox[{"(", RowBox[{ UnderoverscriptBox["\[Sum]", GridBox[{ {\(s = a + h\/2\)}, {\(\[CapitalDelta]\[MediumSpace]s = h\)} }], \(b - h\/2\)], \((y /. x \[Rule] s)\)}], ")"}], " ", "h"}]}]}], "]"}], "]"}]}], "\n", RowBox[{\(TrapSum[y_, domain_, n_]\), ":=", RowBox[{"N", "[", RowBox[{"Module", "[", RowBox[{\({x, a, b, s, h}\), ",", RowBox[{\({x, a, b} = domain\), ";", \(h = \(b - a\)\/n\), ";", RowBox[{\(1\/2\ h\ \((\((y /. x \[Rule] a)\) + \((y /. x \[Rule] b)\))\)\), "+", RowBox[{"h", " ", RowBox[{ UnderoverscriptBox["\[Sum]", GridBox[{ {\(s = a + h\)}, {\(\[CapitalDelta]\[MediumSpace]s = h\)} }], \(b - h\)], \((y /. x \[Rule] s)\)}]}]}]}]}], "]"}], "]"}]}], "\n", RowBox[{\(Simpson[y_, domain_, n_]\), ":=", RowBox[{"N", "[", RowBox[{"Module", "[", RowBox[{\({x, a, b, s, h}\), ",", RowBox[{\({x, a, b} = domain\), ";", \(h = \(b - a\)\/n\), ";", RowBox[{\(1\/6\), " ", RowBox[{"(", RowBox[{ RowBox[{"4", " ", RowBox[{ UnderoverscriptBox["\[Sum]", GridBox[{ {\(s = a + h\/2\)}, {\(\[CapitalDelta]\[MediumSpace]s = h\)} }], \(b - h\/2\)], \((y /. x \[Rule] s)\)}]}], "+", RowBox[{"2", " ", RowBox[{ UnderoverscriptBox["\[Sum]", GridBox[{ {\(s = a + h\)}, {\(\[CapitalDelta]\[MediumSpace]s = h\)} }], \(b - h\)], \((y /. x \[Rule] s)\)}]}], "+", \((y /. x \[Rule] a)\), "+", \((y /. x \[Rule] b)\)}], ")"}], " ", "h"}]}]}], "]"}], "]"}]}], "\n", RowBox[{\(LRSum[y_, domain_, n_]\), ":=", RowBox[{"Module", "[", RowBox[{\({x, a, b, s, h, ps}\), ",", RowBox[{\({x, a, b} = domain\), ";", \(h = \(b - a\)\/n\), ";", RowBox[{"ps", "=", RowBox[{ UnderoverscriptBox["\[Sum]", GridBox[{ {\(s = a + h\)}, {\(\[CapitalDelta]\[MediumSpace]s = h\)} }], \(b - h\)], \((y /. x \[Rule] s)\)}]}], ";", \({n, N[\((ps + y /. x \[Rule] a)\)\ h], N[\((ps + y /. x \[Rule] b)\)\ h]}\)}]}], "]"}]}], "\n", \(Options[SumTable] = {ShowLeft \[Rule] True, ShowRight \[Rule] True, ShowMidPoint \[Rule] False, ShowTrap \[Rule] False, ShowSimpson \[Rule] False};\), "\n", RowBox[{\(sums[y_, domain_, n_, opts___]\), ":=", RowBox[{"Module", "[", RowBox[{\({lft, rt, mp, trp, smp, sumlist, x, a, b, ya, yb, s, h, insum, midsum}\), ",", RowBox[{\({x, a, b} = domain\), ";", \(ya = N[y /. x \[Rule] a]\), ";", \(yb = N[y /. x \[Rule] b]\), ";", \(h = \(b - a\)\/n\), ";", RowBox[{"insum", "=", RowBox[{"N", "[", RowBox[{ UnderoverscriptBox["\[Sum]", GridBox[{ {\(s = a + h\)}, {\(\[CapitalDelta]\[MediumSpace]s = h\)} }], \(b - h\)], \((y /. x \[Rule] s)\)}], "]"}]}], ";", RowBox[{"midsum", "=", RowBox[{"N", "[", RowBox[{ UnderoverscriptBox["\[Sum]", GridBox[{ {\(s = a + h\/2\)}, {\(\[CapitalDelta]\[MediumSpace]s = h\)} }], \(b - h\/2\)], \((y /. x \[Rule] s)\)}], "]"}]}], ";", \({lft, rt, mp, trp, smp} = \({ShowLeft, ShowRight, ShowMidPoint, ShowTrap, ShowSimpson} /. {opts}\) /. Options[SumTable]\), ";", \(sumlist = {n}\), ";", \(sumlist = If[lft, Append[sumlist, h\ \((ya + insum)\)], sumlist]\), ";", \(sumlist = If[rt, Append[sumlist, h\ \((insum + yb)\)], sumlist]\), ";", \(sumlist = If[mp, Append[sumlist, h\ midsum], sumlist]\), ";", \(sumlist = If[trp, Append[sumlist, 1\/2\ h\ \((ya + 2\ insum + yb)\)], sumlist]\), ";", \(sumlist = If[smp, Append[sumlist, 1\/6\ h\ \((ya + yb + 4\ midsum + 2\ insum)\)], sumlist]\)}]}], "]"}]}], "\n", RowBox[{\(sthead[opts___]\), ":=", RowBox[{"Module", "[", RowBox[{ RowBox[{"{", RowBox[{ "lft", ",", "rt", ",", "mp", ",", "trp", ",", "smp", ",", RowBox[{"hd", "=", RowBox[{"{", InterpretationBox[GridBox[{ {"\"\<\>\""}, {"\"\\""}, {"\"\<\>\""} }, GridBaseline->{Baseline, {1, 1}}, ColumnAlignments->{Left}], ColumnForm[ {"", "n", ""}], Editable->False], "}"}]}]}], "}"}], ",", RowBox[{\({lft, rt, mp, trp, smp} = \({ShowLeft, ShowRight, ShowMidPoint, ShowTrap, ShowSimpson} /. {opts}\) /. Options[SumTable]\), ";", RowBox[{"hd", "=", RowBox[{"If", "[", RowBox[{"lft", ",", RowBox[{"Append", "[", RowBox[{"hd", ",", InterpretationBox[GridBox[{ {"\"\\""}, {"\"\\""}, {"\"\<\>\""} }, GridBaseline->{Baseline, {1, 1}}, ColumnAlignments->{Left}], ColumnForm[ {"left", "sum", ""}], Editable->False]}], "]"}], ",", "hd"}], "]"}]}], ";", RowBox[{"hd", "=", RowBox[{"If", "[", RowBox[{"rt", ",", RowBox[{"Append", "[", RowBox[{"hd", ",", InterpretationBox[GridBox[{ {"\"\\""}, {"\"\\""}, {"\"\<\>\""} }, GridBaseline->{Baseline, {1, 1}}, ColumnAlignments->{Left}], ColumnForm[ {"right", "sum", ""}], Editable->False]}], "]"}], ",", "hd"}], "]"}]}], ";", RowBox[{"hd", "=", RowBox[{"If", "[", RowBox[{"mp", ",", RowBox[{"Append", "[", RowBox[{"hd", ",", InterpretationBox[GridBox[{ {"\"\\""}, {"\"\\""}, {"\"\<\>\""} }, GridBaseline->{Baseline, {1, 1}}, ColumnAlignments->{Left}], ColumnForm[ {"midpoint", "sum", ""}], Editable->False]}], "]"}], ",", "hd"}], "]"}]}], ";", RowBox[{"hd", "=", RowBox[{"If", "[", RowBox[{"trp", ",", RowBox[{"Append", "[", RowBox[{"hd", ",", InterpretationBox[GridBox[{ {"\"\\""}, {"\"\\""}, {"\"\<\>\""} }, GridBaseline->{Baseline, {1, 1}}, ColumnAlignments->{Left}], ColumnForm[ {"trapezoid", "sum", ""}], Editable->False]}], "]"}], ",", "hd"}], "]"}]}], ";", RowBox[{"hd", "=", RowBox[{"If", "[", RowBox[{"smp", ",", RowBox[{"Append", "[", RowBox[{"hd", ",", InterpretationBox[GridBox[{ {"\"\\""}, {"\"\\""}, {"\"\<\>\""} }, GridBaseline->{Baseline, {1, 1}}, ColumnAlignments->{Left}], ColumnForm[ {"simpson", "rule", ""}], Editable->False]}], "]"}], ",", "hd"}], "]"}]}]}]}], "]"}]}], "\n", \(SumTable[y_, domain_, n_, iterator_, opts___] := TableForm[Table[sums[y, domain, n, opts], iterator], TableSpacing \[Rule] {0, 3}, TableHeadings \[Rule] {None, sthead[opts]}]\), "\n", \(LeftRectangles[ y_, domain_, n_] := Module[{h, x, a, b, s}, {x, a, b} = domain; h = \(b - a\)\/n; {Graphics[{Table[{GrayLevel[ .9], Polygon[{{s, 0}, {s + h, 0}, {s + h, y /. x \[Rule] s}, {s, y /. x \[Rule] s}}]}, {s, a, b - h, h}], Table[Line[{{s, 0}, {s + h, 0}, {s + h, y /. x \[Rule] s}, {s, y /. x \[Rule] s}, {s, 0}}], {s, a, b - h, h}]}], Plot[{0, y /. x \[Rule] s}, {s, a, b}, DisplayFunction \[Rule] Identity]}]\), "\n", \(RightRectangles[ y_, domain_, n_] := Module[{h, x, a, b, s}, {x, a, b} = domain; h = \(b - a\)\/n; {Graphics[{Table[{GrayLevel[ .7], Polygon[{{s, 0}, {s - h, 0}, {s - h, y /. x \[Rule] s}, {s, y /. x \[Rule] s}}]}, {s, a + h, b, h}], Table[Line[{{s, 0}, {s - h, 0}, {s - h, y /. x \[Rule] s}, {s, y /. x \[Rule] s}, {s, 0}}], {s, a + h, b, h}]}], Plot[{0, y /. x \[Rule] s}, {s, a, b}, DisplayFunction \[Rule] Identity]}]\), "\n", \(Trapezoids[y_, domain_, n_] := Module[{h, x, a, b, s}, {x, a, b} = domain; h = \(b - a\)\/n; {Graphics[{Table[{GrayLevel[ .9], Polygon[{{s, 0}, {s + h, 0}, {s + h, y /. x \[Rule] s + h}, {s, y /. x \[Rule] s}}]}, {s, a, b - h, h}], Table[Line[{{s, 0}, {s + h, 0}, {s + h, y /. x \[Rule] s + h}, {s, y /. x \[Rule] s}, {s, 0}}], {s, a, b - h, h}]}], Plot[{0, y /. x \[Rule] s}, {s, a, b}, DisplayFunction \[Rule] Identity]}]\), "\n", \(MidRectangles[y_, domain_, n_] := Module[{h, x, a, b, s}, {x, a, b} = domain; h = \(b - a\)\/n; {Graphics[{Table[{GrayLevel[ .7], Polygon[{{s, 0}, {s - h, 0}, {s - h, y /. x \[Rule] s - h\/2}, {s, y /. x \[Rule] s - h\/2}}]}, {s, a + h, b, h}], Table[Line[{{s, 0}, {s - h, 0}, {s - h, y /. x \[Rule] s - h\/2}, {s, y /. x \[Rule] s - h\/2}, {s, 0}}], {s, a + h, b, h}]}], Plot[{0, y /. x \[Rule] s}, {s, a, b}, DisplayFunction \[Rule] Identity]}]\), "\n", \(ListIntegrate[ data_] := 1\/2\ \(\[Sum]\+\(k = 1\)\%\(Length[data] - 1\)\((data\ \[LeftDoubleBracket]k, 2\[RightDoubleBracket] + data\[LeftDoubleBracket]k + 1, 2\[RightDoubleBracket])\)\ \((data\[LeftDoubleBracket] k + 1, 1\[RightDoubleBracket] - data\[LeftDoubleBracket]k, 1\[RightDoubleBracket])\)\)\), "\n", \(End[]\), "\n", \ \(EndPackage[]\)}], "Input", InitializationCell->True] }, Closed]], Cell[CellGroupData[{ Cell["The Need for Numerical Integration", "Section", Evaluatable->False, AspectRatioFixed->True], Cell["\<\ By now you have become used to evaluating definite integrals by \ finding an antiderivative for the integrand, and then using the First \ Fundamental Theorem of Calculus. Unfortunately, when we encounter functions \ for which nice, neat antiderivatives can't be found we need to find another \ way to evaluate the integral. Here is an example: \ \>", "Text", Evaluatable->False], Cell[BoxData[{ \(Clear[g, x]\), "\n", \(g[x_] = \@Sin[\(x + x\^3\)\/2]\)}], "Input", InitializationCell->True], Cell[TextData[{ "We can ask ", StyleBox["Mathematica", FontSlant->"Italic"], " to try and evaluate the definite integral of this function for x between \ 0 and 1." }], "Text"], Cell[BoxData[ \(\[Integral]\_0\%1 g[x] \[DifferentialD]x\)], "Input"], Cell["What do you think the output means?", "Text"] }, Closed]], Cell[CellGroupData[{ Cell["Left and Right Sums", "Section", Evaluatable->False, AspectRatioFixed->True], Cell["\<\ Here is a plot of the function g from above, over the interval \ [0,1]:\ \>", "Text", Evaluatable->False], Cell[BoxData[ \(\(Plot[g[x], {x, 0, 1}, AxesOrigin \[Rule] {0, 0}];\)\)], "Input"], Cell[TextData[{ StyleBox["We can approximate ", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ FormBox[ RowBox[{ StyleBox[ SubsuperscriptBox["\[Integral]", StyleBox["0", FontSlant->"Plain"], StyleBox["4", FontSlant->"Plain"]], FontSlant->"Italic"], StyleBox[" ", FontSlant->"Italic"], RowBox[{ RowBox[{ StyleBox["g", FontSlant->"Italic"], StyleBox["[", FontSlant->"Italic"], StyleBox["x", FontSlant->"Plain"], StyleBox["]", FontSlant->"Italic"]}], RowBox[{"\[DifferentialD]", StyleBox["x", FontSlant->"Plain"]}]}]}], TraditionalForm]]], StyleBox[" using rectangles. First, we divide the interval [0,4] into 6 \ subintervals. (There is nothing special about 6. We will change it later.) \ We then draw rectangles whose bases are these subintervals, and whose \ heights are given by the function value at the left edge of each subinterval. \ We can use ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Mathematica", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox[" to draw a picture of the function together with the \ approximating rectangles, using Show and the LeftRectangles routine, as \ demonstrated below. Note that n is the number of rectangles.", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False], Cell[BoxData[{\(Clear[n]\), "\n", RowBox[{ RowBox[{"n", "=", StyleBox["6", FontColor->RGBColor[1, 0, 1]]}], ";"}], "\n", \(Show[LeftRectangles[g[x], {x, 0, 1}, n], Axes \[Rule] True, AxesOrigin \[Rule] {0, 0}, DisplayFunction \[Rule] $DisplayFunction];\)}], "Input"], Cell[TextData[{ StyleBox[ "To get such a \"left-hand\" approximation, we simply add the areas of \ these rectangles. To do this, use the", Evaluatable->False, AspectRatioFixed->True], StyleBox["Mathematica", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox[ " routine LeftSum, demonstrated below. This routine simply adds up the \ areas of the rectangles. (The term \"areas\" actually only applies for \ functions which are always > 0. If the function is sometimes negative, our \ sum takes into account whether the rectangle is above or below the axis. \ For rectangles below the axis, both we and LeftSum use the negative of the \ area of the rectangle in the sum.)", Evaluatable->False, AspectRatioFixed->True] }], "Text"], Cell[BoxData[ \(LeftSum[g[x], {x, 0, 1}, n]\)], "Input"], Cell["You can do the same thing with right sums.", "Text", Evaluatable->False], Cell[BoxData[{\(Clear[n]\), "\n", RowBox[{ RowBox[{"n", "=", StyleBox["6", FontColor->RGBColor[1, 0, 1]]}], ";"}], "\n", \(Show[RightRectangles[g[x], {x, 0, 1}, n], Axes \[Rule] True, AxesOrigin \[Rule] {0, 0}, DisplayFunction \[Rule] $DisplayFunction];\), "\n", \(RightSum[ g[x], {x, 0, 1}, n]\)}], "Input"], Cell["\<\ Go back and change n to 10, and see what happens to the graphs and \ the values from LeftSum and RightSum.\ \>", "Text"], Cell[TextData[{ "The cell below creates a slide show of LeftRectangles, with n increasing \ from ", StyleBox["5", FontColor->RGBColor[1, 0, 1]], " to ", StyleBox["50", FontColor->RGBColor[1, 0, 1]], " by ", StyleBox["5", FontColor->RGBColor[1, 0, 1]], "'s. ", "To see the animation, evaluate the cell, select the entire collection of \ output graphs, and choose ", StyleBox["Animate Selected Graphics", FontColor->RGBColor[0, 0, 1]], " from the ", StyleBox["Cell", FontColor->RGBColor[0, 0, 1]], " menu item. VCR like controls will appear at the bottom of the notebook \ window so that you can slow (or speed) the animation, pause it, and do other \ operations." }], "Text"], Cell[BoxData[{\(Clear[n]\), "\[IndentingNewLine]", RowBox[{"Animate", "[", RowBox[{\(Show[LeftRectangles[g[x], {x, 0, 1}, n], Axes \[Rule] True, AxesOrigin \[Rule] {0, 0}, DisplayFunction \[Rule] $DisplayFunction]\), ",", RowBox[{"{", RowBox[{"n", ",", StyleBox["5", FontColor->RGBColor[1, 0, 1]], ",", StyleBox["50", FontColor->RGBColor[1, 0, 1]], ",", StyleBox["5", FontColor->RGBColor[1, 0, 1]]}], "}"}]}], "]"}]}], "Input"], Cell["The cell below does the same for RightRectangles.", "Text"], Cell[BoxData[{\(Clear[n]\), "\[IndentingNewLine]", RowBox[{"Animate", "[", RowBox[{\(Show[RightRectangles[g[x], {x, 0, 1}, n], Axes \[Rule] True, AxesOrigin \[Rule] {0, 0}, DisplayFunction \[Rule] $DisplayFunction]\), ",", RowBox[{"{", RowBox[{"n", ",", StyleBox["5", FontColor->RGBColor[1, 0, 1]], ",", StyleBox["50", FontColor->RGBColor[1, 0, 1]], ",", StyleBox["5", FontColor->RGBColor[1, 0, 1]]}], "}"}]}], "]"}]}], "Input"] }, Closed]], Cell[CellGroupData[{ Cell["Size of Errors in Left and Right Sums", "Section"], Cell["\<\ Here is a new function, together with the exact answer for its \ integral from 0 to 4.\ \>", "Text"], Cell[BoxData[{ \(Clear[h, x, exact]\), "\n", \(h[x_] = \@\(25 - x\^2\)\), "\n", \(exact = \[Integral]\_0\%4 h[x] \[DifferentialD]x\)}], "Input", InitializationCell->True], Cell["\<\ Let's look at the errors (differences between the Left and Right \ sums and the exact answer), with n=5 for this function.\ \>", "Text"], Cell[BoxData[{\(Clear[n, ls, rs]\), RowBox[{ RowBox[{"n", "=", StyleBox["5", FontColor->RGBColor[1, 0, 1]]}], ";", "\n", \(ls = LeftSum[h[x], {x, 0, 4}, n]\), ";", "\n", \(rs = RightSum[h[x], {x, 0, 4}, n]\), ";", "\n", \(TableForm[{{ls, rs, N[exact]}, {ls - exact, rs - exact, exact - exact}}, TableSpacing \[Rule] {0, 2}, TableHeadings \[Rule] {{"\", "\"}, {"\", "\", "\"}}]\)}]}], "Input"], Cell["\<\ Let's go back and see what happens as we change n to 50 and then \ 500. What happens to the sizes of the errors each time we increase n by a \ factor of 10?\ \>", "Text"], Cell[BoxData[{\(Clear[n, ls, rs]\), RowBox[{ RowBox[{"n", "=", StyleBox["50", FontColor->RGBColor[1, 0, 1]]}], ";", "\n", \(ls = LeftSum[h[x], {x, 0, 4}, n]\), ";", "\n", \(rs = RightSum[h[x], {x, 0, 4}, n]\), ";", "\n", \(TableForm[{{ls, rs, N[exact]}, {ls - exact, rs - exact, exact - exact}}, TableSpacing \[Rule] {0, 2}, TableHeadings \[Rule] {{"\", "\"}, {"\", "\", "\"}}]\)}]}], "Input"], Cell[BoxData[{\(Clear[n, ls, rs]\), RowBox[{ RowBox[{"n", "=", StyleBox["500", FontColor->RGBColor[1, 0, 1]]}], ";", "\n", \(ls = LeftSum[h[x], {x, 0, 4}, n]\), ";", "\n", \(rs = RightSum[h[x], {x, 0, 4}, n]\), ";", "\n", \(TableForm[{{ls, rs, N[exact]}, {ls - exact, rs - exact, exact - exact}}, TableSpacing \[Rule] {0, 2}, TableHeadings \[Rule] {{"\", "\"}, {"\", "\", "\"}}]\)}]}], "Input"], Cell[TextData[{ "Although we improve our accuracy each time we go up by a factor of 10, it \ seems that it might take quite a few subdivisions before we get anything \ approaching calculator accuracy (8 or more decimal places). For example, \ with n=50 using the function h[x] above, we did not quite get 1 decimal place \ accuracy. (The absolute value of the error was about .08, while we need an \ error whose absolute value is less than .05 for one decimal place accuracy.) \ Each time you increase n, the computation time also goes up. Eventually, \ even fast computers will take a long while to get high accuracy using this \ method. Let's try to estimate how long. We'll also find the error \ (ls-exact). By the way, Timing does not always give exactly the same answer \ each time you run it, so you should evaluate the cell a few times to get it \ to settle down. In addition, it is extremely computer dependent, and depends \ on how much memory is free and on what other programs are running, so make \ sure you are doing all the comparisons at about the same time and in the same \ ", StyleBox["Mathematica", FontSlant->"Italic"], " session.)" }], "Text"], Cell[BoxData[{\(Clear[n]\), RowBox[{ RowBox[{"n", "=", StyleBox["50", FontColor->RGBColor[1, 0, 1]]}], ";", "\n", \(Timing[ls = LeftSum[h[x], {x, 0, 4}, n]]\)}], \(ls - exact\)}], "Input"], Cell[TextData[{ "We can see what the command Timing does by evaluating the next cell. (? \ works with any ", StyleBox["Mathematica", FontSlant->"Italic"], " command to give some information about the command. ?? often gives even \ more information.)" }], "Text"], Cell[BoxData[ \(\(?Timing\)\)], "Input"], Cell["\<\ Do this again, but this time with n=500 and 5000. What seems to \ happen to Timing each time we increase n by a factor of 10?\ \>", "Text"], Cell[BoxData[{\(Clear[n]\), RowBox[{ RowBox[{"n", "=", StyleBox["500", FontColor->RGBColor[1, 0, 1]]}], ";", "\n", \(Timing[ls = LeftSum[h[x], {x, 0, 4}, n]]\)}], \(ls - exact\)}], "Input"], Cell[BoxData[{\(Clear[n]\), RowBox[{ RowBox[{"n", "=", StyleBox["5000", FontColor->RGBColor[1, 0, 1]]}], ";", "\n", \(Timing[ls = LeftSum[h[x], {x, 0, 4}, n]]\)}], \(ls - exact\)}], "Input"], Cell["\<\ We would like to design some other methods that might get our \ desired accuracy more quickly. Since the errors are about the same size, and \ opposite in sign, we might take an average of the left and right sums, and \ hope that the error involves an average of the original errors. Let's give \ this a try.\ \>", "Text"], Cell[BoxData[{\(Clear[n, ls, rs, avg]\), RowBox[{ RowBox[{"n", "=", StyleBox["5", FontColor->RGBColor[1, 0, 1]]}], ";", "\n", \(ls = LeftSum[h[x], {x, 0, 4}, n]\), ";", "\n", \(rs = RightSum[h[x], {x, 0, 4}, n]\), ";", "\n", \(avg = \(ls + rs\)\/2\), ";", "\n", \(TableForm[{{ls, rs, avg, N[exact]}, {ls - exact, rs - exact, avg - exact, exact - exact}}, TableSpacing \[Rule] {0, 2}, TableHeadings \[Rule] {{"\", "\"}, {"\", "\", "\", "\"}}]\)}]}], "Input"], Cell["\<\ Let's do this again, but this time with n=50 and then 500. What \ seems to happen to the error for the average each time we increase n by a \ factor of 10?\ \>", "Text"], Cell[BoxData[{\(Clear[n, ls, rs, avg]\), RowBox[{ RowBox[{"n", "=", StyleBox["50", FontColor->RGBColor[1, 0, 1]]}], ";", "\n", \(ls = LeftSum[h[x], {x, 0, 4}, n]\), ";", "\n", \(rs = RightSum[h[x], {x, 0, 4}, n]\), ";", "\n", \(avg = \(ls + rs\)\/2\), ";", "\n", \(TableForm[{{ls, rs, avg, N[exact]}, {ls - exact, rs - exact, avg - exact, exact - exact}}, TableSpacing \[Rule] {0, 2}, TableHeadings \[Rule] {{"\", "\"}, {"\", "\", "\", "\"}}]\)}]}], "Input"], Cell[BoxData[{\(Clear[n, ls, rs, avg]\), RowBox[{ RowBox[{"n", "=", StyleBox["500", FontColor->RGBColor[1, 0, 1]]}], ";", "\n", \(ls = LeftSum[h[x], {x, 0, 4}, n]\), ";", "\n", \(rs = RightSum[h[x], {x, 0, 4}, n]\), ";", "\n", \(avg = \(ls + rs\)\/2\), ";", "\n", \(TableForm[{{ls, rs, avg, N[exact]}, {ls - exact, rs - exact, avg - exact, exact - exact}}, TableSpacing \[Rule] {0, 2}, TableHeadings \[Rule] {{"\", "\"}, {"\", "\", "\", "\"}}]\)}]}], "Input"], Cell[CellGroupData[{ Cell["Truth in Advertising", "Subsection"], Cell[TextData[ "It is not always the case that the errors from the Left and Right sums are \ opposite in sign. For instance, consider the function Sin[x] on the interval \ [0,\[Pi]]. "], "Text"], Cell[BoxData[ \(\(Show[LeftRectangles[Sin[x], {x, 0, \[Pi]}, 10], Axes \[Rule] True, AxesOrigin \[Rule] {0, 0}, DisplayFunction \[Rule] $DisplayFunction]; \n Show[RightRectangles[Sin[x], {x, 0, \[Pi]}, 10], Axes \[Rule] True, AxesOrigin \[Rule] {0, 0}, DisplayFunction \[Rule] $DisplayFunction]; \n \)\)], "Input"], Cell["\<\ The first graph shows the Left rectangles, and the second shows the \ Right rectangles. Notice that in each case, some of the rectangles are above \ the curve, and some are below the curve.\ \>", "Text"], Cell["Here are Left and Right sums for n=10.", "Text"], Cell[BoxData[{ \(LeftSum[Sin[x], {x, 0, \[Pi]}, 10]\), \(RightSum[Sin[x], {x, 0, \[Pi]}, 10]\)}], "Input"], Cell["\<\ Since they are the same, the errors are the same, and have the same \ sign. (In fact, the exact answer is 2, and both errors are negative.)\ \>", "Text"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["The Trapezoidal Approximation", "Section", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[{ StyleBox[ "The \"average\" approximation we created in the last section \ geometrically amounts to approximating areas using trapezoids. There is a \ routine for doing this directly with ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Mathematica", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox[ " using the TrapSum routine. Let's check its answer against the last one \ we got in the previous section.", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False], Cell[BoxData[ \(TrapSum[h[x], {x, 0, 4}, n]\)], "Input"], Cell["\<\ We can create a picture showing the trapezoids. We can change the \ number in magenta to increase the number of trapezoids we draw. The cell \ also gives the approximation using that number of trapezoids.\ \>", "Text"], Cell[BoxData[{\(Clear[n]\), "\n", RowBox[{ RowBox[{"n", "=", StyleBox["3", FontColor->RGBColor[1, 0, 1]]}], ";", "\n", \(Show[Trapezoids[h[x], {x, 0, 4}, n], Axes \[Rule] True, AxesOrigin \[Rule] {0, 0}, DisplayFunction \[Rule] $DisplayFunction]\), ";", "\n", \(TrapSum[h[x], {x, 0, 4}, n]\)}]}], "Input"], Cell["\<\ For a function that is concave down, does the Trapezoidal \ approximation give underestimates, or overestimates? What about a concave up \ function?\ \>", "Text", Evaluatable->False], Cell[TextData[{ "The cell below creates a slide show of Trapezoids, with n increasing from \ ", StyleBox["1", FontColor->RGBColor[1, 0, 1]], " to ", StyleBox["8", FontColor->RGBColor[1, 0, 1]], " by ", StyleBox["1", FontColor->RGBColor[1, 0, 1]], "'s. To see the animation, evaluate the cell, select the entire collection \ of output graphs, and choose ", StyleBox["Animate Selected Graphics", FontColor->RGBColor[0, 0, 1]], " from the ", StyleBox["Cell", FontColor->RGBColor[0, 0, 1]], " menu item. VCR like controls will appear at the bottom of the notebook \ window so that you can slow (or speed) the animation, pause it, and do other \ operations." }], "Text"], Cell[BoxData[{\(Clear[n]\), "\[IndentingNewLine]", RowBox[{"Animate", "[", RowBox[{\(Show[Trapezoids[h[x], {x, 0, 4}, n], Axes \[Rule] True, AxesOrigin \[Rule] {0, 0}, DisplayFunction \[Rule] $DisplayFunction]\), ",", RowBox[{"{", RowBox[{"n", ",", StyleBox["1", FontColor->RGBColor[1, 0, 1]], ",", StyleBox["8", FontColor->RGBColor[1, 0, 1]], ",", StyleBox["1", FontColor->RGBColor[1, 0, 1]]}], "}"}]}], "]"}]}], "Input"] }, Closed]], Cell[CellGroupData[{ Cell["The Midpoint Approximation", "Section", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[{ StyleBox[ "There is another way to obtain approximations of definite integrals using \ rectangles, and that is to evaluate the integrand at the midpoint of each \ subinterval, rather than at one of the ends. ", Evaluatable->False, AspectRatioFixed->True], " Show together with the routine MidRectangles draws the relevant picture." }], "Text", Evaluatable->False], Cell[BoxData[{ \(Clear[n]\), \(n = 6; \n Show[MidRectangles[h[x], {x, 0, 4}, n], Axes \[Rule] True, AxesOrigin \[Rule] {0, 0}, DisplayFunction \[Rule] $DisplayFunction]; \)}], "Input"], Cell[TextData[{ "... and", StyleBox[" the ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Mathematica", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox[" routine MidSum finds the approximation:", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False], Cell[BoxData[ \(MidSum[h[x], {x, 0, 4}, n]\)], "Input"], Cell[TextData[{ "The cell below creates a slide show of MidRectangles, with n increasing \ from ", StyleBox["5", FontColor->RGBColor[1, 0, 1]], " to ", StyleBox["50", FontColor->RGBColor[1, 0, 1]], " by ", StyleBox["5", FontColor->RGBColor[1, 0, 1]], "'s. To see the animation, evaluate the cell, select the entire collection \ of output graphs, and choose ", StyleBox["Animate Selected Graphics", FontColor->RGBColor[0, 0, 1]], " from the ", StyleBox["Cell", FontColor->RGBColor[0, 0, 1]], " menu item. VCR like controls will appear at the bottom of the notebook \ window so that you can slow (or speed) the animation, pause it, and do other \ operations." }], "Text"], Cell[BoxData[{\(Clear[n]\), "\[IndentingNewLine]", RowBox[{"Animate", "[", RowBox[{\(Show[MidRectangles[h[x], {x, 0, 4}, n], Axes \[Rule] True, AxesOrigin \[Rule] {0, 0}, DisplayFunction \[Rule] $DisplayFunction]\), ",", RowBox[{"{", RowBox[{"n", ",", StyleBox["5", FontColor->RGBColor[1, 0, 1]], ",", StyleBox["50", FontColor->RGBColor[1, 0, 1]], ",", StyleBox["5", FontColor->RGBColor[1, 0, 1]]}], "}"}]}], "]"}]}], "Input"], Cell[CellGroupData[{ Cell["By the way...", "Subsubsection"], Cell["\<\ For the Trapezoidal approximation, you were able to tell (question \ (b) in that section) whether the sum was an under or over estimate for the \ actual answer if the function was concave down. Similarly, we can show that \ the Midpoint sum overestimates the actual integral if the function is concave \ down and underestimates the actual integral if the function is concave up, \ but this is a little harder than showing what happens with the Trapezoidal \ Approximation.\ \>", "Text"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Size of Errors in Trapezoidal and Midpoint Sums", "Section"], Cell["\<\ Once again, here is our h[x] from above, together with the exact \ answer for its integral from 0 to 4.\ \>", "Text"], Cell[BoxData[{ \(h[x]\), \(exact\)}], "Input"], Cell["\<\ Let's look at the errors (differences between the sums we have \ calculated and the exact answer), with n=5.\ \>", "Text"], Cell[BoxData[{\(Clear[n, ls, rs, ts, ms]\), RowBox[{ RowBox[{"n", "=", StyleBox["5", FontColor->RGBColor[1, 0, 1]]}], ";", "\n", \(ls = LeftSum[h[x], {x, 0, 4}, n]\), ";", "\n", \(rs = RightSum[h[x], {x, 0, 4}, n]\), ";", "\n", \(ts = TrapSum[h[x], {x, 0, 4}, n]\), ";", "\n", \(ms = MidSum[h[x], {x, 0, 4}, n]\), ";", "\n", \(TableForm[{{ls, rs, ts, ms, N[exact]}, {ls - exact, rs - exact, ts - exact, ms - exact, exact - exact}}, TableSpacing \[Rule] {0, 2}, TableHeadings \[Rule] {{"\", "\"}, {"\", "\", "\", "\", "\"}}] \)}]}], "Input"], Cell["\<\ Look at the errors in the Trapezoidal and Midpoint Sums. Are they \ opposite in sign? Are they approximately a multiple of each other?\ \>", "Text"], Cell["\<\ Let's do this again, but this time with n=50, and then 500. What \ happens to the size of these errors each time we increase n by a factor of \ 10?\ \>", "Text"], Cell[BoxData[{\(Clear[n, ls, rs, ts, ms]\), RowBox[{ RowBox[{"n", "=", StyleBox["50", FontColor->RGBColor[1, 0, 1]]}], ";", "\n", \(ls = LeftSum[h[x], {x, 0, 4}, n]\), ";", "\n", \(rs = RightSum[h[x], {x, 0, 4}, n]\), ";", "\n", \(ts = TrapSum[h[x], {x, 0, 4}, n]\), ";", "\n", \(ms = MidSum[h[x], {x, 0, 4}, n]\), ";", "\n", \(TableForm[{{ls, rs, ts, ms, N[exact]}, {ls - exact, rs - exact, ts - exact, ms - exact, exact - exact}}, TableSpacing \[Rule] {0, 2}, TableHeadings \[Rule] {{"\", "\"}, {"\", "\", "\", "\", "\"}}] \)}]}], "Input"], Cell[BoxData[{\(Clear[n, ls, rs, ts, ms]\), RowBox[{ RowBox[{"n", "=", StyleBox["500", FontColor->RGBColor[1, 0, 1]]}], ";", "\n", \(ls = LeftSum[h[x], {x, 0, 4}, n]\), ";", "\n", \(rs = RightSum[h[x], {x, 0, 4}, n]\), ";", "\n", \(ts = TrapSum[h[x], {x, 0, 4}, n]\), ";", "\n", \(ms = MidSum[h[x], {x, 0, 4}, n]\), ";", "\n", \(TableForm[{{ls, rs, ts, ms, N[exact]}, {ls - exact, rs - exact, ts - exact, ms - exact, exact - exact}}, TableSpacing \[Rule] {0, 2}, TableHeadings \[Rule] {{"\", "\"}, {"\", "\", "\", "\", "\"}}] \)}]}], "Input"], Cell["\<\ Although we improve our accuracy each time we go up by a factor of \ 10, it seems that it might once again take quite a few subdivisions before we \ get anything approaching calculator accuracy (8 or more decimal places). For \ example, with n=50 using the function h[x] above, we got 3 decimal place \ accuracy. (The absolute value of the error was about .00036, and we only \ need an error whose absolute value is less than .0005 for three decimal \ place accuracy.) Again, each time you increase n, the computation time also \ goes up. Eventually, even fast computers will take a long while to get very \ high accuracy using this method. Let's try to estimate how long. We'll also \ compute the error (ms-exact).\ \>", "Text"], Cell[BoxData[{\(Clear[n]\), RowBox[{ RowBox[{"n", "=", StyleBox["50", FontColor->RGBColor[1, 0, 1]]}], ";", "\n", \(Timing[ms = MidSum[h[x], {x, 0, 4}, n]]\)}], \(ms - exact\)}], "Input"], Cell["\<\ Do this again, but this time with n=500 and 5000. What seems to \ happen to Timing each time we increase n by a factor of 10? How does the \ timing here compare with that for LeftSum with the same number of \ subdivisions?\ \>", "Text"], Cell[BoxData[{\(Clear[n]\), RowBox[{ RowBox[{"n", "=", StyleBox["500", FontColor->RGBColor[1, 0, 1]]}], ";", "\n", \(Timing[ms = MidSum[h[x], {x, 0, 4}, n]]\)}], \(ms - exact\)}], "Input"], Cell[BoxData[{\(Clear[n]\), RowBox[{ RowBox[{"n", "=", StyleBox["5000", FontColor->RGBColor[1, 0, 1]]}], ";", "\n", \(Timing[ms = MidSum[h[x], {x, 0, 4}, n]]\)}], \(ms - exact\)}], "Input"], Cell[TextData[{ "You should have noticed that the error in the Trapezoidal Sum was about \ double the error in the Midpoint Sum, and opposite in sign. This might lead \ us to try and take a \"weighted\" average of the Trapezoidal and Midpoint \ sums, and hope that the error becomes much smaller. Let's give this a try. \ You will need to average one or more Midpoint Sums with the Trapezoidal Sum \ to get a much smaller error. Replace ", StyleBox["xx", FontColor->RGBColor[1, 0, 1]], " with the number of Midpoint Sums you think it will take." }], "Text"], Cell[BoxData[{\(Clear[n, ts, ms, m, wavg]\), "\n", RowBox[{ RowBox[{"n", "=", StyleBox["5", FontColor->RGBColor[1, 0, 1]]}], ";", "\n", \(ts = TrapSum[h[x], {x, 0, 4}, n]\), ";"}], "\n", \(ms = MidSum[h[x], {x, 0, 4}, n];\), "\n", RowBox[{ RowBox[{"m", "=", StyleBox["xxx", FontColor->RGBColor[1, 0, 1]]}], ";"}], "\n", \(wavg = \(ts + m\ ms\)\/\(1 + m\);\), "\n", \ \(TableForm[{{ts, ms, wavg, N[exact]}, {ts - exact, ms - exact, wavg - exact, exact - exact}}, TableSpacing \[Rule] {0, 2}, TableHeadings \[Rule] {{"\", "\"}, {"\", \ "\", "\", "\"}}]\)}], "Input"], Cell["\<\ How does the error here compare to the errors using the Midpoint \ and Trapezoidal sums?\ \>", "Text"], Cell["\<\ Do this again, but this time with n=50 and then 500. What seems to \ happen to the error for the average each time we increase n by a factor of \ 10? (We will use the same m as above.)\ \>", "Text"], Cell[BoxData[{\(Clear[n, ts, ms, wavg]\), RowBox[{ RowBox[{"n", "=", StyleBox["50", FontColor->RGBColor[1, 0, 1]]}], ";", "\n", \(ts = TrapSum[h[x], {x, 0, 4}, n]\), ";", "\n", \(ms = MidSum[h[x], {x, 0, 4}, n]\), ";", "\n", \(wavg = \(ts + m\ ms\)\/\(1 + m\)\), ";", "\n", \(TableForm[{{ts, ms, wavg, N[exact]}, {ts - exact, ms - exact, wavg - exact, exact - exact}}, TableSpacing \[Rule] {0, 2}, TableHeadings \[Rule] {{"\", "\"}, {"\", "\", "\", "\"}}]\)}]}], "Input"], Cell[BoxData[{\(Clear[n, ts, ms, wavg]\), RowBox[{ RowBox[{"n", "=", StyleBox["500", FontColor->RGBColor[1, 0, 1]]}], ";", "\n", \(ts = TrapSum[h[x], {x, 0, 4}, n]\), ";", "\n", \(ms = MidSum[h[x], {x, 0, 4}, n]\), ";", "\n", \(wavg = \(ts + m\ ms\)\/\(1 + m\)\), ";", "\n", \(TableForm[{{ts, ms, wavg, N[exact]}, {ts - exact, ms - exact, wavg - exact, exact - exact}}, TableSpacing \[Rule] {0, 2}, TableHeadings \[Rule] {{"\", "\"}, {"\", "\", "\", "\"}}]\)}]}], "Input"] }, Closed]], Cell[CellGroupData[{ Cell["Simpson's Rule", "Section", Evaluatable->False, AspectRatioFixed->True], Cell["\<\ If you made the correct choice for m in the section above, you \ \"invented\" Simpson's Rule. There is a routine for doing this directly, \ without using weighted averages.\ \>", "Text"], Cell[BoxData[ \(Simpson[h[x], {x, 0, 4}, n]\)], "Input"], Cell["\<\ You can check your value for m by evaluating the next cell, which \ uses your weighted average together with the routine that evaluates Simpson's \ Rule directly. If the approximation under \"Simpson\" is not the same as you \ got for \"WAverage,\" you should go back and adjust your choice for m in the \ previous section.\ \>", "Text"], Cell[BoxData[{\(Clear[n, ts, ms, wavg, simp]\), RowBox[{ RowBox[{"n", "=", StyleBox["5", FontColor->RGBColor[1, 0, 1]]}], ";", "\n", \(ts = TrapSum[h[x], {x, 0, 4}, n]\), ";", "\n", \(ms = MidSum[h[x], {x, 0, 4}, n]\), ";", "\n", \(wavg = \(ts + m\ ms\)\/\(1 + m\)\), ";", "\n", \(simp = Simpson[h[x], {x, 0, 4}, n]\), ";", "\n", \(TableForm[{{wavg, simp, N[exact]}, {wavg - exact, simp - exact, exact - exact}}, TableSpacing \[Rule] {0, 2}, TableHeadings \[Rule] {{"\", "\"}, {"\", "\", "\"}}]\)}]}], "Input"], Cell["\<\ With Simpson, each time we increase n by a factor of 10, we get a \ much higher improvement in our approximation in comparison with the other \ methods. For example, with just n=5 using the function h[x] above, we got 3 \ decimal place accuracy, while the midpoint rule needed n=50. Let's once \ again look at how long it will take to get various accuracies. We'll also \ compute the error (simp-exact).\ \>", "Text"], Cell[BoxData[{\(Clear[n]\), RowBox[{ RowBox[{"n", "=", StyleBox["50", FontColor->RGBColor[1, 0, 1]]}], ";", "\n", \(Timing[simp = Simpson[h[x], {x, 0, 4}, n]]\)}], \(simp - exact\)}], "Input"], Cell["\<\ Do this again, but this time with n=500. Does it seem to take \ about the same amount of time, more time, or less time when using Simpson \ with the same number of subdivisions as MidSum (our second most accurate \ method for this integral)? Compare both the time it takes and the number of \ decimal place accuracy we get using 500 subdivisions in Simpson to using 500 \ subdivisions in MidSum.\ \>", "Text"], Cell[BoxData[{\(Clear[n]\), RowBox[{ RowBox[{"n", "=", StyleBox["500", FontColor->RGBColor[1, 0, 1]]}], ";", "\n", \(Timing[simp = Simpson[h[x], {x, 0, 4}, n]]\)}], \(simp - exact\)}], "Input"], Cell[BoxData[{\(Clear[n]\), RowBox[{ RowBox[{"n", "=", StyleBox["500", FontColor->RGBColor[1, 0, 1]]}], ";", "\n", \(Timing[mid = MidSum[h[x], {x, 0, 4}, n]]\)}], \(mid - exact\)}], "Input"], Cell[BoxData[{\(Clear[n]\), RowBox[{ RowBox[{"n", "=", StyleBox["5000", FontColor->RGBColor[1, 0, 1]]}], ";", "\n", \(Timing[simp = Simpson[h[x], {x, 0, 4}, n]]\)}], \(simp - exact\)}], "Input"], Cell[BoxData[{\(Clear[n]\), RowBox[{ RowBox[{"n", "=", StyleBox["5000", FontColor->RGBColor[1, 0, 1]]}], ";", "\n", \(Timing[mid = MidSum[h[x], {x, 0, 4}, n]]\)}], \(mid - exact\)}], "Input"] }, Closed]], Cell[CellGroupData[{ Cell["Built-in routines", "Section"], Cell[TextData[{ StyleBox["Mathematica", FontSlant->"Italic"], " has a built-in routine which computes integrals numerically. Here it is \ in action." }], "Text"], Cell[BoxData[ \(NIntegrate[h[x], {x, 0, 4}]\)], "Input"], Cell[TextData[{ "This routine is more advanced than any of the ones we discussed above. \ For one thing, it is adaptive, meaning it computes the number of subdivisions \ recursively as it tries to approximate the integral, based on the requested \ accuracy. The ", StyleBox["Mathematica", FontSlant->"Italic"], " documentation does not indicate what method the routine is implementing." }], "Text"], Cell[BoxData[ \(?? NIntegrate\)], "Input"], Cell["\<\ Many TI calculators (among other brands) have a numerical \ integration technique built into them. Check the documentation on your \ calculator to see if it has numerical integration capabilities.\ \>", "Text"] }, Closed]] }, Open ]] }, FrontEndVersion->"4.2 for Microsoft Windows", ScreenRectangle->{{0, 1024}, {0, 723}}, AutoGeneratedPackage->None, WindowToolbars->"EditBar", WindowSize->{569, 482}, WindowMargins->{{2, Automatic}, {Automatic, 0}} ] (******************************************************************* 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[1776, 53, 163, 5, 131, "Title", Evaluatable->False], Cell[1942, 60, 252, 5, 44, "SmallText"], Cell[2197, 67, 579, 10, 109, "Text", Evaluatable->False], Cell[2779, 79, 328, 9, 52, "Text"], Cell[CellGroupData[{ Cell[3132, 92, 142, 4, 43, "Subsubsection", Evaluatable->False], Cell[3277, 98, 88, 3, 33, "Text"], Cell[3368, 103, 93, 2, 30, "Input", InitializationCell->True], Cell[3464, 107, 113, 3, 33, "Text"], Cell[3580, 112, 17182, 328, 4125, "Input", InitializationCell->True] }, Closed]], Cell[CellGroupData[{ Cell[20799, 445, 101, 2, 39, "Section", Evaluatable->False], Cell[20903, 449, 394, 7, 90, "Text", Evaluatable->False], Cell[21300, 458, 121, 3, 73, "Input", InitializationCell->True], Cell[21424, 463, 185, 6, 33, "Text"], Cell[21612, 471, 73, 1, 42, "Input"], Cell[21688, 474, 51, 0, 33, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[21776, 479, 86, 2, 39, "Section", Evaluatable->False], Cell[21865, 483, 117, 4, 33, "Text", Evaluatable->False], Cell[21985, 489, 86, 1, 30, "Input"], Cell[22074, 492, 1660, 46, 128, "Text", Evaluatable->False], Cell[23737, 540, 321, 7, 90, "Input"], Cell[24061, 549, 797, 19, 109, "Text"], Cell[24861, 570, 60, 1, 30, "Input"], Cell[24924, 573, 80, 1, 33, "Text", Evaluatable->False], Cell[25007, 576, 369, 8, 110, "Input"], Cell[25379, 586, 130, 3, 52, "Text"], Cell[25512, 591, 722, 22, 90, "Text"], Cell[26237, 615, 562, 12, 90, "Input"], Cell[26802, 629, 65, 0, 33, "Text"], Cell[26870, 631, 563, 12, 90, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[27470, 648, 56, 0, 39, "Section"], Cell[27529, 650, 110, 3, 33, "Text"], Cell[27642, 655, 186, 4, 86, "Input", InitializationCell->True], Cell[27831, 661, 146, 3, 52, "Text"], Cell[27980, 666, 541, 11, 170, "Input"], Cell[28524, 679, 181, 4, 52, "Text"], Cell[28708, 685, 542, 11, 170, "Input"], Cell[29253, 698, 543, 11, 170, "Input"], Cell[29799, 711, 1182, 19, 223, "Text"], Cell[30984, 732, 228, 6, 90, "Input"], Cell[31215, 740, 274, 7, 52, "Text"], Cell[31492, 749, 44, 1, 30, "Input"], Cell[31539, 752, 150, 3, 52, "Text"], Cell[31692, 757, 229, 6, 90, "Input"], Cell[31924, 765, 230, 6, 90, "Input"], Cell[32157, 773, 334, 6, 71, "Text"], Cell[32494, 781, 623, 12, 224, "Input"], Cell[33120, 795, 180, 4, 52, "Text"], Cell[33303, 801, 624, 12, 224, "Input"], Cell[33930, 815, 625, 12, 224, "Input"], Cell[CellGroupData[{ Cell[34580, 831, 42, 0, 47, "Subsection"], Cell[34625, 833, 196, 3, 52, "Text"], Cell[34824, 838, 340, 5, 110, "Input"], Cell[35167, 845, 214, 4, 52, "Text"], Cell[35384, 851, 54, 0, 33, "Text"], Cell[35441, 853, 115, 2, 50, "Input"], Cell[35559, 857, 167, 4, 52, "Text"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[35775, 867, 96, 2, 39, "Section", Evaluatable->False], Cell[35874, 871, 580, 17, 71, "Text", Evaluatable->False], Cell[36457, 890, 60, 1, 30, "Input"], Cell[36520, 893, 230, 4, 52, "Text"], Cell[36753, 899, 367, 8, 110, "Input"], Cell[37123, 909, 195, 5, 52, "Text", Evaluatable->False], Cell[37321, 916, 711, 21, 90, "Text"], Cell[38035, 939, 557, 12, 90, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[38629, 956, 93, 2, 39, "Section", Evaluatable->False], Cell[38725, 960, 395, 9, 71, "Text", Evaluatable->False], Cell[39123, 971, 209, 5, 90, "Input"], Cell[39335, 978, 347, 13, 33, "Text", Evaluatable->False], Cell[39685, 993, 59, 1, 30, "Input"], Cell[39747, 996, 715, 21, 90, "Text"], Cell[40465, 1019, 561, 12, 90, "Input"], Cell[CellGroupData[{ Cell[41051, 1035, 38, 0, 43, "Subsubsection"], Cell[41092, 1037, 497, 8, 109, "Text"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[41638, 1051, 66, 0, 39, "Section"], Cell[41707, 1053, 127, 3, 33, "Text"], Cell[41837, 1058, 55, 2, 50, "Input"], Cell[41895, 1062, 132, 3, 33, "Text"], Cell[42030, 1067, 745, 15, 230, "Input"], Cell[42778, 1084, 163, 4, 52, "Text"], Cell[42944, 1090, 172, 4, 52, "Text"], Cell[43119, 1096, 746, 15, 230, "Input"], Cell[43868, 1113, 747, 15, 230, "Input"], Cell[44618, 1130, 746, 11, 147, "Text"], Cell[45367, 1143, 224, 5, 90, "Input"], Cell[45594, 1150, 248, 5, 71, "Text"], Cell[45845, 1157, 225, 5, 90, "Input"], Cell[46073, 1164, 226, 5, 90, "Input"], Cell[46302, 1171, 572, 10, 109, "Text"], Cell[46877, 1183, 734, 15, 244, "Input"], Cell[47614, 1200, 112, 3, 33, "Text"], Cell[47729, 1205, 210, 4, 52, "Text"], Cell[47942, 1211, 651, 13, 224, "Input"], Cell[48596, 1226, 652, 13, 224, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[49285, 1244, 81, 2, 39, "Section", Evaluatable->False], Cell[49369, 1248, 197, 4, 52, "Text"], Cell[49569, 1254, 60, 1, 30, "Input"], Cell[49632, 1257, 349, 6, 90, "Text"], Cell[49984, 1265, 679, 13, 224, "Input"], Cell[50666, 1280, 430, 7, 90, "Text"], Cell[51099, 1289, 232, 6, 90, "Input"], Cell[51334, 1297, 421, 7, 90, "Text"], Cell[51758, 1306, 233, 6, 90, "Input"], Cell[51994, 1314, 230, 6, 90, "Input"], Cell[52227, 1322, 234, 6, 90, "Input"], Cell[52464, 1330, 231, 6, 90, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[52732, 1341, 36, 0, 39, "Section"], Cell[52771, 1343, 170, 5, 33, "Text"], Cell[52944, 1350, 60, 1, 30, "Input"], Cell[53007, 1353, 410, 8, 90, "Text"], Cell[53420, 1363, 46, 1, 30, "Input"], Cell[53469, 1366, 221, 4, 52, "Text"] }, Closed]] }, Open ]] } ] *) (******************************************************************* End of Mathematica Notebook file. *******************************************************************)