MGM.11 Function Spaces and Root-Mean-Square Approximation
GIVE IT A TRY!

Needs["LinearAlgebra`MatrixManipulation`"];
Needs["LinearAlgebra`Orthogonalization`"];
\(\(Needs["Graphics`Colors`"];\)
\)
\(\(If[
        MemberQ[{"Global`", "Graphics`Common`GraphicsCommon`", "Vector3D`"}, \ Context[ScaleFactor]], 
        Remove["*`ScaleFactor"]];\)\)
<< "Graphics`Legend`";
<< "Graphics`Common`GraphicsCommon`";
\(\(Remove["*`ScaleFactor"];\)
\)
Needs["Calculus`Master`"];
Off[Unique::"usym"];
Off[General::"spell"];
Off[General::"spell1"];
Off[ParametricPlot3D::"ppcom"];
Off[ParametricPlot::"ppcom"];
Off[Plot::"plnr"];
SetOptions[Limit, Analytic -> True];
$Pre = Chop;

CMView = {2.7, 1.6, 1.2};

Vector Drawer

\(\(\( (*\ \(\(:\)\(Date : \ \ Copyright\ 2001\)\), \ 
      Math\ Everywhere, \ \(\(Inc\)\(.\)\)\ 
*) \)\(
\)\( (*
Original\ Conception\ to\ create\ a\ vector\ drawer\ is\ due\ to\ Bill\ Davis . 
Current\ code\ is\ by\ Bruce\ \(\(Carpenter\)\(.\)\)
*) \)\(
\)\( (*\ \ \(\(\(:\)\(Drawbacks : \ \ Since\ the\ vectors\ are\ drawn\ out\ of\)\)\ 

      \ \ \ \ \ context\), \ 
      the\ shapes\ of\ the\ arrowheads\ are\ only\ 
\ \ \ \ \ correct\ with\ AspectRatio\ set\ to\ \(\(Automatic\)\(.\)\)
*) \)\)\)

BeginPackage["Vector3D`","Graphics`Colors`"];

Axes3D::usage = "Axes3D[a, b] creates a Graphics3D object of cartesian axes with x, y, and z running from -a/3 to a, and with axes labels b units beyond the tips of the axes.  Axes3D[a] is Axes3D[a, a/8].";

Perpend::usage = "Perpend[a] returns a unit vector which is perpendicular to the vector a.";

Arrow::usage = "Arrow[a] produces a 2 or 3 dimensional vector from the origin to a. Arrow[a, Tail -> tail] gives a vector from tail to a.";
	
Vector::usage = "Vector[a, b] gives a 2D or 3D vector from a to b.";

ArrowHead::usage = "ArrowHead[a, vec] produces an arrowhead with its tip placed at the point a, pointing in the direction of the vector vec.";

Tail::usage = "Tail -> point puts the tail of the vector at point.";

Norm::usage = "Norm[vec] returns the Euclidean length of vec.";

Normalize::usage = "Normalize[vec] returns a unit vector in the direction of vec, provided vec is nonzero.";

Aperture::usage = "Aperture is the ratio of the radius of the base to the length of the head of a vector.";

TipSize::usage = "TipSize specifies an absolute size for the inner tip length of the head of a vector.";

TipRatio::usage = "TipRatio is the ratio of the inner length of the arrowhead to the length of the shaft of a vector.";

HeadRatio::usage = "HeadRatio is the ratio of the outer length of the arrowhead to the length of the shaft of a vector.";

HeadSize::usage = "HeadSize specifies an absolute size for the head of a vector.";

ScaleFactor::usage = "ScaleFactor specifies the amount to scale a vector in length and may be either a number or a pure function.";

ZeroVectorPointSize::usage = "ZeroVectorPointSize is the size of the point used to represent a zero vector.";

Options[Vector] = Options[Arrow] = Options[ArrowHead] =
{HeadRatio -> 0.18, TipRatio -> 0.14, Aperture -> 0.3, ScaleFactor -> 1, HeadType -> Polygon, ShaftQ -> True, EdgesQ -> True, VectorColor -> RGBColor[0,0,1], ShaftWidth -> 0.005, ZeroVectorPointSize -> 0.01};
		
Begin["`Private`"];

SetOptions[ParametricPlot,AspectRatio -> Automatic];
SetOptions[Plot,AspectRatio -> Automatic];
SetOptions[Graphics,AspectRatio -> Automatic];

Axes3D[u_,v_] := 
      Graphics3D[{
            {Blue,Line[{{-u/3,0,0},{u,0,0}}]},
                    Text["x",{u + v,0,0}],
            {Blue,Line[{{0,-u/3,0},{0,u,0}}]},
                    Text["y",{0, u + v,0}],
            {Blue,Line[{{0,0,-u/3},{0,0,u}}]},
                    Text["z",{0,0,u + v}]}]; 
Axes3D[u_] := Axes3D[u,u/8];
				
Norm[a_?VectorQ] := N[Sqrt[a.a]];

Normalize[a_?VectorQ] := If[a.a == 0, a, a/Norm[a]];

Perpend[a_?VectorQ] := Normalize[{a[[2]],-a[[1]]}]/;Length[a]==2;

Perpend[a_?VectorQ]:=
    Normalize[If[a[[1]]==0,{1,0,0},{a[[2]],-a[[1]],0}]]/;
      Length[a]==3;
      
Base3D = Table[{Cos[2 k Pi/8.], Sin[2 k Pi/8.]},{k,0,8}]; 

Vector[from_?VectorQ, to_?VectorQ, opts___] := Module[
   {sq, sw, ht, hs, hr, tr, ap, sf, vc, zvps, diff = to - from, tip},
   {sq, sw, ht, hs, hr, ts, tr, ap, sf, vc, zvps} = {ShaftQ, ShaftWidth, HeadType, HeadSize, HeadRatio, TipSize, TipRatio, Aperture, ScaleFactor, VectorColor, ZeroVectorPointSize} /. {opts} /. Options[Vector];
   If[from==to, Return[Graphics[{PointSize[zvps],vc,Point[from]}]]];
   diff = If[NumberQ[N[sf]], sf diff, sf[diff]];
   tip = from + diff;
   If[NumberQ[hs], hr = hs/Norm[diff]; tr = 0.75 hr];
   If[NumberQ[ts], tr = ts/Norm[diff]];
   Graphics[{If[sq,{vc,Thickness[sw],Line[{from,tip - tr diff}]},{}],
      With[{trans = ap hr Norm[diff] Perpend[diff]},
      {vc, Thickness[sw], ht[{tip,
                   (tip - hr diff + trans),
                   (tip - tr diff),
                   (tip - hr diff - trans),tip}]}]}]
] /; Length[from]==Length[to]==2

Vector[from_?VectorQ, to_?VectorQ, opts___] := Module[
   {sq, eq, sw, hs, hr, tr,ap, sf, vc, zvps, diff = to - from, tip},
   {sq, eq, sw, hs, hr, ap, sf, vc, zvps} = {ShaftQ, EdgesQ, ShaftWidth, HeadSize, HeadRatio, Aperture, ScaleFactor, VectorColor, ZeroVectorPointSize} /. {opts} /. Options[Vector];
   If[from==to, Return[Graphics3D[{PointSize[zvps],vc,Point[from]}]]];
   diff = If[NumberQ[N[sf]], sf diff, sf[diff]];
   tip = from + diff;
   If[NumberQ[hs], hr = hs/Norm[diff]];
   tr = hr/2;
   Graphics3D[{If[sq,{vc,Thickness[sw],Line[{from,tip-tr diff}]},{}], If[eq, {}, EdgeForm[]], {SurfaceColor[vc],
      With[{temp = Perpend[diff]},
      Polygon[Append[#,tip]]& /@ Partition[(tip - hr diff + #)&/@((ap hr Norm[diff] Base3D) . {temp,Normalize[Cross[temp,diff]]}),2,1]]}}]
] /; Length[from]==Length[to]==3


Arrow[a_, Tail->b_, opts___] := Vector[b,a+b,opts]

Arrow[a_, opts___] := Vector[Table[0,{Length[a]}],a,opts]

ArrowHead[a_, b_, opts___] := Vector[a-b,a,ShaftQ->False,opts];

End[];

EndPackage[];
Null

Graphics`Colors`GosiaGreen = 
        RGBColor[0,  0.392187,  0];

ThreeAxes[u,v]

ThreeAxes[u_, v_] := 
        Graphics3D[{{Blue, Line[{{-u, 0, 0}, {u, 0, 0}}]}, 
            Text["x", {u + v, 0, 0}], {Blue, 
              Line[{{0, -u, 0}, {0, u, 0}}]}, 
            Text["y", {0, u + v, 0}], {Blue, 
              Line[{{0, 0, 0}, {0, 0, u}}]}, 
            Text["z", {0, 0, u + v}]}];
ThreeAxes[u_] := ThreeAxes[u, (u/8)];
ThreeAxes::"usage" = "ThreeAxes[a,b] makes a standard cartesian \
axis graphics object with x, y, and z running from -a to a, and with axis \
labels b units beyond the tips of the axes.  ThreeAxes[a] is \
ThreeAxes[a,a/8].";

Needs["Statistics`ContinuousDistributions`"];

Clear[matrixplucker];
matrixplucker[expr_, 
        vars_] := Simplify[
          Outer[D, {expr}, 
            vars]][[1]]

G.1) Fourier Sine approximations on [0, π], 
        Fourier Cosine approximations on [0, π], 
        Fourier Sine-Cosine  approximations on [-π, π], 
        Fourier Sine-Cosine  approximations on [0, 2π]

G.1.a) Fourier Sine wave approximations on [0,π]

Here is a function f[t] on [0,π]:

a = 0;
b = π;
Clear[f, t];
\(\(f[t_] = 
        2.0\ Abs[t\/\(0.5\ π\) - Round[t\/\(0.5\ π\)]];\)
\)
fplot = 
        Plot[f[t], {t, a, b}, 
          PlotStyle -> {{Thickness[0.02], NavyBlue}}, 
          AxesLabel -> {"t", "f[t]"}];

Here's a quick attempt to get a sine wave approximation of f[t] on [0,π]:

khigh  =  3; 
Clear[s, k, Subscript, t];
(Subscript[s, k])_[t_]  :=  Sin[k t];
Clear[fouriercoeff, Sinapprox, k];
fouriercoeff[k_]  :=  fouriercoeff[k]  =  
          NIntegrate[f[t] (Subscript[s, k])[t], {t, a, b}, AccuracyGoal -> 2]/((∫_a^b) (Subscript[s, k])[t] (Subscript[s, k])[t] \[DifferentialD]t);
\(Sinapprox[
        t_]\ \  = \ ∑\+\(k = 1\)\%khigh\(\( fouriercoeff[
            k]\)\(\ \)\(s\_k[t]\)\(
\)\)\)

Check out the quality of the fit:

fitplot  =  
        Plot[{f[t], Sinapprox[t]}, {t, a, b}, 
          PlotStyle -> {{Thickness[0.02], NavyBlue}, {Thickness[0.01], 
                CadmiumOrange}}, 
          AxesLabel -> {"t", ""}];

This fit needs your help.
▪ In the space below, kick up khigh to come up with a much better Sine wave approximation of f[t] on [0,π]:
Show off your approximation with a decisive plot.
Put answer here.

▪ How do your results mesh with the fact that the sine system
                {Sin[t], Sin[2 t], Sin[3 t], Sin[4 t],. . .,Sin[k t],. . .}
 is a complete orthogonal family on [0,π]?
Put answer here.

▪ When you look in a printed reference book, you find that the Fourier Sine Series for a function  f[t] on [0, π] with
          (∫_0^π) f[t]^2 dt < infinity
is
        (∑_(k = 1)^∞) (Subscript[b, k]) Sin[k t] 
where 
            (Subscript[b, k]) = (2/π) (∫_0^π) 
          f[t] Sin[k t] dt.
What do you think this means? 
Where did those formulas for the (Subscript[b, k])'s come from?
Put answer here

G.1.b) Fourier Cosine wave approximations on [0,π]

Here is a function f[t] on [0,π]:

a = 0;
b = π;
Clear[f, t];
\(\(f[t_] = E\^\(-t\)\ Sign[Sin[3\ t]]\  + \ 
          0.5;\)
\)
fplot = 
        Plot[f[t], {t, a, b}, 
          PlotStyle -> {{Thickness[0.02], NavyBlue}}, 
          AxesLabel -> {"t", "f[t]"}];

Here's a quick attempt to get a Cosine wave approximation of f[t] on [0,π]:

khigh  =  12; 
Clear[s, Subscript, k, t];
(Subscript[s, k])_[t_]  :=  Cos[(k - 1) t];
Clear[fouriercoeff, Cosapprox, k];
fouriercoeff[k_]  :=  fouriercoeff[k]  = 
          NIntegrate[f[t] (Subscript[s, k])[t], {t, a, b}, AccuracyGoal -> 2]/((∫_a^b) (Subscript[s, k])[t] (Subscript[s, k])[t] \[DifferentialD]t);
\(Cosapprox[
        t_]\ \  = \ ∑\+\(k = 1\)\%khigh\(\( fouriercoeff[
            k]\)\(\ \)\(s\_k[t]\)\(
\)\)\)

Check out the quality of the fit:

fitplot  =  
        Plot[{f[t], Cosapprox[t]}, {t, a, b}, 
          PlotStyle -> {{Thickness[0.02], NavyBlue}, {Thickness[0.01], 
                CadmiumOrange}}, 
          AxesLabel -> {"t", ""}];

Not bad, but not all that good.
▪ In the space below, kick up khigh to come up with a much better Cosine wave approximation of f[t] on [0,π]:
Show off your approximation with a decisive plot.
Put answer here.

▪ How do your results mesh with the fact that the Cosine system
                {1,Cos[t], Cos[2 t], Cos[3 t], Cos[4 t],. . .,Cos[k t],. . .}
 is a complete orthogonal family on [0,π]?
 Put answer here

▪ When you look in a printed reference book, you find that the Fourier Cosine Series for a function f[t] on [0, π] with
          (∫_0^π) f[t]^2 dt < infinity
is
          (Subscript[a, 0]) +   (∑_(k = 1)^∞) (Subscript[a, k]) Cos[k t] 
where   (Subscript[a, 0]) = (1/π) (∫_(0 )^π) f[
              t] dt
            (Subscript[a, k]) = (2/π) (∫_0^π) 
          f[t] Cos[k t] dt for k  =  1, 2, 3, .....
What do you think this means? 
Where did those formulas for the  (Subscript[a, k])'s come from?
 Put answer here

G.1.c)  Fourier Sine-Cosine wave approximations on [-π,π]

Here is a function f[t] on [-π,π]:

a = -π;
b = π;
Clear[f, t];
\(\(f[t_] = Sin[t]\ Cosh[t + 0.5];\)
\)
fplot = 
        Plot[f[t], {t, a, b}, 
          PlotStyle -> {{Thickness[0.02], NavyBlue}}, 
          PlotRange -> All, 
          AxesLabel -> {"t", "f[t]"}];

Here's a quick attempt to get a Sine-Cosine wave approximation of f[t] on [-π,π]:

khigh  =  5; 
\(\(Clear[s, k, t];\)
\)
(Subscript[s, k])_[t_]  := 
        If[EvenQ[k], Sin[((k )/2) t],  
          Cos[((k  - 1)/2) t]];
Clear[fouriercoeff, SinCosapprox, k];
fouriercoeff[k_]  :=  fouriercoeff[k]  = 
          NIntegrate[f[t] (Subscript[s, k])[t], {t, a, b}, AccuracyGoal -> 2]/((∫_a^b) (Subscript[s, k])[t] (Subscript[s, k])[t] \[DifferentialD]t);
\(SinCosapprox[
        t_]\ \  = \ ∑\+\(k = 1\)\%khigh\(\( fouriercoeff[
            k]\)\(\ \)\(s\_k[t]\)\(
\)\)\)

Check out the quality of the fit:

fitplot  =  
        Plot[{f[t], SinCosapprox[t]}, {t, a, b}, 
          PlotStyle -> {{Thickness[0.02], NavyBlue}, {Thickness[0.015], 
                CadmiumOrange}}, 
          AxesLabel -> {"t", ""}];

Not all that good.
▪ In the space below, kick up khigh to come up with a better Sine wave and Cosine wave approximation of f[t] on [-π,π]:
Show off your approximation with a decisive plot.
 Put answer here

▪ How do your results mesh with the fact that the sine system
                {1,Sin[t],Cos[t], Sin[2 t],Cos[2 t], Sin[3 t],Cos[3 t], Sin[4 t],Cos[4 t],. . .,Sin[k t], Cos[k t],. . .}
 is a complete orthogonal family on [-π,π]?
  Put answer here

▪ When you look in a printed reference book, you find that the Fourier Sine-Cosine Series for a function  f[t] on [-π, π] with
          (∫_(-π)^π) f[t]^2 dt < infinity
is
          (Subscript[a, 0]) +   (∑_(k = 1)^infinity) (Subscript[a, k]) Cos[k t] + (∑_(k = 1)^infinity) (Subscript[b, k]) Sin[k t]
where   (Subscript[a, 0]) = (1/(2  π)) (∫_(-π)^(π )) 
          f[t] dt
            (Subscript[a, k]) = \(\(\(1\/π\)\(\ \)\(∫\_\(-π\)\%\(\(π\)\(\ \)\)\ \ f[t]\ Cos[k\ t] dt\)\(\ \)\)\)
             (Subscript[b, k]) = (1/π) (∫_(-π)^(π )) 
          f[t] Sin[k t] dt  both for k  =  1, 2, 3, .....
What do you think this means? 
Where did those formulas for the  (Subscript[a, k])'s  and the (Subscript[b, k])'s come from?
 Put answer here

G.1.d) Endpoints and extended intervals

Here is a function f[t] on [0,π]:

a = 0;
b = π;
Clear[f, t];
\(\(f[t_] = t\ Cos[2\ t]\ Sin[t] + 0.3;\)
\)
fplot = 
        Plot[f[t], {t, a, b}, 
          PlotStyle -> {{Thickness[0.015], NavyBlue}}, 
          AxesLabel -> {"t", "f[t]"}];

Here's a quick attempt to get a sine wave approximation of f[t] on [0,π]:

khigh  =  16; 
Clear[s, k, t];
(Subscript[s, k])_[t_]  :=  Sin[k t];
Clear[fouriercoeff, Sinapprox, k];
fouriercoeff[k_]  :=  fouriercoeff[k]  = 
          NIntegrate[f[t] (Subscript[s, k])[t], {t, a, b}, AccuracyGoal -> 2]/((∫_a^b) (Subscript[s, k])[t] (Subscript[s, k])[t] \[DifferentialD]t);
\(Sinapprox[
        t_]\ \  = \ ∑\+\(k = 1\)\%khigh\(\( fouriercoeff[
            k]\)\(\ \)\(s\_k[t]\)\(
\)\)\)

Check out the quality of the fit:

fitplot  =  
        Plot[{f[t], Sinapprox[t]}, {t, a, b}, 
          PlotStyle -> {{Thickness[0.015], NavyBlue}, {Thickness[0.009], 
                CadmiumOrange}}, 
          AxesLabel -> {"t", ""}];

Looking good - except at the endpoints at 0 and π.
▪Give your opinion on why the approximation was always destined to break down at the endpoints at 0 and π.
For what types of functions f[t] would you be guaranteed that a good Sine fit on [0  π] is possible -even at the at the endpoints.
Put answer here.

▪ Keep everything the same and check out what happens when you extend the plotting interval from 
       [0,π] to [-π, π]:

extendedplot  =  
        Plot[{f[t], Sinapprox[t]}, {t, -Pi,  Pi}, 
          PlotStyle -> {{Thickness[0.015], NavyBlue}, {Thickness[0.01], 
                CadmiumOrange}}, 
          AxesLabel -> {"t", ""}];

Describe what you see and explain why you see it.
For what types of functions f[t] will you be guaranteed that the good  Sine fit on [0  π]  will hold up on the extended interval  [-π, π]?
Put answer here.

▪ Here's a function f[t] on [0,π]:

a = 0;
b = π;
Clear[f, t];
\(\(f[t_] = E\^\(-t\^2\) + 0.2\ Sin[3\ t];\)
\)
fplot = 
        Plot[f[t], {t, a, b}, 
          PlotStyle -> {{Thickness[0.02], NavyBlue}}, 
          AxesLabel -> {"t", "f[t]"}];

Here's a quick attempt to get a Cosine wave approximation of f[t] on [0,π]:

khigh  =  8; 
Clear[s, k, t];
(Subscript[s, k])_[t_]  :=  Cos[(k  -  1) t];
Clear[fouriercoeff, Cosapprox, k];
fouriercoeff[k_]  :=  fouriercoeff[k]  =  
          NIntegrate[f[t] (Subscript[s, k])[t], {t, a, b}, AccuracyGoal -> 2]/((∫_a^b) (Subscript[s, k])[t] (Subscript[s, k])[t] \[DifferentialD]t);
\(Cosapprox[
        t_]\ \  = \ ∑\+\(k = 1\)\%khigh\(\( fouriercoeff[
            k]\)\(\ \)\(s\_k[t]\)\(
\)\)\)

Check out the quality of the fit:

fitplot  =  
        Plot[{f[t], Cosapprox[t]}, {t, 0, π}, 
          PlotStyle -> {{Thickness[0.015], NavyBlue}, {Thickness[0.01], 
                CadmiumOrange}}, 
          AxesLabel -> {"t", ""}];

Looking good.
Now see what happens when you extend the plotting interval from [0,π] to [-π,π]:

extendedplot  =  
        Plot[{f[t], Cosapprox[t]}, {t, -Pi,  Pi}, 
          PlotStyle -> {{Thickness[0.015], NavyBlue}, {Thickness[0.01], 
                CadmiumOrange}}, 
          AxesLabel -> {"t", ""}];

Describe what you see and explain why you see it.
For what types of functions f[t] would you be guaranteed that the good fit will hold up on the extended interval [-π,π]?
Put answer here.

▪  Here's a function f[t] on [0,2 π]:

a = 0;
b = 2 π;
Clear[f, t];
\(\(f[t_] = 0.8\ t + 0.4\ Sign[Cos[t]];\)
\)
fplot = 
        Plot[f[t], {t, a, b}, 
          PlotStyle -> {{Thickness[0.02], NavyBlue}}, 
          AxesLabel -> {"t", "f[t]"}];

Here's a quick attempt to get a Sin- Cosine wave approximation of f[t] on [0,2π]:

khigh  =  30; 
\(\(Clear[s, k, t];\)
\)
(Subscript[s, k])_[t_]  := 
        If[EvenQ[k], Sin[((k )/2) t],  
          Cos[((k  - 1)/2) t]];
Clear[fouriercoeff, SinCosapprox, k];
fouriercoeff[k_]  :=  fouriercoeff[k]  =  
          NIntegrate[f[t] (Subscript[s, k])[t], {t, a, b}, AccuracyGoal -> 2]/((∫_a^b) (Subscript[s, k])[t] (Subscript[s, k])[t] \[DifferentialD]t);
\(SinCosapprox[
        t_]\ \  = \ ∑\+\(k = 1\)\%khigh\(\( fouriercoeff[
            k]\)\(\ \)\(s\_k[t]\)\(
\)\)\)

Check out the quality of the fit:

fitplot  =  
        Plot[{f[t], SinCosapprox[t]}, {t, a, b}, 
          PlotStyle -> {{Thickness[0.015], NavyBlue}, {Thickness[0.01], 
                CadmiumOrange}}, 
          AxesLabel -> {"t", ""}];

Not all that bad.
Now see what happens when you extend the plotting interval from [0,2π] to [0,4π]:

extendedplot  =  
        Plot[{f[t], SinCosapprox[t]}, {t, 0, 4 π}, 
          PlotStyle -> {{Thickness[0.015], NavyBlue}, {Thickness[0.01], 
                CadmiumOrange}}, 
          AxesLabel -> {"t", ""}];

Describe what you see and explain why you see it.
For what types of functions f[t] will you be guaranteed that the good fit will hold up on the extended interval [0,4π]?
For what types of functions f[t] do you expect to be able to get good approximations at 0 and 2π?
Put answer here.

G.2) Scaling for other intervals

G.2.a.i) Polynomial approximation on intervals [-L,L] with L ≠ 1

Here is a function f[t] plotted on [-L,L] with L = 6.2

L =  6.2;
Clear[f, t];
f[t_]  =  
      Erf[0.5  t]
fplot = Plot[f[t],{t, -L,  L},PlotStyle -> {{Thickness[0.01], Blue}},AxesLabel -> {"t", "f[t]"}];

Come up with a pretty good root-mean square approximation of f[t] on [-L,L] by polynomials.

G.3) What are the Legendre polynomials?
        What are the Chebyshev polynomials?

G.3.a) What are the Legendre polynomials ?

You might have wondered what the Legendre polynomials are:
If so then look no further.
Start with these power functions:

\(
\(Clear[s, f, Subscript, k, t];\)\)
(Subscript[f, k])_[t_]  :=  t^(k -  1);
powerfunctions  = Table[(Subscript[f, k])[t], {k, 1, 8}]

Gram-Schmidt this set on [a,b] with a = -1 and b = 1 to get

a =  -1;
b = 1;
\(\(orthospanners\  = \ 
        GramSchmidt[powerfunctions\ , 
          InnerProduct\  -> 
\ \ \ \ \ \((∫\_a\%b\( #1\ #2\) \[DifferentialD]t &)\)];\)\)
Clear[s, j];
\(	\(s\_j_[t_]\  := \ Simplify[orthospanners[\([j]\)]];\)\)
schmidts  =  
      Table[(Subscript[s, j])[t], {j, 1, Length[orthospanners]}]

Compare with the first eight Legendre polynomialsL:

legendres  =  
      Table[LegendreP[j - 1,  t], {j, 1, Length[orthospanners]}]

Do you see the relationship?
How far does this relationship go to explain why
         (∫_(-1)^1) LegendreP[p, t] LegendreP[q, t] 
            dt = 0 for p ≠ q?

G.3.b) What are the Chebyshev polynomials ?

You might have wondered what the Chebyshev polynomials are:
If so then look no further.
Start with these power functions:

\(
\(Clear[s, f, Subscript, k, t];\)\)
(Subscript[f, k])_[t_]  := (t^(k - 1));
powerfunctions  = Table[(Subscript[f, k])[t], {k, 1, 6}]

Gram-Schmidt this set on [a,b] with a = -1 and b = 1 with respect to the weight function
           weight[t]=(1/(Sqrt[1 - (t^2)])) 
to get:

Clear[weight];
weight[t_] = (1/(Sqrt[1 - (t^2)]));
a =  -1;
b = 1;
orthospanners = GramSchmidt[powerfunctions ,InnerProduct ->
     ((∫_a^b)#1 #2 weight[t]\[DifferentialD]t&)];
Clear[s, j];
	(Subscript[s, j])_[t_]  :=  
          Simplify[orthospanners[[j]]];
schmidts  =  
      Table[(Subscript[s, j])[t], {j, 1, Length[orthospanners]}]

Compare:

chebys  =  
      Table[ChebyshevT[j - 1,  t], {j, 1, Length[orthospanners]}]

Do you see the relationship?
How far does this relationship go to explain why
         (∫_(-1)^1) ChebyshevT[p, t] ChebyshevT[q, t] 
            (1/(Sqrt[1 - (t^2)])) dt = 0 for p ≠ q?

G.3.c) FYI only - No work for you to do but maybe some juicy info

Start with these Chebyshev polynomials:

Clear[j, t];
\(	chebys\  = \ Table[ChebyshevT[j - 1, \ t], {j, 1, 8}]\)

Change t to Cos[s]:

Clear[s];
\(	Table[ChebyshevT[j - 1, \ Cos[s]], {j, 1, 8}]\)

Apply Trig identities:

Table[TrigReduce[ChebyshevT[j - 1,  Cos[s]]], {j, 1, 8}]

Yes!
          ChebyshevT[k, Cos[s]] = Cos[k s] for every k.
The upshot:
ChebyshevT[k, t] is nothing more or less than the polynomial (Subscript[P, k])[t]that makes
            \(\(P\_k[Cos[s]]\  = \ \(Cos[k\ s] . \)
	\)\)
Lots of folks really like this definition. And this definition makes it fairly easy to see why
         (∫_(-1)^1) ChebyshevT[p, t] ChebyshevT[q, t] 
            (1/(Sqrt[1 - (t^2)])) dt = 0 for p ≠ q.
If this intrigues you then click on the right.

Explanation of why
  (∫_(-1)^1) ChebyshevT[p, t] ChebyshevT[q, 
              t] (1/(Sqrt[1 - (t^2)])) dt = 0 for p ≠ q

Start with
(∫_(-1)^1) ChebyshevT[p, t] ChebyshevT[q, t] 
          (1/(Sqrt[1 - (t^2)])) dt
Transform this integral via the substitution 
       t = Cos[s]  (so that dt = -Sin[s] ds)
 to get
 
   (∫_(-1)^1) ChebyshevT[p, t] ChebyshevT[q, t] 
          (1/(Sqrt[1 - (t^2)])) dt

= (∫_(-Pi)^0) ChebyshevT[p, Cos[s]] ChebyshevT[q, Cos[s]] 
          (1/(Sqrt[1 - Cos[s]^2])) (-Sin[s]) ds

 = (∫_(-Pi)^0) Cos[p s] Cos[q s] 
          (1/(Sqrt[1 - Cos[s]^2])) (-Sin[s]) ds
 
 = (∫_(-Pi)^0) Cos[p s] Cos[q s] (1/(-Sin[s])) 
          (-Sin[s]) ds
 
  =  
        (∫_(-Pi)^0) Cos[p s] Cos[q s] ds

Now look at:

\(Clear[p, q, s]; 
	
    ∫\_\(-Pi\)\%0 Cos[p\ s]\ Cos[q\ s] \[DifferentialD]s\)

When p and q are integers, all the terms in the numerator are 0, so when p and q are unequal positive integers,
       (∫_(-1)^1) ChebyshevT[p, t] ChebyshevT[q, t] 
          (1/(Sqrt[1 - (t^2)])) dt
    = (∫_(-Pi)^0) Cos[p s] Cos[q s] ds = 0.
    Nice calculus.

G.4) Dimension of a function space

G.4.a.i)

When you go with a finite set of functions 
        {(Subscript[s, 1])[t], (Subscript[s, 2])[t], (Subscript[s, 3])[t], (Subscript[s, 4])[t]}
 orthogonal on the interval a ≤ t ≤ b  and then you make the function space S[a,b] spanned by this finite set.
       
This function space consists of all functions f[t] of the form.
           f[t] = (∑_(j = 1)^4) (Subscript[c, j]) (Subscript[s, j])[t]  with  a ≤ t ≤ b.
Read off the dimension of S[a,b].

G.4.a.ii)

When you go with a finite set of functions 
        {(Subscript[s, 1])[t], (Subscript[s, 2])[t], (Subscript[s, 3])[t], (Subscript[s, 4])[t], (Subscript[s, 5])[t], (Subscript[s, 6])[t], (Subscript[s, 7])[t]}
 orthogonal on the interval a ≤ t ≤ b  and then you make the function space S[a,b] spanned by this finite set.
       
This function space consists of all functions f[t] of the form.
           f[t] = (∑_(j = 1)^7) (Subscript[c, j]) (Subscript[s, j])[t]  with  a ≤ t ≤ b.
Read off the dimension of S[a,b].

G.4.a.iii)

When you go with a finite set of functions 
        {(Subscript[s, 1])[t], (Subscript[s, 2])[t], (Subscript[s, 3])[t], (Subscript[s, 4])[t], (Subscript[s, 5])[t], (Subscript[s, 6])[t], (Subscript[s, 7])[t]}
not necessarily orthogonal on the interval a ≤ t ≤ b  and then you make the function space S[a,b] spanned by this finite set.
       
This function space consists of all functions f[t] of the form.
           f[t] = (∑_(j = 1)^7) (Subscript[c, j]) (Subscript[s, j])[t]  with  a ≤ t ≤ b.
Is the dimension of S[a,b] necessarily equal to 7? 
Could it be more than 7?

G.4.b)

Lots of folks call the space of all square-integrable functions on [0,π] contains by the name (L^2)[0, π]. 
This space, (L^2)[0, π], contains all these orthogonal families and more:

\(Clear[k, \ t]; 
orthogfamily1\  = \ Table[Sin[k\ t], {k, 1, 4}]\)

orthogfamily2  =  Table[Sin[k t], {k, 1, 10}]

orthogfamily3  =  Table[Sin[k t], {k, 1, 20}]

orthogfamily4  =  Table[Sin[k t], {k, 1, 100}]

Based on these observations and any others you care to make, what do you say is the dimension of (L^2)[0, π]?

G.5)  Taylor versus Legendre:
Taylor polynomial approximation versus best root-mean-square polynomial approximation via Legendre polynomials

G.5.a) Taylor versus root-mean-square

Here's an a function plotted on [-1,1]:

Clear[f, t];
{a, b}  =  {-1, 1};
f[t_]  =  Sin[3 t]  -  Cos[3  t];
fplot  =  
        Plot[f[t], {t, a, b}, PlotStyle -> {{Thickness[0.01], Blue}}, 
          AxesLabel -> {"t", "f[t]"}];

You probably remember the issue of expansions in powers of t from your calculus course.
The Taylor expansion of f[t] in powers of t  through the (t^5) term is
    f[0]+t f'[0]+(1/2) (t^2) f''[0]+(1/(3!)) (t^3) Derivative[3][f][0]+(1/(4!)) (t^4) Derivative[4][f][0]+(1/(5!)) (t^5) Derivative[5][f][0] 
Let Mathematica calculate this for you:

Clear[taylor5];
\(	taylor5[t_]\  = Normal[Series[f[t], {t, 0, 5}]]\)

See both:

taylorfitplot  =  
        Plot[{f[t], taylor5[t]}, {t, -1, 1}, 
          PlotStyle -> {{Thickness[0.02], Blue}, {Thickness[0.01], Red}}, 
          AxesLabel -> {"t", ""}];

The set of functions   
        {(Subscript[s, 1])[t], (Subscript[s, 2])[t], (Subscript[s, 3])[t],  .   .   . , (Subscript[s, k])[t],  
         .   .   . }
for
         (Subscript[s, k])[t]  =  LegendreP[k - 1,  t] 
is an orthogonal set on the interval a ≤ t ≤ b with a = -1 and b = 1.
Here are the formulas for the first six::

khigh  =  6;
Clear[k];
Clear[s, g, k, t];
(Subscript[s, k])_[t_]  :=  LegendreP[k - 1,  t];
ColumnForm[Table[(Subscript[s, k])[t], {k, 1, khigh}]]

Go with the function space S[-1,1] spanned by this orthogonal set
Notice that this function space consists of polynomials of degree 5 (or less).

 Come up with the function Sclosest[t] in  S[-1,1]  so that
the root-mean-square distance between f[t] and Sclosest[t] is as small as possible.

Compare the quality of the approximation of f[t] by taylor5[t] and Sclosests[t].
Which do you like:The  Root-Mean- Square approximation or the Taylor approximation?
Put answers here.

▪ Here's another function f[t] plotted on [-1,1]:

Clear[f, t];
{a, b}  =  {-1, 1};
f[t_]  =  (1/(1 + 1.3 (t^2)));
fplot  =  
        Plot[f[t], {t, a, b}, PlotStyle -> {{Thickness[0.01], Blue}}, 
          AxesLabel -> {"t", "f[t]"}];

You probably remember the issue of expansions in powers of t from your calculus course.
The expansion of f[t] in powers of t  through the (t^6) term is
         f[0]+t f'[0]+(1/2) (t^2) f''[0]+(1/(3!)) (t^3) Derivative[3][f][0]+(1/(4!)) (t^4) Derivative[4][f][0]+(1/(5!)) (t^5) Derivative[5][f][0] (1/(6!)) (t^6) Derivative[6][f][0] + 
Let Mathematica calculate this for you:

Clear[taylor6];
\(		taylor6[t_]\  = Normal[Series[f[t], {t, 0, 6}]]\)

See both:

taylorfitplot  =  
        Plot[{f[t], taylor6[t]}, {t, -1, 1}, 
          PlotStyle -> {{Thickness[0.015], Blue}, {Thickness[0.01], Red}}, 
          AxesLabel -> {"t", ""}];

Yuck!
The set of functions   
        {(Subscript[s, 1])[t], (Subscript[s, 2])[t], (Subscript[s, 3])[t], . . ., 
        (Subscript[s, k])[t],  . . .}
for
         (Subscript[s, k])[t]  =  LegendreP[k - 1,  t] 
is an orthogonal set on the interval a ≤ t ≤ b with a = -1 and b = 1.
Here are the formulas for the first seven:

khigh  =  7;
Clear[k];
Clear[s, g, k, t];
(Subscript[s, k])_[t_]  :=  LegendreP[k - 1,  t];
ColumnForm[Table[(Subscript[s, k])[t], {k, 1, khigh}]]

Go with the function space S[-1,1] spanned by this orthogonal set
Notice that this function space consists of polynomials of degree 6 (or less).
 Come up with the function Sclosest[t] in  S[-1,1]  so that
the root-mean-square distance between f[t] and Sclosest[t] is as small as possible.
Compare the quality of the approximation of f[t] by taylor6[t] and Sclosests[t].
Which do you like:
The  Root-Mean- Square approximation or the Taylor approximation?
Put answers here.

G.6) Weighted Fourier-Chebyshev polynomial approximation

G.6.a)

Here is a function f[t] plotted on [a,b] = [-1,1]:

Clear[f, t];
a  =  1;
b  =  -1;
f[t_]  = 1 + t + (t^2) - (t^3) + (t^4) - (t^5) + (t^12);
fplot  =  
        Plot[f[t], {t, a, b}, PlotStyle -> {{Thickness[0.02], Blue}}, 
          PlotRange -> All, 
          AxesLabel -> {"t", "f[t]"}];

The set of functions   
        {(Subscript[s, 1])[t], (Subscript[s, 2])[t], (Subscript[s, 3])[t],  .   .   . , (Subscript[s, k])[t],  
         .   .   . }
for
         (Subscript[s, k])[t]  =  ChebyshevT[k  - 1,  t] 
is an orthogonal set with respect to the weight function 
          weight[t] = 1/(Sqrt[1 - (t^2)])
on the interval a ≤ t ≤ b with a = -1 and b = 1.
Here are the formulas for the first seven:

Clear[k];
ColumnForm[Table[ChebyshevT[k - 1,  t], {k, 1, 7}]]

Go with the function space S[a,b] spanned by:

khigh  =  6;
Table[ (Subscript[s, k])[t], {k, 1, khigh}]

Come up with the function Sclosest[t] in  S[a,b]  so that
the weighted root-mean-square distance between f[t] and Sclosest is as small as possible.
Give a fit plot.
Note that you get a nice approximation of a 12th degree polynomial by 5th degree polynomial

G.7) Cranking up the Gram-Schmidt process

G.7.a.i) Not orthogonal

\(Here\ is\ a\ set\ of\ functions\ 

            	\ \ \ \ \ \ \ \ \ \ \ {f\_1[t], f\_2[t], f\_3[t], f\_4[t], 
              f\_5[t], f\_6[t]}\) \(	plotted\ on\ an\ \(interval\ [\(-1.4\), \ 3.7] : \)\)

Clear[s, f, k, t]; (Subscript[f, 1])[t_] = 1; (Subscript[f, 2])[t_] = Cos[2 t]; 
    (Subscript[f, 3])[t_] = Sin[(Sqrt[2]) t]; 
(Subscript[f, 4])[t_] = Sin[4 t]; 
(Subscript[f, 5])[t_] = Cos[4 t]; 
(Subscript[f, 6])[t_] = Cos[(Sqrt[2]) t]; 
a = -1.4; 
b = 3.7; 
Plot[{(Subscript[f, 1])[t], (Subscript[f, 2])[t], (Subscript[f, 3])[t], (Subscript[f, 4])[t], (Subscript[f, 5])[t], (Subscript[f, 6])[t]}, {t, a, b}, 
      PlotStyle -> {{Thickness[0.02], 
            RGBColor[0.8, 0, 0]}, {Thickness[0.02], 
            RGBColor[0.7, 0.5, 0]}, {Thickness[0.02], 
            RGBColor[0.5, 1, 0]}, {Thickness[0.02], 
            RGBColor[0.2, 0.5, 0.5]}, {Thickness[0.02], 
            RGBColor[0, 1, 0.5]}}, 
      AxesLabel -> {"t", ""}];

\(A\ tangled\ mess\ of\ spaghetti . 
		You\ make\ the\ function\ space\ S[a, b]\ spanned\ by\)
              {(Subscript[f, 1])[t],(Subscript[f, 2])[t],(Subscript[f, 3])[t],(Subscript[f, 4])[t],(Subscript[f, 5])[t],(Subscript[f, 6])[t]}.
This function space S[a, b] consists of all functions s[t] of the \(form . 
\ \ \ \ \ \ \ \ \ \ \ s[t]\)=\(∑\+\(j = 1\)\%6 c\_j\ f\_j[t]\ \ with\ \ a ≤ 
            t ≤ 
            b . 

See\ a\ random\ member\ of\ this\ function\ \(\(space\)\(:\)\)\)

\(

c\_k_\  := \ Random[Real, {\(-2\), 2}]\)
s[t_] = (∑_(k = 1)^6) (Subscript[c, k]) (Subscript[f, k])[t]

And its plot:

Plot[s[t], {t, a, b}, PlotStyle -> {{Thickness[0.01], Blue}}, 
        AxesLabel -> {"t", "f[t]"}, 
        AspectRatio -> 1/GoldenRatio];

Keep everything the same as the above and look at:

(∫_a^b) (Subscript[f, 3])[t] (Subscript[f, 4])[t] \[DifferentialD]t

Interpret the result.
Put answer here.

▪Use the Gram-Schmidt process to come up with an orthogonal family
            {(Subscript[s, 1])[t], (Subscript[s, 2])[t], (Subscript[s, 3])[t], (Subscript[s, 4])[t], (Subscript[s, 5])[t], 
        (Subscript[s, 6])[t]} on [a,b] 
 so that function space spanned by
            {(Subscript[s, 1])[t], (Subscript[s, 2])[t], (Subscript[s, 3])[t], (Subscript[s, 4])[t], (Subscript[s, 5])[t], 
        (Subscript[s, 6])[t]}   
 is the same as the function space spanned by
            {(Subscript[f, 1])[t], (Subscript[f, 2])[t],  (Subscript[f, 3])[t], (Subscript[f, 4])[t], (Subscript[f, 5])[t], 
          (Subscript[f, 6])[t]} .

Then use your orthogonal family to come up with the best root-mean-square approximation on [a,b]  of Cos[3 t] by a member of the function space spanned by
            {(Subscript[f, 1])[t], (Subscript[f, 2])[t],  (Subscript[f, 3])[t], (Subscript[f, 4])[t], (Subscript[f, 5])[t], 
          (Subscript[f, 6])[t]} .
Put answer here.

G.8)  Fourier Sine approximation and the heat equation
         Fourier Sine approximation and the wave equation

G.8.a) Fourier Sine approximation and the heat equation

Start with a heated wire L units long with the temperature allowed to vary from position to position on the wire. Think of the wire as the interval 0 ≤ x ≤ L.  At the start of the experiment,  you instantly cool the ends at x = 0 and x = L  and maintain these ends at temperature 0, and you take pains to guarantee that the rest of the wire is perfectly insulated.
At the start of this particular experiment, the temperature of the wire at position x (for 0 ≤ x ≤ L = π) is given by the following function startertemp[x]:

L = π;
Clear[startertemp, x];
\(\(startertemp[x_] = x\ Tan[x\/4]\ \((π - x)\);\)
\)
starterplot = 
        Plot[startertemp[x], {x, 0, L}, 
          PlotStyle -> {{Thickness[0.015], Blue}}, 
          AxesLabel -> {"x", "starting temperature"}];

Think of the interval [0,L] = [0 π] as the wire.  
The tip of the pointer tells you the starting temperature (at time t = 0) at the tail of the pointer.
Your problem here is to use Fourier Sine approximation on [0,π] of startertemp[x] come up with a function temp[x,t] that estimates the  temperature of the wire at position x at time t after the experiment begins. 
Do it.

G.8.b.i) Fourier Sine approximation and the wave equation

The ends of a guitar string are anchored at 0 and L on the x-axis and the string is pulled to an initial position and then allowed to vibrate on its own starting with initial velocity 0.

At the start of this particular experiment, the position of the guitar string at position x (for 0 ≤ x ≤  L = Pi) is given by the following function starterposition[x]:

L = π;
Clear[starterposition, x];
\(\(starterposition[x_] = Sin[x]\ \((x - 1)\)\ \((x - 2)\);\)
\)
starterplot = 
        Plot[starterposition[x], {x, 0, L}, 
          PlotStyle -> {{Thickness[0.01], Blue}}, PlotRange -> All, 
          AspectRatio -> (1/4), 
          AxesLabel -> {"x", "starting position"}];

.Your problem here is to  use Fourier Sine approximation on [0,π] of starterposition[x] come up come up with a function position[x,t] that estimates the position of the guitar string at position x on the x-axis at time t after the experiment begins. 
Do it.

G.9)  A small Dirac mystery

G.9.a.i) Spikes

Here 's a formula 
          (1/( 2 π)) + (1/π) (∑_(k = 1)^khigh) 
              Cos[k t]
and plots of it for various choices of khigh:

khigh  =  12;
Plot[ 
        (1/(2 π)) + (1/π) (∑_(k = 1)^khigh) Cos[
                k t], {t, -Pi, Pi}, PlotRange -> {-5, 12}, 
        PlotStyle -> {{Thickness[0.02], HotPink}}, 
        AspectRatio -> 2];

khigh  =  20;
Plot[ 
        (1/(2 π)) + (1/π) (∑_(k = 1)^khigh) Cos[
                k t], {t, -Pi, Pi}, PlotRange -> {-5, 12}, 
        PlotStyle -> {{Thickness[0.02], HotPink}}, 
        AspectRatio -> 2];

khigh  =  40;
Plot[ 
        (1/(2 π)) + (1/π) (∑_(k = 1)^khigh) Cos[
                k t], {t, -Pi, Pi}, PlotRange -> {-5, 12}, 
        PlotStyle -> {{Thickness[0.02], HotPink}}, 
        AspectRatio -> 2];

What mysterious "function" are these plots associated with?

G.9.a.ii) The integral is 1

Here 's that same  formula 
          (1/( 2 π)) + (1/π) (∑_(k = 1)^khigh) 
              Cos[k t]:
Integrate it from - h to h to get:
      \(∫\_\(\(-h\)\(\ \ \ \ \ \ \ \)\)\%h\((\ 
            1\/\(\(\ \)\(2\ π\)\) + \(1\/π\) \(∑\+\(k = 1\)\%khigh Cos[k\ t]\))\) dt\) = \(\(2  h\)\/\(\(\ \)\(2\ π\)\) + \(1\/π\) \(∑\+\(k = 1\)\%khigh\( Sin[k\ h] - Sin[\(-k\)\ h]\)\/k\)\) 
      = \(h\/\(\(\ \ \)\(π\)\) + \(1\/π\) \(∑\+\(k = 1\)\%khigh\( 2\ Sin[k\ h]\)\/k\)\).
When you let khigh go to infinity, Mathematica gives you for a random small h::

h  =  Random[Real, {0, 0.1}];
result  =  
      (h/(  π)) + (1/π) (∑_(k = 1)^Infinity)(( 2 Sin[k h])/k)

Do you think this an accident?  If not, then why not?