La pregunta pide formas de utilizar a los vecinos más cercanos de manera robusta para identificar y corregir valores atípicos localizados. ¿Por qué no hacer exactamente eso?
El procedimiento consiste en calcular una suavidad local robusta, evaluar los residuos y poner a cero los que sean demasiado grandes. Esto satisface todos los requisitos directamente y es lo suficientemente flexible como para ajustarse a diferentes aplicaciones, ya que uno puede variar el tamaño del vecindario local y el umbral para identificar valores atípicos.
(¿Por qué es tan importante la flexibilidad? Debido a que cualquier procedimiento de este tipo tiene una buena oportunidad de identificar ciertos comportamientos localizados como "periféricos". Como tal, todos estos procedimientos pueden considerarse suavizadores . Eliminarán algunos detalles junto con los valores atípicos aparentes. El analista necesita cierto control sobre la compensación entre retener detalles y no detectar valores atípicos locales).
Otra ventaja de este procedimiento es que no requiere una matriz rectangular de valores. De hecho, incluso se puede aplicar a datos irregulares utilizando un suavizador local adecuado para dichos datos.
R, así como la mayoría de los paquetes de estadísticas con todas las funciones, tiene varios suavizadores locales robustos integrados, como loess. El siguiente ejemplo fue procesado usándolo. La matriz tiene filas y 49 columnas, casi entradas. Representa una función complicada que tiene varios extremos locales, así como una línea completa de puntos donde no es diferenciable (un "pliegue"). A un poco más del de los puntos, una proporción muy alta para ser considerada "periférica", se agregaron errores gaussianos cuya desviación estándar es solo de la desviación estándar de los datos originales. Este conjunto de datos sintéticos presenta muchas de las características desafiantes de los datos realistas.794940005%1/20
Tenga en cuenta que (según las Rconvenciones) las filas de la matriz se dibujan como tiras verticales. Todas las imágenes, excepto los residuos, están sombreadas para ayudar a mostrar pequeñas variaciones en sus valores. Sin esto, ¡casi todos los valores atípicos locales serían invisibles!
Al comparar las imágenes "Imputado" (arreglado) con las imágenes "Reales" (originales no contaminadas), es evidente que la eliminación de los valores atípicos ha suavizado parte, pero no todo, del pliegue (que va desde(0,79) hacia abajo a ; es evidente como una franja angulada cian clara en la trama "Residuos").(49,30)
Las manchas en la trama de "Residuos" muestran los obvios valores aislados locales aislados. Este gráfico también muestra otra estructura (como esa franja diagonal) atribuible a los datos subyacentes. Se podría mejorar este procedimiento utilizando un modelo espacial de los datos (a través de métodos geoestadísticos), pero describirlo e ilustrarlo nos llevaría demasiado lejos aquí.
Por cierto, este código informó haber encontrado solo de los 200 valores atípicos que se introdujeron. Esto no es un fracaso del procedimiento. Debido a que los valores atípicos se distribuían normalmente, aproximadamente la mitad de ellos tenían un tamaño tan cercano a cero, 3 o menos, en comparación con los valores subyacentes que tenían un rango de más de 600, que no hicieron ningún cambio detectable en la superficie. 1022003600
#
# Create data.
#
set.seed(17)
rows <- 2:80; cols <- 2:50
y <- outer(rows, cols,
function(x,y) 100 * exp((abs(x-y)/50)^(0.9)) * sin(x/10) * cos(y/20))
y.real <- y
#
# Contaminate with iid noise.
#
n.out <- 200
cat(round(100 * n.out / (length(rows)*length(cols)), 2), "% errors\n", sep="")
i.out <- sample.int(length(rows)*length(cols), n.out)
y[i.out] <- y[i.out] + rnorm(n.out, sd=0.05 * sd(y))
#
# Process the data into a data frame for loess.
#
d <- expand.grid(i=1:length(rows), j=1:length(cols))
d$y <- as.vector(y)
#
# Compute the robust local smooth.
# (Adjusting `span` changes the neighborhood size.)
#
fit <- with(d, loess(y ~ i + j, span=min(1/2, 125/(length(rows)*length(cols)))))
#
# Display what happened.
#
require(raster)
show <- function(y, nrows, ncols, hillshade=TRUE, ...) {
x <- raster(y, xmn=0, xmx=ncols, ymn=0, ymx=nrows)
crs(x) <- "+proj=lcc +ellps=WGS84"
if (hillshade) {
slope <- terrain(x, opt='slope')
aspect <- terrain(x, opt='aspect')
hill <- hillShade(slope, aspect, 10, 60)
plot(hill, col=grey(0:100/100), legend=FALSE, ...)
alpha <- 0.5; add <- TRUE
} else {
alpha <- 1; add <- FALSE
}
plot(x, col=rainbow(127, alpha=alpha), add=add, ...)
}
par(mfrow=c(1,4))
show(y, length(rows), length(cols), main="Data")
y.res <- matrix(residuals(fit), nrow=length(rows))
show(y.res, length(rows), length(cols), hillshade=FALSE, main="Residuals")
#hist(y.res, main="Histogram of Residuals", ylab="", xlab="Value")
# Increase the `8` to find fewer local outliers; decrease it to find more.
sigma <- 8 * diff(quantile(y.res, c(1/4, 3/4)))
mu <- median(y.res)
outlier <- abs(y.res - mu) > sigma
cat(sum(outlier), "outliers found.\n")
# Fix up the data (impute the values at the outlying locations).
y.imp <- matrix(predict(fit), nrow=length(rows))
y.imp[outlier] <- y[outlier] - y.res[outlier]
show(y.imp, length(rows), length(cols), main="Imputed")
show(y.real, length(rows), length(cols), main="Real")
