Notebook on Fourier theory

belonging to the master course on Fourier Theory and Signal Analysis by T.H. Koornwinder (T.H.Koornwinder@uva.nl)

University of Amsterdam, February-June 2006

Last modified 7 June 2014

Reference: E. Stein and R. Shakarchi, Fourier analysis, Princeton University Press, 2003.

Load packages

no spelling warnings:

Off[General::spell, General::spell1]

The Gibbs phenomenon

sawtooth:=Sign[x](Pi-Abs[x])/2

Plot[sawtooth,{x,-π,π},PlotStyle->Red,Ticks->{{-π,-π/2,π/2,π},{-π/2, π/2}}]

Integrate[1/π sawtooth Sin[n x] ,{x,-π,π},Assumptions->Element[n,Integers]&&n>0]

Simplify[Integrate[1/π sawtooth Cos[n x] ,{x,-π,π}]]

sawtoothhat[n_]:=1/n

psumsawtooth[N_]:=Sum[sawtoothhat[n] Sin[n x],{n,1,N}]

Plot[{psumsawtooth[10],sawtooth},{x,-π,π},PlotStyle->{Red,Green},Ticks->{{-π,-π/2,π/2,π},{-π/2, π/2}}]

Plot[psumsawtooth[10]-sawtooth,{x,-π,π},PlotStyle->Red,Ticks->{{-π,-π/2,π/2,π},{-π/2, π/2}},PlotRange->All]

Plot[{psumsawtooth[20],sawtooth},{x,-π,π},PlotStyle->{Red,Green},Ticks->{{-π,-π/2,π/2,π},{-π/2, π/2}}]

Plot[psumsawtooth[20]-sawtooth,{x,-π,π},PlotStyle->Red,Ticks->{{-π,-π/2,π/2,π},{-π/2,-π/4,π/4, π/2}},PlotRange->All]

Plot[psumsawtooth[20]-sawtooth,{x,0,π},PlotStyle->Red,Ticks->{{-π,-π/2,π/2,π},Automatic}]

Plot[{psumsawtooth[100],sawtooth},{x,-π,π},PlotStyle->{Red,Green},Ticks->{{-π,-π/2,π/2,π},{-π/2, π/2}}]

Integrate[Sin[t]/t,{t,0,x},Assumptions->x∈Reals]

Plot[Sin[x]/x,{x,-10π,10π},Ticks->{{-10π,-8π,-6π,-4π,-2π,2π,4π,6π,8π,10π},Automatic},PlotStyle->Red,PlotRange->All]

Plot[{SinIntegral[x],-π/2,π/2},{x,-10π,10π},Ticks->{{-10π,-8π,-6π,-4π,-2π,2π,4π,6π,8π,10π},{-π/2,π/2}},PlotStyle->{Red,Green,Green},PlotRange->All]

N[SinIntegral[π]/(π/2)]

nn=20;

Plot[SinIntegral[nn x]-π/2,{x,0,π},Ticks->{{π/2,π},Automatic},PlotStyle->Red]

Plot[psumsawtooth[nn]-sawtooth,{x,0,π},Ticks->{{π/2,π},Automatic},PlotStyle->Red]

Plot[((psumsawtooth[nn]-sawtooth)-(SinIntegral[nn x]-π/2))*nn,{x,0,π},Ticks->{{π/2,π},Automatic},PlotStyle->Red]

Plot[((psumsawtooth[nn]-sawtooth)-(SinIntegral[nn x]-π/2))*nn,{x,0,2π/nn },Ticks->{{π/nn,2π/nn},Automatic},PlotStyle->Red]

Weyl's equidistribution theorem

This illustrates Chapter 4, Theorem 2.1 in the book by Stein & Shakarchi about the equidistribution of the sequence {<n γ>} for γ irrational. The second and third plot in each case display phenomena which need further explanation.

TableForm[Table[{k,N[FractionalPart[k*Sqrt[2]]]},{k,1,10}]]

$MachinePrecision

n=100;s=Sort[Table[N[n*FractionalPart[k*Sqrt[2]],40],{k,1,n}]];
ListPlot[s]
ListPlot[(s-Range[n]+0.5)/n];
t=Table[(s[[k+1]]-s[[k]]-1)/n,{k,1,n-1}];
ListPlot[t]

n=1000;s=Sort[Table[N[n*FractionalPart[k*Sqrt[2]],40],{k,1,n}]];
ListPlot[s]
ListPlot[(s-Range[n]+0.5)/n];
t=Table[(s[[k+1]]-s[[k]]-1)/n,{k,1,n-1}];
ListPlot[t]

n=10000;s=Sort[Table[N[n*FractionalPart[k*Sqrt[2]],40],{k,1,n}]];
ListPlot[s]
ListPlot[(s-Range[n]+0.5)/n];
t=Table[(s[[k+1]]-s[[k]]-1)/n,{k,1,n-1}];
ListPlot[t]

n=100;s=Sort[Table[N[n*FractionalPart[k*Pi],40],{k,1,n}]];
ListPlot[s]
ListPlot[(s-Range[n]+0.5)/n];
t=Table[(s[[k+1]]-s[[k]]-1)/n,{k,1,n-1}];
ListPlot[t]

n=1000;s=Sort[Table[N[n*FractionalPart[k*Pi],40],{k,1,n}]];
ListPlot[s]
ListPlot[(s-Range[n]+0.5)/n];
t=Table[(s[[k+1]]-s[[k]]-1)/n,{k,1,n-1}];
ListPlot[t]

n=10000;s=Sort[Table[N[n*FractionalPart[k*Pi],40],{k,1,n}]];
ListPlot[s]
ListPlot[(s-Range[n]+0.5)/n];
t=Table[(s[[k+1]]-s[[k]]-1)/n,{k,1,n-1}];
ListPlot[t]

n=100;s=Sort[Table[N[n*FractionalPart[k*E],40],{k,1,n}]];
ListPlot[s]
ListPlot[(s-Range[n]+0.5)/n];
t=Table[(s[[k+1]]-s[[k]]-1)/n,{k,1,n-1}];
ListPlot[t]

n=1000;s=Sort[Table[N[n*FractionalPart[k*E],40],{k,1,n}]];
ListPlot[s]
ListPlot[(s-Range[n]+0.5)/n]
t=Table[(s[[k+1]]-s[[k]]-1)/n,{k,1,n-1}];
ListPlot[t]
t=Table[(s[[k+1]]-s[[k]]-1)/n,{k,1,n-1}];
ListPlot[t]

n=10000;s=Sort[Table[N[n*FractionalPart[k*E],40],{k,1,n}]];
ListPlot[s]
ListPlot[(s-Range[n]+0.5)/n];
t=Table[(s[[k+1]]-s[[k]]-1)/n,{k,1,n-1}];
ListPlot[t]

n=100;s=Sort[Table[N[n*FractionalPart[k*EulerGamma],40],{k,1,n}]];
ListPlot[s]
ListPlot[(s-Range[n]+0.5)/n];
t=Table[(s[[k+1]]-s[[k]]-1)/n,{k,1,n-1}];
ListPlot[t]

n=1000;s=Sort[Table[N[n*FractionalPart[k*EulerGamma],40],{k,1,n}]];
ListPlot[s]
ListPlot[(s-Range[n]+0.5)/n];
t=Table[(s[[k+1]]-s[[k]]-1)/n,{k,1,n-1}];
ListPlot[t]

n=10000;s=Sort[Table[N[n*FractionalPart[k*EulerGamma],40],{k,1,n}]];
ListPlot[s]
ListPlot[(s-Range[n]+0.5)/n]
t=Table[(s[[k+1]]-s[[k]]-1)/n,{k,1,n-1}];
ListPlot[t]

Weierstrass' nowhere differentiable function

psumwc[N_]:=Sum[2^(-n/2) Cos[2^n x],{n,0,N}]

For[n=1,n≤10,n++,Plot[psumwc[n],{x,-Pi,Pi},PlotStyle->Red,Ticks->{{-π,-π/2,π/2,π},Automatic},PlotLabel->SequenceForm["N=",n]]//Print]

psumws[N_]:=Sum[2^(-n/2) Sin[2^n x],{n,1,N}]

For[n=2,n≤10,n++,Plot[psumws[n],{x,-Pi,Pi},PlotStyle->Red,Ticks->{{-π,-π/2,π/2,π},Automatic},PlotLabel->SequenceForm["N=",n]]//Print]

Riemann's mostly nondifferentiable function

psumriem[N_]:=Sum[n^(-2) Sin[n^2 x],{n,1,N}]

For[n=2,n≤10,n++,Plot[psumriem[n],{x,-Pi,Pi},PlotStyle->Red,Ticks->{{-π,-π/2,π/2,π},Automatic},PlotLabel->SequenceForm["N=",n]]//Print]

At  pπ/q with p and q odd integers and relatively prime the infinite Fourier series is differentiable, see here an approximation at 7π/9 :

Plot[psumriem[100],{x,69π/90,71π/90},PlotStyle->Red,Ticks->{{69π/90,7π/9,71π/90},Automatic},PlotRange->All]

At all other points the infinite Fourier series is not differentiable, see here an approximation at 7π/10 :

Plot[psumriem[100],{x,69π/100,71π/100},PlotStyle->Red,Ticks->{{69π/100,7π/10,71π/100},Automatic},PlotRange->All]