在R中按组欠采样解决分层数据的类别与特征不平衡问题

背景与现有流程 #

我手头有一份分层数据，目标变量Season和核心分类预测变量Location的观测值存在严重不平衡。当前使用XGBoost算法，结合数值变量与Location预测Season，后续还要用SHapley Additive exPlanations（SHAP）解释模型输出。

由于温度、气压、日照的范围和波动高度依赖Location，此前仅平衡Season的欠采样无法解决Location嵌套带来的偏差问题。因此我先按Location对数值变量做标准化，再手动针对Location-Season分组执行欠采样，但手动方法重复运行过于繁琐，希望找到更高效的替代方案。

数据集构建代码 #

# 加载合适的包
library(tidyverse)

# 设置随机种子保证可复现性
set.seed(999)

# 创建嵌套且不平衡的数据集
df <- data.frame(
  Season = sample(as.factor(c("Dry", "Rainy")), replace = TRUE), times=c(90, 10),
  Location = rep(as.factor(c('A', 'B','C', 'D')), times=c(60, 10, 20, 10)), 
  Temperatures = round(rnorm(10000), digits = 2)*10,
  Pressure = round(rnorm(10000), digits = 2)*1000,
  Sunshine = round(rnorm(10000), digits = 2))

# 查看分组观测数
df %>% 
  group_by(Season, Location) %>% 
  tally()

按Location标准化数值变量的代码 #

# 提取Location A的观测值
df_A <- df %>%
  dplyr::filter(Location == "A") %>%
  dplyr::select_if(is.factor) 

# 标准化Location A的观测值
df_A_scaled <- df %>%
  dplyr::filter(Location == "A") %>%
  ungroup() %>%
  dplyr::select_if(is.numeric) %>%
  scale(center = TRUE, scale = TRUE) %>%
  bind_cols(df_A) %>%
  relocate(where(is.factor))

# 提取Location B的观测值
df_B <- df %>%
  dplyr::filter(Location == "B") %>%
  dplyr::select_if(is.factor) 

# 标准化Location B的观测值
df_B_scaled <- df %>%
  dplyr::filter(Location == "B") %>%
  ungroup() %>%
  dplyr::select_if(is.numeric) %>%
  scale(center = TRUE, scale = TRUE) %>%
  bind_cols(df_B) %>%
  relocate(where(is.factor))

# 提取Location C的观测值
df_C <- df %>%
  dplyr::filter(Location == "C") %>%
  dplyr::select_if(is.factor) 

# 标准化Location C的观测值
df_C_scaled <- df %>%
  dplyr::filter(Location == "C") %>%
  ungroup() %>%
  dplyr::select_if(is.numeric) %>%
  scale(center = TRUE, scale = TRUE) %>%
  bind_cols(df_C) %>%
  relocate(where(is.factor))

# 提取Location D的观测值
df_D <- df %>%
  dplyr::filter(Location == "D") %>%
  dplyr::select_if(is.factor) 

# 标准化Location D的观测值
df_D_scaled <- df %>%
  dplyr::filter(Location == "D") %>%
  ungroup() %>%
  dplyr::select_if(is.numeric) %>%
  scale(center = TRUE, scale = TRUE) %>%
  bind_cols(df_D) %>%
  relocate(where(is.factor))

# 合并之前创建的不同数据集的行
df <- bind_rows(df_A_scaled, df_B_scaled, df_C_scaled, df_D_scaled)

# 打印结果
print(df)

手动欠采样代码 #

# 提取按Location和Season分组后的最小观测数
minimum_obs_per_class <- df %>% 
  group_by(Location, Season) %>% 
  tally() %>%
  ungroup() %>%
  select(n) %>%
  summarise(min(n)) %>%
  as.numeric()

# 执行手动欠采样以重新平衡数据
df <- df %>% 
    group_by(Location, Season) %>%
    slice_sample(n = minimum_obs_per_class, replace = F)

# 检查结果
df %>% 
  group_by(Location, Season) %>%
  tally() %>%
  arrange(n)

替代方案推荐 #

1. 简化分组标准化代码 #

无需逐个编写每个Location的标准化逻辑，用group_by+mutate批量处理，一行代码完成所有Location的数值变量标准化：

df_scaled <- df %>%
  group_by(Location) %>%
  mutate(across(where(is.numeric), ~scale(.) %>% as.vector())) %>%
  ungroup()

2. 使用专业重采样工具包 #

(1) themis包（tidyverse友好）

themis是tidymodels生态下的重采样工具，支持分层/分组重采样，直接针对Location-Season分组做欠采样：

library(themis)

# 按Location分组，对每组内的Season类别做欠采样，统一到最小组规模
df_balanced <- df_scaled %>%
  group_by(Location) %>%
  step_downsample(Season) %>%
  ungroup()

如果需要更精细控制样本量，也可结合step_upsample（过采样）使用。

(2) caret包的分层重采样

caret支持创建分层抽样索引，适配嵌套不平衡场景：

library(caret)

# 创建分层抽样索引，按Location-Season组合分层
set.seed(999)
group_labels <- paste(df_scaled$Location, df_scaled$Season, sep = "_")
sample_ratio <- minimum_obs_per_class / max(table(group_labels))
index <- createDataPartition(group_labels, p = sample_ratio, list = FALSE)
df_balanced <- df_scaled[index, ]

3. 模型层面直接处理不平衡（无需提前重采样） #

XGBoost本身支持通过参数调整应对不平衡数据，无需提前重采样，还能保留全部数据信息：

# 计算每个Location-Season组的样本权重，权重为总样本数/(分组数*组内样本数)
df_scaled <- df_scaled %>%
  group_by(Location, Season) %>%
  mutate(weight = nrow(df_scaled) / (n_distinct(paste(Location, Season)) * n())) %>%
  ungroup()

# 训练XGBoost时传入权重
library(xgboost)
xgb_matrix <- xgb.DMatrix(
  data = as.matrix(df_scaled %>% select(-Season, -Location, -weight)),
  label = as.integer(df_scaled$Season) - 1,
  weight = df_scaled$weight
)

xgb_model <- xgboost(
  data = xgb_matrix,
  objective = "binary:logistic",
  nrounds = 100,
  verbose = 0
)

这种方法适合后续SHAP解释，因为SHAP能直接反映样本权重对模型输出的影响。

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