# Approximation of definite integral by parabolas

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}]

• 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! May 13, 2015 at 3:15
• 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. May 13, 2015 at 4:44
• 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. May 13, 2015 at 5:31
• 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? May 18, 2015 at 21:17

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[
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 *)
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"}
] 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.

• 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. May 15, 2015 at 5:58
• 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. May 15, 2015 at 6:00
• 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. May 15, 2015 at 6:06
• @J. M. I've taken your suggestions regarding InterpolatingPolynomial. It does seem to work better than Interpolation. May 15, 2015 at 7:34
• 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. May 15, 2015 at 7:50

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], 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]}] 