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]:=

Here are the proper coefficients ...

In[659]:=

Out[659]=

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

In[660]:=

Out[660]=

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]=

Yup. Here we go.

In[665]:=

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

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}];

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]=

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

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

In[671]:=

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

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}];

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}];

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}];

In[707]:=

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

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

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}];

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}}]];

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}];

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}];

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}];

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}];

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}];

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}}]];

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}];

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}];

Created by Mathematica  (May 5, 2004)