The Riemann Sum

NOTE: I do NOT expect you to be able to understand all of the Mathematica commands we are using here. I have created this notebook for two purposes. 

First, to easily show you the procedure we are using, and the graphs of the rectangles which are being used to approximate the areas. Everything that is done in this notebook is something that for simple functions you should be able to reproduce by hand. As always--the procedure is the important thing, NOT the final answer. 

Second, this notebook shows you the power of Mathematica, and that time spent learning how to make Mathematica do something for you will pay off in the future.

Needs["Graphics`FilledPlot`"];

Consider the function and endpoints given below

f[x_]  =  x^2
b  =  1
a  =  0

We want to find the area under the curve, which is the shaded area in the graph below

FilledPlot[f[x], {x, a, b}]

This area must be greater than 0, but less than 1. It has to be less than one since it only partially fills a square of side 1. We can get better approximations by using rectangles. This will lead us to the right, midpoint, and left Riemann sum (see your class notes):

Sum[f[a + (b - a)/n*i], {i, 1, n}]

R[n_]  =  (b - a)/n  Sum[
          f[a + (b - a)/n*i], {i, 1, n}]
M[n_]  =  (b - a)/n  Sum[
          f[a + (b - a)/(2  n)*(2  i + 1)], {i, 0, 
            n - 1}]
L[n_]  =  (b - a)/n  Sum[
          f[a + (b - a)/n*i], {i, 0, n - 1}]

The area under the graph is found by taking the limits of any of the Riemann sums as n -> ∞. In the table below, we see that as n get large (which means the widths of the rectangles gets smaller), the Riemann sums approach a common value.

TableForm[
      Table[{i, N[L[i]], N[M[i]], N[R[i]]}, {i, 100, 2000, 300}]]

Using Mathematica or our Limit Laws, we are able to find the area under the curve.

Limit[R[n], n -> Infinity]

Limit[M[n], n -> Infinity]

Limit[L[n], n -> Infinity]

We can do this, in principle, for any function and endpoints:

f[x_]  =  x^3  +  2
b  =  2
a  =  -1

R[n_]  =  (b - a)/n  Sum[
          f[a + (b - a)/n*i], {i, 1, n}]
M[n_]  =  (b - a)/n  Sum[
          f[a + (b - a)/(2  n)*(2  i + 1)], {i, 0, 
            n - 1}]
L[n_]  =  (b - a)/n  Sum[
          f[a + (b - a)/n*i], {i, 0, n - 1}]

TableForm[
      Table[{i, N[L[i]], N[M[i]], N[R[i]]}, {i, 100, 20000, 
          2000}]]

Note that the midpoint gives a better approximation than the right or left hand sides. Can you explain why that is for this case? Do you think the midpoint will always be better at approximating the area under any curve? Can you explain why you think what you do?

Limit[R[n], n -> Infinity]

Limit[M[n], n -> Infinity]

Limit[L[n], n -> Infinity]

Using the midpoint to estimate area under curves

Here is a complete example showing how using the midpoint approximates the area under the curve.

a  =  0;  b  =  1;  c  =  0;  d  =  1;  
      n  =  6;
f[x_]  :=  x^2;
g[x_,  m_]  :=  
          f[(b  -  a)/
                  m Floor[(x  -  a)/(b  -  a) m]  +  
              a  +  (b - a)/(2  m)];
Do[h[k] = FilledPlot[
{g[x,  k],  0}, 
{x,  a,  b},
PlotRange  ->  {c,  d}, 
PlotStyle  ->  RGBColor[1,  1,  1]],
{k,  1,  n}];
plotfcn = Plot[f[x],  {x,  a,  b},  PlotStyle  ->  Hue[2/3],  
            PlotRange  ->  {c,  d}];

M[k] is the area of the rectangles for k subintervals.

M[k_]  =  (b - a)/k Sum[
          f[a + (b - a)/(2  k)*(2  i + 1)], {i, 0, 
            k - 1}]

We can combine all of the above to get a nice plot of the rectangles, and the estimate of the area.

Do[{Show[h[k],  plotfcn] 
            Print["Area: ", N[M[k]]]},  {k,  1,  n}]

Here is another example, for a function which is not a polynomial, and we use the right endpoints:

a  =  1;  b  =  5;  c  =  0;  d  =  1;  
      n  =  4;
f[x_]  :=  1/x;
g[x_,  m_]  :=  
          f[(b  -  a)/
                  m Floor[(x  -  a)/(b  -  a) m]  +  
              a  +  (b - a)/(m)];
Do[h[k] = FilledPlot[
{g[x,  k],  0}, 
{x,  a,  b},
PlotRange  ->  {c,  d}, 
PlotStyle  ->  RGBColor[1,  1,  1]],
{k,  1,  n}];
plotfcn = Plot[f[x],  {x,  a,  b},  PlotStyle  ->  Hue[2/3],  
            PlotRange  ->  {c,  d}];

M[k_]  =  (b - a)/k Sum[
          f[a + (b - a)/k*i], {i, 1, k}]

Do[{Show[h[k],  plotfcn] 
            Print["Area: ", N[M[k]]]},  {k,  1,  n}]