如何按多变量比例将样本分为两组？以mtcars数据集为例

我希望将一个样本分成两组，确保两组中2个或更多变量的比例与原样本的比例具有代表性。以mtcars数据集为例，以下是该数据框中最后3个变量的比例：

> data(mtcars)
> round(prop.table(table(mtcars$carb)),2)

   1    2    3    4    6    8 
0.22 0.31 0.09 0.31 0.03 0.03 
> round(prop.table(table(mtcars$gear)),2)

   3    4    5 
0.47 0.38 0.16 
> round(prop.table(table(mtcars$am)),2)

   0    1 
0.59 0.41 

在这个例子中，我希望将样本分成两组，使得am变量接近60/40的拆分比例，同时另外两个变量的拆分比例与原数据集的比例相近。

我目前了解的最接近的方法是匹配抽样，比如处理研究中的方法，但该方法是基于某个处理变量预先定义两组，仅需匹配控制单元与处理单元，使1个或多个协变量的比例在两组间相似。而当前需求有所不同，我认为应该有类似方法，但无法理清思路。是否存在高效的实现方法？或者我应该换一种思路来解决这个问题？

1. 分层抽样（首选方案） #

核心逻辑是基于多个变量的交叉组合创建分层单元，再在每个分层内按目标比例拆分样本，能最大程度保证各组的变量分布与原样本一致。

用R的dplyr包实现：

library(dplyr)

set.seed(123) # 固定随机种子，保证结果可重复
split_result <- mtcars %>%
  # 按am、gear、carb的交叉组合分层
  group_by(am, gear, carb) %>%
  # 每层内按60/40比例分配到两组
  mutate(group = sample(c("组1", "组2"), 
                        size = n(), 
                        replace = TRUE, 
                        prob = c(0.6, 0.4))) %>%
  ungroup()

# 验证分组比例
# 查看am的分组比例
split_result %>% count(am, group) %>% group_by(group) %>% mutate(占比 = n/sum(n))
# 查看gear的分组比例
split_result %>% count(gear, group) %>% group_by(group) %>% mutate(占比 = n/sum(n))
# 查看carb的分组比例
split_result %>% count(carb, group) %>% group_by(group) %>% mutate(占比 = n/sum(n))

如果遇到部分分层单元样本量极小（比如carb=6或8仅1个样本），可以合并相似小分层，或者直接将小样本强制分配到某一组，后续再整体校验比例偏差。

2. 平衡抽样（适配复杂变量场景） #

如果变量类别多、交叉组合过多导致分层单元碎片化，平衡抽样可以在不严格分层的前提下，让多个变量的边际分布在两组中尽可能接近原样本。

用R的balancedSampling包实现：

library(balancedSampling)

set.seed(123)
# 将分类变量转换为哑变量矩阵，用于定义平衡目标
X <- model.matrix(~ factor(am) + factor(gear) + factor(carb) - 1, data = mtcars)
# 计算组1的目标样本量（总样本的60%）
n_group1 <- round(nrow(mtcars) * 0.6)
# 执行平衡抽样
sample_indices <- balancedcube(X, n_group1)

# 拆分两组
组1 <- mtcars[sample_indices, ]
组2 <- mtcars[-sample_indices, ]

# 验证比例
round(prop.table(table(组1$am)), 2)
round(prop.table(table(组2$am)), 2)

3. 遗传算法优化抽样（高精度需求场景） #

如果对比例一致性要求极高，可以用遗传算法寻找最优拆分方案，最小化各组变量分布与原样本的差异。

用R的GA包实现：

library(GA)

set.seed(123)
# 定义适应度函数：计算分组后与原样本的比例差异之和，差异越小适应度越高
fitness_func <- function(x) {
  # x是0/1向量，1代表分到组1，0代表组2
  group1 <- mtcars[x == 1, ]
  # 计算am的比例差异
  diff_am <- abs(prop.table(table(group1$am))[1] - 0.59) + abs(prop.table(table(group1$am))[2] - 0.41)
  # 计算gear的比例差异
  diff_gear <- sum(abs(prop.table(table(group1$gear)) - c(0.47, 0.38, 0.16)))
  # 计算carb的比例差异
  diff_carb <- sum(abs(prop.table(table(group1$carb)) - c(0.22, 0.31, 0.09, 0.31, 0.03, 0.03)))
  # 返回负的差异值，因为GA默认最大化适应度
  return(-(diff_am + diff_gear + diff_carb))
}

# 运行遗传算法，约束组1样本量为总样本的60%
ga_result <- ga(type = "binary", 
                fitness = fitness_func, 
                nBits = nrow(mtcars), 
                popSize = 50, 
                maxiter = 100,
                constraints = list(ineqFun = function(x) sum(x) - n_group1, 
                                   ineqType = "eq"))

# 获取最优分组
best_split <- ga_result@solution[1, ]
组1 <- mtcars[best_split == 1, ]
组2 <- mtcars[best_split == 0, ]

这种方法精度最高，但计算成本也更高，适合样本量不大的场景。

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