8 Fourier Series

Mathematica script by Chris Parrish,
   cparrish@sewanee.edu

Sources and references for some of these problems include
    James Stewart, "Calculus: Concepts and Contexts," Second Edition, Brooks/Cole, 2001
    Deborah Hughes-Hallett, Andrew M. Gleason, et. al., "Calculus," Second Edition, John Wiley & Sons, 1998
    Robert Fraga, ed., "Calculus Problems for a New Century," The Mathematical Association of America, 1993

Fourier Sine Series for u[x] = x (x - 1) over [0,1]

Let's construct a (truncated) Fourier Sine Series for u[x] over [0,1].

In[657]:=

Clear[u, x, a, n, h, numterms, nums, fourier] ; <br /> u[x_] = x^2 - x ;

Here are the proper coefficients ...

In[659]:=

a[n_] = ∫_0^1u[x] Sin[n π x] x

Out[659]=

(-2 + 2 Cos[n π] + n π Sin[n π])/(n^3 π^3)

so use them to construct the separate terms of the series ...

In[660]:=

h[n_, x_] = 2 a[n] Sin[π n x]

Out[660]=

(2 (-2 + 2 Cos[n π] + n π Sin[n π]) Sin[n π x])/(n^3 π^3)

then add together as many terms as we need ...

In[661]:=

numTerms = 20;

nums = Table[k,{k,numTerms}];

fourier[x_] := Apply[Plus,Map[h[#,x]&,nums]]

Let's take a peek.

In[664]:=

fourier[x]

Out[664]=

-(8 Sin[π x])/π^3 - (8 Sin[3 π x])/(27 π^3) - (8 Sin[5 π x])/(125 	 ...  x])/(3375 π^3) - (8 Sin[17 π x])/(4913 π^3) - (8 Sin[19 π x])/(6859 π^3)

Yup. Here we go.

In[665]:=

Plot[{fourier[x],u[x]},
     {x,0,1},
     PlotStyle->{AlizarinCrimson,ForestGreen}];

[Graphics:HTMLFiles/8.app_fourierSeries_7.gif]

Can hardly see the difference. Plot the difference to see the difference (yuk! yuk!)

In[666]:=

Plot[fourier[x] - u[x],
     {x,0,1},
     PlotStyle->{Indigo}];

[Graphics:HTMLFiles/8.app_fourierSeries_8.gif]

Can we package all this up as a Mathematica program?

In[667]:=

fourierSinePolynomial[u_,a_,b_,numTerms_] =
    Module[{}, Apply[Plus,
                 Table[2 Integrate[u[x] Sin[n Pi x],{x,a,b}] Sin[Pi n x],
                       {n,numTerms}]]];
            
newFourier[x_] = fourierSinePolynomial[u,0,1,20]

Plot[newFourier[x],{x,0,1},
     PlotStyle->PermanentRedViolet];

Out[669]=

-(8 Sin[π x])/π^3 - (8 Sin[3 π x])/(27 π^3) - (8 Sin[5 π x])/(125 	 ...  x])/(3375 π^3) - (8 Sin[17 π x])/(4913 π^3) - (8 Sin[19 π x])/(6859 π^3)

[Graphics:HTMLFiles/8.app_fourierSeries_10.gif]

Fourier Polynomial Approximation for a Square Wave over[-π,π]

HHG, Second Edition, Section 9.5, pages 459-460

In[671]:=

Clear[g, x, n] ;  pi = π//N ;  f[x_] := 0/;-pi≤x<0 ; f[x_] := 1/ ... 71;PlotLabel"A Square Wave", AxesLabel {"x", None}] ;

[Graphics:HTMLFiles/8.app_fourierSeries_12.gif]

Now let's construct a Fourier polynomial approximation for f[x].

Clear[g, x, a, b, k, n, left, right] ; <br /> left = 0 ; right = pi ; <br /> g[x_] := 1 ; <br  ... 2754;"Fourier Approximation, n = 1", AxesLabel {"x", None}] ;

RowBox[{f[x] = , , RowBox[{RowBox[{0.5, }], +, RowBox[{3.89817*10^-17,  , Cos[x]}], +, RowBox[{0.63662,  , Sin[x]}]}]}]

[Graphics:HTMLFiles/8.app_fourierSeries_15.gif]

What happens with higher degree approximations?
Let's just cut-and-paste our code, but with some higher values of n.

In[689]:=

n = 3;

cos = Table[a[k] Cos[k x],{k,n}];
sin = Table[b[k] Sin[k x],{k,n}];

series[x_] := Apply[Plus,Flatten[{a[0],cos,sin}]]

Print["f[x] = ",series[x]]

plot3 = Plot[{f[x],series[x]},{x,-pi,pi},
             PlotStyle->{Red,Blue},
             PlotLabel->"Fourier Approximation, n = 3",
             AxesLabel->{"x",None}];

RowBox[{f[x] = , , RowBox[{RowBox[{0.5, }], +, RowBox[{3.89817*10^-17,  , Cos[ ... 662,  , Sin[x]}], +, RowBox[{4.77388*10^-33,  , Sin[2 x]}], +, RowBox[{0.212207,  , Sin[3 x]}]}]}]

[Graphics:HTMLFiles/8.app_fourierSeries_17.gif]

In[695]:=

n = 5;

cos = Table[a[k] Cos[k x],{k,n}];
sin = Table[b[k] Sin[k x],{k,n}];

series[x_] := Apply[Plus,Flatten[{a[0],cos,sin}]]

Print["f[x] = ",series[x]]

plot5 = Plot[{f[x],series[x]},{x,-pi,pi},
             PlotStyle->{Red,Blue},
             PlotLabel->"Fourier Approximation, n = 5",
             AxesLabel->{"x",None}];

RowBox[{f[x] = , , RowBox[{RowBox[{0.5, }], +, RowBox[{3.89817*10^-17,  , Cos[ ... 7,  , Sin[3 x]}], +, RowBox[{9.54777*10^-33,  , Sin[4 x]}], +, RowBox[{0.127324,  , Sin[5 x]}]}]}]

[Graphics:HTMLFiles/8.app_fourierSeries_19.gif]

In[701]:=

n = 7;

cos = Table[a[k] Cos[k x],{k,n}];
sin = Table[b[k] Sin[k x],{k,n}];

series[x_] := Apply[Plus,Flatten[{a[0],cos,sin}]]

Print["f[x] = ",series[x]]

plot7 = Plot[{f[x],series[x]},{x,-pi,pi},
             PlotStyle->{Red,Blue},
             PlotLabel->"Fourier Approximation, n = 7",
             AxesLabel->{"x",None}];

RowBox[{f[x] = , , RowBox[{RowBox[{0.5, }], +, RowBox[{3.89817*10^-17,  , Cos[ ... ,  , Sin[5 x]}], +, RowBox[{1.43217*10^-32,  , Sin[6 x]}], +, RowBox[{0.0909457,  , Sin[7 x]}]}]}]

[Graphics:HTMLFiles/8.app_fourierSeries_21.gif]

In[707]:=

Print["f[x] = ",series[x]]

Show[GraphicsArray[{{plot1,plot3},{plot5,plot7}}]];

RowBox[{f[x] = , , RowBox[{RowBox[{0.5, }], +, RowBox[{3.89817*10^-17,  , Cos[ ... ,  , Sin[5 x]}], +, RowBox[{1.43217*10^-32,  , Sin[6 x]}], +, RowBox[{0.0909457,  , Sin[7 x]}]}]}]

[Graphics:HTMLFiles/8.app_fourierSeries_23.gif]

Fourier  Polynomial Approximation for a Pulse Train over [-Pi,Pi]

HHG, Second Edition, Section 9.5, page 461

In[709]:=

Clear[f,x,n];

pi = Pi//N;

f[x_] := 0 /;  -pi <= x < 0;
f[x_] := 1 /;    0 <= x <= pi/2;
f[x_] := 0 /; pi/2 <  x <= pi;

Plot[f[x],{x,-pi,pi},
     PlotStyle->PermanentRedViolet,
     PlotLabel->"A Pulse Train",
     AxesLabel->{"x",None}];

[Graphics:HTMLFiles/8.app_fourierSeries_24.gif]

Now let's construct a Fourier polynomial approximation for f[x].

In[715]:=

Clear[g,x,a,b,k,n,left,right];

left = 0;
right = pi/2;

g[x_] :=  1;

a[0] = 1/(2pi) Integrate[g[x],{x,left,right}];
a[k_] =   1/pi Integrate[g[x] Cos[k x],{x,left,right}];
b[k_] =   1/pi Integrate[g[x] Sin[k x],{x,left,right}];

n = 1;

cos = Table[a[k] Cos[k x],{k,n}];
sin = Table[b[k] Sin[k x],{k,n}];

series[x_] := Apply[Plus,Flatten[{a[0],cos,sin}]]

plot1 = Plot[{f[x],series[x]},{x,-pi,pi},
             PlotStyle->{Red,Blue},
             PlotLabel->"Fourier Approximation, n = 1",
             AxesLabel->{"x",None},
             DisplayFunction->Identity];
             
n = 3;

cos = Table[a[k] Cos[k x],{k,n}];
sin = Table[b[k] Sin[k x],{k,n}];

series[x_] := Apply[Plus,Flatten[{a[0],cos,sin}]]

plot3 = Plot[{f[x],series[x]},{x,-pi,pi},
             PlotStyle->{Red,Blue},
             PlotLabel->"Fourier Approximation, n = 3",
             AxesLabel->{"x",None},
             DisplayFunction->Identity];

n = 5;

cos = Table[a[k] Cos[k x],{k,n}];
sin = Table[b[k] Sin[k x],{k,n}];

series[x_] := Apply[Plus,Flatten[{a[0],cos,sin}]]

plot5 = Plot[{f[x],series[x]},{x,-pi,pi},
             PlotStyle->{Red,Blue},
             PlotLabel->"Fourier Approximation, n = 5",
             AxesLabel->{"x",None},
             DisplayFunction->Identity];

n = 7;

cos = Table[a[k] Cos[k x],{k,n}];
sin = Table[b[k] Sin[k x],{k,n}];

series[x_] := Apply[Plus,Flatten[{a[0],cos,sin}]]

plot7 = Plot[{f[x],series[x]},{x,-pi,pi},
             PlotStyle->{Red,Blue},
             PlotLabel->"Fourier Approximation, n = 7",
             AxesLabel->{"x",None},
             DisplayFunction->Identity];
             
Print["f[x] = ",series[x]]

Show[GraphicsArray[{{plot1,plot3},{plot5,plot7}}]];

RowBox[{f[x] = , , RowBox[{RowBox[{0.25, }], +, RowBox[{0.31831,  , Cos[x]}],  ... 063662,  , Sin[5 x]}], +, RowBox[{0.106103,  , Sin[6 x]}], +, RowBox[{0.0454728,  , Sin[7 x]}]}]}]

[Graphics:HTMLFiles/8.app_fourierSeries_26.gif]

How well would we do if we used a still larger value for n, say n = 25?

In[746]:=

n = 25;

cos = Table[a[k] Cos[k x],{k,n}];
sin = Table[b[k] Sin[k x],{k,n}];

series[x_] := Apply[Plus,Flatten[{a[0],cos,sin}]]

plot25 = Plot[{f[x],series[x]},{x,-pi,pi},
              PlotStyle->{Red,Blue},
              PlotLabel->"Fourier Approximation, n = 25",
              AxesLabel->{"x",None}];

[Graphics:HTMLFiles/8.app_fourierSeries_27.gif]

Fourier  Polynomial Approximation of the "Periodic Absolute Value" over [-Pi,Pi]

HHG, Second Edition, 9.5.6, page 461

In[751]:=

Clear[f,x,n];

pi = Pi//N;

f[x_] := -x /; -pi <= x < 0;
f[x_] :=  x /;   0 <= x <= pi;

Plot[f[x],{x,-pi,pi},
     PlotStyle->PermanentRedViolet,
     PlotLabel->"Absolute Value",
     AxesLabel->{"x",None}];

[Graphics:HTMLFiles/8.app_fourierSeries_28.gif]

Now let's construct a third degree Fourier polynomial approximation for f[x].

In[756]:=

Clear[g,x,a,b,k,n,left,right];

left = -pi;
middle = 0;
right = pi;

gLeft[x_]  :=  -x;
gRight[x_] :=  x;

a[0] = 1/(2pi) (Integrate[gLeft[x],{x,left,middle}] + Integrate[gRight[x],{x,middle,right}]);
a[k_] =   1/pi (Integrate[gLeft[x] Cos[k x],{x,left,middle}] +
                Integrate[gRight[x] Cos[k x],{x,middle,right}]);
b[k_] =   1/pi (Integrate[gLeft[x] Sin[k x],{x,left,middle}] +
                Integrate[gRight[x] Sin[k x],{x,middle,right}]);

n = 3;

cos = Table[a[k] Cos[k x],{k,n}];
sin = Table[b[k] Sin[k x],{k,n}];

series[x_] := Apply[Plus,Flatten[{a[0],cos,sin}]]

Print["f[x] = ",series[x]]

plot3 = Plot[{f[x],series[x]},{x,-pi,pi},
             PlotStyle->{Red,Blue},
             PlotLabel->"Fourier Approximation, n = 3",
             AxesLabel->{"x",None}];

RowBox[{f[x] = , , RowBox[{RowBox[{1.5708, }], -, RowBox[{1.27324,  , Cos[x]}], -, RowBox[{2.44929*10^-16,  , Cos[2 x]}], -, RowBox[{0.141471,  , Cos[3 x]}]}]}]

[Graphics:HTMLFiles/8.app_fourierSeries_30.gif]

Plot the difference to see the difference. Yuk! Yuk!

In[771]:=

Plot[f[x]-series[x],{x,-pi,pi},
     PlotStyle->Green,
     PlotLabel->"Fourier Approximation error, n = 3",
     AxesLabel->{"x",None}];

[Graphics:HTMLFiles/8.app_fourierSeries_31.gif]

Notice that the error is largest where the graph of the original function is spiky.

Fourier  Polynomial Approximation of a "Periodic Parabola" over [-Pi,Pi]

HHG, Second Edition, 9.5.8, page 461

In[772]:=

Clear[f,x,n];

pi = Pi//N;

f[x_] := x^2;

Plot[f[x],{x,-pi,pi},
     PlotStyle->PermanentRedViolet,
     PlotLabel->"A Parabola",
     AxesLabel->{"x",None}];

[Graphics:HTMLFiles/8.app_fourierSeries_32.gif]

Now let's construct a Fourier polynomial approximation for f[x].

In[776]:=

Clear[g,x,a,b,k,n,left,right];

left = -pi;
right = pi;

g[x_] :=  x^2;

a[0] = 1/(2pi) Integrate[g[x],{x,left,right}];
a[k_] =   1/pi Integrate[g[x] Cos[k x],{x,left,right}];
b[k_] =   1/pi Integrate[g[x] Sin[k x],{x,left,right}];

n = 1;

cos = Table[a[k] Cos[k x],{k,n}];
sin = Table[b[k] Sin[k x],{k,n}];

series[x_] := Apply[Plus,Flatten[{a[0],cos,sin}]]

plot1 = Plot[{f[x],series[x]},{x,-pi,pi},
             PlotStyle->{Red,Blue},
             PlotLabel->"Fourier Approximation, n = 1",
             AxesLabel->{"x",None},
             DisplayFunction->Identity];
             
n = 3;

cos = Table[a[k] Cos[k x],{k,n}];
sin = Table[b[k] Sin[k x],{k,n}];

series[x_] := Apply[Plus,Flatten[{a[0],cos,sin}]]

plot3 = Plot[{f[x],series[x]},{x,-pi,pi},
             PlotStyle->{Red,Blue},
             PlotLabel->"Fourier Approximation, n = 3",
             AxesLabel->{"x",None},
             DisplayFunction->Identity];

n = 5;

cos = Table[a[k] Cos[k x],{k,n}];
sin = Table[b[k] Sin[k x],{k,n}];

series[x_] := Apply[Plus,Flatten[{a[0],cos,sin}]]

plot5 = Plot[{f[x],series[x]},{x,-pi,pi},
             PlotStyle->{Red,Blue},
             PlotLabel->"Fourier Approximation, n = 5",
             AxesLabel->{"x",None},
             DisplayFunction->Identity];

n = 7;

cos = Table[a[k] Cos[k x],{k,n}];
sin = Table[b[k] Sin[k x],{k,n}];

series[x_] := Apply[Plus,Flatten[{a[0],cos,sin}]]

plot7 = Plot[{f[x],series[x]},{x,-pi,pi},
             PlotStyle->{Red,Blue},
             PlotLabel->"Fourier Approximation, n = 7",
             AxesLabel->{"x",None},
             DisplayFunction->Identity];
             
Print["f[x] = ",series[x]]

Show[GraphicsArray[{{plot1,plot3},{plot5,plot7}}]];

RowBox[{f[x] = , , RowBox[{RowBox[{3.28987, }], -, RowBox[{4.,  , Cos[x]}], +, ... [{0.16,  , Cos[5 x]}], +, RowBox[{0.111111,  , Cos[6 x]}], -, RowBox[{0.0816327,  , Cos[7 x]}]}]}]

[Graphics:HTMLFiles/8.app_fourierSeries_34.gif]

How well would we do if we used a still larger value for n, say n = 25?

In[807]:=

n = 25;

cos = Table[a[k] Cos[k x],{k,n}];
sin = Table[b[k] Sin[k x],{k,n}];

series[x_] := Apply[Plus,Flatten[{a[0],cos,sin}]]

plot25 = Plot[{f[x],series[x]},{x,-pi,pi},
              PlotStyle->{Red,Blue},
              PlotLabel->"Fourier Approximation, n = 25",
              AxesLabel->{"x",None}];

[Graphics:HTMLFiles/8.app_fourierSeries_35.gif]

Plot the difference to see the difference. Yuk! Yuk!

In[812]:=

Plot[f[x]-series[x],{x,-pi,pi},
     PlotStyle->Green,
     PlotLabel->"Fourier Approximation error, n = 25",
     AxesLabel->{"x",None}];

[Graphics:HTMLFiles/8.app_fourierSeries_36.gif]


Created by Mathematica  (May 5, 2004)