La question demande des moyens d'utiliser les voisins les plus proches de manière robuste pour identifier et corriger les valeurs aberrantes localisées. Pourquoi ne pas faire exactement ça?
La procédure consiste à calculer un lissage local robuste, à évaluer les résidus et à éliminer ceux qui sont trop grands. Cela répond directement à toutes les exigences et est suffisamment flexible pour s'adapter à différentes applications, car on peut faire varier la taille du voisinage local et le seuil d'identification des valeurs aberrantes.
(Pourquoi la flexibilité est-elle si importante? Parce qu'une telle procédure a de bonnes chances d'identifier certains comportements localisés comme étant "éloignés". En tant que telles, toutes ces procédures peuvent être considérées comme plus lisses . Elles élimineront certains détails ainsi que les valeurs aberrantes apparentes. L'analyste a besoin d'un certain contrôle sur le compromis entre conserver les détails et ne pas détecter les valeurs aberrantes locales.)
Un autre avantage de cette procédure est qu'elle ne nécessite pas de matrice rectangulaire de valeurs. En fait, il peut même être appliqué à des données irrégulières en utilisant un lisseur local adapté à ces données.
R, ainsi que la plupart des progiciels de statistiques complets, disposent de plusieurs lisseurs locaux robustes, tels que loess. L'exemple suivant a été traité à l'aide de celui-ci. La matrice a lignes et79 colonnes - près de 4000 entrées. Il représente une fonction compliquée ayant plusieurs extrema locaux ainsi qu'une ligne entière de points où il n'est pas différenciable (un "pli"). Pourpeu plus de 5 % des points - une proportion très élevée pour être considérée comme « périphériques » - ont été ajoutéeserreurs gaussiennes dontécart type est seulement 1 / 20 de l'écarttype des donnéesorigine. Cet ensemble de données synthétiques présente ainsi bon nombre des caractéristiques difficiles des données réalistes.4940005%1/20
Notez que (selon les Rconventions) les lignes de la matrice sont dessinées sous forme de bandes verticales. Toutes les images, à l'exception des résidus, sont ombrées pour aider à afficher de petites variations dans leurs valeurs. Sans cela, presque toutes les valeurs aberrantes locales seraient invisibles!
En comparant les images "imputées" (fixées) aux images "réelles" (originales non contaminées), il est évident que la suppression des valeurs aberrantes a lissé une partie, mais pas la totalité, du pli (qui va de vers le bas à ( 49 , 30 ) ; il apparaît comme une bande angulaire cyan clair dans le graphique "Résidus").(0,79)(49,30)
Les taches dans l'intrigue "Résiduels" montrent les valeurs aberrantes locales isolées évidentes. Ce graphique affiche également d'autres structures (telles que la bande diagonale) attribuables aux données sous-jacentes. On pourrait améliorer cette procédure en utilisant un modèle spatial des données ( via des méthodes géostatistiques), mais le décrire et l'illustrer nous mènerait trop loin ici.
BTW, ce code a signalé avoir trouvé seulement des 200102200 valeurs aberrantes qui ont été introduites. Ce n'est pas un échec de la procédure. Parce que les valeurs aberrantes étaient normalement distribuées, environ la moitié d'entre elles étaient si proches de zéro - ou moins en taille, par rapport aux valeurs sous-jacentes ayant une plage de plus de 600 - qu'elles n'ont fait aucun changement détectable dans la surface. 3600
#
# 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")
