Riemann Sum

Author

Eric W. Weisstein
March 5, 2012

This notebook downloaded from http://mathworld.wolfram.com/notebooks/Calculus/RiemannSum.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/RiemannSum.html.

©2012 Wolfram Research, Inc. except for portions noted otherwise

Code

(*Riemann Sum Package Creates plots of functions together with rectangles used for Riemann sums.June 8,2004:John Renze May 13,2010:Fixed and updated for V6+Eric Weisstein*)BeginPackage["RiemannSum`",{"Utilities`FilterOptions`"}]

RiemannBlocks::usage="RiemannBlocks[...]"

RiemannSumPlot::usage="RiemannSumPlot[f, {x, a, b, n}] plots the rectangles for the Riemann sum \ 
of f[x] between x=a and x=b with n subdivisions.  The option SamplingFunction specifies which sampling point determines the height of the rectangle.  Currently implemented choices are \ 
maxValue, minValue, LeftValue, RightValue, and MidpointValue.  ShowEstimate -> True prints the estimated and actual areas under the curve."

RiemannSum::usage="RiemannSum[f, {x, a, b, n}] returns the estimate given by the Riemann sum of f[x] between x=a and x=b with n subdivisions.  The option SamplingFunction specifies which sampling point determines the height of the rectangle.  Currently implemented choices are \ 
maxValue, minValue, LeftValue, RightValue, and MidpointValue."

MinimumValue::usage=""
MaximumValue::usage=""
LeftValue::usage=""
RightValue::usage=""
MidpointValue::usage=""

SamplingFunction::usage=""
RectangleStyle::usage=""
ShowEstimate::usage=""

Options[RiemannSumPlot]={ShowEstimate->True,AxesOrigin->{Automatic,0},PlotStyle->Red,PlotRange->All,Sequence@@Options[Plot]};
Options[RiemannBlocks]={SamplingFunction->MidpointValue,RectangleStyle->GrayLevel[0.5]};
Options[RiemannSum]={SamplingFunction->MidpointValue};

Begin["Private`"]

MinimumValue[f_,{x_,a_,b_}]:=NMinimize[{f,a≤x≤b},x][[1]]
MaximumValue[f_,{x_,a_,b_}]:=-MinimumValue[-f,{x,a,b}]
LeftValue[f_,{x_,a_,b_}]:=N[f/.x->a]
RightValue[f_,{x_,a_,b_}]:=N[f/.x->b]
MidpointValue[f_,{x_,a_,b_}]:=N[f/.x->(a+b)/2]

BlockCoords[a_,b_,h_]:={{a,0},{a,h},{b,h},{b,0}}
RiemannBlocks[f_,{x_,a_,b_,n_},opts___]:=Module[{sample=Evaluate[SamplingFunction/.{opts}/.Options[RiemannBlocks]],rectstyle=Evaluate[RectangleStyle/.{opts}/.Options[RiemannBlocks]]},Module[{i},Table[({{rectstyle,Polygon[#1]},Line[Append[#1,#1[[1]]]]}&)[(BlockCoords[#1,#2,sample[f,{x,#1,#2}]]&)[a+i*((b-a)/n),a+(i+1)*((b-a)/n)]],{i,0,n-1}]]]

IsReal[x_]:=Module[{},If[!NumericQ[x]||Im[x]≠0,Throw["One or more samples are outside the domain."]];x]

RiemannSum[f_,{x_,a_,b_,n_},opts___]:=Module[{sample=Evaluate[SamplingFunction/.{opts}/.Options[RiemannSum]],i},(b-a)*(Sum[IsReal[sample[f,{x,a+i*((b-a)/n),a+(i+1)*((b-a)/n)}]],{i,0,n-1}]/n)]

RiemannSumPlot[f_,{x_,a_,b_,n_},opts___]:=Module[{graphopts=FilterOptions[Graphics,opts,Options[RiemannSumPlot]],plotopts=FilterOptions[Plot,opts,Options[RiemannSumPlot]],blockopts=FilterOptions[RiemannBlocks,opts,Options[RiemannBlocks]],labelopts=FilterOptions[RiemannSum,opts,Options[RiemannSum]],estimate=ShowEstimate/.{opts}/.Options[RiemannSumPlot],estimatedmessage,actual,actualmessage,functionplot,newbounds},functionplot=Plot[f,{x,a,b},Evaluate[plotopts]];
newbounds={Min[0,#[[1]]],Max[0,#[[2]]]}&[FullOptions[functionplot,PlotRange][[2]]];
If[estimate,newbounds={#[[1]]-0.2(#[[2]]-#[[1]]),#[[2]]}&[newbounds];
estimatedmessage=Catch["Estimated Area = "<>ToString[TraditionalForm[Chop[RiemannSum[f,{x,a,b,n},labelopts]]]]];
actual=Check[Chop[NIntegrate[f,{x,a,b},AccuracyGoal->12]],I];
actualmessage=If[Im[actual]==0,"   Actual Area = "<>ToString[TraditionalForm[actual]],"Unable to compute actual area."]];
Show[Graphics[RiemannBlocks[f,{x,a,b,n},blockopts]],functionplot,Graphics[If[estimate,Text[estimatedmessage<>"\n"<>actualmessage,Scaled[{0.5,0}],{0,-.9},Background->LightYellow],{}]],PlotRange->newbounds,AxesLabel->{x,f},Method->{"AxesInFront"->False},Evaluate[graphopts]]]

End[]

EndPackage[]

Figure

RiemannSumPlot[x^4-3x^2+1,{x,-1,1.9,29},ShowEstimate->False]