La pregunta es cuál es el modo de utilizar la más cercana a los vecinos en una sólida manera de identificar y corregir localizada valores atípicos. ¿Por qué no hacer exactamente eso?
El procedimiento consiste en calcular una robusta locales suave, evaluar los residuos, y de cero que son demasiado grandes. Esto satisface todos los requisitos directamente y es lo suficientemente flexible como para adaptarse a diferentes aplicaciones, ya que se puede variar el tamaño de la vecindad local y el umbral para la identificación de valores atípicos.
(¿Por qué la flexibilidad es tan importante? Porque tal procedimiento tiene buenas posibilidades de la identificación de ciertas localizada comportamientos como "periféricas". Como tal, todos estos procedimientos pueden ser considerados suavizadores. Van a eliminar algunos de los detalles junto con la aparente valores atípicos. El analista necesita algún tipo de control sobre el trade-off entre conservar los detalles y no detectar local de valores atípicos.)
Otra ventaja de este procedimiento es que no requiere de una matriz rectangular de valores. De hecho, puede incluso ser aplicado a los irregulares de datos mediante el uso de un local más suave adecuado para estos datos.
R, así como la más completa de las estadísticas de los paquetes, tiene varias robusto local suavizadores integradas, como loess. En el ejemplo siguiente se procesan utilizando. La matriz ha $79$ filas y $49$ columnas: casi $4000$ entradas. Representa una complicada función de tener varios extremos locales así como toda una línea de puntos donde no es derivable (un "pliegue"). A poco más de $5\%$ de los puntos--una proporción muy alta de ser considerados "periféricos"--se han añadido Gaussiano errores cuya desviación estándar es sólo $1/20$ de la desviación estándar de los datos originales. Este sintético conjunto de datos con lo que presenta muchas de las difíciles características de los datos realistas.
![Figures]()
Tenga en cuenta que (como por R convenios), las filas de la matriz se dibujan como líneas verticales. Todas las imágenes, excepto para los residuos, se hillshaded para ayudar a mostrar pequeñas variaciones en sus valores. Sin esto, casi todos los locales de los valores atípicos serían invisibles!
Al comparar el "Imputado" (fija) a la "Real" (original no contaminado) de las imágenes, es evidente que la eliminación de los valores extremos se ha pulido algunos, pero no todos, de la raya (la cual se de$(0,79)$$(49, 30)$; es evidente como la luz cian ángulo de la raya en los "Residuos" de la trama).
Las motas en los "Residuos" de la trama mostrar la evidente locales aislados de los valores atípicos. Este gráfico también muestra otra estructura (como la que se raya diagonal) atribuible a los datos subyacentes. Se podría mejorar en este procedimiento mediante un modelo espacial de los datos (a través de métodos geoestadísticos), pero describiendo e ilustrando nos llevaría demasiado lejos de aquí.
Por CIERTO, este código informaron el hallazgo de sólo $102$ de la $200$ valores atípicos que se han introducido. Esto no es un fracaso del procedimiento. Debido a que los valores atípicos se distribuyeron Normalmente, alrededor de la mitad de ellos estaban tan cerca de cero--$3$ o menos en tamaño, en comparación con los valores subyacentes de tener una gama de más de $600$--a la que no hizo ningún cambio detectable en la superficie.
#
# 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")
