Определить интерполяционные функции Mathematica из графиков (не Эрмита) - PullRequest
Новая
       33

Определить интерполяционные функции Mathematica из графиков (не Эрмита)

5 голосов
/ 25 мая 2011

Я занимаюсь обратным проектированием, как Mathematica выполняет интерполяцию списка: 

(* 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

РЕДАКТИРОВАТЬ: Спасибо, whuber!Это именно то, что я хотел.Для справки, коэффициенты (по порядку): 

(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

1 Ответ

7 голосов
/ 25 мая 2011

Согласно документации, интерполятор является кусочно-полиномиальным. Это немного расплывчато, поэтому здесь есть что исследовать.

Вы можете экспериментально установить, что интерполятор является линейной функцией данных. Хорошая основа для всех возможных данных состоит из векторов вида {1,0, ..., 0}, {0,1,0, ..., 0}, ..., {0, ..., 0,1}. Для этого давайте создадим крошечную функцию для получения этих векторов длиной $ n $: 

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

Вы можете подтвердить линейность, попробовав несколько примеров, подобных этому, с коэффициентами $ a $ и $ b $, действующими на базисные векторы $ i ^ \ text {th} $ и $ j ^ \ text {th} $ длина $ 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}]
]

Будет только одна кривая, потому что две функции наложены.

Установив линейность, достаточно проанализировать значения интерполятора по базисным векторам $ n $. Вы можете определить степени многочленов путем дифференцирования. По умолчанию степень равна 3, но вы можете изменить ее с помощью параметра «InterpolatingOrder». В следующем коде будет построена таблица явно кусочно-постоянных кривых, полученных из производных интерполятора для интерполяции порядков с 1 по ioMax, используя все базисные векторы для данных длины $ 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

Вывод показывает, что разрывы происходят при целочисленных значениях аргумента и что существует не более $ n-d $ различных сегментов для данных длины $ n $ и интерполятора степени $ d $. Эта информация должна помочь вам в этом.

...