NotebookFileName[]

Legendre polynomials  (Subscript[P, 0])(x),...,(Subscript[P, 9])(x)

Below is a table of the inner products of the first ten monomials:

TableForm[Table[Integrate[(x^j) (x^k),{x,-1,1}],{j,0,9},{k,0,9}],TableHeadings->{{"1","x","(x^2)","(x^3)","(x^4)","(x^5)","(x^6)","(x^7)","(x^8)","(x^9)"},{"1","x","(x^2)","(x^3)","(x^4)","(x^5)","(x^6)","(x^7)","(x^8)","(x^9)"}}]

Mathematica has its own command for to orthonormalize functions.

The command

x^Range[0,9]

lists the first ten monomials. The following command will give us the orthonormalized monomials.  The logic of this command is that we give the formula for the inner product in the special form:

Integrate[#1*#2,{x,-1,1}]&[f[x],g[x]]

Below I name the list of orthonormalized polynomials OrNoPo9

OrNoPo9=Expand[FullSimplify[Orthogonalize[x^Range[0,9],Integrate[#1*#2,{x,-1,1}]&]]]

The orthonormalized polynomials have norms 1. To prove this calculate:

TableForm[Table[Integrate[OrNoPo9[[j]]OrNoPo9[[k]],{x,-1,1}],{j,1,10},{k,1,10}]]

It is common to introduce the polynomials that have value 1 at x=1. Now calculate the values at x=1 for all polynomials in OrNoPo9

OrNoPo9/.{x->1}

LePo9=Expand[(1/(OrNoPo9/.{x->1}))OrNoPo9]

Next we calculate that the Legendre Polynomials are orthogonal to each other:

TableForm[Table[Integrate[LePo9[[j]]LePo9[[k]],{x,-1,1}],{j,1,10},{k,1,10}]]

These polynomials are called Legendre Polynomials. Just to verify that these polynomials have value 1 at x=1

LePo9/.{x->1}

Next I will give a recursive  definition of orthogonal polynomials as we do it on the website, using the Gram-Schmidt algorithm:

Clear[GrScOr];GrScOr[0,x_]=1; GrScOr[1,x_]=x;GrScOr[n_,x_]:=GrScOr[n,x]=Expand[(x^n)-Sum[((Integrate[(x^n)*GrScOr[k,x],{x,-1,1}])/(Integrate[((GrScOr[k,x])^2),{x,-1,1}]))GrScOr[k,x],{k,0,n-1}]]

GrScOr[7,x]

(GrScOr[7,t])/.{t->1}

Here is the list of the first 10 of orthogonal polynomials obtained in this way:

TableForm[Expand[FullSimplify[Table[GrScOr[k,x],{k,0,9}]]]]

We can use this definition to get an alternative formula for Legendre Polynomials:

LePoR[n_,x_]:=Expand[(1/((GrScOr[n,t])/.{t->1}))GrScOr[n,x]]

LePoR[7,x]

LePoR[9,x]

Here is the list of the first 10 Legendre Polynomials

TableForm[Expand[FullSimplify[Table[LePoR[k,x],{k,0,9}]]]]

Next is a little nice representation of a Legendre Polynomial

((Last[LePo9]/.{a_*x^n_.:>DisplayForm@RowBox[{"(",MakeBoxes@a,")"}]*HoldForm[x^n]})/. HoldForm[x^1]:>HoldForm[x])

Next, we plot Legendre Polynomials:

Plot[Evaluate[LePo9],{x,-1,1},PlotStyle-> ColorData[97,"ColorList"][[Range[1,10,1]]],PlotRange->{{-1,1},{-1,1}},AspectRatio->Automatic,ImageSize->500]

Plot[Evaluate[LePo9],{x,-1,1},PlotStyle->({Thickness[0.004],#}&/@ ColorData[97,"ColorList"][[Range[1,10,1]]]),PlotRange->{{-1,1},{-1,1}},AspectRatio->Automatic,ImageSize->500]

InputForm[ColorData[97,"ColorList"][[Range[1,2,1]]]]

Next, I display the first five Legendre Polynomials of even degree

Plot[Evaluate[LePo9[[Range[1,10,2]]]],{x,-1,1},PlotStyle->InputForm[ColorData[97,"ColorList"][[Range[1,10,2]]]],PlotRange->{{-1,1},{-0.6,1}},AspectRatio->Automatic,ImageSize->500]

Odd degree

Plot[Evaluate[LePo9[[Range[2,10,2]]]],{x,-1,1},PlotStyle->ColorData[97,"ColorList"][[Range[2,10,2]]],PlotRange->{{-1,1},{-1,1}},AspectRatio->Automatic,ImageSize->500]

allL=Plot[Evaluate[LePo9],{x,-1,1},PlotPoints->201,PlotStyle->({Thickness[0.001],#}&/@ ColorData[97,"ColorList"][[Range[1,10,1]]]),PlotRange->{{-1,1},{-1,1}},AspectRatio->Automatic,ImageSize->500]

lp=Table[TraditionalForm[(Subscript[P, n])[x]],{n,0,9}]

Manipulate[Show[allL,Plot[Evaluate[LePo9[[n+1]]],{x,-1,1},PlotPoints->201,PlotStyle->{Thickness[0.006], ColorData[97,"ColorList"][[n+1]]}],Graphics[{{RGBColor[1,1,0],Polygon[{{-0.9,0.74},{0.7,0.74},{0.7,0.98},{-0.9,0.98},{-0.9,0.74}}]},Text["Legendre polynomial",{-0.12,0.775},{1,0},BaseStyle->{FontSize->12}],Text[lp[[n+1]],{-0.09,0.775},{-1,0},BaseStyle->{FontSize->14}],
Text[PolynomialForm[LegendreP[n,x],TraditionalOrder->False],{-0.1,0.9},{0,0},BaseStyle->{FontSize->10}]}],ImageSize->400,PlotRange->{{-1.005,1.005},{-1,1}},AspectRatio->Automatic,Axes->False,Frame->True,FrameTicks->{{{-1,0,1},{}},{{-1,0,1},{}}},GridLines->{Range[-1,1,0.1],Range[-1,1,0.1]},GridLinesStyle->{{GrayLevel[0.8],Dashing[{0,Small}]},{GrayLevel[0.8],Dashing[{0,Small}]}}
],
{{n,5},Range[0,9],Setter},ControlPlacement->Top,SaveDefinitions->True]

Below I explore how to display polynomials in traditional form (closed)

Display polynomials in traditional form

((LePo9[[10]]/.{a_*x^n_.:>DisplayForm@RowBox[{"(",MakeBoxes@a,")"}]*HoldForm[x^n]})/. HoldForm[x^1]:>HoldForm[x])

Table[((LePo9[[n+1]]/.{a_*x^n_.:>DisplayForm@RowBox[{"(",MakeBoxes@a,")"}]*HoldForm[x^n]})/. HoldForm[x^1]:>HoldForm[x]),{n,0,9}];

ttt={"1","x","-(1/2)+((3/2)) (x^2)","(-(3/2)) x+((5/2)) (x^3)","(3/8)+(-(15/4)) (x^2)+((35/8)) (x^4)","((15/8)) x+(-(35/4)) (x^3)+((63/8)) (x^5)","-(5/16)+((105/16)) (x^2)+(-(315/16)) (x^4)+((231/16)) (x^6)","(-(35/(16))) x+((315/16)) (x^3)+(-(693/16)) (x^5)+((429/16)) (x^7)","(35/128)+(-(315/32)) (x^2)+((3465/64)) (x^4)+(-(3003/32)) (x^6)+((6435/128)) (x^8)","((315/128)) x+(-(1155/32)) (x^3)+((9009/64)) (x^5)+(-(6435/32)) (x^7)+((12155/128)) (x^9)"};

ttt[[4]]

Approximations

Next we calculate the approximations of some functions using the first 10 Legendre Polynomials.

First we calculate the squares of the norms of the first 10 Legendre Polynomials:

Table[{Integrate[((LePo9[[k]])^2),{x,-1,1}],(2/(2 k -1))},{k,1,10}]

Next we calculate the best approximations of some familiar functions with the first 10 Legendre Polynomials. In the above Manipulations n stands for the degree of the approximating polynomial. The approximation by the polynomial of degree n is calculated as the projection of a given function f[x] onto the span of the first n Legendre Polynomials. The formula is familiar from our work with the dot product, we just replace the dot product with integrals:

(∑_(k=0)^n)((2k+1)/2)((∫_(-1)^1)f[ξ](Subscript[P, k])[ξ]dξ)(Subscript[P, k])[x]   (this is a function of x, call it (Subscript[Proj, n])[x])

By the general Pythagorean Theorem the norm of this projection is

(Sqrt[(∫_(-1)^1)|(Subscript[Proj, n])[x]((|)^2)dx])=(Sqrt[(∑_(k=0)^n)((2k+1)/2)((((∫_(-1)^1)f[ξ](Subscript[P, k])[ξ]dξ))^2)])

Here (Subscript[P, k])[x] is k-th Legendre Polynomial. In the command below it is LePo9[[k]], a member of the list of the Legendre Polynomials that I created earlier.

The calculation of the error is as follows:

(Sqrt[(∫_(-1)^1)|f[x]-(Subscript[Proj, n])[x]((|)^2)dx ]) = (Sqrt[(∫_(-1)^1)|f[x]((|)^2)dx-(∑_(k=0)^n)((2k+1)/2)((((∫_(-1)^1)f[ξ](Subscript[P, k])[ξ]dξ))^2)])

Clear[App];DynamicModule[{App,coeff},App=Expand[Table[((2 k -1)/2)NIntegrate[Cos[Pi x]*LePo9[[k]],{x,-1,1},WorkingPrecision->20,AccuracyGoal->12]*LePo9[[k]],{k,1,10}]];coeff=Table[((2 k -1)/2)((NIntegrate[Cos[Pi x]*LePo9[[k]],{x,-1,1},WorkingPrecision->20,AccuracyGoal->12])^2),{k,1,10}];Manipulate[Plot[{Cos[Pi x],Total[App[[Range[n+1]]]]},{x,-1,1},PlotStyle->{{Thickness[0.012],RGBColor[0,0,0.5]},{Thickness[0.004],RGBColor[1,0,0]}},Epilog->{Text["error ≈",{0.8,1.2},{0,0}],Text[N[√NIntegrate[(((Cos[Pi x]- Total[App[[Range[n+1]]]]))^2),{x,-1,1},WorkingPrecision->20,AccuracyGoal->12]],{0.8,1.1},{0,0}],Text[Sqrt[N[NIntegrate[(((Cos[Pi x]))^2),{x,-1,1},WorkingPrecision->20,AccuracyGoal->12]- Total[coeff[[Range[n+1]]]]]],{0.8,1},{0,0}]},PlotRange->{-1.3,1.3},ImageSize->500],{{n,5},Range[0,9],Setter},ControlPlacement->Top,SaveDefinitions->True]]

Clear[App];DynamicModule[{App,coeff},App=Expand[Table[((2 k -1)/2)NIntegrate[Sin[Pi x]*LePo9[[k]],{x,-1,1},WorkingPrecision->20,AccuracyGoal->12]*LePo9[[k]],{k,1,10}]];coeff=Table[((2 k -1)/2)((NIntegrate[Sin[Pi x]*LePo9[[k]],{x,-1,1},WorkingPrecision->20,AccuracyGoal->12])^2),{k,1,10}];Manipulate[Plot[{Sin[Pi x],Total[App[[Range[n+1]]]]},{x,-1,1},PlotStyle->{{Thickness[0.012],RGBColor[0,0,0.5]},{Thickness[0.004],RGBColor[1,0,0]}},Epilog->{Text["error ≈",{-0.8,1.2},{0,0}],Text[N[√NIntegrate[(((Sin[Pi x]- Total[App[[Range[n+1]]]]))^2),{x,-1,1},WorkingPrecision->14,AccuracyGoal->12]],{-0.8,1.1},{0,0}],Text[Sqrt[N[NIntegrate[(((Sin[Pi x]))^2),{x,-1,1},WorkingPrecision->20,AccuracyGoal->12]- Total[coeff[[Range[n+1]]]]]],{-0.8,1},{0,0}]},PlotRange->{-1.3,1.3},ImageSize->500],{{n,5},Range[0,9],Setter},ControlPlacement->Top,SaveDefinitions->True]]

Clear[App];DynamicModule[{App,coeff},App=Expand[Table[((2 k -1)/2)NIntegrate[Exp[x]*LePo9[[k]],{x,-1,1},WorkingPrecision->20,AccuracyGoal->12]*LePo9[[k]],{k,1,10}]];coeff=Table[((2 k -1)/2)((NIntegrate[Exp[x]*LePo9[[k]],{x,-1,1},WorkingPrecision->20,AccuracyGoal->12])^2),{k,1,10}];Manipulate[Plot[{Exp[x],Total[App[[Range[n+1]]]]},{x,-1,1},PlotStyle->{{Thickness[0.012],RGBColor[0,0,0.5]},{Thickness[0.004],RGBColor[1,0,0]}},Epilog->{Text["error ≈",{-0.8,2.85},{0,0}],Text[N[√NIntegrate[(((Exp[x]- Total[App[[Range[n+1]]]]))^2),{x,-1,1},WorkingPrecision->14,AccuracyGoal->12]],{-0.8,2.7},{0,0}],Text[Sqrt[N[NIntegrate[(((Exp[x]))^2),{x,-1,1},WorkingPrecision->20,AccuracyGoal->12]- Total[coeff[[Range[n+1]]]]]],{-0.8,2.55},{0,0}]},PlotRange->{-.3,3.3},ImageSize->500],{{n,5},Range[0,9],Setter},ControlPlacement->Top,SaveDefinitions->True]]

Clear[App];DynamicModule[{App,coeff},App=Expand[Table[((2 k -1)/2)NIntegrate[x UnitStep[x]*LePo9[[k]],{x,-1,1},WorkingPrecision->20,AccuracyGoal->12]*LePo9[[k]],{k,1,10}]];
coeff=Table[((2 k -1)/2)((NIntegrate[x UnitStep[x]*LePo9[[k]],{x,-1,1},WorkingPrecision->20,AccuracyGoal->12])^2),{k,1,10}];Manipulate[Plot[{x UnitStep[x],Total[App[[Range[n+1]]]]},{x,-1,1},PlotStyle->{{Thickness[0.01],RGBColor[0,0,0.5]},{Thickness[0.005],RGBColor[1,0,0]}},
Epilog->{Text["error ≈",{-0.8,1.1},{0,0}],Text[N[√NIntegrate[(((x UnitStep[x]- Total[App[[Range[n+1]]]]))^2),{x,-1,1},WorkingPrecision->14,AccuracyGoal->12]],{-0.8,1.05},{0,0}],Text[Sqrt[N[NIntegrate[(((x UnitStep[x]))^2),{x,-1,1},WorkingPrecision->20,AccuracyGoal->12]- Total[coeff[[Range[n+1]]]]]],{-0.8,1},{0,0}]},PlotRange->{-0.2,1.2},ImageSize->500,AspectRatio->Automatic],{{n,5},Range[0,9],Setter},ControlPlacement->Top,SaveDefinitions->True]]

Clear[App];DynamicModule[{App,coeff},App=Expand[Table[((2 k -1)/2)NIntegrate[Sign[x]*LePo9[[k]],{x,-1,1},WorkingPrecision->20,AccuracyGoal->12]*LePo9[[k]],{k,1,10}]];coeff=Table[((2 k -1)/2)((NIntegrate[Sign[x]*LePo9[[k]],{x,-1,1},WorkingPrecision->20,AccuracyGoal->12])^2),{k,1,10}];Manipulate[Plot[{Sign[x],Total[App[[Range[n+1]]]]},{x,-1,1},PlotStyle->{{Thickness[0.01],RGBColor[0,0,0.6]},{Thickness[0.006],RGBColor[1,0,0]}},Exclusions->{0},Prolog->{{PointSize[0.024],RGBColor[0,0,0.5],Point[#]&/@{{0,0}}}},Epilog->{{PointSize[0.024],RGBColor[0,0,0.5],Point[#]&/@{{0,-1},{0,1}}},{PointSize[0.015],RGBColor[1,1,1],Point[#]&/@{{0,-1},{0,1}}},Text["error ≈",{-0.8,1.2},{0,0}],Text[N[√NIntegrate[(((Sign[x]- Total[App[[Range[n+1]]]]))^2),{x,-1,1},WorkingPrecision->14,AccuracyGoal->12]],{-0.8,1.1},{0,0}],Text[Sqrt[N[NIntegrate[(((Sign[x]))^2),{x,-1,1},WorkingPrecision->20,AccuracyGoal->12]- Total[coeff[[Range[n+1]]]]]],{-0.8,1},{0,0}]},
PlotRange->{{-1.3,1.3},{-1.3,1.3}},ImageSize->500,AspectRatio->(1/GoldenRatio)],{{n,5},Range[0,9],Setter},ControlPlacement->Top,SaveDefinitions->True]]

Clear[App];DynamicModule[{App,coeff},App=Expand[Table[((2 k -1)/2)NIntegrate[Abs[x]*LePo9[[k]],{x,-1,1},WorkingPrecision->20,AccuracyGoal->12]*LePo9[[k]],{k,1,10}]];coeff=Table[((2 k -1)/2)((NIntegrate[Abs[x]*LePo9[[k]],{x,-1,1},WorkingPrecision->20,AccuracyGoal->12])^2),{k,1,10}];Manipulate[Plot[{Abs[x],Total[App[[Range[n+1]]]]},{x,-1,1},PlotStyle->{{Thickness[0.011],RGBColor[0,0,0.5]},{Thickness[0.006],RGBColor[1,0,0]}},
Epilog->{Text["error ≈",{-0.6,1.2},{0,0}],Text[N[√NIntegrate[(((Abs[x]- Total[App[[Range[n+1]]]]))^2),{x,-1,1},WorkingPrecision->14,AccuracyGoal->12]],{-0.6,1.15},{0,0}],Text[Sqrt[N[NIntegrate[(((Abs[x]))^2),{x,-1,1},WorkingPrecision->20,AccuracyGoal->12]- Total[coeff[[Range[n+1]]]]]],{-0.6,1.1},{0,0}]},PlotRange->{-0.3,1.3},ImageSize->500,AspectRatio->Automatic],{{n,5},Range[0,9],Setter},ControlPlacement->Top,SaveDefinitions->True]]

Clear[App];DynamicModule[{App,coeff},App=Expand[Table[((2 k -1)/2)NIntegrate[Clip[x,{-1/2,1/2}]*LePo9[[k]],{x,-1,1},WorkingPrecision->20,AccuracyGoal->12]*LePo9[[k]],{k,1,10}]];
coeff=Table[((2 k -1)/2)((NIntegrate[Clip[x,{-1/2,1/2}]*LePo9[[k]],{x,-1,1},WorkingPrecision->20,AccuracyGoal->12])^2),{k,1,10}];Manipulate[Plot[{Clip[x,{-1/2,1/2}],Total[App[[Range[n+1]]]]},{x,-1,1},PlotStyle->{{Thickness[0.01],RGBColor[0,0,0.5]},{Thickness[0.005],RGBColor[1,0,0]}},
Epilog->{Text["error ≈",{-0.7,0.7},{0,0}],Text[N[√NIntegrate[(((Clip[x,{-1/2,1/2}]- Total[App[[Range[n+1]]]]))^2),{x,-1,1},WorkingPrecision->14,AccuracyGoal->12]],{-0.7,0.65},{0,0}],Text[Sqrt[N[NIntegrate[(((Clip[x,{-1/2,1/2}]))^2),{x,-1,1},WorkingPrecision->20,AccuracyGoal->12]- Total[coeff[[Range[n+1]]]]]],{-0.7,0.6},{0,0}]},PlotRange->{-0.75,0.75},ImageSize->500,AspectRatio->Automatic],{{n,5},Range[0,9],Setter},ControlPlacement->Top,SaveDefinitions->True]]

Below are some unrelated explorations (closed cells)

Learn Fold

Clear[GramSchmidt];GramSchmidt:=Fold[
Append[
#1,((1/(Sqrt[#1.#1]))#1&)[Fold[#1-(#1.#2)#2,#2,#1]]]&,{},#1]&

mu={{1,1,1},{1,1,0},{3,2,1}}

Clear[GramSchmidt];GramSchmidt:=Fold[
Append[
#1,Fold[#1-(#1.#2)#2,#2,#1]]&,{},#1]&

oneStepOrtogonalizeGen[vec_,{},_,_,_]:=vec;

oneStepOrtogonalizeGen[vec_,vecmat_List,dotF_,plusF_,timesF_]:=Fold[plusF[#1,timesF[-dotF[vec,#2]/dotF[#2,#2],#2]]&,vec,vecmat];

GSOrthogonalizeGen[startvecs_List,dotF_,plusF_,timesF_]:=Fold[Append[#1,oneStepOrtogonalizeGen[#2,#1,dotF,plusF,timesF]]&,{},startvecs];

hermiteDot[f_Function,g_Function]:=Module[{x},Integrate[f[x]*g[x]*Exp[-x^2],{x,-Infinity,Infinity}]];

SetAttributes[functionPlus,{Flat,Orderless,OneIdentity}];
functionPlus[f__Function]:=With[{expr=Plus@@Through[{f}[#]]},expr&];

SetAttributes[functionTimes,{Flat,Orderless,OneIdentity}];
functionTimes[a___,f_Function]/;FreeQ[{a},#|Function]:=With[{expr=Times[a,f[#]]},expr&];

LaDot[f_Function,g_Function]:=Module[{x},Integrate[f[x]*g[x],{x,-1,1}]];

(* results = 
  GSOrthoNormalizeGen[{1 &, #&, #^2&, #^3&, #^4&}, LaDot, 
      functionPlus, functionTimes] *)

Expand[GSOrthogonalizeGen[{1 &, #&, #^2&, #^3&, #^4&}, LaDot, 
      functionPlus, functionTimes]]

({1&,#1&,-(1/3)+((#1)^2)&,-((3 #1)/5)+((#1)^3)&,-(1/5)+((#1)^4)-(6/7) (-(1/3)+((#1)^2))&}[[3]])[x]