如何按比例进行分层抽样？R代码报错求解决及替代方案

问题描述 #

我有一个名为Tree_all_exclusive的数据集（7607行、39列），记录了树木的树龄、高度、名称等信息。原本用sample_n可以生成1200条随机样本：

sam1 <- sample_n(Tree_all_exclusive, size = 1200)

但需要生成按树种比例分配的分层样本（即按各树种在总数据中的占比抽取对应数量样本），尝试了以下代码但报错：

sam3 <- Tree_all_exclusive %>%
  group_by(TaxonNameFull)%>%
  summarise(total_numbers=n())%>%
  arrange(-total_numbers)%>%
  mutate(pro = total_numbers/7607)%>% #7607为总树木数量
  mutate(sz= pro*1200)%>% #1200为样本总量
  mutate(siz=as.integer(sz)+1) #避免部分样本量为0.01的情况，取整后加1
sam3

s <- stratified(sam3, group="TaxonNameFull", sam3$siz)

报错信息：

Error in s_n(indt, group, size) : 'size' should be entered as a named vector.

错误修复 #

报错原因是stratified（来自splitstackshape包）的size参数要求是命名向量——向量名称对应分组变量的取值，值对应每组的抽取数量。同时原代码错误地将统计后的汇总表传给stratified，应该传入原始数据集。调整后代码如下：

# 计算各树种应抽取的样本量，同时修正总样本量可能超标的问题
sam3 <- Tree_all_exclusive %>%
  group_by(TaxonNameFull)%>%
  summarise(total_numbers=n())%>%
  arrange(-total_numbers)%>%
  mutate(pro = total_numbers/7607,
         sz = pro*1200,
         # 先取整，再调整总和到1200
         siz = round(sz)) %>%
  # 调整总和：如果总和小于1200，给数量最多的组依次补1；大于则减
  mutate(siz = ifelse(row_number() <= (1200 - sum(siz)), siz +1, siz))

# 将样本量转换为命名向量
size_vec <- setNames(sam3$siz, sam3$TaxonNameFull)

# 基于原始数据集执行分层抽样
s <- stratified(Tree_all_exclusive, group="TaxonNameFull", size=size_vec)

其他比例分层抽样方法 #

方法1：用dplyr直接按比例抽样 #

无需手动计算样本量，直接通过分组+抽样实现：

sam_stratified <- Tree_all_exclusive %>%
  group_by(TaxonNameFull) %>%
  # 按总样本量与总数据量的比例抽取每组样本
  slice_sample(prop = 1200/nrow(Tree_all_exclusive)) %>%
  ungroup()

# 严格控制总样本量为1200
final_sam <- if(nrow(sam_stratified) > 1200){
  slice_sample(sam_stratified, n=1200)
} else {
  # 补充缺失的样本量
  remaining_data <- anti_join(Tree_all_exclusive, sam_stratified)
  bind_rows(sam_stratified, slice_sample(remaining_data, n=1200-nrow(sam_stratified)))
}

方法2：base R原生实现 #

# 按树种拆分数据集
tree_groups <- split(Tree_all_exclusive, Tree_all_exclusive$TaxonNameFull)
# 计算抽样比例
sampling_prop <- 1200/nrow(Tree_all_exclusive)

# 对每组执行抽样，保证每组至少抽1个样本
sam_list <- lapply(tree_groups, function(x){
  n_sample <- max(1, round(nrow(x)*sampling_prop))
  x[sample(nrow(x), n_sample), ]
})

# 合并样本并调整总数量
sam_stratified <- do.call(rbind, sam_list)
final_sam <- if(nrow(sam_stratified) > 1200){
  sam_stratified[sample(nrow(sam_stratified), 1200), ]
} else {
  remaining_rows <- setdiff(rownames(Tree_all_exclusive), rownames(sam_stratified))
  rbind(sam_stratified, Tree_all_exclusive[sample(remaining_rows, 1200-nrow(sam_stratified)), ])
}

方法3：用sampling包的strata函数 #

library(sampling)
# 计算每组抽样数量并调整总和到1200
n_per_group <- round(table(Tree_all_exclusive$TaxonNameFull)*1200/7607)
n_per_group[which.max(n_per_group)] <- n_per_group[which.max(n_per_group)] + (1200 - sum(n_per_group))

# 执行分层抽样
strat_result <- strata(Tree_all_exclusive, stratanames = "TaxonNameFull", 
                       size = n_per_group, method = "srswor")
# 提取最终样本
sam_stratified <- getdata(Tree_all_exclusive, strat_result)

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