Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Identify Mathematica interpolation functions from graphs (not Hermite)

I'm reverse-engineering how Mathematica does list interpolation:

(* Fortunately, Mathematica WILL interpolate an arbitrary list *) 

tab = Table[a[i], {i,1,100}] 

f = Interpolation[tab] 

(* get the coefficient of each term by setting others to zero *) 

Plot[{f[42+x] /. {a[42] -> 0, a[43] ->0, a[44] -> 0, a[41] -> 1}}, 
 {x,0,1}] 

Plot[{f[42+x] /. {a[41] -> 0, a[43] ->0, a[44] -> 0, a[42] -> 1}}, 
 {x,0,1}] 

Plot[{f[42+x] /. {a[42] -> 0, a[41] ->0, a[44] -> 0, a[43] -> 1}}, 
 {x,0,1}] 

Plot[{f[42+x] /. {a[42] -> 0, a[43] ->0, a[41] -> 0, a[44] -> 1}}, 
 {x,0,1}] 

(* above is neither Hermite, nor linear, though some look close *) 

(* these are available at oneoff.barrycarter.info/STACK/ *) 

Table[f[42+x] /. {a[42] -> 0, a[43] ->0, a[44] -> 0, a[41] -> 1}, 
 {x,0,1, 1/100}] >> /home/barrycarter/BCINFO/ONEOFF/STACK/coeff41.txt 

Table[f[42+x] /. {a[41] -> 0, a[43] ->0, a[44] -> 0, a[42] -> 1}, 
 {x,0,1, 1/100}] >> /home/barrycarter/BCINFO/ONEOFF/STACK/coeff42.txt 

Table[f[42+x] /. {a[41] -> 0, a[42] ->0, a[44] -> 0, a[43] -> 1}, 
 {x,0,1, 1/100}] >> /home/barrycarter/BCINFO/ONEOFF/STACK/coeff43.txt 

Table[f[42+x] /. {a[41] -> 0, a[42] ->0, a[43] -> 0, a[44] -> 1}, 
 {x,0,1, 1/100}] >> /home/barrycarter/BCINFO/ONEOFF/STACK/coeff44.txt

EDIT: Thanks, whuber! That did exactly what I wanted. For reference, the coefficients are (in order):

(x-2)*(x-1)*x/-6
(x-2)*(x-1)*(x+1)/2
x*(x+1)*(x-2)/-2
(x-1)*x*(x+1)/6
like image 472
barrycarter Avatar asked May 25 '11 16:05

barrycarter


1 Answers

According to the documentation the interpolator is piecewise polynomial. That's a little vague, so there is something to be investigated here.

You can establish experimentally that the interpolator is a linear function of the data. A nice basis for all possible data consists of vectors of the form {1,0,...,0}, {0,1,0,...,0}, ..., {0,...,0,1}. To this end, let's build a tiny function to produce these vectors of length $n$:

test[n_, i_] := Module[{x = ConstantArray[0,n]},x[[i]] = 1; x]

You can confirm the linearity by trying some examples like this one, with coefficients $a$ and $b$ acting on the $i^\text{th}$ and $j^\text{th}$ basis vectors of length $n$:

With[{a=1, b=2.5, n=5, i=2, j=3},
    Plot[{Interpolation[a test[n,i] + b test[n,j]][x], 
        a Interpolation[test[n,i]][x] + b Interpolation[test[n,j]][x]}, {x, 1, n}]
]

There will be but a single curve because the two functions are superimposed.

Having established the linearity, it will suffice to analyze the interpolator's values on the $n$ basis vectors. You can determine the degrees of the polynomials by differentiation. By default the degree is 3, but you can modify that with the "InterpolatingOrder" parameter. The following code will plot a table of obviously piecewise constant curves resulting from the derivatives of the interpolator for interpolating orders 1 through ioMax, using all the basis vectors for data of length $n$:

With[{n=7, ioMax = 5},
    Table[
        Module[{fns},
            fns = Table[Interpolation[test[n,i], InterpolationOrder->io], {i,1,n}];
            Table[Plot[Evaluate@D[f[#], {#,io}]&[x], {x,1,n},
                PlotRange->Full, PlotStyle->Thick, ImageSize->150], {f, fns}]
        ], {io, 1, ioMax}
    ]
] // TableForm

The output shows that the breaks occur at the integer values of the argument and that there are at most $n-d$ distinct segments for data of length $n$ and an interpolator of degree $d$. This information should get you most of the way there.

like image 151
whuber Avatar answered Oct 10 '22 19:10

whuber