Approximation of definite integral by parabolas

Question

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

Answer 1

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

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.

Answer 2

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