Riemann Sums

LeftValue[f_,{x_,a_,b_}]:=N[f/.x->a];
MidpointValue[f_,{x_,a_,b_}]:=N[f/.x->(a+b)/2];
RightValue[f_,{x_,a_,b_}]:=N[f/.x->b];
Sample[f_,{x_,a_,b_},type_] :={LeftValue[f,{x,a,b}], MidpointValue[f,{x,a,b}],RightValue[f,{x,a,b}] }[[type]];
BlockCoords[a_,b_,h_]:={{a,0},{a,h},{b,h},{b,0}};
IsReal[x_]:=Module[{},If[!NumericQ[x]||Im[x]≠0,Throw["One or more samples are outside the domain."]];x];

FunctionF[x_]:= {x,x^2 ,x -3,Log[x+1],(1-x)^2, Abs[x-5],Cos[x],Sqrt[Abs[x-1]]};

FunctionText ={"x","(x^2)","x - 3","log( x + 1 )","( 1 - x )^2", "\[LeftBracketingBar] x - 5 \[RightBracketingBar]","cos( x )","\!\(\*SqrtBox[\(\[LeftBracketingBar]\\ x - 1\[RightBracketingBar]\)]\)"};

FunctionButtons =Map[#[[1]]-> #[[2]]&,Transpose[{Range[Length[FunctionText]],FunctionText}]];

RiemannBlocks[f_,{x_,a_,b_,n_},type_]:=Plot[f,{x,a,b},PlotRange->{{0,10},Module[{fmin,fmax},{fmin,fmax}=AbsoluteOptions[Plot[f,{x,0,10},PlotRange->Automatic],PlotRange][[1,2,2]];{Min[0,fmin],fmax}]},Prolog-> Table[({{GrayLevel[0.8],Polygon[#1]},Line[Append[#1,#1[[1]]]]}&)[(BlockCoords[#1,#2,Sample[f,{x,#1,#2},type]]&)[a+i*((b-a)/n),a+(i+1)*((b-a)/n)]],{i,0,n-1}],
ImagePadding->{{25,25},{25,50}},
PlotLabel -> "estimated area = "<>ToString[NumberForm[(b-a)*(Sum[IsReal[Sample[f,
{x,a+i*((b-a)/n),a+(i+1)*((b-a)/n)},type]],{i,0,n-1}]/n),{7,4},NumberPadding->{"","0"}]]
<>"\n"<>"actual area = "<>ToString[NumberForm[Check[Chop[NIntegrate[f,{x,a,b},AccuracyGoal->12]],I],{7,4},NumberPadding->{"","0"}]]]

Manipulate[If[start≥end,start=end-.01];RiemannBlocks[FunctionF[x][[fff]],{x,start,end,blocks},type],{{start,0,"Start"},0,10,.1,Appearance->"Labeled"},{{end,10,"End"},0,10,.1,Appearance->"Labeled"},{{blocks,5,"number of rectangles"},4,70,1,Appearance->"Labeled"},{{type,1,"height"},{1->"left",2->"midpoint",3->"right"}},{{fff,2,"function"},FunctionButtons,ControlType->Setter},SaveDefinitions-> True]

THIS NOTEBOOK IS THE SOURCE CODE FROM

"Riemann Sums" from The Wolfram Demonstrations Project
 http://demonstrations.wolfram.com/RiemannSums/

Contributed by: Ed Pegg Jr

A full-function Wolfram Mathematica 6 system is required to edit or run this notebook.
(Mathematica Player runs only Demonstrations published on this site.)
GET WOLFRAM MATHEMATICA 6 »

© The Wolfram Demonstrations Project & Contributors   |   Terms of Use   |   Make a new version of this Demonstration »