Module for Lagrange Polynomials

Numerical Methods using Mathematica  
Complementary software supplements for   
Numerical Methods textbooks  
John H. Mathews and Kurtis Fink, 2004

Background.

We have seen how to expand a function  f (x) in a Maclaurin polynomial about (Subscript[x, 0]) = 0 involving the powers (x^k) and a Taylor polynomial about (Subscript[x, 0]) ≠ 0 involving the powers (((x - (Subscript[x, 0])))^k).  The Lagrange polynomial of degree n passes through the n + 1 points  ((Subscript[x, k]),(Subscript[y, k]))  for  k = 0,1,.... ,n  and were investigated by the mathematician Joseph-Louis Lagrange (1736-1813).

Theorem ( Lagrange Polynomial ).  Assume that  f∈(C^(n + 1))[a,b] and  (Subscript[x, k])∈[a,b] for  k = 0,1,.... ,n  are distinct  values.  Then 

	f (x) = (Subscript[P, n]) (x) + (Subscript[R, n]) (x),
	
where (Subscript[P, n]) (x) is a polynomial that can be used to approximate  f (x), 

	(Subscript[P, n]) (x)=(∑_(k = 0)^n)\(y\_k\ \(\(\(\((x\  - \ x\_0)\)\  ... \) \((x\  - \ x\_\(k - 1\))\)\ \((x\  - \ x\_\(k + 1\))\)\  ... \)\ \((x\  - \ x\_n)\)\)\/\(\(\(\((x\_k - x\_0)\)\  ... \) \((x\_k - x\_\(k - 1\))\)\ \((x\_k - x\_\(k + 1\))\)\  ... \)\ \((x\_k - x\_n)\)\)\)  

and we write  

	f (x) ≈ (Subscript[P, n]) (x).

The Lagrange polynomial goes through the n + 1 points  (Subscript[{((Subscript[x, k]),(Subscript[y, k]))}, k = 0]^n),  i.e.

	(Subscript[P, n]) ((Subscript[x, k]))  =  f ((Subscript[x, k]))    for   k = 0,1,.... ,n.  

The remainder term  (Subscript[R, n]) (x) has the form

	(Subscript[R, n]) (x)=((Derivative[n + 1][f](c))/((n + 
                      1)!))(x - (Subscript[x, 0])) (x - (Subscript[x, 1])) (x - (Subscript[x, 2])) ...(x - (Subscript[x, n - 1]))(x - (Subscript[x, n])),

for some value c = c (x) that lies in the interval [a, b].

Proof  Lagrange Polynomials  Lagrange Polynomials

The cubic curve in the figure below illustrates a Lagrange polynomial of degree n = 3, which passes through the four points ((Subscript[x, k]),(Subscript[y, k])) for  k = 0,1,2,3.

x = 0;  y = 0;   Clear[p, t, x, y]; 
p[
          t_] := (Subscript[y, 0]) (( (t  -  (Subscript[x, 1])) (t  -  (Subscript[x, 2])) (t  -  (Subscript[x, 3])))/(((Subscript[x, 0]) - (Subscript[x, 1])) ((Subscript[x, 0]) - (Subscript[x, 2])) ((Subscript[x, 0]) - (Subscript[x, 3])))) + (Subscript[y, 1]) (((t  -  (Subscript[x, 0])) (t  -  (Subscript[x, 2])) (t  -  (Subscript[x, 3])))/(((Subscript[x, 1]) - (Subscript[x, 0]))  ((Subscript[x, 1]) - (Subscript[x, 2])) ((Subscript[x, 1]) - (Subscript[x, 3])))) + 
            (Subscript[y, 2]) (((t  -  (Subscript[x, 0])) (t  -  (Subscript[x, 1])) (t  -  (Subscript[x, 3])))/(((Subscript[x, 2]) - (Subscript[x, 0])) ((Subscript[x, 2]) - (Subscript[x, 1]))  ((Subscript[x, 2]) - (Subscript[x, 3])))) + (Subscript[y, 3]) (((t  -  (Subscript[x, 0])) (t  -  (Subscript[x, 1])) (t  -  (Subscript[x, 2])))/(((Subscript[x, 3]) - (Subscript[x, 0])) ((Subscript[x, 3]) - (Subscript[x, 1]))  ((Subscript[x, 3]) - (Subscript[x, 2]))));  
Print["p[x] = ", p[x]]; 
\(\(Print[\*""p[\!\(x\_0\)] = "", 
        p[x\_0], "
", "
", \*""p[\!\(x\_1\)] = "", 
        p[x\_1], "
", "
", \*""p[\!\(x\_2\)] = "", 
        p[x\_2], "
", "
", \*""p[\!\(x\_3\)] = "", 
        p[x\_3]\ ];\)\ \)

Theorem.  (Error Bounds for Lagrange Interpolation, Equally Spaced Nodes)  Assume that  f (x)  defined on [a, b],  which contains the equally spaced nodes  (Subscript[x, k]) = (Subscript[x, 0]) +  kh.  Additionally, assume that    f (x)  and the derivatives of  f (x)  up to the order  n + 1  are continuous and bounded on the special subintervals  [(Subscript[x, 0]),(Subscript[x, 1])], [(Subscript[x, 0]),(Subscript[x, 2])], [(Subscript[x, 0]),(Subscript[x, 3])], [(Subscript[x, 0]),(Subscript[x, 4])], and [(Subscript[x, 0]),(Subscript[x, 5])], respectively;  that is, 

	|(f^((n + 1))) (x)| ≤  (Subscript[M, n + 1])   for   (Subscript[x, 0])<x<(Subscript[x, n]),  

for  n = 1,2,3,4,5.  The error terms corresponding to these three cases have the following useful bounds on their magnitude  

(i).	|(Subscript[R, 1]) (x)|≤  ((Subscript[M, 2])/8) (h^2)   is valid for  x∈[(Subscript[x, 0]),(Subscript[x, 1])],  

(ii).	\(\(\(|\)\(\(R\_2\) \((x)\)\)\(|\)\(\ \)\(\(≤\)\(\ \ \)\)\)\)((Subscript[M, 3])/(9 (Sqrt[3]))) (h^3)   is valid for  x∈[(Subscript[x, 0]),(Subscript[x, 2])],  

(iii).	\(\(\(|\)\(\(R\_3\) \((x)\)\)\(|\)\(\ \)\(\(≤\)\(\ \ \)\)\)\)((Subscript[M, 4])/24) (h^4)   is valid for  x∈[(Subscript[x, 0]),(Subscript[x, 3])],  

(iv).	\(\(\(|\)\(\(R\_4\) \((x)\)\)\(|\)\(\ \)\(\(≤\)\(\ \ \)\)\)\)((Sqrt[4750 + 290 (Sqrt[145])])/3000) (Subscript[M, 5]) (h^5)   is valid for  x∈[(Subscript[x, 0]),(Subscript[x, 4])],  

(v).	\(\(\(|\)\(\(R\_5\) \((x)\)\)\(|\)\(\ \)\(\(≤\)\(\ \ \)\)\)\)((10 + 7 (Sqrt[7]))/1215) (Subscript[M, 6]) (h^6)   is valid for  x∈[(Subscript[x, 0]),(Subscript[x, 5])].

Proof  Lagrange Polynomials  Lagrange Polynomials

Animations (Lagrange Polynomials  Lagrange Polynomials).  Internet hyperlinks to animations.

Algorithm ( Lagrange Polynomial ).  To construct the Lagrange polynomial  

	P (x)=(∑_(k = 0)^n)(Subscript[y, k]) (Subscript[L, n, k]) (x)  
	
of degree n,  based on the n + 1 points ((Subscript[x, k]),(Subscript[y, k])) for  k = 0,1,...,n.  The Lagrange coefficient polynomials  (Subscript[L, n, k]) (x)  for degree n are:  

	\(\(L\_\(n, 
              k\)\) \((x)\)\  = \ \(\(\(\((x\  - \ x\_0)\)\  ... \) \((x\  - \ x\_\(k - 1\))\)\ \((x\  - \ x\_\(k + 1\))\)\  ... \)\ \((x\  - \ x\_n)\)\)\/\(\(\(\((x\_k - x\_0)\)\  ... \) \((x\_k - x\_\(k - 1\))\)\ \((x\_k - x\_\(k + 1\))\)\  ... \)\ \((x\_k - x\_n)\)\)\)  for  k = 0,1,...,n.

Computer Programs  Lagrange Polynomials  Lagrange Polynomials

You can use the first Mathematica subroutine that does things in the "traditional way" or you are welcome to use the second subroutine that illustrates  "Object Oriented Programming."

Mathematica Subroutine (Lagrange Polynomial). Traditional programming.

Lagrange[
          XY_] := 
Module[{j, k, n, prod, sum, term, X, 
            Y}, 
n  =  
            Length[XY] - 
              1;  
X  =  (Subscript[(Transpose[XY]), [[1]]]);  
Y  =  (Subscript[(Transpose[XY]), [[2]]]);  
sum = 
            0;  
For[ k = 0,  
            k ≤ n,  k++, 
prod  =  
              1;  
For[ j = 0,  
              j ≤ n,  j++, 
term  =  
                Which[ j == k,  
                  1, 
j ≠ 
                    k, ((x  -  (Subscript[X, [[j + 1]]]))/((Subscript[X, [[k + 1]]]) - (Subscript[X, [[j + 1]]]))) ];  
prod  =  
                prod   term; ];  
sum  =  
              sum  +  
                (Subscript[Y, [[k + 1]]]) prod; ];  
Return[sum]; ];

The above algorithm is sufficient for understanding and/or constructing the Lagrange polynomial.

Object Oriented Programming.  Welcome to the brave new world of "Object Oriented Programming."  Use the following Mathematica subroutine which is "programmed" using the "mathematical objects"  (Subscript[X, k])_,(Subscript[Y, k])_,\(∑\+\(□ = □\)\%□\)□  and  \(∏\+\(□ = □\)\%□ □\).  Templates for the objects are located by going to "File" then select "Palettes", then select "BasicInput."

Mathematica Subroutine (Lagrange Polynomial). Object oriented programming.

Lagrange[
          XY_] := 
Module[{j, k, n, X, 
            Y}, 
(Subscript[X, k])_  :=  (Subscript[(Transpose[XY]), [[1, k + 1]]]);  
(Subscript[Y, k])_  :=  (Subscript[(Transpose[XY]), [[2, k + 1]]]);  
n  =  
            Length[XY] - 1;  
For[ k = 0,  
            k ≤ 
              n,  k++, 
L[n, k, 
                  x_]  =  ( (∏_(j = 0)^(k - 1))((x - (Subscript[X, j]))/((Subscript[X, k]) - (Subscript[X, j])))) ((∏_(j = k + 1)^n)(( x - (Subscript[X, j]))/((Subscript[X, k]) - (Subscript[X, j]))));  ];  
Return[  (∑_(k = 0)^n) 
                    (Subscript[Y, k]) L[n, k, x] ]; ];

Mathematica Subroutine (Lagrange Polynomial). Compact object oriented programming.

Lagrange[
          XY_] := 
Module[{j, k, n, X, 
            Y}, 
(Subscript[X, k])_  :=  (Subscript[(Transpose[XY]), [[1, k + 1]]]);  
(Subscript[Y, k])_  :=  (Subscript[(Transpose[XY]), [[2, k + 1]]]);  
n  =  
            Length[XY] - 
              1;  
Return[  (∑_(k = 0)^n) (Subscript[Y, k]) ( (∏_(j = 0)^(k - 1))((x - (Subscript[X, j]))/((Subscript[X, k]) - (Subscript[X, j])))) ((∏_(j = k + 1)^n)(( x - (Subscript[X, j]))/((Subscript[X, k]) - (Subscript[X, j])))) ]; ];

Getting comfortable with objects.

The function form for a subscripted variable  (Subscript[c, n])_,  and the summation object  \(∑\+\(□ = □\)\%□ □\)  can be used to construct a power series function.
For example, the coefficients for the exponential series are reciprocals of factorials.

(Subscript[c, n])_=(1/(n!));  
Print["(Subscript[c, n]) = ",(Subscript[c, n]) ];  
Print[ Table[(Subscript[c, n]), {n, 0, 5}] ];

They can be used together to make a familiar polynomial approximation to (e^x).

p[x_]=(∑_(n = 0)^5)(Subscript[c, n]) (x^n);   
Needs["Graphics`Colors`"];  
Plot[{p[x], (E^x)}, {x, -5, 5}, 
          PlotRange -> {{-5.2, 5.2}, {-20, 150}}, 
          PlotStyle -> {Blue, Red}];  
Print["y = ", (E^x) ];  
Print["y = ", p[x] ];

Our use of the function for a subscripted variable precludes some awkward subscripts in the list of data points which we want to label with the starting subscript zero, for example ((Subscript[x, k]),(Subscript[y, k])) for  k = 0,1,...,n.

XY=Table[{k, Sin[k]}, {k, 0, 4}]

Note that the "points" require a data structure that is a list of "pairs" of numbers. The mathematics we use uses individual values such as (Subscript[x, k]) and (Subscript[y, k]).  

The abscissas and ordinates are extracted with the assistance of the "Transpose" operator

Transpose[XY]

(Subscript[(Transpose[
          XY]), [[1]]])

(Subscript[(Transpose[
          XY]), [[2]]])

Using the selection operation for matrices we can get the  (Subscript[x, 2]) = 1  out of the "list" with the command

(Subscript[(Transpose[XY]), [[1, 
        2]]])

That's o.k. but you need to add one to the "matrix subscript" to get the desired "abscissa."  To make things nicer we used a function for a subscripted variable.

(Subscript[X, k])_  :=  (Subscript[(Transpose[XY]), [[1, k + 1]]]);  
Table[(Subscript[X, k]), {k, 0, 4}]

Compare this with the commands for working with "matrix subscripts."  Notice the difference in the range: 0,1,2,3,4 for the subscripted variable and 1,2,3,4,5 for the "table" which is stored in a "list."

(Subscript[(Transpose[XY]), [[1, 
        Range[1, 5]]]])

The product object \(∏\+\(□ = □\)\%□ □\)  is probably new to you.  It can be used to construct a polynomial with known roots.

p[
          x_] = (∏_(k = 1)^7)(x - 
              k);  
Needs["Graphics`Colors`"];  
Plot[p[x], {x, 0, 8}, 
        PlotStyle -> Magenta];  
Print["p[x] = ", p[x] ];  
Print["p[x] = ", Expand[p[x]] ];

Example 1. Construct three interpolating polynomials of degree  n=1  for the function  f[x] = Cos[x]  over  [0,1].  
Use the following sets of interpolation nodes.
1 (a).  Use the nodes  {0.0,f[0.0]}  and  {1.0,f[1.0]}.  
1 (b).  Use the nodes  {0.1,f[0.1]}  and  {0.9,f[0.9]}.  
1 (c).  Use the nodes  {0.146447,f[0.146447]}  and  {0.853553,f[0.853553]}.

Solution 1.

1 (a).  Using the nodes  {0.0,f[0.0]} and {1.0,f[1.0]}.

f[x_] = Cos[x];  
XY = {{0.0, f[0.0]}, {1.0, f[1.0]}};  
(Subscript[p, 1])[x_] = Lagrange[XY];  
\(\(Print[\*""\!\(p\_1\)[x] = "", p\_1[x]\ ];\)\ \ \)

Now plot the function  f[x]  and polynomial  (Subscript[p, 1])[x].

Needs["Graphics`Colors`"];
dots = 
        ListPlot[XY, PlotStyle -> {Red, PointSize[0.02]}, 
          DisplayFunction -> Identity];  
gr = 
        Plot[{f[x], (Subscript[p, 1])[x]}, {x, 0.0, 1.0}, 
          PlotStyle -> {Magenta, DarkGreen}, 
          DisplayFunction -> Identity];  
Show[gr, dots, PlotRange -> {{0, 1.0}, {0.0, 1.15}}, 
        DisplayFunction -> $DisplayFunction];  
Print["f[x] = ", f[x] ];  
Print["Nodes = ", XY];  
\(\(Print[\*""\!\(p\_1\)[x] = "", p\_1[x]\ ];\)\ \ \)

1 (b).  Using the nodes  {0.1,f[0.1]} and {0.9,f[0.9]}.

f[x_] = Cos[x];  
XY = {{0.1, f[0.1]}, {0.9, f[0.9]}};  
(Subscript[q, 1])[x_] = Lagrange[XY];  
\(\(Print[\*""\!\(q\_1\)[x] = "", q\_1[x]\ ];\)\ \ \)

Now plot the function  f[x]  and polynomial  (Subscript[q, 1])[x].

dots = 
        ListPlot[XY, PlotStyle -> {Red, PointSize[0.02]}, 
          DisplayFunction -> Identity];  
gr = 
        Plot[{f[x], (Subscript[q, 1])[x]}, {x, 0.0, 1.0}, 
          PlotStyle -> {Magenta, DarkGreen}, 
          DisplayFunction -> Identity];  
Show[gr, dots, PlotRange -> {{0, 1.0}, {0.0, 1.15}}, 
        DisplayFunction -> $DisplayFunction];    
Print["f[x] = ", f[x]];  
Print["Nodes = ", XY];  
\(\(Print[\*""\!\(q\_1\)[x] = "", q\_1[x]\ ];\)\ \ \)

1 (c).  Using the nodes  {0.146447,f[0.146447]} and {0.853553,f[0.853553]}.

f[x_] = Cos[x];  
XY = {{0.146447, f[0.146447]}, {0.853553, 
            f[0.853553]}};  
(Subscript[t, 1])[x_] = Lagrange[XY];  
\(\(Print[\*""\!\(t\_1\)[x] = "", t\_1[x]\ ];\)\ \ \)

Now plot the function  f[x]  and polynomial  (Subscript[t, 1])[x].

dots = 
        ListPlot[XY, PlotStyle -> {Red, PointSize[0.02]}, 
          DisplayFunction -> Identity];  
gr = 
        Plot[{f[x], (Subscript[t, 1])[x]}, {x, 0.0, 1.0}, 
          PlotStyle -> {Magenta, DarkGreen}, 
          DisplayFunction -> Identity];  
Show[gr, dots, PlotRange -> {{0, 1.0}, {0.0, 1.15}}, 
        DisplayFunction -> $DisplayFunction];  
Print["f[x] = ", f[x] ];  
Print["Nodes = ", XY];  
\(\(Print[\*""\!\(t\_1\)[x] = "", t\_1[x]\ ];\)\ \ \)

Notice that the three polynomials of degree n = 1 were different.

\(\(Print[\*""\!\(p\_1\)[x] = "", 
        p\_1[x]\ ];\)\ \ \)
\(\(Print[\*""\!\(p\_1\)[x] = "", 
        Expand[p\_1[x]]\ ];\)\ \ \)
Print[""];  
\(\(Print[\*""\!\(q\_1\)[x] = "", 
        q\_1[x]\ ];\)\ \ \)
\(\(Print[\*""\!\(q\_1\)[x] = "", 
        Expand[q\_1[x]]\ ];\)\ \ \)
Print[""];  
\(\(Print[\*""\!\(t\_1\)[x] = "", 
        t\_1[x]\ ];\)\ \ \)
\(\(Print[\*""\!\(t\_1\)[x] = "", 
        Expand[t\_1[x]]\ ];\)\ \ \)

Compare the various graphs.

gr3 = 
        Plot[{f[x], (Subscript[p, 1])[x], (Subscript[q, 1])[x], (Subscript[t, 1])[x]}, {x, 0, 1}, 
          PlotRange -> {{0, 1.0}, {0.0, 1.15}}, 
          PlotStyle -> {Magenta, DarkGreen, Blue, 
              Red}];  
Print["y = f[x]", f[x] ];  
\(\(Print[\*""y = \!\(p\_1\)[x]"", p\_1[x]\ ];\)\ \ \)
\(\(Print[\*""y = \!\(q\_1\)[x]"", q\_1[x]\ ];\)\ \ \)
\(\(Print[\*""y = \!\(t\_1\)[x]"", t\_1[x]\ ];\)\ \ \)

Notice that the three polynomials of degree n = 1 are different.  The error in approximating  f[x]  will also be different.

Needs["Graphics`Colors`"];  
gr3 = 
        Plot[{f[x] - (Subscript[p, 1])[x], f[x] - (Subscript[q, 1])[x], f[x] - (Subscript[t, 1])[x]}, {x, 0, 1}, 
          PlotStyle -> {DarkGreen, Blue, 
              Red}];  
\(\(Print[\*""y = Cos[x] - \!\(p\_1\)[x]""];\)\ \ \)
\(\(Print[\*""y = Cos[x] - \!\(q\_1\)[x]""];\)\ \ \)
\(\(Print[\*""y = Cos[x] - \!\(t\_1\)[x]""];\)\ \ \)

Which polynomial has the smallest overall error on the entire interval  [0,1].  Later we will discover that  (Subscript[t, 1])[x]  was based on "Chebyshev's nodes."

Example 2.   Form several Lagrange polynomials of degree  n = 2, 3, 4, and 5  for the function  f[x] = Cos[x]  over the interval  [0,1]  using  n+1 equally spaced nodes.  Then compare the four Lagrange polynomials.

Solution 2 (a).

Construct the Lagrange interpolation polynomial (Subscript[p, 2])[x],  of degree n = 2.

f[x_] = Cos[x];  
n = 2;  
XY = 
        Table[{(1.0/n) k, f[(1.0/n) k]}, {k, 0, n}];  
(Subscript[p, 2])[x_] = Lagrange[XY];  
Print["\n", "Nodes = ", 
        XY, "\n"];  
\(\(Print[\*""\!\(p\_2\)[x] = "", 
        p\_2[x]\ ];\)\ \ \)
\(\(Print[\*""\!\(p\_2\)[x] = "", 
        Expand[p\_2[x]]\ ];\)\ \ \)

Now graph the function and polynomial, and interpolation nodes.

Needs["Graphics`Colors`"];  
dots = 
        ListPlot[XY, PlotStyle -> {Red, PointSize[0.02]}, 
          DisplayFunction -> Identity];  
gr2 = 
        Plot[{f[x], (Subscript[p, 2])[x]}, {x, 0.0, 1.0}, 
          PlotStyle -> {Magenta, Orange}, 
          DisplayFunction -> Identity];  
Show[gr2, dots, PlotRange -> {{0.0, 1.0}, {0, 1.0}}, 
        DisplayFunction -> $DisplayFunction];  
Print["f[x] = ", f[x] ];  
Print["Nodes = ", XY, "\n"];  
Print["The interval for interpolation is [0.0,1.0]."];  
\(\(Print[\*""\!\(p\_2\)[x] = "", p\_2[x]\ ];\)\ \ \)

Needs["Graphics`Colors`"];  
dots = 
        ListPlot[XY, PlotStyle -> {Red, PointSize[0.02]}, 
          DisplayFunction -> Identity];  
gr2 = 
        Plot[{f[x], (Subscript[p, 2])[x]}, {x, -1.5, 2.2}, 
          PlotStyle -> {Magenta, Orange}, 
          DisplayFunction -> Identity];  
Show[gr2, dots, PlotRange -> {{-1.0, 2.0}, {-0.7, 1.0}}, 
        DisplayFunction -> $DisplayFunction];  
Print["f[x] = ", f[x] ];  
Print["Nodes = ", XY, "\n"];  
Print["The interval for interpolation is [0.0,1.0]."];  
\(\(Print[\*""\!\(p\_2\)[x] = "", p\_2[x]\ ];\)\ \ \)

Solution 2 (b).

Construct the Lagrange interpolation polynomial (Subscript[p, 3])[x], of degree n = 3.

f[x_] = Cos[x];  
n = 3;  
XY = 
        Table[{(1.0/n) k, f[(1.0/n) k]}, {k, 0, 
            n}];  
(Subscript[p, 3])[x_] = Lagrange[XY];  
Print["Nodes = ", XY, "\n"];  
\(\(Print[\*""\!\(p\_3\)[x] = "", 
        p\_3[x]\ ];\)\ \ \)
\(\(Print[\*""\!\(p\_3\)[x] = "", 
        Expand[p\_3[x]]\ ];\)\ \ \)

Now graph the function and polynomial, and interpolation nodes.

dots = 
        ListPlot[XY, PlotStyle -> {Red, PointSize[0.02]}, 
          DisplayFunction -> Identity];  
gr3 = 
        Plot[{f[x], (Subscript[p, 3])[x]}, {x, 0.0, 1.0}, 
          PlotStyle -> {Magenta, Violet}, 
          DisplayFunction -> Identity];  
Show[gr3, dots, PlotRange -> {{0.0, 1.0}, {0.0, 1.0}}, 
        DisplayFunction -> $DisplayFunction];  
Print["f[x] = ", f[x] ];  
Print["Nodes = ", XY, "\n"];  
Print["The interval for interpolation is [0.0,1.0]."];  
\(\(Print[\*""\!\(p\_3\)[x] = "", p\_3[x]\ ];\)\ \ \)

dots = 
        ListPlot[XY, PlotStyle -> {Red, PointSize[0.02]}, 
          DisplayFunction -> Identity];  
gr3 = 
        Plot[{f[x], (Subscript[p, 3])[x]}, {x, -1.5, 2.2}, 
          PlotStyle -> {Magenta, Violet}, 
          DisplayFunction -> Identity];  
Show[gr3, dots, PlotRange -> {{-1.0, 2.0}, {-0.7, 1.0}}, 
        DisplayFunction -> $DisplayFunction];  
Print["f[x] = ", f[x] ];  
Print["Nodes = ", XY];  
Print["The interval for interpolation is [0.0,1.0]."];  
\(\(Print[\*""\!\(p\_3\)[x] = "", p\_3[x]\ ];\)\ \ \)

Solution 2 (c).

Construct the Lagrange interpolation polynomial (Subscript[p, 4])[x], of degree n = 4.

f[x_] = Cos[x];  
n = 4;  
XY = 
        Table[{(1.0/n) k, f[(1.0/n) k]}, {k, 0, n}];  
(Subscript[p, 4])[x_] = Lagrange[XY];  
Print["Nodes = ", XY, "\n"];  
\(\(Print[\*""\!\(p\_4\)[x] = "", 
        p\_4[x]\ ];\)\ \ \)
\(\(Print[\*""\!\(p\_4\)[x] = "", 
        Expand[p\_4[x]]\ ];\)\ \ \)

Now graph the function and polynomial, and interpolation nodes.

dots = 
        ListPlot[XY, PlotStyle -> {Red, PointSize[0.02]}, 
          DisplayFunction -> Identity];  
gr4 = 
        Plot[{f[x], (Subscript[p, 4])[x]}, {x, 0.0, 1.0}, 
          PlotStyle -> {Magenta, Blue}, 
          DisplayFunction -> Identity];  
Show[gr4, dots, PlotRange -> {{0.0, 1.0}, {0.0, 1.0}}, 
        DisplayFunction -> $DisplayFunction];  
Print["f[x] = ", f[x] ];  
Print["Nodes = ", XY, "\n"];  
Print["The interval for interpolation is [0.0,1.0]."];  
\(\(Print[\*""\!\(p\_4\)[x] = "", p\_4[x]\ ];\)\ \ \)

dots = 
        ListPlot[XY, PlotStyle -> {Red, PointSize[0.02]}, 
          DisplayFunction -> Identity];  
gr4 = 
        Plot[{f[x], (Subscript[p, 4])[x]}, {x, -1.5, 2.2}, 
          PlotStyle -> {Magenta, Blue}, 
          DisplayFunction -> Identity];  
Show[gr4, dots, PlotRange -> {{-1.0, 2.0}, {-0.5, 1.0}}, 
        DisplayFunction -> $DisplayFunction];  
Print["f[x] = ", f[x] ];  
Print["Nodes = ", XY, "\n"];  
Print["The interval for interpolation is [0.0,1.0]."];  
\(\(Print[\*""\!\(p\_4\)[x] = "", p\_4[x]\ ];\)\ \ \)

Solution 2 (d).

Construct the Lagrange interpolation polynomial (Subscript[p, 5])[x], of degree n = 5.

Clear[f, P5, Q5, x];  
f[x_] = Cos[x];  
n = 5;  
XY = 
        Table[{(1.0/n) k, f[(1.0/n) k]}, {k, 0, 
            n}];  
(Subscript[p, 5])[x_] = Lagrange[XY];  
Print["Nodes = ", XY, "\n"];  
\(\(Print[\*""\!\(p\_5\)[x] = "", 
        p\_5[x]\ ];\)\ \ \)
\(\(Print[\*""\!\(p\_5\)[x] = "", 
        Expand[p\_5[x]]\ ];\)\ \ \)

Now graph the function and polynomial, and interpolation nodes.

dots = 
        ListPlot[XY, PlotStyle -> {Red, PointSize[0.02]}, 
          DisplayFunction -> Identity];  
gr5 = 
        Plot[{f[x], (Subscript[p, 5])[x]}, {x, 0.0, 1.0}, 
          PlotStyle -> {Magenta, Green}, 
          DisplayFunction -> Identity];  
Show[gr5, dots, PlotRange -> {{0.0, 1.0}, {0.0, 1.0}}, 
        DisplayFunction -> $DisplayFunction];  
Print["f[x] = ", f[x] ];  
Print["Nodes = ", XY, "\n"];  
Print["The interval for interpolation is [0.0,1.0]."];  
\(\(Print[\*""\!\(p\_5\)[x] = "", p\_5[x]\ ];\)\ \ \)

dots = 
        ListPlot[XY, PlotStyle -> {Red, PointSize[0.02]}, 
          DisplayFunction -> Identity];  
gr5 = 
        Plot[{f[x], (Subscript[p, 5])[x]}, {x, -1.5, 2.2}, 
          PlotStyle -> {Magenta, Green}, 
          DisplayFunction -> Identity];  
Show[gr5, dots, PlotRange -> {{-1.0, 2.0}, {-0.7, 1.0}}, 
        DisplayFunction -> $DisplayFunction];  
Print["f[x] = ", f[x] ];  
Print["Nodes = ", XY];  
Print["The interval for interpolation is [0.0,1.0]."];  
\(\(Print[\*""\!\(p\_5\)[x] = "", p\_5[x]\ ];\)\ \ \)

Solution 2 (e).

Show[gr2, gr3, gr4, gr5, dots, 
        PlotRange -> {{-1.5, 2.2}, {-1.0, 1.0}}, 
        DisplayFunction -> $DisplayFunction];  
Print["f[x] = ", f[x] ];  
\(\(Print[\*""\!\(p\_2\)[x] = "", 
        p\_2[x]\ ];\)\ \ \)
\(\(Print[\*""\!\(p\_3\)[x] = "", 
        p\_3[x]\ ];\)\ \ \)
\(\(Print[\*""\!\(p\_4\)[x] = "", 
        p\_4[x]\ ];\)\ \ \)
\(\(Print[\*""\!\(p\_5\)[x] = "", p\_5[x]\ ];\)\ \ \)

Example 3.  Error Analysis.  Investigate the error for the Lagrange polynomial approximations of degree  n = 2, 3, 4, and 5 in Example 2.

Solution 3 (a).

Investigate the error for the Lagrange interpolation polynomial (Subscript[p, 2])[x],  of degree n = 2.

(Subscript[e, 2])[x_] = f[x] - (Subscript[p, 2])[x];  
maxerror2  =  0.00329294;
ge2 = 
        Plot[{0.00329, -0.00429, (Subscript[e, 2])[x]}, {x, 0.0, 1.0}, 
          PlotStyle -> {Cyan, Cyan, Blue}];  
Print["f[x] = ", f[x] ];  
\(\(Print[\*""\!\(p\_2\)[x] = "", 
        p\_2[x]\ ];\)\ \ \)
Print["The interval for interpolation is [0.0,1.0]."];  
\(\(Print[\*""Graph of the error (Subscript[e, 2])[x] = f[x] - (Subscript[p, 2])[x]""];\)\ \ \)

Looking at the above graph we make the following estimate for the error: |(Subscript[e, 2])[x]|≤ 0.00329294

Use formula (ii).	\(\(\(|\)\(\(R\_2\) \((x)\)\)\(|\)\(\ \)\(\(≤\)\(\ \ \)\)\)\)((Subscript[M, 3])/(9 (Sqrt[3]))) (h^3)   is valid for  x∈[(Subscript[x, 0]),(Subscript[x, 2])],  and find the error bound for this example.

h = (1/2);
(Subscript[M, 3]) =Derivative[3][f][1];
Plot[Derivative[3][f][x] ,{x, 0, 1},PlotStyle -> Green];
Print[" 
(f^((3)))[x]  = ",Derivative[3][f][x]]; 
\(Print[\*""|(f^((3)))(x)| ≤  (Subscript[M, 3]) = "", M\_3, " = ", 
        N[M\_3]];\)
Print["h = ", 
        h];
\(Print[\*""The remainder term (Subscript[R, 2])(x) has the form""];\)
\(Print[\*""|(Subscript[R, 2])(x)| ≤ "", \*""\!\(M\_3\/\(9\\ \@3\)\)(h^3) = "", \(M\_3\/\(9\ \@3\)\) h\^3, " = ", 
        N[\(M\_3\/\(9\ \@3\)\) h\^3]];\)

Thus,  \(\(\(|\)\(\(R\_2\) \((x)\)\)\(|\)\(\ \)\(\(≤\)\(\ \ \)\(0.00674754860547359`\)\)\)\)  is valid for  x∈[0,1],  which is a little bit larger than the maximum error  0.00329294.  After all, it is an error bound.

Solution 3 (b).

Investigate the error for the Lagrange interpolation polynomial (Subscript[p, 3])[x],  of degree n = 3.

(Subscript[e, 3])[x_] = f[x] - (Subscript[p, 3])[x];  
maxerror3  =  0.000463413; 
ge3 = 
        Plot[{-0.000463, 0.000252, -0.000427, (Subscript[e, 3])[x]}, {x, 0.0, 
            1.0}, PlotStyle -> {Cyan, Cyan, Cyan, 
              Blue}];  
Print["f[x] = ", f[x]];  
\(\(Print[\*""\!\(p\_3\)[x] = "", 
        p\_3[x]];\)\ \ \)
Print["The interval for interpolation is [0.0,1.0]."];  
\(\(Print[\*""Graph of the error (Subscript[e, 3])[x] = f[x] - (Subscript[p, 3])[x]""];\)\ \ \)

Looking at the above graph we make the following estimate for the error: \(\(\(|\)\(e\_3[
          x]\)\(|\)\(\(≤\)\(\ \)\(0.00046341275695549466`\)\)\)\)

Use formula (iii).	\(\(\(|\)\(\(R\_3\) \((x)\)\)\(|\)\(\ \)\(\(≤\)\(\ \ \)\)\)\)((Subscript[M, 4])/24) (h^4)   is valid for  x∈[(Subscript[x, 0]),(Subscript[x, 3])],  and find the error bound for this example.

h = (1/3);
(Subscript[M, 4]) =Derivative[4][f][0];
Plot[Derivative[4][f][x] ,{x, 0, 1},PlotStyle -> Green];
Print[" 
(f^((4)))[x]  = ",Derivative[4][f][x]]; 
Print["|
(f^((4)))[x]| ≤  (Subscript[M, 4]) = ",(Subscript[M, 4])," = ",N[(Subscript[M, 4])]];
Print["h = ", 
        h];
\(Print[\*""The remainder term (Subscript[R, 3])(x) has the form""];\)
\(Print[\*""|(Subscript[R, 3])(x)| ≤ "", \*""((Subscript[M, 4])/24)(h^4) = "", \(M\_4\/24\) h\^4, " = ", 
        N[\(M\_4\/24\) h\^4]];\)

Thus,  \(\(\(|\)\(\(R\_3\) \((x)\)\)\(|\)\(\ \)\(\(≤\)\(\ \ \)\(0.000514403\)\)\)\)   is valid for  x∈[0,1],  which is a little bit larger than the maximum error  0.000463413.  After all, it is an error bound.

Solution 3 (c).

Investigate the error for the Lagrange interpolation polynomial (Subscript[p, 4])[x],  of degree n = 4.

(Subscript[e, 4])[x_] = f[x] - (Subscript[p, 4])[x];  
maxerror4  =  0.0000157713;
ge4 = 
        Plot[{-0.0000122, 0.00000527, -0.00000572, 0.0000158, 
            (Subscript[e, 4])[x]}, {x, 0.0, 1.0}, 
          PlotStyle -> {Cyan, Cyan, Cyan, Cyan, Blue}];  
Print["f[x] = ", f[x] ];  
\(\(Print[\*""\!\(p\_4\)[x] = "", 
        p\_4[x]\ ];\)\ \ \)
Print["The interval for interpolation is [0.0,1.0]."];  
\(\(Print[\*""Graph of the error (Subscript[e, 4])[x] = f[x] - (Subscript[p, 4])[x]""];\)\ \ \)

Looking at the above graph we make the following estimate for the error: |(Subscript[e, 4])[
          x]|≤ 0.0000157712878811056`

Use formula (iv).	\(\(\(|\)\(\(R\_4\) \((x)\)\)\(|\)\(\ \)\(\(≤\)\(\ \ \)\)\)\)((Sqrt[4750 + 290 (Sqrt[145])])/3000) (Subscript[M, 5]) (h^5)   is valid for  x∈[(Subscript[x, 0]),(Subscript[x, 4])],  and find the error bound for this example.

h = (1/4);
(Subscript[M, 5]) =Abs[Derivative[5][f][1]];
Plot[Abs[Derivative[5][f][x]] ,{x, 0, 1},PlotStyle -> Green];
Print["|
(f^((5)))[x]| = ",Abs[Derivative[5][f][x]]]; 
Print["|
(f^((5)))[x]| ≤  (Subscript[M, 5]) = ",(Subscript[M, 5])," = ",N[(Subscript[M, 5])]];
Print["h = ", 
        h];
\(Print[\*""The remainder term (Subscript[R, 4])(x) has the form""];\)
\(Print[\*""|(Subscript[R, 4])(x)| ≤ "", \*""\!\(\@\(4750 + 290\\ \@145\)\/3000\) (Subscript[M, 5]) (h^5) = "", \@\(4750 + 290\ \@145\)\/3000\ M\_5\ h\^5, " = ", 
        N[\@\(4750 + 290\ \@145\)\/3000\ M\_5\ h\^5]];\)

Thus,  \(\(\(|\)\(\(R\_4\) \((x)\)\)\(|\)\(\ \)\(\(≤\)\(\ \ \ \)\(0.000024867715142468753`\)\)\)\)   is valid for  x∈[0,1],  which is a little bit larger than the maximum error  0.0000157713.  After all, it is an error bound.

Solution 3 (d).

Investigate the error for the Lagrange interpolation polynomial (Subscript[p, 5])[x],  of degree n = 5.

(Subscript[e, 5])[x_] = f[x] - (Subscript[p, 5])[x];  
maxerror5  =  0.00000134999;
ge5 = 
        Plot[{0.00000135, -0.000000398, 0.000000273, -0.000000385, 
            0.00000126, (Subscript[e, 5])[x]}, {x, 0.0, 1.0}, 
          PlotStyle -> {Cyan, Cyan, Cyan, Cyan, Cyan, 
              Blue}];  
Print["f[x] = ", f[x] ];  
\(\(Print[\*""\!\(p\_5\)[x] = "", 
        p\_5[x]\ ];\)\ \ \)
Print["The interval for interpolation is [0.0,1.0]."];  
\(\(Print[\*""Graph of the error (Subscript[e, 5])[x] = f[x] - (Subscript[p, 5])[x]""];\)\ \ \)

Looking at the above graph we make the following estimate for the error: |(Subscript[e, 5])[
          x]|≤ 0.00000134999

Use formula (v).	\(\(\(|\)\(\(R\_5\) \((x)\)\)\(|\)\(\ \)\(\(≤\)\(\ \ \)\)\)\)((10 + 7 (Sqrt[7]))/1215) (Subscript[M, 6]) (h^6)   is valid for  x∈[(Subscript[x, 0]),(Subscript[x, 5])],  and find the error bound for this example.

h = (1/5);
(Subscript[M, 6]) =Abs[Derivative[6][f][0]];
Plot[Abs[Derivative[6][f][x]] ,{x, 0, 1},PlotStyle -> Green];
Print["|
(f^((6)))[x]| = ",Abs[Derivative[6][f][x]]]; 
Print["|
(f^((6)))[x]| ≤  (Subscript[M, 6]) = ",(Subscript[M, 6])," = ",N[(Subscript[M, 6])]];
Print["h = ", 
        h];
\(Print[\*""The remainder term (Subscript[R, 5])(x) has the form""];\)
\(Print[\*""|(Subscript[R, 5])(x)| ≤ "", \*""((10 + 7 (Sqrt[ 7]))/1215)(Subscript[M, 6])(h^6) = "", \(\(10 + 7\ \@7\)\/1215\) \(M\_6\) 
          h\^6, " = ", 
        N[\(\(10 + 7\ \@7\)\/1215\) \(M\_6\) h\^6]];\)

Thus,  \(\(\(|\)\(\(R\_5\) \((x)\)\)\(|\)\(\ \)\(\(≤\)\(\ \ \ \)\(1.5023017179892483`*^-6\)\)\)\)   is valid for  x∈[0,1],  which is a little bit larger than the maximum error  1.34999`*^-6.  After all, it is an error bound.

Example 4.  Summary of the maximum error and the error bounds over the interval  [0, 1] that were found in Example 3.
4 (a).  Find  (max_(o  ≤  x  ≤  1)) {|f[x] - 
              (Subscript[p, 2])[x]|}.  
4 (b).  Find  (max_(o  ≤  x  ≤  1)) {|f[x] - 
              (Subscript[p, 3])[x]|}.  
4 (c).  Find  (max_(o  ≤  x  ≤  1)) {|f[x] - 
              (Subscript[p, 4])[x]|}.  
4 (d).  Find  (max_(o  ≤  x  ≤  1)) {|f[x] - 
              (Subscript[p, 5])[x]|}.

Solution 4.

Show[ge2]; Show[ge3]; Show[ge4]; Show[ge5];
\(\(Print[\*""For (Subscript[p, 2])[x] over the interval [0,1] we have  |(Subscript[e, 2])[x]| ≤ "", 
        maxerror2\ ];\)\ \ \)
\(\(Print[\*""For (Subscript[p, 3])[x] over the interval [0,1] we have  |(Subscript[e, 3])[x]| ≤ "", 
        maxerror3\ ];\)\ \ \)
\(\(Print[\*""For (Subscript[p, 4])[x] over the interval [0,1] we have  |(Subscript[e, 4])[x]| ≤ "", 
        maxerror4\ ];\)\ \ \)
\(\(Print[\*""For (Subscript[p, 5])[x] over the interval [0,1] we have  |(Subscript[e, 5])[x]| ≤ "", maxerror5\ ];\)\ \ \)

\(\(Print[\*""The remainder term (Subscript[R, n])(x) has the form""];\)\)
\(\(Print[\*""|(Subscript[R, 2])(x)| ≤ "", \*""\!\(M\_3\/\(9\\ \@3\)\) (h^3) = "", 
        M\_3\/\(9\ \@3\), \*""((1/2))^3"", " = ", 
        N[\(M\_3\/\(9\ \@3\)\) \((1\/2)\)\^3]];\)\)
\(\(Print[\*""|(Subscript[R, 3])(x)| ≤ "", \*""((Subscript[M, 4])/24) (h^4) = "", 
        M\_4\/24, \*""((1/3))^4"", " = ", 
        N[\(M\_4\/24\) \((1\/3)\)\^4]];\)\)
\(\(Print[\*""|(Subscript[R, 4])(x)| ≤ "", \*""\!\(\@\(4750 + 290\\ \@145\)\/3000\) (Subscript[M, 5]) (h^5) = "", \@\(4750 + 290\ \@145\)\/3000\ M\_5\ , \*""((1/4))^5"", " = ", 
        N[\@\(4750 + 290\ \@145\)\/3000\ M\_5\ \((1\/4)\)\^5]];\)\)
\(\(Print[\*""|(Subscript[R, 5])(x)| ≤ "", \*""\!\(\(10 + 7\\ \@7\)\/1215\)(Subscript[M, 6]) (h^6) = "", \(\(10 + 7\ \@7\)\/1215\) 
          M\_6, \*""((1/5))^6"", " = ", 
        N[\(\(10 + 7\ \@7\)\/1215\) \(M\_6\) \((1\/5)\)\^6]];\)\)

Print["The maximum error is less than the error bound."];
\(\(Print[\*""|\!\(e\_2\)[x]| ≤ "", 
        maxerror2\ , "   ≤ ", 
        N[\(M\_3\/\(9\ \@3\)\) \((1\/2)\)\^3]];\)\ \ \)
\(\(Print[\*""|\!\(e\_3\)[x]| ≤ "", 
        maxerror3\ , "  ≤ ", 
        N[\(M\_4\/24\) \((1\/3)\)\^4]];\)\)
\(\(Print[\*""|\!\(e\_4\)[x]| ≤ "", 
        maxerror4, " ≤ ", 
        N[\@\(4750 + 290\ \@145\)\/3000\ M\_5\ \((1\/4)\)\^5]];\)\)
\(\(Print[\*""|\!\(e\_5\)[x]| ≤ "", 
        maxerror5, " ≤ ", 
        N[\(\(10 + 7\ \@7\)\/1215\) \(M\_6\) \((1\/5)\)\^6]];\)\)

Various Scenarios and Animations for Lagrange Polynomials.

Example 5.  Find the Lagrange polynomial approximation for  f[x] = (Sqrt[x]), on the interval [0, 2], [0, 8], and [0, 10].

Solution 5 (a).

f[x_] = (Sqrt[x]);  
x0 = 1;  
a = 0; 
b =  10.5; 
c = 0.0; 
d = 3.5; 
a0 = 0.0; 
b0 = 2.0; 
Needs["Graphics`Colors`"]; 
Rends = 
        Graphics[{{Green, Line[{{a0, c}, {a0, d}}]}, {Red, 
              Line[{{x0, c}, {x0, d}}]}, {Green, 
              Line[{{b0, c}, {b0, d}}]}}]; 
For[n = 2, 
      n ≤ 5, n++, 
aa = 
        0.0; 
bb = 2.0; 
XY = 
        N[Table[{aa + ((bb - aa)/n) k, 
              f[aa + ((bb - aa)/n) k]}, {k, 0, 
              n}]]; 
Cdot = 
        ListPlot[XY, PlotStyle -> {Red, PointSize[0.02]}, 
          DisplayFunction -> Identity]; 
P[x_] = 
        Lagrange[XY];    
graph = 
        Plot[{f[x], P[x]}, {x, a, b}, PlotStyle -> {Magenta, Blue}, 
          PlotRange -> {{a, b}, {c, d}}, 
          Ticks -> {Range[0, 10, 2], Range[0, 4, 1]}, 
          DisplayFunction -> Identity]; 
Show[graph, 
        Cdot, Rends, 
        DisplayFunction -> $DisplayFunction]; 
Print["\
f[x] = ", f[x], "\n", "\n", "P[x] = ", 
        P[x], "\n", "\n", "P[x] = ", 
        Chop[Expand[P[x]]]];   ]

Animation 4.  ( Lagrange Polynomial  Lagrange Polynomial ).  Internet hyperlink.

Solution 5 (b).

f[x_] = (Sqrt[x]);  
x0 = 4;  
a = 0; 
b =  10.5; 
c = 0.0; 
d = 3.5; 
a0 = 0.0; 
b0 = 8.0; 
Needs["Graphics`Colors`"];
Rends = 
        Graphics[{{Green, Line[{{a0, c}, {a0, d}}]}, {Red, 
              Line[{{x0, c}, {x0, d}}]}, {Green, 
              Line[{{b0, c}, {b0, d}}]}}]; 
\(For[n = 2, 
      n ≤ 5, \(n++\), 
aa = 
        0.0; 
bb = 8.0; 
XY = 
        N[Table[{aa + \(\(bb - aa\)\/n\) k, 
              f[aa + \(\(bb - aa\)\/n\) k]}, {k, 0, 
              n}]]; 
Cdot = 
        ListPlot[XY, PlotStyle -> {Red, PointSize[0.02]}, 
          DisplayFunction -> Identity]; 
P[x_] = 
        Lagrange[XY]; \ \ \ 
graph = 
        Plot[{f[x], P[x]}, {x, a, b}, PlotStyle -> {Magenta, Blue}, 
          PlotRange -> {{a, b}, {c, d}}, 
          Ticks -> {Range[0, 10, 2], Range[0, 4, 1]}, 
          DisplayFunction -> Identity]; 
Show[graph, 
        Cdot, Rends, 
        DisplayFunction -> $DisplayFunction]; \ \ 
Print["f[x] = ", 
        f[x], "
", "
", "P[x] = ", 
        P[x], "
", "
", "P[x] = ", 
        Chop[Expand[P[x]]]];\ \ \ ]\ \ \)

Animation 5.  ( Lagrange Polynomial  Lagrange Polynomial ).  Internet hyperlink.

Solution 5 (c).

f[x_] = (Sqrt[x]);  
x0 = 5;  
a = 0; 
b =  10.5; 
c = 0.0; 
d = 3.5; 
a0 = 0.0; 
b0 = 10.0; 
Needs["Graphics`Colors`"];
Rends = 
        Graphics[{{Green, Line[{{a0, c}, {a0, d}}]}, {Red, 
              Line[{{x0, c}, {x0, d}}]}, {Green, 
              Line[{{b0, c}, {b0, d}}]}}]; 
\(For[n = 2, 
      n ≤ 5, \(n++\), 
aa = 
        0.0; 
bb = 10.0; 
XY = 
        N[Table[{aa + \(\(bb - aa\)\/n\) k, 
              f[aa + \(\(bb - aa\)\/n\) k]}, {k, 0, 
              n}]]; 
Cdot = 
        ListPlot[XY, PlotStyle -> {Red, PointSize[0.02]}, 
          DisplayFunction -> Identity]; 
P[x_] = 
        Lagrange[XY]; \ \ \ \ 
graph = 
        Plot[{f[x], P[x]}, {x, a, b}, PlotStyle -> {Magenta, Blue}, 
          PlotRange -> {{a, b}, {c, d}}, 
          Ticks -> {Range[0, 10, 2], Range[0, 4, 1]}, 
          DisplayFunction -> Identity]; 
Show[graph, 
        Cdot, Rends, 
        DisplayFunction -> $DisplayFunction]; \ \ 
Print["f[x] = ", 
        f[x], "
", "
", "P[x] = ", 
        P[x], "
", "
", "P[x] = ", 
        Chop[Expand[P[x]]]];\ \ \ ]\ \ \)

Animation 6.  ( Lagrange Polynomial  Lagrange Polynomial ).  Internet hyperlink.

Example 6.  Find the Lagrange polynomial approximation for  f[x] = (1/(Sqrt[1 - x])), on the interval [-1.5, 0.95].

Solution 6.

f[x_] = (1/(Sqrt[1 - x]));  
x0 = 0;  
a = -1.5; 
b =  1.5; 
c = 0.0; 
d = 8.5; 
a0 = -1.0; 
b0 = 1.0; 
Needs["Graphics`Colors`"];
Rends = 
        Graphics[{{Green, Line[{{a0, c}, {a0, d}}]}, {Red, 
              Line[{{x0, c}, {x0, d}}]}, {Green, 
              Line[{{b0, c}, {b0, d}}]}}]; 
\(For[n = 2, 
      n ≤ 
        5, \(n++\), 
aa = \(-1.5\); 
bb = 
        0.95; 
XY = 
        N[Table[{aa + \(\(bb - aa\)\/n\) k, 
              f[aa + \(\(bb - aa\)\/n\) k]}, {k, 0, 
              n}]]; 
Cdot = 
        ListPlot[XY, PlotStyle -> {Red, PointSize[0.02]}, 
          DisplayFunction -> Identity]; 
P[x_] = 
        Lagrange[XY]; \ \ 
graph1 = 
        Plot[f[x], {x, \(-1.5\),  .9999}, PlotStyle -> Magenta, 
          DisplayFunction -> Identity]; 
graph2 = 
        Plot[P[x], {x, \(-1.5\), 1.5}, PlotStyle -> Blue, 
          DisplayFunction -> Identity]; 
Show[graph1, 
        graph2, Cdot, Rends, PlotRange -> {{a, b}, {c, d}}, 
        Ticks -> {Range[\(-1.5\), 1.5, 0.5], Range[0, 5, 1]}, 
        DisplayFunction -> $DisplayFunction]; \ \ 
Print["f[x] = ", 
        f[x], "
", "
", "P[x] = ", 
        P[x], "
", "
", "P[x] = ", 
        Chop[Expand[P[x]]]];\ \ \ ]\ \ \)

Animation 7.  ( Lagrange Polynomial  Lagrange Polynomial ).  Internet hyperlink.

Example 7.  Find the Lagrange polynomial approximation for  f[x] = (1/(1  +  10  (x^2))), on the interval [-1, 1].

Solution 7.

f[x_] = (1/(1 + 10  (x^2)));  
x0 = 0;  
a = -1.5; 
b =  1.5; 
c = 0.0; 
d = 1.25; 
a0 = -1.0; 
b0 = 1.0; 
Needs["Graphics`Colors`"];
Rends = 
        Graphics[{{Green, Line[{{a0, c}, {a0, d}}]}, {Red, 
              Line[{{x0, c}, {x0, d}}]}, {Green, 
              Line[{{b0, c}, {b0, d}}]}}]; 
\(For[n = 3, 
      n ≤ 
        6, \(n++\), 
aa = \(-1.0\); 
bb = 
        1.0; 
XY = 
        N[Table[{aa + \(\(bb - aa\)\/n\) k, 
              f[aa + \(\(bb - aa\)\/n\) k]}, {k, 0, 
              n}]]; 
Cdot = 
        ListPlot[XY, PlotStyle -> {Red, PointSize[0.02]}, 
          DisplayFunction -> Identity]; 
P[x_] = 
        Lagrange[XY]; \ \ 
graph = 
        Plot[{f[x], P[x]}, {x, \(-1.5\), 1.5}, 
          PlotStyle -> {Magenta, Blue}, 
          DisplayFunction -> Identity]; 
Show[graph, 
        Cdot, Rends, PlotRange -> {{a, b}, {c, d}}, 
        Ticks -> {Range[\(-1.5\), 1.5, 0.5], Range[0, 1, 0.5]}, 
        DisplayFunction -> $DisplayFunction]; \ \ 
Print["f[x] = ", 
        f[x], "
", "
", "P[x] = ", 
        P[x], "
", "
", "P[x] = ", 
        Chop[Expand[P[x]]]];\ \ \ ]\ \ \)

Animation 8.  ( Lagrange Polynomial  Lagrange Polynomial ).  Internet hyperlink.

Example 8.  Find the Lagrange polynomial approximation for  f[x] = Log[x], on the interval [0.02, 2], and [0.02, 4].

Solution 8 (a).

f[x_] = Log[x];  
x0 = 1;  
a = -0.5; 
b =  4.1; 
c = -6.0; 
d = 3.0; 
a0 = 0; 
b0 = 2.0; 
Needs["Graphics`Colors`"];
Rends = 
        Graphics[{{Green, Line[{{a0, c}, {a0, d}}]}, {Red, 
              Line[{{x0, c}, {x0, d}}]}, {Green, 
              Line[{{b0, c}, {b0, d}}]}}]; 
\(For[n = 2, 
      n ≤ 5, \(n++\), 
aa = 
        0.02; 
bb = 2.0; 
XY = 
        N[Table[{aa + \(\(bb - aa\)\/n\) k, 
              f[aa + \(\(bb - aa\)\/n\) k]}, {k, 0, 
              n}]]; 
Cdot = 
        ListPlot[XY, PlotStyle -> {Red, PointSize[0.02]}, 
          DisplayFunction -> Identity]; 
P[x_] = 
        Lagrange[XY]; \ \ 
graph1 = 
        Plot[{f[x], P[x]}, {x, 0.001, b}, PlotStyle -> {Magenta, Blue}, 
          DisplayFunction -> Identity]; 
graph2 = 
        Plot[P[x], {x, \(-0.5\), b}, PlotStyle -> {Magenta, Blue}, 
          DisplayFunction -> Identity]; 
Show[graph1, 
        graph2, Cdot, Rends, PlotRange -> {{a, b}, {c, d}}, 
        Ticks -> {Range[\(-0.5\), 4.0, 0.5], Range[\(-5\), 0, 1]}, 
        DisplayFunction -> $DisplayFunction]; \ 
Print["f[x] = ", 
        f[x], "
", "
", "P[x] = ", 
        P[x], "
", "
", "P[x] = ", 
        Chop[Expand[P[x]]]];\ \ \ ]\ \ \)

Animation 9.  ( Lagrange Polynomial  Lagrange Polynomial ).  Internet hyperlink.

Solution 8 (b).

f[x_] = Log[x];  
x0 = 2;  
a = -0.5; 
b =  4.1; 
c = -6.0; 
d = 3.0; 
a0 = 0; 
b0 = 4.0; 
Needs["Graphics`Colors`"];
Rends = 
        Graphics[{{Green, Line[{{a0, c}, {a0, d}}]}, {Red, 
              Line[{{x0, c}, {x0, d}}]}, {Green, 
              Line[{{b0, c}, {b0, d}}]}}]; 
\(For[n = 2, 
      n ≤ 5, \(n++\), 
aa = 
        0.02; 
bb = 4.0; 
XY = 
        N[Table[{aa + \(\(bb - aa\)\/n\) k, 
              f[aa + \(\(bb - aa\)\/n\) k]}, {k, 0, 
              n}]]; 
Cdot = 
        ListPlot[XY, PlotStyle -> {Red, PointSize[0.02]}, 
          DisplayFunction -> Identity]; 
P[x_] = 
        Lagrange[XY]; \ \ 
graph1 = 
        Plot[{f[x], P[x]}, {x, 0.001, b}, PlotStyle -> {Magenta, Blue}, 
          DisplayFunction -> Identity]; 
graph2 = 
        Plot[P[x], {x, \(-0.5\), b}, PlotStyle -> {Magenta, Blue}, 
          DisplayFunction -> Identity]; 
Show[graph1, 
        graph2, Cdot, Rends, PlotRange -> {{a, b}, {c, d}}, 
        Ticks -> {Range[\(-0.5\), 4.0, 0.5], Range[\(-6\), 0, 1]}, 
        DisplayFunction -> $DisplayFunction]; \ 
Print["f[x] = ", 
        f[x], "
", "
", "P[x] = ", 
        P[x], "
", "
", "P[x] = ", 
        Chop[Expand[P[x]]]];\ \ \ ]\ \ \)

Animation 10.  ( Lagrange Polynomial  Lagrange Polynomial ).  Internet hyperlink.

Example 9.  Find the Lagrange polynomial approximation for  f[x] = Sin[x], on the interval [-10, 10].

Solution 9.

f[x_] = Sin[x];  
x0 = 0;  
a = -3 π; 
b = 3  π; 
c = -1.3; 
d =  1.3; 
a0 = -10; 
b0 = 10; 
Needs["Graphics`Colors`"];
Cdot = 
        Graphics[{{Red, PointSize[0.02], 
              Point[{x0, f[x0]}]}}]; 
Rends = 
        Graphics[{{Green, Line[{{a0, c}, {a0, d}}]}, {Red, 
              Line[{{x0, c}, {x0, d}}]}, {Green, 
              Line[{{b0, c}, {b0, d}}]}}]; 
\(For[i = 2, 
      i ≤ 5, \(i++\), 
n = 
        2  i + 4; 
XY = 
        N[Table[{a + \(\(b - a\)\/n\) k, f[a + \(\(b - a\)\/n\) k]}, {k, 0, 
              n}]]; 
Cdot = 
        ListPlot[XY, PlotStyle -> {Red, PointSize[0.02]}, 
          DisplayFunction -> Identity]; 
P[x_] = 
        Lagrange[XY]; 
graph = 
        Plot[{f[x], P[x]}, {x, a, b}, PlotStyle -> {Magenta, Blue}, 
          PlotRange -> {{a, b}, {c, d}}, 
          Ticks -> {Range[\(-3\) π, 3  π, π], 
              Range[\(-0.5\), 1, 0.5]}, 
          DisplayFunction -> Identity]; 
Show[graph, 
        Cdot, Rends, 
        DisplayFunction -> $DisplayFunction]; \ \ 
Print["f[x] = ", 
        f[x], "
", "
", "P[x] = ", 
        Chop[Expand[P[x]]]];\ \ \ ]\ \ \)

Animation 12.  ( Lagrange Polynomial  Lagrange Polynomial ).  Internet hyperlink.

Example 10.  Find the Lagrange polynomial approximation for  f[x] = Cos[x], on the interval [-10, 10].

Solution 10.

f[x_] = Cos[x];  
x0 = 0;  
a = -3 π; 
b = 3  π; 
c = -1.3; 
d =  1.3; 
a0 = -10; 
b0 = 10; 
Needs["Graphics`Colors`"];
Cdot = 
        Graphics[{{Red, PointSize[0.02], 
              Point[{x0, f[x0]}]}}]; 
Rends = 
        Graphics[{{Green, Line[{{a0, c}, {a0, d}}]}, {Red, 
              Line[{{x0, c}, {x0, d}}]}, {Green, 
              Line[{{b0, c}, {b0, d}}]}}]; 
\(For[i = 3, 
      i ≤ 6, \(i++\), 
n = 
        2  i; 
XY = 
        N[Table[{a + \(\(b - a\)\/n\) k, f[a + \(\(b - a\)\/n\) k]}, {k, 0, 
              n}]]; 
Cdot = 
        ListPlot[XY, PlotStyle -> {Red, PointSize[0.02]}, 
          DisplayFunction -> Identity]; 
P[x_] = 
        Lagrange[XY]; 
graph = 
        Plot[{f[x], P[x]}, {x, a, b}, PlotStyle -> {Magenta, Blue}, 
          PlotRange -> {{a, b}, {c, d}}, 
          Ticks -> {Range[\(-3\) π, 3  π, π], 
              Range[\(-0.5\), 1, 0.5]}, 
          DisplayFunction -> Identity]; 
Show[graph, 
        Cdot, Rends, 
        DisplayFunction -> $DisplayFunction]; \ \ 
Print["f[x] = ", 
        f[x], "
", "
", "P[x] = ", 
        Chop[Expand[P[x]]]];\ \ \ ]\ \ \)

Animation 13.  ( Lagrange Polynomial  Lagrange Polynomial ).  Internet hyperlink.

Example 11.  Find the Lagrange polynomial approximation for  f[x] = Tan[x], on the interval [-1.45, 1.45].

Solution 11.

f[x_] = Tan[x];  
x0 = 0;  
a = -π; 
b = π; 
c = -10; 
d =  10; 
a0 = -1.45; 
b0 = 1.45; 
Needs["Graphics`Colors`"];
Rends = 
        Graphics[{{Green, Line[{{a0, c}, {a0, d}}]}, {Red, 
              Line[{{x0, c}, {x0, d}}]}, {Green, 
              Line[{{b0, c}, {b0, d}}]}}]; 
\(For[n = 3, 
      n ≤ 
        6, \(n++\), 
aa = \(-1.45\); 
bb = 1.45; 
XY = 
        N[Table[{aa + \(\(bb - aa\)\/n\) k, 
              f[aa + \(\(bb - aa\)\/n\) k]}, {k, 0, 
              n}]]; 
Cdot = 
        ListPlot[XY, PlotStyle -> {Red, PointSize[0.02]}, 
          DisplayFunction -> Identity]; 
P[x_] = 
        Lagrange[XY]; \ 
graph1 = 
        Plot[f[x], {x, a, \(-π\)\/2}, PlotStyle -> {Magenta}, 
          DisplayFunction -> Identity]; 
graph2 = 
        Plot[f[x], {x, \(-π\)\/2, π\/2}, PlotStyle -> {Magenta}, 
          DisplayFunction -> Identity]; 
graph3 = 
        Plot[f[x], {x, π\/2, b}, PlotStyle -> {Magenta}, 
          DisplayFunction -> Identity]; 
graph4 = 
        Plot[P[x], {x, \(-π\), π}, PlotStyle -> {Blue}, 
          DisplayFunction -> Identity]; 
Show[graph1, 
        graph2, graph3, graph4, Cdot, Rends, 
        PlotRange -> {{a, b}, {c, d}}, 
        Ticks -> {Range[\(-π\), π, π\/2], 
            Range[\(-6\), 10, 2]}, 
        DisplayFunction -> $DisplayFunction]; \ \ 
Print["f[x] = ", 
        f[x], "
", "
", "P[x] = ", 
        P[x], "
", "
", "P[x] = ", 
        Chop[Expand[P[x]]]];\ \ \ ]\ \ \)

Animation 14.  ( Lagrange Polynomial  Lagrange Polynomial ).  Internet hyperlink.

Example 12.  Find the Lagrange polynomial approximation for  f[x] = (e^x), on the interval [-5, 5].

Solution 12.

f[x_] = (E^x);  
x0 = 0;  
a = -2.0; 
b =  3.0; 
c = -4.0; 
d = 20.5; 
a0 = -5.0; 
b0 = 5.0; 
Needs["Graphics`Colors`"];
Rends = 
        Graphics[{{Green, Line[{{a0, c}, {a0, d}}]}, {Red, 
              Line[{{x0, c}, {x0, d}}]}, {Green, 
              Line[{{b0, c}, {b0, d}}]}}]; 
\(For[n = 2, 
      n ≤ 5, \(n++\), 
XY = 
        N[Table[{a + \(\(b - a\)\/n\) k, f[a + \(\(b - a\)\/n\) k]}, {k, 0, 
              n}]]; 
Cdot = 
        ListPlot[XY, PlotStyle -> {Red, PointSize[0.02]}, 
          DisplayFunction -> Identity]; 
P[x_] = 
        Lagrange[XY]; 
graph1 = 
        Plot[{f[x], P[x]}, {x, a, b}, PlotStyle -> {Magenta, Blue}, 
          PlotRange -> {{a, b}, {c, d}}, 
          Ticks -> {Range[\(-2\), 3, 1], Range[0, 20, 5]}, 
          DisplayFunction -> Identity]; 
figure = 
        Show[graph1, Cdot, Rends, 
          DisplayFunction -> $DisplayFunction]; \ 
Print["f[x] = ", 
        f[x], "
", "
", "P[x] = ", 
        P[x], "
", "
", "P[x] = ", 
        Chop[Expand[P[x]]]];\ \ \ ]\ \ \)

Animation 15.  ( Lagrange Polynomial  Lagrange Polynomial ).  Internet hyperlink.

Example 13.  Find the Lagrange polynomial approximation for  f[x] = ArcTan[x], on the interval [-2, 2].

Solution 13.

f[x_] = ArcTan[x];  
x0 = 0;  
a = -2; 
b =  2; 
c = -1.6; 
d =  1.6; 
a0 = -2; 
b0 = 2; 
Needs["Graphics`Colors`"];
Rends = 
        Graphics[{{Green, Line[{{a0, c}, {a0, d}}]}, {Red, 
              Line[{{x0, c}, {x0, d}}]}, {Green, 
              Line[{{b0, c}, {b0, d}}]}}]; 
\(For[n = 3, 
      n ≤ 
        6, \(n++\), 
aa = \(-2.0\); 
bb = 
        2.0; 
XY = 
        N[Table[{aa + \(\(bb - aa\)\/n\) k, 
              f[aa + \(\(bb - aa\)\/n\) k]}, {k, 0, 
              n}]]; 
Cdot = 
        ListPlot[XY, PlotStyle -> {Red, PointSize[0.02]}, 
          DisplayFunction -> Identity]; 
P[x_] = 
        Lagrange[XY]; \ \ 
graph = 
        Plot[{f[x], P[x]}, {x, a, b}, PlotStyle -> {Magenta, Blue}, 
          PlotRange -> {{a, b}, {c, d}}, 
          Ticks -> {Range[\(-1.5\), 1.5, 0.5], 
              Range[\(-π\)\/4, π\/4, π\/4]}, 
          DisplayFunction -> Identity]; 
Show[graph, 
        Cdot, Rends, 
        DisplayFunction -> $DisplayFunction]; \ 
Print["f[x] = ", 
        f[x], "
", "
", "P[x] = ", 
        P[x], "
", "
", "P[x] = ", 
        Chop[Expand[P[x]]]];\ \ \ ]\ \ \)

Animation 18.  ( Lagrange Polynomial  Lagrange Polynomial ).  Internet hyperlink.

Example 14.  Find the Lagrange polynomial approximation for  f[x] = ArcSin[x], on the interval [-1, 1].

Solution 14.

f[x_] = ArcSin[x];  
x0 = 0;  
a = -1.5; 
b =  1.5; 
c = -2.2; 
d = 2.2; 
a0 = -1.0; 
b0 = 1.0; 
Needs["Graphics`Colors`"];
Rends = 
        Graphics[{{Green, Line[{{a0, c}, {a0, d}}]}, {Red, 
              Line[{{x0, c}, {x0, d}}]}, {Green, 
              Line[{{b0, c}, {b0, d}}]}}]; 
\(For[n = 3, 
      n ≤ 
        6, \(n++\), 
aa = \(-1.0\); 
bb = 
        1.0; 
XY = 
        N[Table[{aa + \(\(bb - aa\)\/n\) k, 
              f[aa + \(\(bb - aa\)\/n\) k]}, {k, 0, 
              n}]]; 
Cdot = 
        ListPlot[XY, PlotStyle -> {Red, PointSize[0.02]}, 
          DisplayFunction -> Identity]; 
P[x_] = 
        Lagrange[XY]; \ 
graph1 = 
        Plot[{f[x], P[x]}, {x, \(-0.9999\), 0.9999}, 
          PlotStyle -> Magenta, 
          DisplayFunction -> Identity]; 
graph2 = 
        Plot[P[x], {x, \(-1.5\), 1.5}, PlotStyle -> Blue, 
          DisplayFunction -> Identity]; 
Show[graph1, 
        graph2, Cdot, Rends, PlotRange -> {{a, b}, {c, d}}, 
        Ticks -> {Range[\(-1.5\), 1.5, 0.5], 
            Range[\(-π\)\/2, π\/2, π\/4]}, 
        DisplayFunction -> $DisplayFunction]; \ 
Print["f[x] = ", 
        f[x], "
", "
", "P[x] = ", 
        P[x], "
", "
", "P[x] = ", 
        Chop[Expand[P[x]]]];\ \ \ ]\ \ \)

Animation 19.  ( Lagrange Polynomial  Lagrange Polynomial ).  Internet hyperlink.

Example 15.  Find the Lagrange polynomial approximation for  f[x] = BesselJ[0, x], on the interval [-10, 10].

Solution 15.

f[x_] = BesselJ[0, x];  
x0 = 0;  
a = -10.2; 
b = 10.2; 
c = -0.8; 
d =  1.3; 
a0 = -11; 
b0 = 11; 
Needs["Graphics`Colors`"];
Cdot = 
        Graphics[{{Red, PointSize[0.02], 
              Point[{x0, f[x0]}]}}]; 
Rends = 
        Graphics[{{Green, Line[{{a0, c}, {a0, d}}]}, {Red, 
              Line[{{x0, c}, {x0, d}}]}, {Green, 
              Line[{{b0, c}, {b0, d}}]}}]; 
\(For[n = 5, 
      n ≤ 
        8, \(n++\), 
aa = \(-10\); 
bb = 
        10; 
XY = 
        N[Table[{aa + \(\(bb - aa\)\/n\) k, 
              f[aa + \(\(bb - aa\)\/n\) k]}, {k, 0, 
              n}]]; 
Cdot = 
        ListPlot[XY, PlotStyle -> {Red, PointSize[0.02]}, 
          DisplayFunction -> Identity]; 
P[x_] = 
        Lagrange[XY]; 
graph = 
        Plot[{f[x], P[x]}, {x, a, b}, PlotStyle -> {Magenta, Blue}, 
          PlotRange -> {{a, b}, {c, d}}, 
          Ticks -> {Range[\(-10\), 10, 2], Range[\(-0.5\), 1, 0.5]}, 
          DisplayFunction -> Identity]; 
Show[graph, 
        Cdot, Rends, 
        DisplayFunction -> $DisplayFunction]; \ \ 
Print["f[x] = ", 
        f[x], "
", "
", "P[x] = ", 
        Chop[Expand[P[x]]]];\ \ \ ]\ \ \)

Animation 20.  ( Lagrange Polynomial  Lagrange Polynomial ).  Internet hyperlink.

Example 16.  Find the Lagrange polynomial approximation for  f[x] = (1/(Sqrt[2  π])) (e^(-(x^2)/2)), on the interval [-3, 3].

Solution 16.

f[
          x_] = (1/(Sqrt[2  π])) (E^(-(x^2)/2));  
x0 = 0;  
a = -3.0; 
b =  3.0; 
c = -0.15; 
d = 0.5; 
a0 = -4.0; 
b0 = 4.0; 
Needs["Graphics`Colors`"];
Cdot = 
        Graphics[{{Red, PointSize[0.02], 
              Point[{x0, f[x0]}]}}]; 
Rends = 
        Graphics[{{Green, Line[{{a0, c}, {a0, d}}]}, {Red, 
              Line[{{x0, c}, {x0, d}}]}, {Green, 
              Line[{{b0, c}, {b0, d}}]}}]; 
\(For[i = 2, 
      i ≤ 5, \(i++\), 
n = 
        2  i; 
aa = \(-3.0\); 
bb = 
        3.0; 
XY = 
        N[Table[{aa + \(\(bb - aa\)\/n\) k, 
              f[aa + \(\(bb - aa\)\/n\) k]}, {k, 0, 
              n}]]; 
Cdot = 
        ListPlot[XY, PlotStyle -> {Red, PointSize[0.02]}, 
          DisplayFunction -> Identity]; 
P[x_] = 
        Lagrange[XY]; 
graph = 
        Plot[{f[x], P[x]}, {x, a, b}, PlotStyle -> {Magenta, Blue}, 
          PlotRange -> {{a, b}, {c, d}}, 
          Ticks -> {Range[\(-3\), 3, 1], Range[0, 0.4, 0.1]}, 
          DisplayFunction -> Identity]; 
Show[graph, 
        Cdot, Rends, 
        DisplayFunction -> $DisplayFunction]; \ \ 
Print["f[x] = ", 
        f[x], "
", "
", "P[x] = ", 
        Chop[Expand[P[x]]]];\ \ \ ]\ \ \)

Animation 22.  ( Lagrange Polynomial  Lagrange Polynomial ).  Internet hyperlink.

Example 17.  Find the Lagrange polynomial approximation for  f[x] = (1/2)  + (1/2) Erf[(x/(Sqrt[2]))], on the interval [-3, 3].

Solution 17.

f[x_] = (1/2)  + (1/2) Erf[(x/(Sqrt[2]))];  
x0 = 0;  
a = -3.0; 
b =  3.0; 
c = -0.25; 
d = 1.25; 
a0 = -4. ; 
b0 = 4.0; 
Needs["Graphics`Colors`"];
Cdot = 
        Graphics[{{Red, PointSize[0.02], 
              Point[{x0, f[x0]}]}}]; 
Rends = 
        Graphics[{{Green, Line[{{a0, c}, {a0, d}}]}, {Red, 
              Line[{{x0, c}, {x0, d}}]}, {Green, 
              Line[{{b0, c}, {b0, d}}]}}]; 
\(For[i = 2, 
      i ≤ 5, \(i++\), 
n = 
        2  i; 
aa = \(-3.0\); 
bb = 
        3.0; 
XY = 
        N[Table[{aa + \(\(bb - aa\)\/n\) k, 
              f[aa + \(\(bb - aa\)\/n\) k]}, {k, 0, 
              n}]]; 
Cdot = 
        ListPlot[XY, PlotStyle -> {Red, PointSize[0.02]}, 
          DisplayFunction -> Identity]; 
P[x_] = 
        Lagrange[XY]; 
graph = 
        Plot[{f[x], P[x]}, {x, a, b}, PlotStyle -> {Magenta, Blue}, 
          PlotRange -> {{a, b}, {c, d}}, 
          Ticks -> {Range[\(-3\), 3, 1], Range[0, 0.8, 0.25]}, 
          DisplayFunction -> Identity]; 
Show[graph, 
        Cdot, Rends, 
        DisplayFunction -> $DisplayFunction]; \ \ 
Print["f[x] = ", 
        f[x], "
", "
", "P[x] = ", 
        Chop[Expand[P[x]]]];\ \ \ ]\ \ \)

Animation 23.  ( Lagrange Polynomial  Lagrange Polynomial ).  Internet hyperlink.

Animations (Lagrange Polynomial Approximation  Lagrange Polynomial Approximation).  Internet hyperlinks to animations.

Old Lab Project (Lagrange Polynomial Approximation  Lagrange Polynomial Approximation).  Internet hyperlinks to an old lab project.

Research Experience for Undergraduates

Lagrange Polynomials  Lagrange Polynomials  Internet hyperlinks to web sites and a bibliography of articles.