11
$\begingroup$

I am trying to graphically represent the error in a Riemann sum. My current code looks like:

    Show[DiscretePlot[Log[t], {t, 1, 10, 1}, ExtentSize -> Left, PlotMarkers -> "Point"], 
          Plot[Log[t], {t, 1, 10}]]

The output of the above code

I would know like to plot JUST the curve-linear triangles above the plot of ln(x) that represents the error in the Riemann Sum.

$\endgroup$
18
$\begingroup$

If only visual matters - then use filling to mask everything under the curve:

Show[DiscretePlot[Log[t], {t, 1, 10, 1}, ExtentSize -> Left, PlotMarkers -> "Point"], 
 Plot[Log[t], {t, 1, 10}, Filling -> Bottom, FillingStyle -> White]]

enter image description here

You can also get crafty to show with color varying size of error triangles. And also give a vague opaque hint on underlying vertical rectangles - as their discreteness is the reason for error:

Show[
  DiscretePlot[Log[t], {t, 1, 10, 1}, ExtentSize -> Left, 
  ExtentMarkers -> {"Filled", "Empty"}, ColorFunction -> "Rainbow", 
  ExtentElementFunction -> "GlassRectangle"],

 Plot[Log[t], {t, 1, 10}, Filling -> Bottom, 
  FillingStyle -> Directive[White, Opacity[.8]]],

 DiscretePlot[Log[t], {t, 1, 10, 1}, 
  PlotStyle -> Directive[Dashed, Thick, Black]]  ]

enter image description here

$\endgroup$
6
$\begingroup$

A bit more compact:

Plot[{Log[x], Differences[Log[Range[10]]].UnitStep[x - Range[9]]},
     {x, 1, 10}, Filling -> {2 -> {1}}]

a Riemann sum fill


In the interest of making this post less useless, here is a general function for depicting the difference between a function and its left or right Riemann approximation:

Options[RiemannErrorPlot] = Sort[Join[Options[Plot], {"Panels" -> 10, "Type" -> Left}]];

RiemannErrorPlot[ff_, {x_, xmin_, xmax_}, opts : OptionsPattern[]] := 
 Module[{app, f, n, pts, typ},
        n = Max[1, Round[OptionValue["Panels"]]];
        typ = OptionValue["Type"];
        If[! MatchQ[typ, Left | Right],
           Message[NIntegrate::riemtype, typ]; Return[$Failed]];
        f = Function[x, ff, Listable];
        pts = Range[xmin, xmax, (xmax - xmin)/n];
        app = Function[\[FormalX], f[xmin] + Differences[f[pts]] .
                       UnitStep[\[FormalX] - Switch[typ, Left, Rest, Right, Most][pts]]
                       // Evaluate, Listable];
        Plot[{f[x], app[x]}, {x, xmin, xmax}, Filling -> {2 -> {1}}, 
             Evaluate[Sequence @@ FilterRules[{opts}, Options[Plot]]], 
             FillingStyle -> LightGray, PlotStyle -> {Red, Gray}]]

A demonstration:

Table[RiemannErrorPlot[x^4 - 3 x^2 + 1, {x, -1, 2}, Frame -> True, "Panels" -> 20,
                       PlotLabel -> StringForm["`1` approximation", type], "Type" -> type],
      {type, {Left, Right}}] // GraphicsRow

left and right approximations

I didn't implement the midpoint approximation, but it isn't too hard to add support for it; I'll leave that addition as an exercise for the interested reader.

$\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.