在估算数据中使用邻居信息或查找偏离数据（在R中）

我有一个数据集，假设最近的邻居是最好的预测变量。只是可视化的双向梯度的完美示例-

假设我们缺少一些值，可以很容易地根据邻居和趋势进行预测。

R中的对应数据矩阵（用于锻炼的虚拟示例）：

miss.mat <- matrix (c(5:11, 6:10, NA,12, 7:13, 8:14, 9:12, NA, 14:15, 10:16),ncol=7, byrow = TRUE)
miss.mat 
    [,1] [,2] [,3] [,4] [,5] [,6] [,7]
[1,]    5    6    7    8    9   10   11
[2,]    6    7    8    9   10   NA   12
[3,]    7    8    9   10   11   12   13
[4,]    8    9   10   11   12   13   14
[5,]    9   10   11   12   NA   14   15
[6,]   10   11   12   13   14   15   16

注意：（1）假定缺少值的属性是随机的，它可以在任何地方发生。

（2）所有数据点均来自单个变量，但假定它们的值受neighbors与其相邻的行和列的影响。因此，矩阵中的位置很重要，可以视为其他变量。

我希望在某些情况下可以预测一些偏离值（可能是错误）并纠正偏差（仅举例来说，让我们在虚拟数据中生成此类错误）：

> mat2 <- matrix (c(4:10, 5, 16, 7, 11, 9:11, 6:12, 7:13, 8:14, 9:13, 4,15, 10:11, 2, 13:16),ncol=7, byrow = TRUE)
> mat2

    [,1] [,2] [,3] [,4] [,5] [,6] [,7]
[1,]    4    5    6    7    8    9   10
[2,]    5   16    7   11    9   10   11
[3,]    6    7    8    9   10   11   12
[4,]    7    8    9   10   11   12   13
[5,]    8    9   10   11   12   13   14
[6,]    9   10   11   12   13    4   15
[7,]   10   11    2   13   14   15   16

以上示例仅是示例（可以通过视觉方式回答），但实际示例可能更令人困惑。我正在寻找是否有健壮的方法来进行这种分析。我认为这应该是可能的。什么是执行此类分析的合适方法？有任何R程序/软件包建议可以进行这种类型的分析吗？

该问题问的方式使用最近的邻居在一个强大的方式来发现和纠正局部异常值。为什么不这样做呢？

该过程是计算稳健的局部平滑度，评估残差并对所有过大的零进行清零。这可以直接满足所有要求，并且具有足够的灵活性以适应不同的应用程序，因为可以改变本地邻域的大小和识别异常值的阈值。

（为什么灵活性如此重要？因为任何这样的过程都很有可能将某些局部行为识别为“异常”。因此，所有这些过程都可以被认为是更平滑的。它们将消除一些细节以及明显的异常值。分析师需要对保留细节和无法检测到局部离群值之间的权衡进行一些控制。）

此过程的另一个优点是它不需要值的矩形矩阵。实际上，它甚至可以通过使用适合此类数据的局部平滑器来应用于不规则数据。

R以及大多数功能齐全的统计信息包，都内置了几个强大的本地平滑器，例如loess。使用它处理了以下示例。矩阵有行列-几乎个条目。它表示一个复杂的函数，具有多个局部极值以及一整行不可微分的点（“折痕”）。在略高于的点上（非常高的比例被认为是“外围”）添加了高斯误差，其标准偏差仅为原始数据的标准偏差的。因此，该合成数据集呈现了现实数据的许多挑战性特征。49 4000 5 ％1 /$79$$49$$4000$$5\%$$1/20$

请注意（按照R惯例），矩阵行绘制为垂直条。除残差外，所有图像都经过阴影处理以帮助显示其值的微小变化。没有这个，几乎所有本地异常值都将不可见！

通过将“受感染”（固定）图像与“真实”（原始未污染）图像进行比较，很明显，去除异常值可以消除部分但不是全部折痕（从向下到；在“残差”图中明显显示为浅青色的条纹）。（49 ，30 $(0,79)$$(49, 30)$

“残差”图中的斑点显示出明显的孤立局部离群值。该图还显示了可归因于基础数据的其他结构（例如对角线）。可以通过使用数据的空间模型（通过地统计方法）来改进此过程，但是在此进行描述和说明将使我们走得太远。

顺便说一句，该代码报告仅发现了引入的离群值中的。这不是该过程的失败。 由于离群值呈正态分布，因此与离范围超过基础值相比，离群值中的大约一半是如此接近零（大小为或更小），以至于表面没有可检测到的变化。 200 3 $102$$200$$3$$600$

#
# 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")

我建议您看一下这篇文章[0]。它所要解决的问题似乎很符合您对您的描述，但作者提出的方法比NN输入稍微更精细（尽管它使用了类似的起点）。

$\pmb X$$n$$p$

$k$

每次迭代的第一步是数据插补步骤。这与EM算法中的操作相同：缺少的单元格将填充它们期望具有的值（这是E步）。

在两步迭代过程的第二部分中，将（鲁棒的）PCA拟合为从上一步获得的增强数据。这导致的光谱分解$\pmb X$$\pmb t\in\mathbb{R}^p$$p$$k$$\pmb L$$k$$k$$\pmb D$$k\leq p$

总结本文，这是他们提出的通用算法：

• $l=0$$\pmb W^0$$\pmb X$

• 然后，执行直到收敛：

  一种。在上进行健壮的PCA$\pmb W^l$$(\pmb t^l,\pmb L^l,\pmb D^l)$

  $l=l+1$

  $\pmb Y^{l}=\pmb L^{l-1}(\pmb W^{l-1}-\pmb t^{l-1}) (\pmb L^{l-1})'$

  d。填充的缺失元素$\pmb W^{l}$$\pmb W^{l}\sim\mathcal{N}(\pmb t^{l-1},\pmb L^{l-1} \pmb D^{l-1}(\pmb L^{l-1})')$$\pmb Y^{l}$

$||\pmb W^{l-1}-\pmb W^l||_F$$(\pmb t,\pmb L,\pmb D)$

$(\pmb t^{l-1},\pmb L^{l-1} \pmb D^{l-1})$

$\mathcal{N}(\pmb t^{l-1},\pmb L\pmb D(\pmb L)')$

我不知道这种方法的现成的R实现，但是可以很容易地从子组件中产生一个（主要是一种健壮的PCA算法），并且这些都很好地在R中实现，请参见rrcov软件包（本文为安静地提供有关此主题的信息）。

• [0] Serneels S.和Verdonck，T.（2008）。主成分分析，用于包含异常值和缺失元素的数据。计算统计与数据分析vol：52 Issue：3 pages：1712-1727。