Вопрос задает способы использования ближайших соседей в прочном способ выявления и исправления локальных выбросов. Почему бы не сделать именно это?
Процедура состоит в том, чтобы вычислить устойчивое локальное сглаживание, оценить невязки и обнулить все, что слишком велико. Это напрямую удовлетворяет всем требованиям и является достаточно гибким для адаптации к различным приложениям, поскольку можно варьировать размер локального соседства и порог для определения выбросов.
(Почему гибкость так важна? Потому что любая такая процедура имеет хорошие шансы идентифицировать определенные локализованные поведения как "отдаленные". Таким образом, все такие процедуры можно считать более плавными . Они устранят некоторые детали наряду с очевидными выбросами. Аналитик нужен некоторый контроль над компромиссом между сохранением деталей и неспособностью обнаружить локальные выбросы.)
Еще одним преимуществом этой процедуры является то, что она не требует прямоугольной матрицы значений. Фактически, это может даже применяться к нерегулярным данным, используя локальный сглаживатель, подходящий для таких данных.
R, как и большинство полнофункциональных пакетов статистики, имеет несколько надежных локальных сглаживателей, таких как loess. Следующий пример был обработан с использованием этого. Матрица имеет строк и 49 столбцов - почти 4000 записей. Он представляет собой сложную функцию, имеющую несколько локальных экстремумов, а также целую линию точек, где она не дифференцируема («складка»). Для того, чтобы немного больше , чем 5 % из точек - очень высокий процент , чтобы считать «периферийное» - были добавлены гауссовых ошибки которых стандартное отклонение составляет только 1 / 20 стандартного отклонения исходных данных. Этот синтетический набор данных, таким образом, представляет многие сложные характеристики реалистичных данных.794940005%1/20
Обратите внимание, что (согласно Rсоглашениям) строки матрицы отображаются в виде вертикальных полос. Все изображения, за исключением остатков, затенены, чтобы помочь отображать небольшие изменения в их значениях. Без этого почти все местные выбросы были бы невидимы!
Сравнивая «вмененный» (исправленный) с «реальным» (исходным незагрязненным) изображением, становится очевидным, что удаление выбросов сгладило некоторую, но не всю, складку (которая идет от вниз в ( 49 , 30 ) ; очевидно , в виде светло - голубой полосой под углом в «Разности» сюжета).(0,79)(49,30)
Спеклы на графике «Остатки» показывают очевидные изолированные локальные выбросы. Этот график также отображает другую структуру (например, диагональную полосу), относящуюся к базовым данным. Эту процедуру можно улучшить, используя пространственную модель данных (с помощью геостатистических методов), но ее описание и иллюстрирование приведут нас здесь слишком далеко.
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")
