4
$\begingroup$

I've got this task:

Use Mathematica to obtain an approximate value for the area between the curve $y=1/4$ and the x-axis over the interval $[1,2]$ with $50$ subintervals using the left endpoint, midpoint and right endpoint approximations. Note: the entire calculation needs to be shown in Mathematica.

Here's what I've tried:

a = 1; b = 2; n = 20; 
Ln = (b - a[f)/n*Sum[f[a + (i - 1) (b - a) / n], {i, 1, n}]
LeftSum[f_, a_, b_, n_] := (b - a)/n* Sum[f[a + (i - 1) (b - a)/n], {i, 1, n}]
f[x_] := 1/xLeft = N[LeftSum[f, 1, 2, 20]]
$\endgroup$
5
  • $\begingroup$ a = 1; b = 2; n = 20; Ln = (b - a[f)/n*Sum[f[a + (i - 1) (b - a) / n], {i, 1, n}] $\endgroup$
    – Ashneel
    Aug 31 '14 at 23:59
  • $\begingroup$ LeftSum[f_, a_, b_, n_] := (b = a)/n* Sum[f[a + (i - 1) (b - a)/n], {i, 1, n}] $\endgroup$
    – Ashneel
    Aug 31 '14 at 23:59
  • $\begingroup$ Clear[f]f[x_] := 1/xLeft = N[LeftSum[f, 1, 2, 20]] $\endgroup$
    – Ashneel
    Sep 1 '14 at 0:01
  • $\begingroup$ how can you please show me $\endgroup$
    – Ashneel
    Sep 1 '14 at 0:03
  • $\begingroup$ 2 - (3771059091081773 f)/5342931457063200 is this the output $\endgroup$
    – Ashneel
    Sep 1 '14 at 0:15
12
$\begingroup$

I'll change your proposed function because it's a constant and for such a function all sums will be equal.So:

f[x_] := 1/4 x^2
di = (2 - 1)/50;
intervals = Range[1, 2, di];

leftSum =   Sum[f[i] di,        {i, Most@intervals}];
rightSum =  Sum[f[i] di,        {i, Rest@intervals}];
middleSum = Sum[f[i + di/2] di, {i, Most@intervals}];

exact = Integrate[f@x, {x, 1, 2}];
N@{leftSum, rightSum, middleSum, exact}

(*{0.57585, 0.59085, 0.583325, 0.583333}*)

Edit

NIntegrate[] already provides the Left and Right Riemann sums:

Quiet@NIntegrate[f@x, {x, 1, 2}, Method ->{"RiemannRule", "Type"-> #, "Points"-> 25}, 
                 MaxRecursion -> 0] & /@ {"Left", "Right"}

(* {0.57585, 0.59085}*)

You could verify that these Riemann sums are the same that we calculated earlier by doing:

pts = Rationalize@First@Last@Reap@Quiet@
        NIntegrate[f@x, {x, 1, 2}, 
                   Method -> {"RiemannRule", "Type" -> #, "Points" -> 25}, 
         MaxRecursion -> 0, EvaluationMonitor :> Sow[x]] & /@ {"Left", "Right"}

Complement[intervals, #] & /@ pts
(*{{2}, {1}}*)

So showing that the last or first point are excluded depending on the type of sum.

Edit

Framed@GraphicsRow[Plot[f[x], {x, 1, 1.25}, PlotStyle -> {Red, Thick}, 
     Epilog -> {Opacity[.5], Blue, EdgeForm[Darker@Blue], 
       Rectangle @@@ (Transpose /@ Transpose[{Partition[intervals, 2, 1], 
       Partition[Riffle[f /@ #@intervals, 0, {1, -2, 2}], 2]}])}] & /@ 
                                        {Most, Rest,MovingAverage[#, 2] &}]

Mathematica graphics

$\endgroup$
4
  • $\begingroup$ Pending upvote (could you produce some output ?) $\endgroup$
    – eldo
    Sep 1 '14 at 3:22
  • $\begingroup$ @eldo Since the function proposed by the OP is constant, all Riemann sums are equal. I didn't include the numerical results because I thought they could bring some confusion. $\endgroup$ Sep 1 '14 at 3:25
  • $\begingroup$ @eldo Done. Perhaps I found a way to alleviate the confusion. $\endgroup$ Sep 1 '14 at 3:53
  • 1
    $\begingroup$ Now I can see. Unfortunately, I can't upvote twice :) $\endgroup$
    – eldo
    Sep 1 '14 at 4:00
6
$\begingroup$
f[x_] := 1/4
int = N@FindDivisions[{1, 2}, 50];
dx = int[[2]] - int[[1]];

Then:

leftSum = Total[f[#] dx & /@ Most[int]]
rightSum = Total[f[#] dx & /@ Rest[int]]
middleSum = Total[f[# + dx/2] dx & /@ Most@int]
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.