# upper envelope of data

Here is a ListPlot[] of some data. Clearly, there is a fairly smooth upper envelope - the question is whether there is an nice way of extracting it...

• Why not start with a maximizing over a moving window, and then smooth the result? Also, if you could send the data (or a small subset of it) it would be hlepful – yohbs Sep 16 '15 at 14:26
• Check out MaxFilter. – N.J.Evans Sep 16 '15 at 15:24
• Use ConvexHull[] on the reciprocals. – Eric Towers Sep 16 '15 at 18:20
• @EricTowers This will work for a convex envelope like this, but not in general. – Igor Rivin Sep 16 '15 at 18:21

One could imagine a more detailed question (e.g. with data, and a clear statement of whether it is the upper points, or a function, that is wanted).

Here is an approach to this.

First set up an example.

pts = RandomReal[{1, 5}, {10^4, 2}];
pts2 = Select[pts, #[[1]]*#[[2]] <= 5 &];
pts2 // Length
ListPlot[pts2]


We use an internal function to extract the envelope points.

upper = -InternalListMin[-pts2];
Length[upper]
ListPlot[upper]

(* Out[212]= 111 *)


Now guess a formula.

FindFormula[upper]

(* Out[209]= 4.92582954108/#1 & *)


More generally if one has in mind say a small set of monomials and wants to find an algebraic relation amongst the points, then there are various fitting functions that can be used.

• I am not sure what the significance of "Internal" is. Does it mean that this is something that could change at any moment? – Igor Rivin Sep 16 '15 at 17:11
• In theory yes. In this example, no. It is somethig we have used for the better part of a decade in FrobeniusNumber code and maybe elsewhere. For the life of me I don't know why it has not been promoted to System context. Uses the Bentley-Clarkson-Levine algorithm, by the way. – Daniel Lichtblau Sep 16 '15 at 17:20

This is an almost perfect application for Quantile Regression. (See these blog posts for Quantile Regression implementations and applications in Mathematica.)

Here is some data (as in Daniel Lichtblau's answer):

pts = RandomReal[{1, 5}, {10^4, 2}];
pts2 = Select[pts, #[[1]]*#[[2]] <= 5 &];
pts2 // Length
ListPlot[pts2]


Import["https://raw.githubusercontent.com/antononcube/MathematicaForPrediction/master/QuantileRegression.m"]


Apply Quantile Regression (using a basis of five B-splines of order 3) so that 99% of the points are below the regression quantile curve:

qFunc = QuantileRegression[pts2, 5, {0.99}][[1]];


Plot the result:

Show[{
ListPlot[pts2],
Plot[qFunc[x], {x, Min[pts2[[All, 1]]], Max[pts2[[All, 1]]]},
PlotStyle -> Red]}, PlotRange -> All]


Here is how the function looks like:

qFunc[x] // Simplify


Using Quantile Regression also works in more complicated cases:

pts = RandomReal[{0, 3 Pi}, 20000];
pts = Transpose[{pts, RandomReal[{0, 20}, Length[pts]]}];
pts2 = Select[pts, Sin[#[[1]]/2] + 2 + Cos[2*#[[1]]] >= #[[2]] &];
Length[pts2]
ListPlot[pts2, PlotRange -> All]


qFunc = QuantileRegression[pts2, 16, {0.996}][[1]];

Show[{
ListPlot[pts2],
Plot[qFunc[x], {x, Min[pts2[[All, 1]]], Max[pts2[[All, 1]]]},
PlotStyle -> Red]}, PlotRange -> All]


(I was not able to obtain good results using InternalListMin in this case.)

Since this question has popped up again, here is a way to use MaxFilter followed by smoothing with a GaussianFilter.

pts = RandomReal[{1, 5}, {10^4, 2}];
pts2 = Select[pts, #[[1]]*#[[2]] <= 5 &];
{xs, ys} = Transpose[Sort[pts2, #1[[1]] < #2[[1]] &]];
Show[{ListPlot[pts2],
ListLinePlot[Transpose[{xs, GaussianFilter[MaxFilter[ys, 50], 50]}],
PlotStyle -> Red]}]


• Nice and simple (+1). Also, works fairly well for the second dataset in my answer -- see this image. (And it is much faster...) – Anton Antonov May 25 '16 at 22:59

Just for record by a function used in this site rarely:EstimatedBackground

pts = RandomReal[{1, 5}, {10^4, 2}];
pts2 = Select[pts, #[[1]]*#[[2]] <= 5 &];
ListPlot[pts2]


ListLinePlot[-EstimatedBackground[-Reverse@
SortBy[pts2, Last][[All, 2]]],
DataRange -> MinMax[pts2[[All, 1]]], Epilog -> {Red, Point[pts2]}]


• Very interesting solution! Unfortunately, does not seem to be working for even slightly different data. E.g. pts2 = Select[pts, #[[1]]*#[[2]] <= 2 &]. – Anton Antonov May 25 '16 at 21:59
• @AntonAntonov Thanks for your foresight.The answer's code to should adjust to be-EstimatedBackground[-Reverse@SortBy[pts2,Last][[All,2]],25] to fit your pts2.It seems that I this way is not so good to do this. – yode May 25 '16 at 22:34