# Remove noise from data

Hi, as you can see above I have some experimental data which has a large offset and shows clear noise fluctations around the tendency of the curve. I wanted to ask if someone could suggest me a method to remove the noise, withoud eliminating the oscillations.

Using EstimateBackground[] I was able to envelope the oscillations (yellow and green curves) but as you can see, the noise spikes make it very uncertain. The red curve was my attempt to reproduce the tendency of the oscillations and smoothing the data, using a median noise filter (Median noise filter), but it is a little off.

data = Uncompress[FromCharacterCode[
Flatten[ImageData[Import["http://i.stack.imgur.com/7agjd.png"],"Byte"]]]]

• You could try applying MovingAverage or TrimmedMean on the data, together with BlockMap. – user31159 Aug 27 '16 at 15:50
• Thanks for the quick reply! The MovingAverage methog worked fine, but the result is still not very smooth, even increasing the number of points to be averaged. Could you elaborate on the second method you suggested? – Filipe Aug 27 '16 at 16:00
• With TrimmedMean you will be able to remove outliers on a given window (defined by, e.g. BlockMap) before taking the average. This should be smoother in principle. – user31159 Aug 27 '16 at 16:22
• – Algohi Aug 27 '16 at 17:02
• How do you know it's noise? In other words, the answer will depend on how the signal and the noise differ; not all noise is created equal. (In your case, there are a lot of large downward spikes but fewer and smaller downward ones, which marks your noise as different from the standard gaussian model.) Trying to remove the noise from a signal without a good model for its characteristics might make it look prettier, but it won't produce scientifically valuable data if that's what you're after. For the latter, try Cross Validated for how to approach this, then this site can help implement it. – Emilio Pisanty Aug 27 '16 at 20:54

You could try BilateralFilter:

ListLinePlot[{data,
BilateralFilter[data, 2, .5, MaxIterations -> 25]},
PlotStyle -> {Thin, Red}]


Or alternatively, MeanShiftFilter can produce similar results:

ListLinePlot[{data,
MeanShiftFilter[data, 5, .5, MaxIterations -> 10]},
PlotStyle -> {Thin, Red}]


Third alternative, as mentioned by @Xavier in the comments, is to apply TrimmedMean over a sliding window:

ListLinePlot[{data, ArrayFilter[TrimmedMean, data, 20]},
PlotStyle -> {Thin, Red}]


As requested in the comments, a Savitzky Golay filter:

ListLinePlot[{
data,
ListConvolve[SavitzkyGolayMatrix[{10}, 2],
}, PlotStyle -> {Thin, Red}]


For comparison:

Show[
ListPlot[data, PlotLegends -> {"Raw Data"}],
ListLinePlot[{BilateralFilter[data, 2, .5, MaxIterations -> 25],
MeanShiftFilter[data, 5, .5, MaxIterations -> 10],
ArrayFilter[TrimmedMean, data, 20],
ListConvolve[SavitzkyGolayMatrix[{10}, 2],
PlotLegends -> {"BilateralFilter", "MeanShiftFilter",
"ArrayFilter[TrimmedMean]", "SavitzkyGolay"}], ImageSize -> 800]


• MeanShiftFilter and BilateralFilter produce a smooth result, and are almost indistinguishable with these parameters.
• The sliding window TrimmedMean filter technique looks more "ragged" in comparison.
• I couldn't get a smooth curve with the Savitzky Golay filter, probably because the large outliers aren't well suited to linear filtering.

You'll have to play with the parameters to each of them to get the results you want.

• I would recommend using the same parameters for the BilateralFilter. It's a bit confusing seeing it behave one way in the first plot and another way in the combined plot. – William Mariager Aug 28 '16 at 9:27
• Would be interesting to compare your results with that of the Savitzky-Golay filter (mathematica.stackexchange.com/questions/37380/…) – yarchik Aug 28 '16 at 12:30
• Very pedagogical answer. – yarchik Aug 28 '16 at 19:48

I would suggest using a median filter with small radius to eliminate the large spikes, then a mean filter to smooth the remaining signal. @Xavier essentially combines these two filters by using TrimmedMean.

Other than the large spikes, your data seem to have a strong signal with a period of about 10 points. You could use BandstopFilter to remove this, or LowpassFilter to eliminate this oscillation plus higher frequencies.

In the following, I removed the mean from your original data.

Manipulate[
Module[{f},
f = LowpassFilter[MedianFilter[data, r], w];
ListLinePlot[{data, f - Mean[f]}, ImageSize -> 600, Frame -> True,
PlotStyle -> {Thin, Thick}]
],
{{r, 0, "Median Filter Radius"}, 0, 10, 1, Appearance -> "Labeled"},
{{w, 3., "Cutoff Angular Frequency"}, 0.002,Pi, Appearance -> "Labeled"}]


I am not sure what is called "noise" in the question, from the description, I think it is about removing outliers. This solution uses Quantile regression twice: to detect the outliers, and then to find quantile regression curves in the data without the outliers.

Import["https://raw.githubusercontent.com/antononcube/MathematicaForPrediction/master/QuantileRegression.m"]


data = Transpose[{Range[Length[data]], data}];


Selection of quantiles to detect the outliers:

qs = {0.05, 0.5, 0.98};
{qs[[1]], 1 - qs[[-1]]}*Length[data]
(* {25.6, 10.24} *)


Quantile regression with the selected quantiles:

qfuncs = QuantileRegression[data, 15, qs];


Finding the top outliers:

topOutliers = Select[data, qfuncs[[-1]][#[[1]]] < #[[2]] &]

(* {{54, 8.16422}, {145, 8.16422}, {155, 8.14875}, {203,
8.19841}, {289, 8.14254}, {370, 8.17358}, {433, 8.17358}} *)


Finding the bottom outliers:

bottomOutliers = Select[data, qfuncs[[1]][#[[1]]] > #[[2]] &]

(* {{29, 7.9156}, {78, 8.08349}, {81, 7.98714}, {101,
8.03685}, {127, 7.99335}, {140, 8.01821}, {178, 7.8689}, {182,
8.07728}, {220, 8.08349}, {263, 7.98714}, {268, 8.00884}, {323,
8.12381}, {331, 8.12696}, {334, 8.09276}, {386, 8.0617}, {387,
8.05243}, {406, 8.08349}, {454, 8.0617}, {456, 8.05864}, {486,
8.07412}, {496, 8.10833}} *)


Plot data, regression quantiles, and outliers:

qfPlot = ListLinePlot[
Table[{#, qfuncs[[i]][#]} & /@
Rescale[Range[0, 1, 0.005], {0, 1}, MinMax[data[[All, 1]]]], {i,
1, Length[qfuncs]}], PerformanceGoal -> "Quality",
PlotRange -> All, PlotTheme -> "Detailed", PlotLegends -> qs];
Show[{ListPlot[data, PlotRange -> All, PlotStyle -> {GrayLevel[0.5]},
PlotTheme -> "Detailed"], qfPlot,
ListPlot[{topOutliers, bottomOutliers}, PlotStyle -> {{
Blue, PointSize[0.01]}, {Red, PointSize[0.01]}}]},
ImageSize -> 600]


Remove the outliers from the data:

newData = Complement[data, Join[topOutliers, bottomOutliers]];


Make another quantile regression computation over the new data. (This time is to facilitate analysis instead of detecting outliers.)

Block[{data = newData, qfuncs, qs = {0.05, 0.25, 0.5, 0.75, 0.95}},
qfuncs = QuantileRegression[data, 40, qs];
Show[{ListPlot[data, PlotStyle -> GrayLevel[0.5], PlotRange -> All,
PlotTheme -> "Detailed"],
ListLinePlot[
Transpose@

• For computing the average of a dataset the $q=0.5$ quantile (i.e. the median) is already resistant to outliers (e.g. the median of $\{1,2,3,4,500\}$ is still $3$). Is this no longer true in the case of computing regression curves? What happens if you only run quantile regression once without removing outliers first? – Rahul Aug 28 '16 at 19:05