Solución:
Te daré dos métodos similares. Pero, volveré a escribir uno de los comentarios anteriores solo para asegurarme de que se lea.
Le han dado algunas buenas respuestas, pero esté absolutamente seguro de que eliminar los valores atípicos es Doing The Right Thing ™. Es posible que desee considerar métodos “robustos” que puedan hacer frente a la presencia de valores atípicos. – Adivina quién es.
Umbral gaussiano simple
La forma más sencilla es eliminar la media móvil de los datos, luego calcular su desviación estándar ($ sigma $), luego elegir un nivel en el que desea rechazar los datos, digamos al 1%, para que pueda eliminar cualquier punto que varían más de $ 3 veces sigma $. Si sabe cómo se distribuyen los datos sobre sus valores medios, puede elegir un método diferente. También puede eliminar la mediana, ya que sería menos sensible a la distribución.
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]
Tenemos alrededor de 8 valores atípicos. Calculamos la media móvil,
movingAvg=ArrayPad[MovingAverage[data2, 5],{5-1,0},"Fixed"]
Aquí restamos la media móvil,
subtractedmean = (Subtract @@@Transpose[{data2, movingAvg}]);
Ahora busque las ubicaciones de los valores atípicos:
outpos=Position[subtractedmean, x_ /; x>StandardDeviation[subtractedmean]*3];
Length[outpos]
8
parece que tenemos el número correcto de valores atípicos. Eliminándolos.
newdata=Delete[data2,outpos]
ListPlot[newdata, PlotRange -> All]
Para darte una idea de la línea “Umbral” en este caso,
dathreshold =
ConstantArray[StandardDeviation[subtractedmean]*3, Length[data2]] + movingAvg;
Aquí está la línea “Umbral” dibujada junto con los puntos eliminados,
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]]}]}]]
Por derivados
Una segunda forma de eliminar los valores atípicos es mirando los derivados y luego el umbral en ellos. Es más probable que las diferencias en los datos se comporten en forma gaussiana que las distribuciones reales.
[email protected][data2,2];
ListPlot[diff, PlotRange -> All, Joined -> True]
Ahora hace el mismo umbral (basado en la desviación estándar) en estos picos. Tenga en cuenta que los valores atípicos ahora están muy bien separados de los datos reales. Puede encontrar las posiciones pico que están por encima del umbral que estableció, en nuestro caso seguiremos usando $ 3 times sigma $.
Probablemente pueda usar la función de búsqueda de picos de V10 (no estoy seguro de si hay una manera de limitar los picos), pero como me quedé atascado en V9, hago el camino del pobre.
newpos=Flatten[Position[Partition[diff, 3, 1],
x_ /; ((x[[1]] < x[[2]] > x[[3]]) && (x[[2]] > 3*sddif)), {1}]] + 2
newpos===First /@ outpos
Cierto
La mediana móvil apenas se ve afectada por algunos valores atípicos, esto se puede utilizar para identificar los valores atípicos.
newData = Select[Transpose[{
data2[[10 ;;]],
MovingMedian[data2, 10]
}], Abs[Subtract @@ #] < 1 &] // Transpose;
ListPlot[newData, PlotRange -> Full]
En este fragmento de código 10 y 1 son números elegidos arbitrariamente que es posible que desee reemplazar con otra cosa.