R语言循环遍历虚拟数据 用sample随机替换任意数量值为NA

问题背景 #

我就职于生物技术公司，核心业务为检测科研机构提交的各类实验样本中的小分子生物标志物。科研团队常分多轮开展同一方向的人群研究（不同轮次的受试者可能部分重合、也可能完全不同），最终需要将多轮实验数据合并为统一数据框，但实际数据处理并非简单的行堆叠：部分生物标志物仅在部分受试者中检出，还有部分标志物仅在单轮实验的样本人群中存在，天然存在大量缺失值。

我目前负责公司内部研发项目，需要模拟三批次独立实验的真实数据结构，已编写如下基础代码生成3个toy测试数据框：

# 加载数据处理包
library(dplyr)

# 生成3个测试用数据框，模拟不同批次的检测结果
set.seed(42)
toy_df1 <- as.data.frame(matrix(data = rnorm(n = 100, mean = 0, sd = 1), nrow = 10, ncol = 10))
toy_df2 <- as.data.frame(matrix(data = rnorm(n = 100, mean = 0, sd = 1), nrow = 10, ncol = 10))
toy_df3 <- as.data.frame(matrix(data = rnorm(n = 100, mean = 0, sd = 1), nrow = 10, ncol = 10))

# 给不同数据框设置不完全重合的列名，模拟不同批次检测的生物标志物差异
names(toy_df1) <- c("x1", "x2", "x3", "x4", "x5", "x6", "x7", "x8", "x9", "x10")
names(toy_df2) <- c("x1", "x2", "x3", "x5", "x6", "x7", "x8", "x9", "x10", "x11")
names(toy_df3) <- c("x1", "x3", "x4", "x5", "x7", "x8", "x9", "x10", "x11", "x13")

# 新增SSID列标记样本所属批次
toy_df1$SSID <- as.numeric(rep(24001, nrow(toy_df1)))
toy_df2$SSID <- as.numeric(rep(24002, nrow(toy_df2)))
toy_df3$SSID <- as.numeric(rep(24003, nrow(toy_df3)))

# 将3个数据框存入列表方便批量处理
toy_data_list <- list(toy_df1, toy_df2, toy_df3)

# 初步合并得到30行的总数据集，已实现*部分标志物仅存在于单批次*的特征
toy_data_all <- bind_rows(toy_df1, toy_df2, toy_df3)

待实现需求 #

需要在现有数据基础上模拟真实检测的随机缺失值：对每个数据框的生物标志物列（即除SSID外的所有列），随机选择0到该列总观测数之间任意数量的观测替换为NA，每列缺失值数量不固定（范围0~10，可全列无缺失也可全列缺失），缺失位置完全随机。

之前编写的嵌套循环代码运行报错，无法达到预期效果，错误代码如下：

# 错误的缺失值生成代码
amount_sampled <- c(0:10)

for (i in 1:length(df_list)){
  for (j in 1:nrow(df_list[[i]])){
    
    df_list[[i]][,j][sample(df_list[[i]][,j], size = sample(amount_sampled, 1))] <- NA
    
  }
}

原有代码错误点 #

• 列表对象名不匹配：定义的存储列表名为toy_data_list，循环中错误写为df_list，直接触发对象不存在报错
• 循环维度错误：需要遍历的是数据列，内层循环用nrow()取行数做遍历，完全搞错了操作维度
• 索引逻辑错误：sample()第一个参数传入的是列的实际检测值，不是行位置索引，选出来的结果无法作为替换位置使用
• 未排除标识列：逻辑上SSID是批次标记，不应该生成缺失值，原有代码未做排除

正确实现方案 #

方案1：修正后的嵌套循环写法 #

逻辑直白易读，适合新手理解：

set.seed(123) # 固定随机种子可复现结果，不需要可删除
amount_sampled <- 0:10
na_toy_list <- toy_data_list

for (i in seq_along(na_toy_list)) {
  # 内层遍历列，最后一列是SSID不需要处理，所以列数减1
  for (j in 1:(ncol(na_toy_list[[i]]) - 1)) {
    # 先随机选当前列的缺失值数量
    na_count <- sample(amount_sampled, 1)
    # 缺失数为0时直接跳过，避免sample函数报错
    if (na_count > 0) {
      # 随机选要替换为NA的行位置
      na_rows <- sample(1:nrow(na_toy_list[[i]]), size = na_count)
      na_toy_list[[i]][na_rows, j] <- NA
    }
  }
}

# 处理完成后合并为总数据集
na_toy_all <- bind_rows(na_toy_list)

方案2：简洁向量化写法 #

用lapply配合dplyr::across批量处理，代码更精简：

set.seed(123)
na_toy_list <- lapply(toy_data_list, function(df) {
  df %>% 
    mutate(across(-SSID, ~{
      na_count <- sample(0:length(.x), 1)
      if (na_count == 0) return(.x)
      na_pos <- sample(1:length(.x), na_count)
      .x[na_pos] <- NA
      .x
    }))
})

na_toy_all <- bind_rows(na_toy_list)

效果验证 #

运行完可执行如下代码查看每列的缺失值数量，会看到每列缺失数在0~10之间随机分布，符合预期：

# 查看第一个批次各列缺失值数量
colSums(is.na(na_toy_list[[1]]))

内容的提问来源于stack exchange，提问作者Matthew Graham