Periodic Phenomena


Let's begin by "looking" at a familiar periodic phenomena:

In[81]:=

Cfreq = 261.6 ;

Dfreq = 293.7 ;

Efreq = 329.6 ;

Ffreq = 349.2 ;

Gfreq = 392. ;

Afreq = 440. ;

Bfreq = 493.9 ;

Note[freq_] := Sin[ 2 Pi freq t] ;

CNote = Note[Cfreq] ;

DNote = Note[Dfreq] ;

ENote = Note[Efreq] ;

FNote = Note[Ffreq] ;

GNote = Note[Gfreq] ;

ANote = Note[Afreq] ;

BNote = Note[Bfreq] ;

Csound = Play[{CNote, DNote}, {t, 0, 2}]

[Graphics:HTMLFiles/Lecture-17_17.gif]

Out[96]=

-Sound -

In[97]:=

Play[If[t>0.5, CNote, 0], {t, 0, 1}]

[Graphics:HTMLFiles/Lecture-17_20.gif]

Out[97]=

-Sound -

Let's see if we can play this:    l[Graphics:HTMLFiles/Lecture-17_22.gif]

In[98]:=

Beats[list_, duration_, cadence_] := Table[If[t≥ (i - 1) * cadence && t  ≤ (i - 1) * cadence + duration, Evaluate[list[[i]]], 0], {i, 1, Length[list]}]

In[99]:=

twoframes = {ENote, ENote, FNote, GNote, GNote, FNote, ENote, DNote, CNote, CNote, DNote, ENote}

Out[99]=

{Sin[2070.94 t], Sin[2070.94 t], Sin[2194.09 t], Sin[2463.01 t], Sin[2463.01 t], Sin[2194.09 t], Sin[2070.94 t], Sin[1845.37 t], Sin[1643.68 t], Sin[1643.68 t], Sin[1845.37 t], Sin[2070.94 t]}

In[102]:=

Play[Evaluate[Beats[twoframes, 0.5, 0.75]], {t, 0, 12}]

[Graphics:HTMLFiles/Lecture-17_27.gif]

Out[102]=

-Sound -

In[110]:=

Play[Sin[x Sin[3000 (Exp[x]    + Sin[x]/x)]], {x, -5, 5}]

[Graphics:HTMLFiles/Lecture-17_30.gif]

                                     1 Power :: infy : Infinite expression  -- encountered. More…                                      0.

∞ :: indet : Indeterminate expression 0. ComplexInfinity encountered. More…

Out[110]=

-Sound -

Fourier Series

Define a function that is periodic  with wavelength λ using the modulus function:

Boomerang uses Mod to force a function, f, with a single argument, x, to be periodic with wavelength λ

Boomerang[f_ , x_ , λ_ ] := f[Mod[x, λ]]

AFunction[x_ ] := ((3 - x)^3)/27

General :: spell1 : Possible spelling error: new symbol name \"AFunction\" is similar to existing symbol \"Function\".  More…

The following step uses Boomerang to produce a periodic repetition of AFunction over the range 0 < x < 6:

General :: spell1 : Possible spelling error: new symbol name \"AFunction\" is similar to existing symbol \"Function\".  More…

Plot[Boomerang[AFunction, x, 6], {x, -12, 12}, PlotRange→All]

[Graphics:HTMLFiles/Lecture-17_39.gif]

-Graphics -

Fourier Series

Demonstration of the orthogonality of the trigonometric functions

Simplify[coscos/.{Minteger→4 , Ninteger→34}]

0

Assuming[Minteger ε Integers && Ninteger ∈ Integers &&xo ∈ Reals && λ ∈ Reals, Limit[coscos, Minteger→Ninteger]]

λ/2

Simplify[cossin/.{Minteger→ -7 , Ninteger→35}]

0

Assuming[Minteger ε Integers && Ninteger ∈ Integers &&xo ∈ Reals && λ ∈ Reals, Limit[cossin, Minteger→Ninteger]]

0

Simplify[sinsin/.{Minteger→10 , Ninteger→9}]

0

Assuming[Minteger ε Integers && Ninteger ∈ Integers &&xo ∈ Reals && λ ∈ Reals, Limit[sinsin, Minteger→Ninteger]]

λ/2

Example of determination of fourier coefficients

First we will "do it the hard way" and write short programs that evaluate Fourier coefficients; then we will demonstrate how to make use of built-in functions in Mathematica's FourierTransform package…

Define functions based on the formulas derived for the fourier amplitudes

The constant term:

EvenTerms[0, function_ , wavelength_] := 1/wavelength∫_0^wavelengthfunction[dummy] dummy

A function that defines each even amplitude individually (this is not very efficient, it would be better to evaluate the integral once and use that result)

EvenTerms[SP_Integer, function_ , wavelength_] := EvenTerms[SP, function , wavelength] = 2/wavelength∫_0^wavelengthfunction[dummy] Cos[(2 SP π dummy)/wavelength] dummy

Define the zeroth odd term as zero for symmetry with the even terms:

OddTerms[0, function_ , wavelength_] := 0

OddTerms[SP_Integer, function_ , wavelength_] := OddTerms[SP, function , wavelength] = 2/wavelength∫_0^wavelengthfunction[dummy] Sin[(2 SP π dummy)/wavelength] dummy

A function to create a vector of amplitudes for the odd terms and one for the even terms

OddAmplitudeVector[NTerms_Integer, function_, wavelength_] := Table[OddTerms[i, function, wavelength], {i, 0, NTerms}]

EvenAmplitudeVector[NTerms_Integer, function_, wavelength_] := Table[EvenTerms[i, function, wavelength], {i, 0, NTerms}]

Define a function to use as an example:

myfunction[x_ ] := (x * (2 - x) * (1 - x)^2)

OriginalPlot = Plot[myfunction[x], {x, 0, 2}, PlotStyle→ {Hue[1], Thickness[0.015]}]

[Graphics:HTMLFiles/Lecture-17_67.gif]

-Graphics -

Now calculate Fourier amplitudes for this function…

 EvenAmplitudeVector[6, myfunction, 2]

{2/15, (48 - 4 π^2)/π^4, (3 - π^2)/π^4, -(4 (-4 + 3 π^2))/(27 π^4), (3 - 4 π^2)/(16 π^4), (48 - 100 π^2)/(625 π^4), (1 - 3 π^2)/(27 π^4)}

The odd terms should all vanish because the function is even around the center x=λ/2

OddAmplitudeVector[6, myfunction, 2]

{0, 0, 0, 0, 0, 0, 0}

OddBasisVector[NTerms_Integer, var_,   wavelength_] := Table[Sin[(2 π  i var)/wavelength], {i, 0, NTerms}]

OddBasisVector[6, x, 2]

{0, Sin[π x], Sin[2 π x], Sin[3 π x], Sin[4 π x], Sin[5 π x], Sin[6 π x]}

EvenBasisVector[NTerms_Integer, var_,   wavelength_] := Table[Cos[(2 π  i var)/wavelength], {i, 0, NTerms}]

EvenBasisVector[6, x, 2]

{1, Cos[π x], Cos[2 π x], Cos[3 π x], Cos[4 π x], Cos[5 π x], Cos[6 π x]}

Make the Fourier series representation by taking the dot product of the AmplitudeVectors with the BasisVectors:

For myfunction we write the Fourier series out to six terms as:

FourierTruncSeries[6, myfunction, x, 2]

FourierPlot = Plot[FourierTruncSeries[3, myfunction, x, 2], {x, -2, 4}]

[Graphics:HTMLFiles/Lecture-17_84.gif]

-Graphics -

Note the periodicity of the plot above.  The wavelength is 2. Only three terms were calculated in the Fourier series representation of myfunction. Below the Fourier series and the exact function are shown superposed.

Show[OriginalPlot, FourierPlot]

[Graphics:HTMLFiles/Lecture-17_87.gif]

-Graphics -

Now the calculation is repeated but retaining 6 terms in the Fourier series representation and hopefully obtaining a more accurate representation of myfunction.

FourierPlot = Plot[FourierTruncSeries[6, myfunction, x, 2], {x, -2, 4}]

[Graphics:HTMLFiles/Lecture-17_90.gif]

-Graphics -

Show[OriginalPlot, FourierPlot]

[Graphics:HTMLFiles/Lecture-17_93.gif]

-Graphics -

Fourier Series Coefficients using Mathematica's package:

<<Calculus`FourierTransform`

AFunction[x_] := (x - 3)^3/27

Plot[AFunction[x], {x, 0, 6}]

[Graphics:HTMLFiles/Lecture-17_98.gif]

-Graphics -

Mathematica's Fourier Series functions are defined for function that are periodic in the domain x ∈ (-1/2,1/2).  So we need to map the periodic functions to this domain

ReduceHalfHalf[f_ , x_ , λ_ ] := f[(x + 1/2) * λ ]

ReducedFunction = ReduceHalfHalf[AFunction, x, 6]//Simplify

8 x^3

Plot[ReducedFunction, {x, -1/2, 1/2}, PlotRange→All]

[Graphics:HTMLFiles/Lecture-17_104.gif]

-Graphics -

FourierCosCoefficient[ReducedFunction, x, n]

0

FourierSinCoefficient[ReducedFunction, x, n]

(2 (-1)^n (6 - n^2 π^2))/(n^3 π^3)

FourierTrigSeries[ReducedFunction, x, 5]

The function above will work, but it is horribly inefficient!  Because it asks FourierTrigSeries to calculate one more term each time, it is doing some redundant work.  We can fix this up by having
it calculate one new term and adding to the sum calculated previously. Here it is:

General :: spell1 : Possible spelling error: new symbol name \"coscof\" is similar to existing symbol \"coscos\".  More…

The following will demonstrate how convergence is difficult where the function changes rapidly---this is known as Gibbs' Phenomenon

AnimateTruncatedFourierSeriesVersionTwo[ReducedFunction, {1, 60}]

[Graphics:HTMLFiles/Lecture-17_176.gif]

Recall the definition used above for myfunction

myfunction[x]

(1 - x)^2 (2 - x) x

Reduce myfunction to a domain so that we can use Mathematica's Fourier Package on it.

ReducedMyFunction = ReduceHalfHalf[myfunction, x, 2]//Simplify

4 x^2 - 16 x^4

General form of the even amplitudes

myfunccos = FourierCosCoefficient[4 x^2 - 16 x^4, x, n]

-(4 (-1)^n (-12 + n^2 π^2))/(n^4 π^4)

FourierSinCoefficient[4 x^2 - 16 x^4, x, n]

0

Illustrate how amplitude of each term behaves. This plot indicates that the short wavelength contributions are smaller and smaller.

ListPlot[Table[myfunccos, {n, 1, 50}]]

[Graphics:HTMLFiles/Lecture-17_186.gif]

-Graphics -

ListPlot[Table[myfunccos, {n, 1, 10}], PlotJoined→True, PlotRange→All]

[Graphics:HTMLFiles/Lecture-17_189.gif]

-Graphics -


Created by Mathematica  (November 2, 2005) Valid XHTML 1.1!