R语言按指定factor列无重复抽样将dataframe分为4个等规模组

核心思路 #

你的需求核心有两个约束：

1. 200行全量划分为4组，每组50行
2. 单个组内factor水平无重复，每个factor水平最多在同一组出现1次

实现逻辑如下：

• 利用你提到的「每个factor水平最多对应4条观测」的特性，先按factor水平分组，给每个水平下的所有观测分配互不重复的组号（组号取值1-4），这一步天然保证同个factor不会出现在同一个组内
• 初始分配完成后，如果各组样本量存在偏差，只需将超额组的行调整到缺口组，调整时确保转移的factor水平不在缺口组中存在即可，总样本量200刚好对应4组各50行，必然存在可行的调整方案

实现代码 #

以下是基于dplyr的可运行实现：

library(dplyr)

set.seed(123) # 固定随机种子保证结果可复现

# 1. 初始分配组号，保证同factor不同组
df_with_group <- df %>%
  group_by(factor) %>%
  mutate(
    # 每个factor下的观测分配互不重复的组号
    group = sample(1:4, size = n(), replace = FALSE)
  ) %>%
  ungroup()

# 2. 调整组大小到每组50行
group_cnt <- table(df_with_group$group)
over_g <- as.numeric(names(group_cnt[group_cnt > 50]))
under_g <- as.numeric(names(group_cnt[group_cnt < 50]))

while (length(under_g) > 0) {
  # 取第一个超额组和第一个缺口组
  current_over <- over_g[1]
  current_under <- under_g[1]
  
  # 筛选可转移的行：所属factor不在缺口组中存在
  transfer_row <- df_with_group %>%
    filter(group == current_over) %>%
    filter(!factor %in% df_with_group$factor[df_with_group$group == current_under]) %>%
    slice_sample(n = 1)
  
  # 变更组号
  row_idx <- which(
    df_with_group$factor == transfer_row$factor &
    df_with_group$y == transfer_row$y &
    df_with_group$x == transfer_row$x
  )
  df_with_group$group[row_idx] <- current_under
  
  # 更新计数
  group_cnt[as.character(current_over)] <- group_cnt[as.character(current_over)] - 1
  group_cnt[as.character(current_under)] <- group_cnt[as.character(current_under)] + 1
  
  # 已达标的组从列表中移除
  if (group_cnt[as.character(current_over)] == 50) over_g <- over_g[-1]
  if (group_cnt[as.character(current_under)] == 50) under_g <- under_g[-1]
}

结果校验 #

运行以下代码确认符合要求：

# 校验每组样本量为50
print(table(df_with_group$group))

# 校验每组内无重复factor
dup_check <- df_with_group %>%
  group_by(group) %>%
  summarise(has_dup = any(duplicated(factor)))
print(dup_check)

所有has_dup值都为FALSE且每组行数为50即代表符合需求。

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