R语言处理缺失数据：Bootstrap与Jackknife插补前后对比

Elena

发布时间：2026-10-16| 7人浏览过

原创

在处理含有缺失值的数据集时，直接删除缺失项或统一填补缺失后再进行重抽样（如Bootstrap）往往会掩盖数据的不确定性并引入偏差。本文通过R语言构建模型，对比了“先填补后重抽样”与“先重抽样再局部填补”两种策略在均值和变异系数估计上的表现，证明了后者在缩小标准差和提高置信区间覆盖率方面的优势。

核心结论

在缺失数据场景中，统计推断的准确性高度依赖于处理缺失值的时机。模拟实验表明：

填补前重抽样（推荐）：在Bootstrap或Jackknife的每一次迭代中，仅使用当前子样本进行数据填补，能有效保留数据的变异性，显著减小估计方差，90%置信区间的覆盖效果更好。
填补后重抽样（不推荐）：若先用完整数据集填补缺失值，再对填充后的数据进行重抽样，由于引入了插补模型的偏差且未反映缺失不确定性，会导致估计结果偏离真实值更远，波动性更大。

数据生成与问题定义

为了验证上述假设，我们需要构造一个包含特定机制缺失值的数据集。题目设定如下变量关系：

其中参数 a=2, b=0，用于控制第三列变量的缺失机制。真实的目标是估计第二列变量（y2）的均值与变异系数。

实现步骤详解

第1步：构建数据生成函数

目的是重现含有随机缺失（Missing at Random, MAR）特性的数据集。我们通过线性关系生成观测值，并依据残差条件判断是否将部分数据标记为 NA。

# GenerateData <- function(a = 0, b = 0) {
#   y <- matrix(nrow = 3, ncol = 100)
#   z <- matrix(rnorm(300), nrow = 3)
# 
#   y[1, ] <- 1 + z[1, ]
#   y[2, ] <- 5 + 2 * z[1, ] + z[2, ]
# 
#   u <- a * (y[1, ] - 1) + b * (y[2, ] - 5) + z[3, ]
# 
#   y[3, ] <- y[2, ]
#   y[3, u < 0] <- NA
# 
#   dat_comp <- data.frame(y1 = y[1, ], y2 = y[2, ])     # 完整数据
#   dat_incomp <- data.frame(y1 = y[1, ], y2 = y[3, ])  # 含缺失数据
#   return(list(dat_comp = dat_comp, dat_incomp = dat_incomp))
# }

此函数返回两个数据框：dat_comp 为无缺失的真实数据，dat_incomp 为实际观察到的含缺失数据。

第2步：编写基础重抽样函数

分别实现基础的 Bootstrap（有放回抽样）和 Jackknife（留一法）逻辑，用于后续对比不同场景下的统计量（如均值、标准差）。

# Bootstrap: B为重复次数，fun为重抽样计算函数
Bootstrap1 <- function(Y, B = 200, fun) {
  Y_len <- length(Y)
  mat_boots <- matrix(sample(Y, Y_len * B, replace = T), nrow = B, ncol = Y_len)
  statis_boots <- apply(mat_boots, 1, fun)
  boots_mean <- mean(statis_boots)
  boots_sd <- sd(statis_boots)
  return(list(mean = boots_mean, sd = boots_sd))
}

# Jackknife: 剔除第i个样本
Jackknife1 <- function(Y, fun) {
  Y_len <- length(Y)
  mat_jack <- sapply(1:Y_len, function(i) Y[-i])
  redu_samp <- apply(mat_jack, 2, fun)
  jack_mean <- mean(redu_samp)
  jack_sd <- sqrt(((Y_len - 1) ^ 2 / Y_len) * var(redu_samp))
  return(list(mean = jack_mean, sd = jack_sd))
}

第3步：执行线性填补策略 (After Imputation)

这是传统做法：先在完整观测数据上训练线性回归模型预测缺失值，填补完成后，再对填充好的数据进行 Bootstrap 或 Jackknife。

填补逻辑：

DatImputation <- function(dat_incomp) {
  dat_imp <- dat_incomp
  # 使用非缺失数据建立 y2 ~ y1 模型
  lm_model <- lm(y2 ~ y1, data = na.omit(dat_incomp))
  na_ind <- is.na(dat_incomp$y2)
  if(any(na_ind)) {
    na_dat <- dat_incomp[na_ind, ]
    dat_imp[na_ind, 'y2'] <- predict(lm_model, na_dat)
  }
  return(dat_imp)
}

# 应用举例
# dat <- GenerateData(a = 2, b = 0)
# dat_imp <- DatImputation(dat$dat_incomp)
# Bootstrap1(dat_imp$y2, B = 200, mean)$sd  # 填补后Bootstrap

问题分析：这种做法忽略了填补值本身的不确定性，使得方差估计偏小或产生系统性偏差。

第4步：执行重抽样伴随填补策略 (Before Imputation)

改进策略：在Bootstrap或Jackknife抽取子样本后，再对该子样本单独进行线性填补，最后计算统计量。这样能保证每次重抽样都反映了该子样本特有的填补不确定性。

组合函数逻辑：

# 针对某个子样本数组进行填补并计算均值(CV)
Array2meancv <- function(j, myarray) {
  dat_incomp <- as.data.frame(myarray[, j, ])   # 提取第j次抽样/留样
  names(dat_incomp) <- c('y1', 'y2')
  # 在该子样本内部重新拟合并填补
  dat_imp_temp <- DatImputation(dat_incomp)
  
  y2_val <- dat_imp_temp$y2
  return(c(mean = mean(y2_val), cv = sd(y2_val)/mean(y2_val)))
}

# Bootstrap带填补版本
Bootstrap_imp <- function(dat_incomp, B = 200) {
  n <- nrow(dat_incomp)
  array_boots <- array(dim = c(n, B, 2))
  mat_boots_ind <- matrix(sample(1:n, n * B, replace = T), nrow = B, ncol = n)
  
  # 构建B个子样本矩阵
  array_boots[, , 1] <- sapply(1:B, function(i) dat_incomp$y1[mat_boots_ind[i, ]])
  array_boots[, , 2] <- sapply(1:B, function(i) dat_incomp$y2[mat_boots_ind[i, ]])
  
  mean_cv_imp <- sapply(1:B, Array2meancv, array_boots)
  return(list(
    mean = apply(mean_cv_imp, 1, mean),
    sd = apply(mean_cv_imp, 1, sd)
  ))
}