如何用R从10列data frame中抽取500样本，最大化多列多样性？

我有一个包含10966行、10列的data frame，希望使用R从中抽取约500个样本，以最大化各列唯一值的多样性。对该数据集运行data %>% summarise_all(n_distinct)后，得到各列唯一值数量如下：

注：ID列所有行均为唯一ID。由于无法捕获所有列的全部多样性（部分列的唯一值数量超过500），请问是否存在可最大化样本多样性的方法？

1. 优先覆盖低基数列全值，再补充高基数列抽样 #

先把J、K、L、D、I这类唯一值远少于500的列的所有取值组合对应的行保留，确保这些列的多样性完全覆盖，再从剩余行里针对A、F这类高基数列抽样，补满500个样本：

library(dplyr)

# 定义低基数列（唯一值数量≤500的列）
low_card_cols <- c("J", "K", "L", "D", "I", "B", "E", "C")
# 提取这些列所有唯一组合对应的行（去重，保留每个组合至少一行）
base_sample <- data %>% 
  distinct(across(all_of(low_card_cols)), .keep_all = TRUE)

# 计算还需要补充的样本量
needed <- 500 - nrow(base_sample)

# 从剩余行中优先保留A、F的唯一组合，再抽样
remaining_rows <- data %>% 
  anti_join(base_sample, by = low_card_cols) %>%
  distinct(A, F, .keep_all = TRUE)

# 合并基础样本和补充样本
final_sample <- bind_rows(
  base_sample,
  slice_sample(remaining_rows, n = min(needed, nrow(remaining_rows)))
)

# 如果仍未达到500，从全数据集未选中的行里随机补充
if(nrow(final_sample) < 500) {
  final_sample <- bind_rows(
    final_sample,
    data %>% 
      anti_join(final_sample, by = "ID") %>%
      slice_sample(n = 500 - nrow(final_sample))
  )
}

2. 贪心算法精准最大化唯一值覆盖 #

每次选择能新增最多未覆盖列唯一值的行，直到样本量达到500。这种方法对多样性的提升更精准，但计算量略大：

library(dplyr)

# 初始化各列已覆盖的唯一值列表（排除ID列）
covered <- lapply(data[-1], function(x) character(0))
sample_ids <- c()

while(length(sample_ids) < 500) {
  # 给未选中的行打分：计算该行能新增的未覆盖唯一值数量
  row_scores <- data %>%
    filter(!ID %in% sample_ids) %>%
    rowwise() %>%
    mutate(
      score = sum(
        !A %in% covered$A, !B %in% covered$B, !C %in% covered$C,
        !D %in% covered$D, !E %in% covered$E, !F %in% covered$F,
        !I %in% covered$I, !J %in% covered$J, !K %in% covered$K, !L %in% covered$L
      )
    ) %>%
    ungroup() %>%
    arrange(desc(score))
  
  # 选中得分最高的行
  top_row <- row_scores %>% slice(1)
  sample_ids <- c(sample_ids, top_row$ID)
  
  # 更新已覆盖的唯一值集合
  covered$A <- unique(c(covered$A, top_row$A))
  covered$B <- unique(c(covered$B, top_row$B))
  covered$C <- unique(c(covered$C, top_row$C))
  covered$D <- unique(c(covered$D, top_row$D))
  covered$E <- unique(c(covered$E, top_row$E))
  covered$F <- unique(c(covered$F, top_row$F))
  covered$I <- unique(c(covered$I, top_row$I))
  covered$J <- unique(c(covered$J, top_row$J))
  covered$K <- unique(c(covered$K, top_row$K))
  covered$L <- unique(c(covered$L, top_row$L))
}

final_sample <- data %>% filter(ID %in% sample_ids)

3. 用专业抽样包实现分层平衡抽样 #

借助caret包的分层抽样功能，以低基数列的组合作为分层依据，尽量覆盖所有分层后调整样本量到500：

library(caret)

# 用低基数列的组合生成分层标识
data$strata <- interaction(data[, low_card_cols])
# 按分层抽样，比例对应500/总样本量
sample_indices <- createDataPartition(data$strata, p = 500/nrow(data), list = FALSE)
final_sample <- data[sample_indices, ]

内容的提问来源于stack exchange，提问作者Emma Doughty