1
$\begingroup$

This question is related to Trapezoid approximation to definite integral. As promised, I am now asking about how to draw an approximation of integrals by parabolas. I tried to modify MarcoB's code, and I am using interpolation to create the parabolas. I guess that command doesn't get along with Graphics. I am attaching my code so you can spot my mistake. Thank you.

f[x_] := Sin[x]
Manipulate[
 polygons = {Table[{Green, Opacity[0.15], EdgeForm[Blue], 
     Rectangle[{a + i (b - a)/n, 0}, {a + (i + 1) (b - a)/n, 
       f[a + (i + 1) (b - a)/n]}]}, {i, 0, n - 1, 1}],
   Table[{Red, Opacity[0.15], EdgeForm[Blue], 
     Rectangle[{a + i (b - a)/n, 0}, {a + (i + 1) (b - a)/n, 
       f[a + (i + 1/2) (b - a)/n]}]}, {i, 0, n - 1, 1}],
   Table[{Yellow, Opacity[0.15], EdgeForm[Blue], 
     Rectangle[{a + i (b - a)/n, 0}, {a + (i + 1) (b - a)/n, 
       f[a + i (b - a)/n]}]}, {i, 0, n - 1, 1}],
   Table[{Yellow, Opacity[0.15], EdgeForm[Blue], 
     Interpolation[{ {a + i (b - a)/n, 
        f[a + i (b - a)/n]}, {a + (i + 1) (b - a)/n, 
        f[a + (i + 1) (b - a)/n]}, {a + (i + 2) (b - a)/n, 
        f[a + (i + 2) (b - a)/n]}, InterpolationOrder -> 2}], {i, 0, 
      n - 2, 2}}],
   Table[{Cyan, Opacity[0.25], EdgeForm[Blue], 
     Polygon[{{a + i (b - a)/n, 0}, {a + i (b - a)/n, 
        f[a + i (b - a)/n]}, {a + (i + 1) (b - a)/n, 
        f[a + (i + 1) (b - a)/n]}, {a + (i + 1) (b - a)/n, 0}}]}, {i, 
     0, n - 1, 1}]};
 Show[{Plot[f[x], {x, a, b}, PlotStyle -> {Red, Thick}, 
    AxesOrigin -> {0, 0}], Graphics[polygons[[type]]]}, 
  ImageSize -> Large], {{a, -1}, -10, 10}, {{b, 6}, -10, 10}, {{n, 5},
   1, 40, 1}, {{type, 5, "Type of \nApprox"}, {1 -> "left rectangles",
    2 -> "mid rectangles", 3 -> "right rectangles", 
   4 -> "par rectangles", 5 -> "trap"}}]

EDIT: Thank you MarcoB and J. M. After J. M.'s comment, I just tried to go back one step and now just try to plot the parabolas (without having to switch between rectangles and other figures). This is what I tried, but I don't know now how to make it plot every arc of a parabola only in the related interval (namely, I get the plots of the entire parabolas). How can I fix this?

f[x] = Sin[x]
a = 0
b = 2
n = 5
g = Table[
  InterpolatingPolynomial[{{a + i (b - a)/n, 
     f[a + i (b - a)/n]}, {a + (i + 1) (b - a)/n, 
     f[a + (i + 1) (b - a)/n]}, {a + (i + 2) (b - a)/n, 
     f[a + (i + 2) (b - a)/n]}}, x], {i, 0, n - 1, 2}]
Plot[g, {x, 0, 2}]
$\endgroup$
  • $\begingroup$ Gio, unfortunately I'm swamped right now, so I won't be able to dedicate much attention to this, but I'd still like to give you my two cents. The Rectangle and Polygon that were used before are "Graphics primitive", i.e. they are representations of 2D graphical objects and as such they can be fed to Graphics directly. The output of Interpolation is an InterpolatingFunction. As you guessed, Graphics doesn't know what to do with it, so it spits it right out. This one will be quite a bit more laborious! $\endgroup$ – MarcoB May 13 '15 at 3:15
  • $\begingroup$ You seem to want to do Simpson's rule. There is a function, InterpolatingPolynomial[] that you can use to generate the explicit parabolas, as well as for deriving the integral of a parabola. A rendering is much more challenging: you can use Plot[] to render the parabola, and maybe use Cases[] to extract the Line[] object representing the parabola. You can then use that for further renderings. $\endgroup$ – J. M. will be back soon May 13 '15 at 4:44
  • $\begingroup$ Certainly, you use Plot[] to generate only arcs of the parabolas; something like First[Cases[Plot[InterpolatingPolynomial[{{a, f[a]}, {b, f[b]}, {c, f[c]}}, x], {x, a, b}], _Line, Infinity]] yields a Line[] object representing a parabola arc through three points. $\endgroup$ – J. M. will be back soon May 13 '15 at 5:31
  • $\begingroup$ Gio I just noticed the edit in your question, but honestly I don't remember whether your edit came before or after I submitted my answer below (my memory is in shambles these days...). Does my answer below address the problem you mentioned of plotting only arcs of parabolas, or are you still stuck there? $\endgroup$ – MarcoB May 18 '15 at 21:17
2
$\begingroup$

Here is my second stab at the problem. The first time I tried this, I was using Interpolation to find the expression of the parabolas, but the Manipulate wrapper was quite sluggish. @GuessWhoItIs. pointed out that InterpolatingPolynomials might be a snappier choice in this case.

As I understand it, this function constructs a Newton divided difference polynomial form, and indeed it seems faster than Interpolation, so I switched over to it.

Here is goes:

f[x_] := Sin[10 x] + Sin[12 x]

Manipulate[
 (* Subdivide the domain into estimation intervals *)
 listpoints = Table[{
    {a + i (b - a)/n, f[a + i (b - a)/n]},
    {a + (i + 0.5) (b - a)/n, f[a + (i + 0.5) (b - a)/n]},
    {a + (i + 1) (b - a)/n, f[a + (i + 1) (b - a)/n]}
    }, {i, 0, n - 1, 1}];

 (* Calculate interpolating polynomials: 3 pts = 2nd degree = parabolas *)
 listint = InterpolatingPolynomial[#, x] & /@ listpoints;

 (* Calculate the true integral and compare it to *)
 (* the estimate obtained using the parabolas     *)
 interr = 100 (Total[
       MapThread[
        Integrate[#1, {x, #2[[1, 1]], #2[[3, 1]]}] &,
        {listint, listpoints}
        ]
       ] - (realint = NIntegrate[f[x], {x, a, b}]) )/realint;

 (* Graphics *)
 Show[

  (* Plot the interpolating polynomials in their respective intervals *)
  MapThread[
   Plot[#1, {x, #2[[1, 1]], #2[[3, 1]]}, Filling -> 0, Axes -> None, Frame -> True] &,
   {listint, listpoints}
   ],

  (*Plot the function*)
  Plot[f[x], {x, a, b}, PlotStyle -> {Red, Thick}],

  (* Add the points that delimit the integration intervals *)
  Graphics[{PointSize[0.012], Blue, Point /@ listpoints}],

  (* Print the error as a signed percentage *)
  Epilog -> 
    Inset[
      Style[ToString@Round[interr, 0.1] <> "%", FontSize -> 16],
      Scaled[{0.94, 0.94}]
    ],

  PlotRange -> All, PlotRangePadding -> {Scaled[0.01], Scaled[0.05]}, 
  GridLines -> {{0}, {0}},
  ImageSize -> Large
  ],

 (* Controls *)
 {{n, 4}, 1, 25, 1, Appearance -> "Open"},
 {{a, -1.5}, -10, 10, Appearance -> "Open"},
 {{b, 0.7}, -10, 10, Appearance -> "Open"}
]

new with InterpolatingPolynomial

I have have not yet tried to put it all together with the other integration methods from your two previous questions (using rectangles and trapezoids).

The graphics presentation also includes the points used for the interpolation, and the error associated with the estimation of the integral using the selected parabolas instead of the function itself.

$\endgroup$
  • $\begingroup$ If you've set InterpolationOrder -> 2, you shouldn't have to need to set the Method option. Methinks it's still safer to just use InterpolatingPolynomial[] instead. $\endgroup$ – J. M. will be back soon May 15 '15 at 5:58
  • $\begingroup$ I should have thought so as well, but I left the Method set empirically because the Manipulate was much more responsive that way. Honestly, however, I have no idea why that would be. I will try the conversion to InterpolatingPolynomial as well. This was thrown together kinda quickly so I wouldn't leave the question completely unanswered, but I should like to revisit a few things when I have time. $\endgroup$ – MarcoB May 15 '15 at 6:00
  • $\begingroup$ Now that I think about it, there's a way to produce a quadratic B-spline (effectively a parabola arc, then) that goes through three points; one can then use FilledCurve[] and BSplineCurve[]. I am reluctant to recommend this, however, since the formulae are rather messy IIRC, and the code would be less readable than using the interpolating polynomial explicitly. $\endgroup$ – J. M. will be back soon May 15 '15 at 6:06
  • $\begingroup$ @J. M. I've taken your suggestions regarding InterpolatingPolynomial. It does seem to work better than Interpolation. $\endgroup$ – MarcoB May 15 '15 at 7:34
  • $\begingroup$ Thanks for following through, Marco! I have done this sort of demonstration before in the (distant?!) past, and I still have some recollection of how I designed it. I'm glad they still work with the current version. $\endgroup$ – J. M. will be back soon May 15 '15 at 7:50
2
$\begingroup$

I'll leave the creation of a suitable Manipulate[] interface for somebody else; I'll just share a few ideas in this answer.

First, here is a routine that generates a parabola through three points, represented as a B-spline:

parabolicArc[pts_?MatrixQ] /; Dimensions[pts] == {3, 2} := 
           BSplineCurve[ReplacePart[pts, 2 -> Mean[Delete[pts, 2]] +
           {0, (Subtract @@ pts[[{-1, 1}, 1]]) (Subtract @@ Divide @@@ Reverse /@
           Differences[pts])/2}], SplineDegree -> 2]

(I still stand by my comment that the B-spline representation is a bit ugly, but at least it works here.)

Here's a picture similar to the one in Marco's answer:

f[x_] := Sin[10 x] + Sin[12 x];
a = -3/2; b = 7/10; n = 9; (* n should be odd! *)

pts = Table[N[{x, f[x]}], {x, a, b, (b - a)/(n - 1)}];

Plot[f[x], {x, a, b}, 
     Epilog -> {Directive[Blue, AbsolutePointSize[5]], Point[pts]}, 
     PlotStyle -> Red, 
     Prolog -> {{Directive[Opacity[1/4, ColorData[1, 1]],
                           EdgeForm[ColorData[1, 1]]], 
                 FilledCurve[{parabolicArc[#],
                              Line[ReplacePart[Reverse[Delete[#, 2]],
                                               {_, 2} -> 0]]}]} & /@
                              Partition[pts, 3, 2]}]

integral approximated by parabolic arcs

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