5
$\begingroup$

I need to interpolate data, that consists of many points in the beginning and a few in the end of the interval, like in the following example:

(* Generate data *)
dat = {#, Exp[-#]} & /@ Append[Range[0, 3, .5], 10];

(* Make interpolations of different orders *)
int = Interpolation[dat, InterpolationOrder -> #] & /@ Range[2, 7];

Show[
 ListPlot[dat, PlotRange -> {-1.1, 1.1}], 
 Plot[Evaluate@Through@int[x], {x, 0, 10}, PlotRange -> All]
]

But this produces quite poor results:

enter image description here

Is it possible somehow to produce more appropriate result?

Improve this question
$\endgroup$
9
  • 1
    $\begingroup$ You might want to look up monotonic interpolation; there have been a few answers on this site using it. $\endgroup$
    – J. M.'s eventual burnout ♦
    Jun 3, 2016 at 11:13
  • $\begingroup$ Why not stick with linear interpolation (InterpolationOrder->1) in the absence of more information? Or you can move to log-space. $\endgroup$
    – Markus Roellig
    Jun 3, 2016 at 11:53
  • $\begingroup$ @J.M. Thanks, but what I've found so far doesn't solve this type of problems $\endgroup$
    – funnyp0ny
    Jun 3, 2016 at 12:01
  • 2
    $\begingroup$ for this toy example a fit to Exp will obviously work pretty well. What are you actually trying to acomplish? $\endgroup$
    – george2079
    Jun 3, 2016 at 12:17
  • 1
    $\begingroup$ Method -> "Spline" with InterpolationOrder -> 2 usually works better than the default in such cases (can't test right now: writing from a smartphone). $\endgroup$
    – Alexey Popkov
    Jun 5, 2016 at 13:55

4 Answers 4

Reset to default
5
$\begingroup$

Interpolation sometimes does not handle endpoints well, and this appears to be exacerbated in the present case, because the upper endpoint is far removed from the rest of the points. One workaround is to provide more, but very closely spaced, points of identical value (so that there is no need to know the form of the original function there) near the upper end of the data.

{#, Exp[-#]} & /@ Append[Range[0, 3, .5], 10];
dat = Join[%, Array[(Last@% + {0.01 #, 0}) &, 4]]; 
int = Interpolation[dat, InterpolationOrder -> #] & /@ Range[2, 7]; 
Show[ListPlot[dat, PlotRange -> {All, {-1.1, 1.1}}], 
     Plot[Evaluate@Through@int[x], {x, 0, 10}, PlotRange -> All]]

enter image description here

In effect, this causes higher derivatives of the interpolation function to be very small at the upper end of the interval.

Improve this answer
$\endgroup$
2
  • $\begingroup$ What do you do when you know only the points and not the function? $\endgroup$
    – user36273
    Jun 4, 2016 at 8:17
  • $\begingroup$ @rewi Good question. I have modified my answer to use additional points that do not rely on knowing the original function. Not surprisingly, there is no change in the resulting curve. $\endgroup$
    – bbgodfrey
    Jun 4, 2016 at 14:57
3
$\begingroup$

As I mentioned in a comment this blog post, "Find Fit for Non-linear data", discusses a similar problem.

Quantile Regression (QR) can produce a good enough interpolation of order two:

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

qfunc = First@
   QuantileRegression[dat, dat[[All, 1]], {0.5}, 
    InterpolationOrder -> 2];

Show[Plot[qfunc[x], {x, 0, 10}, PlotRange -> All], 
 ListPlot[dat, PlotRange -> {All, {-1.1, 1.1}}, PlotStyle -> Red]]

enter image description here

I said "interpolation" (not "fitting") because the data x-coordinates are given to be the knots for the basis functions in QuantileRegression. This kind of QR interpolation is very similar to using Method -> "Spline" with InterpolationOrder -> 2 as mentioned in a comment by Alexey Popkov.

What I find kind of interesting is that increasing the order of interpolation makes oscillations on the opposite end of the plot in the question:

qfuncs = Table[
   First@QuantileRegression[dat, dat[[All, 1]], {0.5}, 
     InterpolationOrder -> i], {i, 2, 7}];

Show[Plot[Evaluate@Through@qfuncs[x], {x, 0, 10}, PlotRange -> All, 
  PlotLegends -> Range[2, 7]], 
 ListPlot[dat, PlotRange -> {-1.1, 1.1}, PlotStyle -> Red]]

enter image description here

Improve this answer
$\endgroup$
7
  • $\begingroup$ Do you see a way to get QuantileRegression working for extremely unevenly spaced datasets (my example: pastebin.com/SCFyCA24)? I want to find a fit and some sort of confidence intervals, from which I can extract the values for the periods that were not sampled - so your QuantileRegression would be perfect - but it seems to have problems with such datasets... $\endgroup$
    – mjayvizzle
    Mar 30, 2017 at 19:00
  • 1
    $\begingroup$ Yes you can use QuantileRegression.m -- just rescale the data before the QR calculations. See this screenshot. $\endgroup$
    – Anton Antonov
    Mar 30, 2017 at 23:12
  • $\begingroup$ Thanks - rescaling does the trick! $\endgroup$
    – mjayvizzle
    Mar 31, 2017 at 7:31
  • $\begingroup$ I'm really like your QuantileRegression package, it helped me in many cases! However, I recently ran into problems with larger datasets (e.g. dropbox.com/s/1zvye4c3jblxgyo/testdata.csv?dl=0), where rescaling doesn't help either. The kernel is eating up all the memory and crashes after some point. It might be a problem with the new Mathematica V11.1 or V11.1.1, because the QuantileRegression worked fine for this dataset earlier... Any ideas what the problem could be? $\endgroup$
    – mjayvizzle
    Jun 7, 2017 at 9:11
  • $\begingroup$ @mjayvizzle I made a few experiments with the data you linked... I don't know what are your end goals, but the following suggestions might help. 1) Use the option Method -> {LinearProgramming, Method -> "CLP"}. 2) Use a 10-20% sample of the data. See this screenshot. $\endgroup$
    – Anton Antonov
    Jun 7, 2017 at 13:12
3
$\begingroup$

One could try to find a solution with FindFormula.

dat = {#, Exp[-#]} & /@ Append[Range[0, 3, .5], 10];
Plot[Evaluate@FindFormula[dat, x], {x, 0, 10}, PlotRange -> All, 
 Epilog -> {Red, PointSize@Medium, Point@dat}]

enter image description here

Addendum

For the 2nd try to solve the problem I use BSplines. I insert a point until the curve is smooth. We don't know the function!

Manipulate[
 data = {{0, 1}, {0.5, 0.606531}, {1, 0.367879}, {1.5, 0.22313}, {2, .135335}, {2.5, 0.082085}, {3, 0.0497871}, {a, b}, {10, 0.0000453999}};
 spline = BSplineFunction@data;
 p = ParametricPlot[spline[x], {x, 0, 1}, PlotRange -> All, 
   AspectRatio -> 0.5, Epilog -> {Red, PointSize@Medium, Point@data}],
 {a, 3, 10}, {b, 0.0497871, 0.0000453999}]

enter image description here

Now I build the Interpolation and compare the solution with the 1st solution:

f = Interpolation@Cases[p, Line[_], \[Infinity]][[1, 1]];

dat = {#, Exp[-#]} & /@ Append[Range[0, 3, .5], 10];
Show[
 Plot[f[x], {x, 0, 10}, PlotRange -> All,  PlotTheme -> "Detailed",
  Epilog -> {Red, PointSize@Medium, Point@dat}], 
 Plot[Evaluate@FindFormula[dat, x], {x, 0, 10}, PlotRange -> All]
 ]

enter image description here

Improve this answer
$\endgroup$
2
$\begingroup$

In such situations some sort of preprocessing of the data might be very useful:

Clear[int, x]
int[x_] = 
  With[{data = {#1, Log@#2} & @@@ dat}, 
     Exp[Interpolation[data, InterpolationOrder -> #, 
        Method -> "Spline"][x]]] & /@ Range[2, 7];

Show[Plot[Evaluate@int[x], {x, 0, 10}, PlotRange -> All], 
 ListPlot[dat], PlotRange -> {0, 1.}]

plot

Of course here the use of Log for preprocessing was cheating, but the idea is clear: in general one should guess the appropriate function.

Improve this answer
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.