Fourier Transform With Noise

Question

For the following function I need to do the following steps.

Sin[2πt](1+0.2 Sin [6πt] + 0.1 Sin [8πt])

Plot the function. Generate a table of data points from this function with random noise added. Plot these data points. Take the Fourier transform of the table and plot the results. Filter the transform and replot the data to show removal of the noise.

This is what I have so far but it seems to be wrong.

f[t_] = Sin[2 Pi*t] (1 + 0.2 Sin[6 Pi*t] + 0.1 Sin[8 Pi*t])
b = Plot[a, {t, -2 Pi, Pi}]
c = Table[N[a] + (RandomReal[{-1, 1}] - 1/2), {t, 1000}];
ListLinePlot[c]
ListLinePlot[Abs[Fourier[c]], PlotRange -> All]

Answer 1

It depends how we define "noise". Suppose the noise comes from the Alternative Current (AC) of a device placed near the recorder of the signal. Then the noise is going to be a high frequency sinusoid.

Here is a signal and its noised version:

f[t_] := Sin[2 Pi*t] (1 + 0.2 Sin[6 Pi*t] + 0.1 Sin[8 Pi*t]);

data = Table[{t, f[t]}, {t, -2 \[Pi], 2 \[Pi], 0.05}];

rdata = Table[{t, f[t] + Sin[50 t]}, {t, -2 \[Pi], 2 \[Pi], 0.05}];

MapThread[
 ListLinePlot[#, PlotLabel -> #2, PlotRange -> All, 
   ImageSize -> Medium, PlotTheme -> "Detailed"] &, {{data, 
   rdata}, {"signal\nno noise", "signal\nwith noise"}}]

Here are the corresponding Fourier transforms:

MapThread[
 ListLinePlot[#, PlotLabel -> #2, PlotRange -> {0, 8}, 
   ImageSize -> Medium, 
   PlotTheme -> "Detailed"] &, {{Abs@Fourier[data[[All, 2]]], 
   Abs@Fourier[rdata[[All, 2]]]}, {"Fourier transform\nno noise", 
   "Fourier transform\nwith noise"}}]

We can see that the "high pitch" noise components are closer to the middle of the calculated spectrum.

This interface defines and applies a filter that preserves or removes components at specified frequency locations:

Manipulate[
 n = Length[rdata[[All, 2]]];
 nf = Fourier[rdata[[All, 2]]];
 filter = Table[f, {n}];
 filter[[k - m ;; k + m]] = Abs[f - 1]; 
 filter[[n - (k + m) ;; n - (k - m)]] = Abs[f - 1];
 Column[{
   ListLinePlot[{Abs@nf, filter}, PlotRange -> MinMax[Abs[nf]], 
    PlotLegends -> {"Abs@Fourier", "filter"}, ImageSize -> Medium],
   ListLinePlot[{rdata[[All, 2]], Re@InverseFourier[nf*filter]}, 
    PlotLegends -> {"original", "filtered"}, 
    PlotStyle -> {GrayLevel[0.8], 
      RGBColor[0.368417, 0.506779, 0.709798, 1.]}, 
    PlotRange -> MinMax[rdata[[All, 2]]], PlotTheme -> "Detailed", 
    ImageSize -> Medium],
   Row[{"root mean square error:", 
     RootMeanSquare[Re@InverseFourier[nf*filter] - data[[All, 2]]]}]
   }],
 {{k, 20, "location"}, 1, Floor[Length[rdata]/2], 1, 
  Appearance -> "Open"}, {{m, 5, "window size"}, 3, 15, 1, 
  Appearance -> "Open"}, {{f, 0, "filter action"}, 
  Thread[{0, 1} -> {"preserve", "remove"}]}]