Lagrange interpoláció

Adott n db különböző pont, (Subscript[x, 1])<(Subscript[x, 2])<…<(Subscript[x, n]) ((Subscript[x, j])∈ℝ) és n db függvényérték, (Subscript[f, 1]),(Subscript[f, 2]),…,(Subscript[f, n]) ((Subscript[f, j])∈ℝ). Keressünk egy olyan p polinomfüggvényt, melyre p[(Subscript[x, j])]=(Subscript[f, j]).

(Underscript[∃!, p∈(Subscript[ℙ, n-1])])(Underscript[∀, j])p[(Subscript[x, j])]=(Subscript[f, j]).

A függvényértékek lehetnek egyenlők, az alappontok rendezettsége nem jelent megszorítást.

Lagrange előállítás

Adjuk meg az Lagrange alapinterpolációs polinomokat, majd ezek segítségével állítsuk elõ a Lagrange interpolációs polinomot! Próbáljuk ki a következõ adathalmazokon: X={(Subscript[x, 1]),(Subscript[x, 2]),(Subscript[x, 3])}={1,2,3}, F={(Subscript[f, 1]),(Subscript[f, 2]),(Subscript[f, 3])}={2,5,10}.

Programjavaslat

Lagrange bázispolinomok

LagrBase[j_,x_List,var_]:=((∏_(k=1)^(j-1))((var-x[[k]])/(x[[j]]-x[[k]])))((∏_(k=j+1)^(Length[x]))((var-x[[k]])/(x[[j]]-x[[k]])))

LagrInterp[x_List,f_List,var_]:=(∑_(j=1)^(Length[x]))f[[j]]LagrBase[j,x,var]

Clear[X,F]

X={1,2,3};F={2,5,10};

Az első bázispolinom

LagrBase[1,X,x]//Expand

Az összes bázispolinom (j=1,2,3):

{LagrBase[1,X,x],LagrBase[2,X,x],LagrBase[3,X,x]}

A Lagrange interpolációs polinom mint lineáris kombináció:

LagrInterp[X,F,x]

Expand[%]

Transpose[{X,F}]//TableForm

Ábrázoljuk a pontokat és az interpolációs polinomot!

Plot[LagrInterp[X,F,x],{x,0,4}]

Plot[LagrInterp[X,F,x],{x,0,4},ImageSize->{300,300},Epilog->{RGBColor[1,0,0],PointSize[.03],Map[Point[#]&,Transpose[{X,F}]]},PlotRange->{0,20}]

(Black Box típusú feladatmegoldás a beépített függvényekkel)

?InterpolatingPolynomial

Expand[InterpolatingPolynomial[Transpose[{X,F}],x]]

Expand[InterpolatingPolynomial[{{1,2},{2,5},{3,10}},x]]

X1={1,2,3,4,5}; F1={0,6,24,60,120}

Adjuk meg a bázispolinomokat, az interpolációs polinomokat és ábrázoljuk a pontokat és az interpolációs polinomot!

Oldjuk meg a feladatot a határozatlan együtthatók módszerével is!

X1={1,2,3,4,5};F1={0,6,24,60,120};

LagrBase[1,X1,x]//Expand

Ellenőrizzük az első interpolációs alappolinomra kirótt feltételeket!

Map[(%/.x->#)&,X1]

LagrBase[2,X1,x]//Expand

Ellenőrizzük a második interpolációs alappolinomra kirótt feltételeket!

Map[(%/.x->#)&,X1]

Table[LagrBase[j,X1,x]//Expand,{j,1,5}]//TableForm

0LagrBase[1,X1,x]+6LagrBase[2,X1,x]+24LagrBase[3,X1,x]+60LagrBase[4,X1,x]+120LagrBase[5,X1,x]//Expand

LagrInterp[X1,F1,x]//Expand

Plot[LagrInterp[X1,F1,x],{x,0,6},ImageSize->{300,300},Epilog->{RGBColor[1,0,0],PointSize[.03],Map[Point[#]&,Transpose[{X1,F1}]]},PlotRange->{-5,130}]

Határozatlan együtthatók módszere

X1={1,2,3,4,5};F1={0,6,24,60,120};

Clear[p];
p[x_]=(Subscript[a, 4])(x^4)+(Subscript[a, 3])(x^3)+(Subscript[a, 2])(x^2)+(Subscript[a, 1])x+(Subscript[a, 0]);

Solve[Table[p[X1[[j]]]==F1[[j]],{j,Length[X1]}]]

p[x]/.%[[1]]

Newton előállítás osztott differenciákkal (rekurzív)

A Lagrange alaknál új adat hozzávételére nincs lehetőség ⟶ Newton féle előállítás osztott differenciák segítségével

Osztott differencia

Clear[OD, x1, f1, x2, f2, x3, f3]

NewtInterp[x_List,f_List,var_]:=(∑_(j=1)^(Length[x]))OD[Take[x,j],Take[f,j]](∏_(i=1)^(j-1))(var-x[[i]])

NewtInterp[{x1,x2,x3},{f1,f2,f3},x]

OD[x1, x2] ugyanaz mint (f [x2]-f [x1])/(x2-x1) azaz, mint a differenciahányados

OD[{x_},{f_}]:=f;
OD[x_List,f_List]:=(OD[Drop[x,1],Drop[f,1]]-OD[Drop[x,-1],Drop[f,-1]])/(Last[x]-First[x])

OD[{x1,x2},{f1,f2}]

NewtInterp[{x1,x2,x3},{f1,f2,f3},x]

Konkrét Lagrange polinom előállításhoz:

NewtInterp[{1,2,3,4,5},{0,6,24,60,120},x]

Expand[%]

Séma az f[x1], f[x1;x2], f[x1;x2;x3], f[x1;x2;x3;x4],f[x1;x2;x3;x4;x5] 
osztott differencia sorozat kiszámításához.

(Subscript[L, 4])[x]=((((0)+6 (-1+x))+6 (-2+x) (-1+x))+1(-3+x) (-2+x) (-1+x))+0(-1+x)(-2+x)(-3+x)(-4+x)(-5+x)

(Subscript[x, i]) (Subscript[f, i  ])          1 .      2.     3.      4.

1    0  
               6   
2    6               6
             18            1
3   24             9            0
             36            1
4   60             12
             60
5  120

Függvénycsíra módszer

A táblázat nélkül is meghatárohatjuk a következő eljárással (minden egyes lineáris egyenletben pontosan egy ismeretlen (A)):

p0=0;

p1=p0+A(x-1)

p1/.x->2

Solve[(p1/.x->2)==6]

p1=p0+6(x-1)

p2=p1+A(x-1)(x-2)

p2/.x->3

Solve[(p2/.x->3)==24]

p2=p1+6(x-1)(x-2)

p3=p2+A(x-1)(x-2)(x-3)

Solve[(p3/.x->4)==60]

p3=p2+1 (x-1)(x-2)(x-3)

p4=p3+A(x-1)(x-2)(x-3)(x-4)

Solve[(p4/.x->5)==120,A]

p4=p3+0(x-1)(x-2)(x-3)(x-4)

Expand[%]

X={1,2,3,4,5};
F={0,6,24,60,120};
Clear[LP];
LP[0]:=(P=F[[1]]);
LP[n_]:=Module[{pl},P=InterpolatingPolynomial[Take[Transpose[{X,F}],n],x];pl=P+A Product[x-X[[j]],{j,1,n}];
P=pl/.Solve[(pl/.x->X[[n+1]])==F[[n+1]],A][[1]];{pl,(pl/.x->X[[n+1]])==F[[n+1]],Solve[(pl/.x->X[[n+1]])==F[[n+1]],A][[1]],P,Expand[P]}]
Manipulate[TableForm[{{LP[n]}}],{n,0,4,1},FrameLabel->{"","","LP1",""},SaveDefinitions->True]

Mutassuk meg a példánkon (X={1,2,3,4,5}, Y={0,6,24,60,120}), hogy a Lagrange interpoláció kezelhető a határozatlan együtthatók módszerével.

p=α0+α1 x+α2 (x^2)+α3 (x^3)+α4 (x^4);

X={1,2,3,4,5}; Y={0,6,24,60,120};

Solve[Thread[Equal[p/.x->X,Y]]]

p/.%[[1]]

Illusztráljuk a példánkon (X={1,2,3,4,5}, Y={0,6,24,60,120}), hogy az osztott differenciák tkp. egy alkalmas másik bázisban vett koordinátasorral egyeznek meg.
Megoldás. Legfeljebb 4-edfokú polinomok lineáris tere (Subscript[P, 4]). Az intterpolációs feltételrendszer ekvivalens egy Vandermonde együtthatómátrixú lineáris egyenletrendszerrel.

V[l_]:=Table[((l[[i]])^j),{i,Length[l]},{j,0,Length[l]-1}]

V[{1,2,3,4,5}]//MatrixForm

U={u0,u1,u2,u3,u4};

V[{1,2,3,4,5}][[2]].U

Inverse[V[{1,2,3,4,5}]].{0,6,24,60,120}

LinearSolve[V[{1,2,3,4,5}],{0,6,24,60,120}]

%.Table[(x^(j-1)),{j,5}]

A másik bázis elemei, bázisátmenetmátrix (BTM)

B ={1,(x-1),(x-1)(x-2),(x-1)(x-2)(x-3),(x-1)(x-2)(x-3)(x-4)}

(BTM=Transpose[Table[PadRight[CoefficientList[Expand[B[[j]]],x],5],{j,5}]])//TableForm

Inverse[BTM].Inverse[V[{1,2,3,4,5}]].{0,6,24,60,120}

Tehát:

%.B