How to remove outliers from data

I have a data with noise which some times includes significant outliers. The position of the outliers are random.

For example:

data1 = Table[PDF[NormalDistribution[3.5, .8], i], {i, -5, 15, .01}] +
RandomReal[{100, 500}];
noise = RandomReal /@ RandomReal[{-0.2, .2}, Length[data1]];
data2 = data1 + noise;
n = RandomInteger[{1, Length[data2]}, RandomInteger[{2, 10}]];
data2[[n]] = data2[[n]]*1.01;
ListPlot[{data2}, PlotRange -> All]


One solution is to use the average of the data but because the position of the outliers are random, the non-noisy data is hard to extract. The whole level of the data is random which means I can not use fixed reference to check and remove outliers.

Any idea how to remove these points using Mathematica?

Thanks.

• Take the Mean & StandardDeviation of data. Choose some appropriate limit on the top side (e.g. 5 SD), Clip the data to Minof data and top side choice, using Missing[] as replacement in Clip. Plot. Win. – ciao Apr 29 '15 at 0:30
• You've been given some fine answers, but be absolutely sure that removing the outliers is Doing The Right Thing™. You might want to consider "robust" methods that can deal with the presence of outliers. – J. M.'s discontentment May 4 '15 at 4:47
• @Guesswhoitis.I did not get your idea. can you explain to me little bit. Thanks. – Algohi May 4 '15 at 14:34
• My point was that you need a more substantial reason than "my plots look off with them" when removing outliers; there are a number of discussions on stats.SE on this, e.g. this one. – J. M.'s discontentment May 4 '15 at 14:43
• @Guesswhoitis. Thanks for the link. My data is a result of measuring devices and these outliers are measuring errors (due to weather inducing some electrical malfunctions) I have thousands of similar data and only some of them have these outliers which means they are irrelevant to the data. These outliers are not more than 2% of the data. – Algohi May 4 '15 at 14:54

I will give you two similar methods. But, I will rewrite one of the comments above just to make sure it is read.

You've been given some fine answers, but be absolutely sure that removing the outliers is Doing The Right Thing™. You might want to consider "robust" methods that can deal with the presence of outliers. – Guess who it is.

Simple Gaussian Threshold

The simplest way is to remove the moving mean of the data, then compute its standard deviation ($\sigma$), then pick a level at which you want to reject the data, say at 1%, so you can remove any points that vary more than $3\times \sigma$ . If you know how the data is distributed about its mean values, then you can pick a different method. You can also remove the median since that would be less sensitive to the distribution.

SeedRandom[1245];
data1 =
Table[PDF[NormalDistribution[3.5, .8], i], {i, -5, 15, .01}] +
RandomReal[{100, 500}];
noise = RandomReal /@ RandomReal[{-0.2, .2}, Length[data1]];
data2 = data1 + noise;
n = RandomInteger[{1, Length[data2]}, RandomInteger[{2, 10}]];
data2[[n]] = data2[[n]]*1.01;
ListPlot[{data2}, PlotRange -> All]


We have about 8 outliers. We compute the moving average,

movingAvg=ArrayPad[MovingAverage[data2, 5],{5-1,0},"Fixed"]


Here we subtract the moving mean,

subtractedmean = (Subtract @@@Transpose[{data2, movingAvg}]);


Now find the locations of the outliers:

 outpos=Position[subtractedmean, x_ /; x>StandardDeviation[subtractedmean]*3];

Length[outpos]


8

looks like we got the right number of outliers. Removing them.

 newdata=Delete[data2,outpos]
ListPlot[newdata, PlotRange -> All]


To give you an idea of "Threshold" line in this case,

 dathreshold =
ConstantArray[StandardDeviation[subtractedmean]*3, Length[data2]] + movingAvg;


Here is the "Threshold" line drawn along with the points removed,

 Show[ListPlot[data2, PlotRange -> All, AspectRatio -> 1],
ListPlot[dathreshold, Joined -> True, PlotStyle -> {Thick, Purple}],
Graphics[{Red,Circle[#, {100, 0.5}] & /@
Thread[{First /@ outpos, data2[[First /@ outpos]]}]}]]


By derivatives

A second way to remove outliers, is by looking at the Derivatives, then threshold on them. Differences in the data are more likely to behave gaussian then the actual distributions.

 diff=Abs@Differences[data2,2];

ListPlot[diff, PlotRange -> All, Joined -> True]


Now you do the same threshold, (based on the standard deviation) on these peaks. Note that the outliers are now really well separated from the actual data. You can find the peak positions that are above the threshold you set, in our case we will keep using $3 \times \sigma$.

You can probably use the peak finding function from V10 (not sure if there is a way to threshold the peaks), but since I stuck in V9 I do the poor's man way.

 newpos=Flatten[Position[Partition[diff, 3, 1],
x_ /; ((x[[1]] < x[[2]] > x[[3]]) && (x[[2]] > 3*sddif)), {1}]] + 2

newpos===First /@ outpos


True

• +1 but I would use MovingMedian in place of MovingAverage – mikado Aug 21 '16 at 11:33

The moving median is hardly affected at all by a few outliers, this can be used to identify the outliers.

newData = Select[Transpose[{
data2[[10 ;;]],
MovingMedian[data2, 10]
}], Abs[Subtract @@ #] < 1 &] // Transpose;
ListPlot[newData, PlotRange -> Full]


In this piece of code 10 and 1 are arbitrarily chosen numbers that you might want to replace with something else.

• The MovingMedian change the data a bit which I don't want. Thanks – Algohi Apr 29 '15 at 0:25
• @Algohi You can just prepend those ten first elements again. Unless there's an outlier among those ten first elements there won't be a problem. If there are - well, how can you tell? Can't spot a pattern before it emerges. Next best thing in that situation might be to compare those elements with the median among the elements 10-20. – C. E. Apr 29 '15 at 0:37

Now there is this new function called, TrimmedMean which could be used for this purpose. Please see the examples given in Mathematica documentation for TrimmedMean for a complete example (heights).