In der Frage wird nach Möglichkeiten gefragt, wie die nächsten Nachbarn auf robuste Weise verwendet werden können, um lokalisierte Ausreißer zu identifizieren und zu korrigieren. Warum nicht genau das tun?
Die Prozedur besteht darin, eine robuste lokale Glättung zu berechnen, die Residuen auszuwerten und alle zu großen zu nullen. Dies erfüllt alle Anforderungen direkt und ist flexibel genug, um sich an unterschiedliche Anwendungen anzupassen, da man die Größe der lokalen Nachbarschaft und die Schwelle zur Identifizierung von Ausreißern variieren kann.
(Warum ist Flexibilität so wichtig? Weil bei einem solchen Verfahren bestimmte lokalisierte Verhaltensweisen mit hoher Wahrscheinlichkeit als "äußerlich" eingestuft werden können. Daher können alle derartigen Verfahren als reibungslos angesehen werden . Sie beseitigen einige Details zusammen mit den offensichtlichen Ausreißern. Der Analyst muss eine gewisse Kontrolle über den Kompromiss zwischen der Beibehaltung von Details und der Nichterkennung lokaler Ausreißer haben.)
Ein weiterer Vorteil dieses Verfahrens besteht darin, dass keine rechteckige Wertematrix erforderlich ist. Tatsächlich kann es sogar auf unregelmäßige Daten angewendet werden, indem ein lokaler Glätter verwendet wird, der für solche Daten geeignet ist.
RNeben den meisten Statistikpaketen mit vollem Funktionsumfang sind mehrere robuste lokale Smoothers integriert, z loess. Das folgende Beispiel wurde damit bearbeitet. Die Matrix hat Zeilen und 49 Spalten - fast 4000 Einträge. Es handelt sich um eine komplizierte Funktion mit mehreren lokalen Extrema sowie einer ganzen Linie von Punkten, an denen es nicht unterscheidbar ist (eine "Falte"). Um etwas mehr als 5 % der Punkte - ein sehr hoher Anteil zu betrachten „abgelegenen“ - wurden Gauß - Fehler , deren Standardabweichung hinzugefügt ist nur 1 / 20 der Standardabweichung der ursprünglichen Daten. Dieser synthetische Datensatz bietet viele der herausfordernden Merkmale realistischer Daten.794940005 %1 / 20
Beachten Sie, dass (gemäß RKonventionen) die Matrixzeilen als vertikale Streifen gezeichnet werden. Alle Bilder mit Ausnahme der Residuen sind schattiert, um kleine Abweichungen in ihren Werten anzuzeigen. Ohne dies wären fast alle lokalen Ausreißer unsichtbar!
Durch den Vergleich der "unterstellten" (fixierten) mit den "echten" (nicht kontaminierten) Originalbildern wird deutlich, dass das Entfernen der Ausreißer einige, aber nicht alle Falten (die von unten verlaufen ) geglättet hat bis ( 49 , 30 ) ; es ist als hellcyanfarbener Winkelstreifen in der "Residuen" -Darstellung erkennbar).( 0 , 79 )( 49 , 30 )
Die Flecken in der Darstellung "Residuen" zeigen die offensichtlichen lokal isolierten Ausreißer. In diesem Diagramm wird auch eine andere Struktur (z. B. der Diagonalstreifen) angezeigt, die den zugrunde liegenden Daten zugeordnet werden kann. Man könnte dieses Verfahren verbessern, indem man ein räumliches Modell der Daten ( über geostatistische Methoden) verwendet, aber dies zu beschreiben und zu veranschaulichen, würde uns hier zu weit führen.
Übrigens wurde in diesem Code gemeldet, dass nur der 200 eingeführten Ausreißer gefunden wurden. Dies ist kein Fehlschlag des Verfahrens. Da die Ausreißer normalverteilt waren, lag ihre Größe bei etwa der Hälfte nahe bei Null - 3 oder darunter, verglichen mit zugrunde liegenden Werten mit einem Bereich von über 600 -, die keine nachweisbare Veränderung der Oberfläche bewirkten. 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")
