CV1 - Lagrangeův intrpolační polynom

Program pro výpočet Lagrangeova interpolačního polynomu

\(\(IntPol[data_, 
          x_] := 
	\(Module[{n, lpol, i, j}, {n = Length[data]; 
	
              lpol = Expand[
                  Sum[data[\([i, 
                          2]\)]*\((Product[\((x - 
                                  data[\([j, 1]\)])\)/\((data[\([i, 1]\)] - 
                                  data[\([j, 1]\)])\), {j, 1, i - 1}]*
                          Product[\((x - 
                                  data[\([j, 1]\)])\)/\((data[\([i, 1]\)] - 
                                  data[\([j, 1]\)])\), {j, i + 1, n}])\), {i, 
                      1, n}]]; lpol}]\)[\([1]\)];\)\)

Konec programu

Výpočet Lagrangeova interpolačního polynomu

Mějme následující data a zobrazme si je do grafu

\(\(data = {{0, 1}, {0.2, 2}, {0.4, 1}, 
\ \ \ \ \ {0.6, 3}, {0.8, 
            2}, {1, 1}};\)\)

gb = ListPlot[data, PlotStyle -> PointSize[0.02]]

Použijeme náš program pro výpočet Lagrangeova interpolačního polynomu pro naše data

PolNas[x_] = IntPol[data, x]

Nyní použijem pro výpočet Lagrangeova interpolačního polynomu  vestavenou funkci systemu Mathematica

PolMat[x_]=Expand[InterpolatingPolynomial[{{0,1},{0.2,2},{0.4,1},
     {0.6,3},{0.8,2},{1,1}},x]]

Polynomy jsou totožné

Nakreslíme graf Lagrangova interpolačního polynomu

g=Plot[PolNas[x],{x,0,1}];

Nakreslíme graf i s vyznačenými body

Show[{g, gb}]

Nyní provedeme výpočet Lagrangeova interpolačního polynomu pro data získaná z konkretní funkce a porovnáme polynom se původní funkcí

a=0;
b=1;
n=5;
fce[x_]=Exp[x];
h=(b-a)/n;

data=N[Table[{a+i h,fce[a+i h]},{i,0,n}]]

PolNas[x_] = IntPol[data, x]

Plot[{PolNas[x],Exp[x]},{x,0,1},
             PlotStyle->{{RGBColor[1,0,0]},{RGBColor[0,1,0]}}];

Na intervalu ⟨0,1⟩ jsou grafy totožné

Zvolím teď větší interval ⟨-2,3⟩

Plot[{PolNas[x], Exp[x]}, {x, -2, 3}, 
        PlotStyle -> {{RGBColor[1, 0, 0]}, {RGBColor[0, 1, 
                0]}}];

Mimo interpoleční interval se již objevila velká chyba

Nyní zvětším počet interpolovaných bodů

a=0;
b=1;
n=20;
fce[x_]=Exp[x];
h=(b-a)/n;

data=N[Table[{a+i h,fce[a+i h]},{i,0,n}]]

PolNas[x_] = IntPol[data, x]

Plot[{PolNas[x],Exp[x]},{x,0,1},
             PlotStyle->{{RGBColor[1,0,0]},{RGBColor[0,1,0]}}];

Nyní se projeví chyba už na intervalu ⟨0,1⟩ , hlavně v krajním bodě.

Nyní zvolíme jinou funkci na intervalu ⟨-5,5⟩

a=-5;
b=5;
n=8;
fce[x_]=1/(x x+1);
h=(b-a)/n;
data=N[Table[{a+i h,fce[a+i h]},{i,0,n}]];
PolNas[x_]=IntPol[data,x];
g=Plot[{PolNas[x],1/(x x+1)},{x,-5,5},
             PlotStyle->{{RGBColor[1,0,0]},{RGBColor[0,1,0]}}];

Zde je chyba už na interpolačním polynomu i s malou hodnotou n=8.

Interpolace pomocí splinů

V předchozím případě musíme místo Lagrangeova interpolačního polynomu použít metodu splinů.

<< NumericalMath`SplineFit`

sp = SplineFit[data, Cubic]

gs = 
      ParametricPlot[sp[t], {t, 0, 8}, Compiled -> False]

Show[{g, gs}]

Zde vidíme, že interpolace pomocí splinů je lepší.

Ukažeme si ještě jednu funkci, pro kterou je interpolační polynom nevhodný

a = 0;
b = 1;
n = 10;
fce[x_] = Exp[-Sin[15*x^2]];
h = (b - a)/n;
data = N[Table[{a + i*h, fce[a + i*h]}, {i, 0, n}]]

PolNas[x_] = IntPol[data, x]

g = 
      Plot[{PolNas[x], fce[x]}, {x, a, b}, 
        PlotStyle -> {{RGBColor[1, 0, 0]}, {RGBColor[0, 0, 1]}}]

sp = SplineFit[data, Cubic]

gs = 
      ParametricPlot[sp[t], {t, 0, 10}, Compiled -> False]

Show[{g, gs}]

Pro n=12 bude metoda splinů ještě lepší

a = 0;
b = 1;
n = 12;
fce[x_] = Exp[-Sin[15*x^2]];
h = (b - a)/n;
data = N[Table[{a + i*h, fce[a + i*h]}, {i, 0, n}]]

PolNas[x_] = IntPol[data, x]

g = 
      Plot[{PolNas[x], fce[x]}, {x, a, b}, 
        PlotStyle -> {{RGBColor[1, 0, 0]}, {RGBColor[0, 0, 1]}}]

sp = SplineFit[data, Cubic]

gs = 
      ParametricPlot[sp[t], {t, 0, 12}, Compiled -> False]

Show[{g, gs}]