一种解决方案是为mice程序包编写自己的自定义插补函数。为此已准备好包装，并且安装过程令人惊讶地无痛。
首先，我们根据建议设置数据：
dat=data.frame(x1=c(21, 50, 31, 15, 36, 82, 14, 14, 19, 18, 16, 36, 583, NA,NA,NA, 50, 52, 26, 24),
x2=c(0, NA, 18,0, 19, 0, NA, 0, 0, 0, 0, 0, 0,NA,NA, NA, 22, NA, 0, 0),
x3=c(0, 0, 0, 0, 0, 54, 0 ,0, 0, 0, 0, 0, 0, NA, NA, NA, NA, 0, 0, 0))
接下来，我们加载mice程序包，并查看其默认选择的方法：
library(mice)
# Do a non-imputation
imp_base <- mice(dat, m=0, maxit = 0)
# Find the methods that mice chooses
imp_base$method
# Returns: "pmm" "pmm" "pmm"
# Look at the imputation matrix
imp_base$predictorMatrix
# Returns:
# x1 x2 x3
#x1 0 1 1
#x2 1 0 1
#x3 1 1 0
预测均值匹配的pmm立场-可能是插补连续变量的最流行的插补算法。它使用回归模型计算预测值，并选择与预测值最接近的5个元素（按欧式距离）。这些选定的元素称为供体池，最终值是从该供体池中随机选择的。
从预测矩阵中，我们发现这些方法获得了传递给限制的变量感兴趣的变量。请注意，行是目标变量，列是预测变量。如果x1在x3列中没有1，则必须在矩阵中将其添加：imp_base$predictorMatrix["x1","x3"] <- 1
现在到有趣的部分，生成插补方法。我在这里选择了一种比较粗糙的方法，如果所有值都不符合标准，我将丢弃所有值。这可能会导致较长的循环时间，并且可能会更有效地保留有效的插补，而仅重做其余的插补，尽管如此，这需要更多的调整。
# Generate our custom methods
mice.impute.pmm_x1 <-
function (y, ry, x, donors = 5, type = 1, ridge = 1e-05, version = "",
...)
{
max_sum <- sum(max(x[,"x2"], na.rm=TRUE),
max(x[,"x3"], na.rm=TRUE))
repeat{
vals <- mice.impute.pmm(y, ry, x, donors = 5, type = 1, ridge = 1e-05,
version = "", ...)
if (all(vals < max_sum)){
break
}
}
return(vals)
}
mice.impute.pmm_x2 <-
function (y, ry, x, donors = 5, type = 1, ridge = 1e-05, version = "",
...)
{
repeat{
vals <- mice.impute.pmm(y, ry, x, donors = 5, type = 1, ridge = 1e-05,
version = "", ...)
if (all(vals == 0 | vals >= 14)){
break
}
}
return(vals)
}
mice.impute.pmm_x3 <-
function (y, ry, x, donors = 5, type = 1, ridge = 1e-05, version = "",
...)
{
repeat{
vals <- mice.impute.pmm(y, ry, x, donors = 5, type = 1, ridge = 1e-05,
version = "", ...)
if (all(vals == 0 | vals >= 16)){
break
}
}
return(vals)
}
一旦定义了方法，我们就可以简单地更改先前的方法。如果您只想更改一个变量，则可以简单地使用，imp_base$method["x2"] <- "pmm_x2"但是在此示例中，我们将全部更改（命名是不必要的）：
imp_base$method <- c(x1 = "pmm_x1", x2 = "pmm_x2", x3 = "pmm_x3")
# The predictor matrix is not really necessary for this example
# but I use it just to illustrate in case you would like to
# modify it
imp_ds <-
mice(dat,
method = imp_base$method,
predictorMatrix = imp_base$predictorMatrix)
现在让我们看一下第三个估算数据集：
> complete(imp_ds, action = 3)
x1 x2 x3
1 21 0 0
2 50 19 0
3 31 18 0
4 15 0 0
5 36 19 0
6 82 0 54
7 14 0 0
8 14 0 0
9 19 0 0
10 18 0 0
11 16 0 0
12 36 0 0
13 583 0 0
14 50 22 0
15 52 19 0
16 14 0 0
17 50 22 0
18 52 0 0
19 26 0 0
20 24 0 0
好的，就可以了。我喜欢这个解决方案，因为您可以搭载主流功能，并添加您认为有意义的限制。
更新资料
为了执行注释中提到的严格限制@ t0x1n，我们可能要向包装函数添加以下功能：
- 在循环过程中保存有效值，这样就不会丢弃先前部分成功运行的数据
- 为了避免无限循环的逃逸机制
- 尝试x次后未找到合适的匹配项而使供体池膨胀（这主要适用于pmm）
这导致包装函数稍微复杂一些：
mice.impute.pmm_x1_adv <- function (y, ry,
x, donors = 5,
type = 1, ridge = 1e-05,
version = "", ...) {
# The mice:::remove.lindep may remove the parts required for
# the test - in those cases we should escape the test
if (!all(c("x2", "x3") %in% colnames(x))){
warning("Could not enforce pmm_x1 due to missing column(s):",
c("x2", "x3")[!c("x2", "x3") %in% colnames(x)])
return(mice.impute.pmm(y, ry, x, donors = 5, type = 1, ridge = 1e-05,
version = "", ...))
}
# Select those missing
max_vals <- rowSums(x[!ry, c("x2", "x3")])
# We will keep saving the valid values in the valid_vals
valid_vals <- rep(NA, length.out = sum(!ry))
# We need a counter in order to avoid an eternal loop
# and for inflating the donor pool if no match is found
cntr <- 0
repeat{
# We should be prepared to increase the donor pool, otherwise
# the criteria may become imposs
donor_inflation <- floor(cntr/10)
vals <- mice.impute.pmm(y, ry, x,
donors = min(5 + donor_inflation, sum(ry)),
type = 1, ridge = 1e-05,
version = "", ...)
# Our criteria check
correct <- vals < max_vals
if (all(!is.na(valid_vals) |
correct)){
valid_vals[correct] <-
vals[correct]
break
}else if (any(is.na(valid_vals) &
correct)){
# Save the new valid values
valid_vals[correct] <-
vals[correct]
}
# An emergency exit to avoid endless loop
cntr <- cntr + 1
if (cntr > 200){
warning("Could not completely enforce constraints for ",
sum(is.na(valid_vals)),
" out of ",
length(valid_vals),
" missing elements")
if (all(is.na(valid_vals))){
valid_vals <- vals
}else{
valid_vals[is.na(valid_vals)] <-
vals[is.na(valid_vals)]
}
break
}
}
return(valid_vals)
}
请注意，这不能很好地执行，很可能是由于建议的数据集在所有情况下都没有约束而没有丢失。我需要将循环长度增加到400-500，然后才能开始工作。我认为这不是故意的，您的估算应该模仿实际数据的生成方式。
优化
该参数ry包含非缺失值，我们可以通过删除找到符合条件的归因的元素来加快循环速度，但是由于我不熟悉内部函数，因此我对此一无所知。
我认为，当您有很强的约束条件并且需要一些时间才能完成填充时，最重要的事情就是并行化插补（请参阅我对CrossValidated的回答）。如今，大多数计算机都具有4-8核的计算机，并且R默认情况下仅使用其中之一。通过增加内核数量，可以（几乎）将时间缩短一半。
插补时缺少参数
关于x2插补时丢失的问题，老鼠实际上从来不会将缺失的值喂入x-中data.frame。所述小鼠方法包括在启动一些随机值进行填充。估算的链部分限制了此初始值的影响。如果查看mice-function，则可以在插补调用（mice:::sampler-function）之前找到它：
...
if (method[j] != "") {
for (i in 1:m) {
if (nmis[j] < nrow(data)) {
if (is.null(data.init)) {
imp[[j]][, i] <- mice.impute.sample(y,
ry, ...)
}
else {
imp[[j]][, i] <- data.init[!ry, j]
}
}
else imp[[j]][, i] <- rnorm(nrow(data))
}
}
...
在data.init可被提供给所述mice功能和mice.imput.sample是一个基本的采样过程。
参观顺序
如果访问顺序很重要，则可以指定mice-函数运行插补的顺序。默认值为from，1:ncol(data)但是您可以将设置visitSequence为任意值。
0 or 16 or >= 16为0 or >= 16因为>=16包含值16。希望那不会弄乱你的意思。相同0 or 14 or >= 14