0% found this document useful (0 votes)
2 views

Mathematica Lab 6

Copyright
© © All Rights Reserved
Available Formats
Download as PDF, TXT or read online on Scribd
0% found this document useful (0 votes)
2 views

Mathematica Lab 6

Copyright
© © All Rights Reserved
Available Formats
Download as PDF, TXT or read online on Scribd
You are on page 1/ 8

MATH 1234 Lab 6, Part II

Riemann Sums: Exercises


By Helen P. Read, University of Vermont. Last revised July 2023.

Name: Collin Chamberlain

Initialization
Evaluate the following initialization cell with Shift-Enter before you begin. (It will evaluate
automatically if you answer Yes at the prompt.)

In[95]:= err="Interval is backwards. Fix it and try again.";

Table[Line[{{a + i*dx, 0},{a + i*dx, f/.{xa + (i+loc)*dx}},


getlines[f_,{x_,a_,b_},n_,loc_]:=Module[{dx},dx=(b-a)/n;

{a + (i+1)*dx, f/.{xa + (i+loc)*dx}},


{a + (i+1)*dx, 0}}], {i, 0, n - 1}]];

PlotLeftRec[f_,{x_,a_, b_}, n_] :=If[a>b,Print[err],Show[Plot[f, {x, a, b},


PlotRange{{Min[0,a],Max[0,b]},All}],
Graphics[{Darker[Green], Thick,getlines[f,{x,a, b}, n,0]}],
AxesOrigin{0,0},PlotLabelToString[n]<>" Left Rectangles",
PlotRangeClippingFalse]];

PlotRightRec[f_,{x_,a_, b_}, n_] :=If[a>b,Print[err],Show[Plot[f, {x, a, b},


PlotRange{{Min[0,a],Max[0,b]},All}],
Graphics[{Red, Thick,getlines[f,{x,a, b}, n,1]}],AxesOrigin{0,0},
PlotLabelToString[n]<>" Right Rectangles",PlotRangeClippingFalse]];

PlotMidRec[f_,{x_,a_, b_}, n_] :=If[a>b,Print[err],Show[Plot[f, {x, a, b},


PlotRange{{Min[0,a],Max[0,b]},All}],
Graphics[{Purple, Thick,getlines[f,{x,a, b}, n,1/2]}],
AxesOrigin{0,0},PlotLabelToString[n]<>" Midpoint Rectangles",
PlotRangeClippingFalse]];

This defines functions for plotting the area-approximating rectangles.


2 math1234_lab6_part2.nb

Exercise 1
In[62]:= Clear["`*"]

(a)
To begin, define f (x) = lnx4 + 6 x + 15

f[x_] := Logx4 + 6 x + 15


In[100]:=

Plot f (x) on the interval [1, 4] with 5 left rectangles, and with 5 right rectangles.

PlotLeftRec[f[x], {x, 1, 4}, 5]


In[101]:=

Out[101]=
5 Left Rectangles
6

0
1 2 3 4

Do left rectangles overestimate or underestimate the area under the curve?

Underestimate
math1234_lab6_part2.nb 3

In[70]:= PlotRightRec[f[x], {x, 1, 4}, 5]


Out[70]=
5 Right Rectangles
6

0
1 2 3 4

Do right rectangles overestimate or underestimate the area under the curve?

Overestimate

Find the sum of the areas of 5 left and 5 right rectangles. Give your answers as decimal
numbers to 6 significant digits.

4-1
In[102]:=

Δx =
5
Out[102]=

3
5

N[Sum[f[x] Δx, {x, 1 + Δx, 4, Δx}], 6]


In[103]:=

Out[103]=

13.6413

N[Sum[f[x] Δx, {x, 1, 4 - Δx, Δx}], 6]


In[107]:=

Out[107]=

12.0837

Answers:
4 math1234_lab6_part2.nb

5 Left 5 Right
12.0837 13.6413

Plot f(x) on the interval [1, 4] with 50 left rectangles, and with 50 right rectangles. Find
the sum of the rectangle areas as decimals to 6 significant digits.

In[76]:= PlotLeftRec[f[x], {x, 1, 4}, 50]


Out[76]=
50 Left Rectangles
6

0
1 2 3 4

In[75]:= PlotRightRec[f[x], {x, 1, 4}, 50]


Out[75]=
50 Right Rectangles
6

0
1 2 3 4
math1234_lab6_part2.nb 5

4-1
In[108]:=

Δx =
50
Out[108]=

3
50

N[Sum[f[x] Δx, {x, 1 + Δx, 4, Δx}], 6]


In[109]:=

Out[109]=

12.9274

N[Sum[f[x] Δx, {x, 1, 4 - Δx, Δx}], 6]


In[112]:=

Out[112]=

12.7716

Answers:

50 Left 50 Right
12.7716 12.9274

Plot f(x) on the interval [1, 4] with 200 left rectangles, and with 200 right rectangles. Find
the sum of the rectangle areas as decimals to 6 significant digits.

4-1
In[113]:=

Δx =
200
Out[113]=

3
200

N[Sum[f[x] Δx, {x, 1 + Δx, 4, Δx}], 6]


In[114]:=

Out[114]=

12.8689
6 math1234_lab6_part2.nb

N[Sum[f[x] Δx, {x, 1, 4 - Δx, Δx}], 6]


In[115]:=

Out[115]=

12.8299

Answers:

200 Left 200 Right


12.8299 12.8689

What happens to the accuracy of the left and right rectangle sums as the number of rectan-
gles is increased?

The more rectangles you create, the more accurate the left and right rectangle sums
become.

(b)

estimate of the area under f(x) on [1, 4]. Include a margin of error with your estimate.
Based on the most accurate approximating sums that you found above, give your best

(Use only the left and right rectangles that you already calculated. Don’t use midpoint
rectangles or anything else.)

12.8299324736659076235 + 12.868871467210630183
In[116]:=

2
Out[116]=

12.849401970438268903

12.84940197043826890325 - 12.8299324736659076235
In[117]:=

Out[117]=

0.019469496772361280

area ≈ 12.8494 ± 0.01946


math1234_lab6_part2.nb 7

Exercise 2
(a)
To begin, define g(x) = 4500 x - 1800 x2 + 225 x3 - 9 x4
Plot g(x) with 100 midpoint rectangles on the interval [0, 5], and find the midpoint rectan-
gle sum as a decimal to 6 significant digits.

g[x_] := 4500 x - 1800 x2 + 225 x3 - 9 x4


In[118]:=

PlotMidRec[g[x], {x, 0, 5}, 100]


In[119]:=

Out[119]=
100 Midpoint Rectangles
3500

3000

2500

2000

1500

1000

500

0
1 2 3 4 5

5-0
In[121]:=

Δx =
100
Out[121]=

1
20

N[Sum[g[x] Δx, {x, Δx / 2, 5 - Δx / 2, Δx}], 6]


In[123]:=

Out[123]=

10 781.8

Rectangle sum = 10 781.8


8 math1234_lab6_part2.nb

(b)
Plot g(x) with 200 midpoint rectangles on the interval [0, 10], and find the midpoint rectan-
gle sum as a decimal to 6 significant digits. (Note that Δx is the same as it was in (a). The
interval is now twice as wide, but we are using twice as many rectangles, so the width of
each rectangle is the same as before.)

PlotMidRec[g[x], {x, 0, 10}, 200]


In[124]:=

Out[124]=
200 Midpoint Rectangles

3000

2000

1000

0
2 4 6 8 10

-1000

N[Sum[g[x] Δx, {x, Δx / 2, 10 - Δx / 2, Δx}], 6]


In[125]:=

Out[125]=

7500.47

Rectangle sum = 7500.47

(c)
Explain why the answer to (b) is less than the answer to (a), even though the region is
twice as wide.

The answer is less in answer b than answer a because the area is negative from 5 to
10.

You might also like