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?

$\endgroup$
  • 1
    $\begingroup$ You might want to look up monotonic interpolation; there have been a few answers on this site using it. $\endgroup$ – J. M. is away Jun 3 '16 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 '16 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 '16 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 '16 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 '16 at 13:55
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.

$\endgroup$
  • $\begingroup$ What do you do when you know only the points and not the function? $\endgroup$ – user36273 Jun 4 '16 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 '16 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

$\endgroup$
  • $\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 '17 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 '17 at 23:12
  • $\begingroup$ Thanks - rescaling does the trick! $\endgroup$ – mjayvizzle Mar 31 '17 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 '17 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 '17 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

$\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.

$\endgroup$

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.