6
$\begingroup$

I have a list of points as you can see in the image below. From this list of points, I want to generate a filtered list of points, which is the envelope. Additionally, calculate the area under the envelope. enter image description here

rawData = {{1.`, 1.`}, {0.6666666666666666`, 
    0.9316770186335404`}, {0.5`, 0.906832298136646`}, {0.5`, 
    0.8757763975155279`}, {0.5`, 0.8633540372670807`}, {0.5`, 
    0.8509316770186336`}, {0.5`, 0.7888198757763976`}, {0.5`, 
    0.7142857142857143`}, {0.5`, 0.6645962732919255`}, {0.5`, 
    0.577639751552795`}, {0.3333333333333333`, 
    0.5341614906832298`}, {0.3333333333333333`, 
    0.453416149068323`}, {0.16666666666666666`, 
    0.36024844720496896`}, {0.16666666666666666`, 
    0.2670807453416149`}, {0.`, 0.21739130434782608`}, {0.`, 
    0.18633540372670807`}, {0.`, 0.13664596273291926`}, {0.`, 
    0.09937888198757763`}, {0.`, 0.062111801242236024`}, {0.`, 
    0.055900621118012424`}, {0.`, 0.`}};

points={{1.`,1.`},{0.6666666666666666`,0.9316770186335404`},{0.5`,0.906832298136646`},{0.3333333333333333`,0.5341614906832298`},{0.16666666666666666`,0.36024844720496896`},{0.`,0.21739130434782608`}};

Show[ListPlot[rawData, PlotStyle -> Red], ListLinePlot[points]]
f = Interpolation[points, InterpolationOrder -> 1];
NIntegrate[f[t], {t, 0, 1}, Method -> "GlobalAdaptive"]
$\endgroup$
8
$\begingroup$
{l, u} = Transpose[Through[{First, Last}@#] & /@ GatherBy[SortBy[rawData, Last], First]];
{f1, f2} = Interpolation[#, InterpolationOrder -> 1]& /@ {l, u}
NIntegrate[f2[t] - f1[t], {t, 0, 1}, Method -> "GlobalAdaptive"]

0.101967

Alternatively,

RegionMeasure@BoundaryDiscretizeGraphics[Polygon[Join[Reverse@l, u]]]

0.101967

ListPlot[{rawData, l, u}, Joined -> {False, True, True}, 
 PlotStyle -> {Blue, Red, Green}, Filling -> {2 -> {3}}]

enter image description here

$\endgroup$
  • $\begingroup$ You should use InterpolationOrder -> 1; otherwise the integral will be wrong. $\endgroup$ – Henrik Schumacher Oct 15 '18 at 20:00
  • $\begingroup$ Thank you @Henrik. $\endgroup$ – kglr Oct 15 '18 at 20:01
5
$\begingroup$

Here another way, using the three-argument version of GroupBy:

a = KeySort[GroupBy[rawData, First -> Last, MinMax]];
lower = Values[a][[All, 1]];
upper = Values[a][[All, 2]];
t = Keys[a];
Show[
 ListLinePlot[{Transpose[{t, upper}], Transpose[{t, lower}]}],
 ListPlot[rawData, PlotStyle -> Red]
 ]

enter image description here

And since these functions are piecewise-linear, we can apply Tai's method directly to obtain the integral exactly:

ω = 0.5 (Join[#, {0.}] + Join[{0.}, #]) &@Differences[t];
(upper - lower).ω

0.101967

$\endgroup$
  • 1
    $\begingroup$ "Tai's method" - :D $\endgroup$ – J. M. is away Oct 15 '18 at 20:30
2
$\begingroup$

If you assume "envelope" means the "shrink wrap" of the points, the answer is:

ConvexHullMesh[rawData]

If you want to get the area under the curve, add a point at {1,0}.

myRegion = ConvexHullMesh[rawData];

enter image description here

Get the area:

RegionMeasure[myRegion]

(* 0.757764 *)

Get the coordinates:

MeshCoordinates[myRegion]

(*

{{1., 1.}, {0.5, 0.906832}, {0., 0.217391}, {0., 0.186335}, 
 {0., 0.136646}, {0., 0.0993789}, {0., 0.0621118}, {0., 0.0559006}, 
 {0., 0.}, {1., 0.}}

*)

Show[HighlightMesh[myRegion, Style[2, Opacity[0.5]]], 
 Graphics[{PointSize[0.02], Red, Point[MeshCoordinates[myRegion]]}]]

enter image description here

$\endgroup$
  • $\begingroup$ thank you for the answer. How I get the boundary points from the ConvexHull $\endgroup$ – Kiril Danilchenko Oct 15 '18 at 18:58
  • $\begingroup$ The problem with this is that by design, it will miss dips or troughs in the data. $\endgroup$ – J. M. is away Oct 15 '18 at 19:13
  • $\begingroup$ It all comes down to what the poser means by "envelope." I assumed the Convex Hull. $\endgroup$ – David G. Stork Oct 15 '18 at 19:16
  • 1
    $\begingroup$ A bit hard to explain since I am on mobile, but I will try. Look at kglr's answer. In particular, notice the green line in his answer. A convex hull approach will not be able to reproduce that. $\endgroup$ – J. M. is away Oct 15 '18 at 19:16

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.