在考虑循环趋势的情况下估算缺失值答案

【问题标题】：Imputing missing values keeping circular trend in mind在考虑循环趋势的情况下估算缺失值
【发布时间】：2015-05-08 18:24:55
【问题描述】：

想象一张日出的图片，红色圆圈被黄色厚环包围，然后是蓝色背景。取红色为 3，黄色为 2，蓝色为 1。

 11111111111
 11111211111
 11112221111
 11222322211
 22223332222
 11222322221
 11112221111
 11111211111

这是所需的输出。但是，记录/文件/数据有缺失值（所有元素的 30% 缺失）。

在牢记循环趋势的情况下，我们如何估算缺失值以获得所需的输出。

【问题讨论】：

数据有多大？是像这篇文章一样只有一个圆圈，还是还有其他圆圈或其他形状？

标签： r data-manipulation

【解决方案1】：

这就是我以非常简单、直接的方式解决此类问题的方法。请注意，我已将您上面的示例数据更正为对称：

d <- read.csv(header=F, stringsAsFactors=F, text="
1,1,1,1,1,1,1,1,1,1,1
1,1,1,1,1,2,1,1,1,1,1
1,1,1,1,2,2,2,1,1,1,1
1,1,2,2,2,3,2,2,2,1,1
2,2,2,2,3,3,3,2,2,2,2
1,1,2,2,2,3,2,2,2,1,1
1,1,1,1,2,2,2,1,1,1,1
1,1,1,1,1,2,1,1,1,1,1
")

library(raster)

##  Plot original data as raster:
d <- raster(as.matrix(d))
plot(d, col=colorRampPalette(c("blue","yellow","red"))(255))

##  Simulate 30% missing data:
d_m <- d
d_m[ sample(1:length(d), length(d)/3) ] <- NA
plot(d_m, col=colorRampPalette(c("blue","yellow","red"))(255))

##  Construct a 3x3 filter for mean filling of missing values:
filter <- matrix(1, nrow=3, ncol=3) 

##  Fill in only missing values with the mean of the values within
##    the 3x3 moving window specified by the filter.  Note that this
##    could be replaced with a median/mode or some other whole-number
##    generating summary statistic:
r <- focal(d_m, filter, mean, na.rm=T, NAonly=T, pad=T)

##  Plot imputed data:
plot(r, col=colorRampPalette(c("blue","yellow","red"))(255), zlim=c(1,3))

这是原始样本数据的图像：

模拟 30% 的缺失值：

只有那些用 3x3 移动窗口的平均值插值的缺失值：

【讨论】：

谢谢本！只是想把这些年来我从你和其他人那里学到的一点点回报。
在运行上面给出的“focal”命令时，我收到此错误：无法找到用于签名“matrix”的函数“focal”的继承方法
确保第一个参数是raster 对象。您将在我的示例中看到，在模拟丢失的数据之前，我首先将样本数据（matrix）转换为raster 对象。我认为这就是您遇到的问题。

【解决方案2】：

在这里，我将 Forrest 的方法与薄板样条 (TPS) 进行了比较。它们的性能大致相同——取决于样本。如果间隙更大以至于焦点无法再估计，则 TPS 可能更可取——但在这种情况下，您也可以使用更大的（也许是高斯，参见?focalWeight）过滤器。

d <- matrix(c(
1,1,1,1,1,1,1,1,1,1,1,
1,1,1,1,1,2,1,1,1,1,1,
1,1,1,1,2,2,2,1,1,1,1,
1,1,2,2,2,3,2,2,2,1,1,
2,2,2,2,3,3,3,2,2,2,2,
1,1,2,2,2,3,2,2,2,1,1,
1,1,1,1,2,2,2,1,1,1,1,
1,1,1,1,1,2,1,1,1,1,1), ncol=11, byrow=TRUE)


library(raster)
d <- raster(d)
plot(d, col=colorRampPalette(c("blue","yellow","red"))(255))
##  Simulate 30% missing data:
set.seed(1)
d_m <- d
d_m[ sample(1:length(d), length(d)/3) ] <- NA
plot(d_m, col=colorRampPalette(c("blue","yellow","red"))(255))


# Forrest's solution:
filter <- matrix(1, nrow=3, ncol=3) 
r <- focal(d_m, filter, mean, na.rm=T, NAonly=T, pad=T)

#an alterative:
rp <- rasterToPoints(d_m)

library(fields)
# thin plate spline interpolation 
#(for a simple pattern like this, IDW might work, see ?interpolate)
tps <- Tps(rp[,1:2], rp[,3])
# predict
x <- interpolate(d_m, tps)
# use the orginal values where available
m <- cover(d_m, x)

i <- is.na(d_m)
cor(d[i], m[i])
## [1]  0.8846869
cor(d[i], r[i])
## [1] 0.8443165

【讨论】：

不错！肯定还有其他更复杂的插值技术可用，包括地统计方法。希望这些可以作为很好的例子，即使是简单的二维和三维插补/插值方法也可能不熟悉。