R语言如何通过for/foreach循环批量完成分组数据清洗与拼接

假设我编写了如下用于数据清洗的函数：

clean <- function(data, year, ecSec, tail = T, head = F){
  
  data1 <- data %>% 
    filter(year == year) %>% 
    filter(ciiu1 == ecSec) %>% 
    select(year, ruc, valueAdded, sales, totAssets, wages, materials, c_debtRatio)
  
  if(tail == T){
    
    list <- data1 %>% 
      filter_if(is.numeric, any_vars(. < quantile(., 0.01, na.rm=T))) %>% 
      select(ruc, year) %>% 
      unique()
    
    data2 <- data %>% 
      filter(! ruc %in% list$ruc & year == year)
    
    return(data2)
  }
  
  if(head ==T){
    list <- data2 %>% 
      filter_if(is.numeric, any_vars(. > quantile(., 0.99, na.rm = T))) %>% 
      select(ruc, year) %>% 
      unique()
    
    data3 <- data %>% 
      filter(! ruc %in% list$ruc & year == year)
    
    return(data3)
  }
  
}

该函数的设计目标是按ciiu1和year筛选数据后，剔除首尾1%的异常值。

我的需求是首先处理ciiu1 == "A"、year == 2012的子集：

r1 <- clean(data, year = 2012, ecSec = "A")

上述代码会返回名为r1的dataframe，后续我需要在该结果基础上继续执行：

r2 <- clean(r1, year = 2013, ecSec = "A")

按照该逻辑依次迭代，覆盖所有ecSec取值（"A","C","F","G"）以及2012-2020的完整时间跨度。

• 如何通过for循环实现上述操作？
• 如果可行的话，也希望了解如何通过foreach循环实现该需求？
• 由于我的数据集体量过大，无法直接全量上传，如果需要提供可复现示例，请问如何抽取小规模样本用于问题复现？

回答 #

前置：修正原清洗函数的逻辑问题 #

原函数存在两个会导致结果错误的bug，迭代前需要先修复：

1. filter(year == year)为恒成立判断，dplyr会优先匹配数据框内的year列，无法按传入的年份参数筛选，需要通过.env$year显式引用函数外部传入的参数。
2. 默认参数tail = T, head = F不会执行上1%异常值剔除，且head分支依赖tail分支生成的data2对象，单独传入head = T会直接报错。

修正后的函数如下：

library(tidyverse)
clean_fixed <- function(data, target_year, ecSec, tail = T, head = T){
  # 筛选当前年份+当前行业的目标子集
  data_sub <- data %>% 
    filter(year == .env$target_year, ciiu1 == .env$ecSec) %>% 
    select(year, ruc, valueAdded, sales, totAssets, wages, materials, c_debtRatio)
  
  outlier_ruc <- c()
  # 标记下1%异常值
  if(tail){
    lower_outlier <- data_sub %>% 
      filter(across(where(is.numeric), ~ .x < quantile(.x, 0.01, na.rm = T))) %>% 
      pull(ruc) %>% 
      unique()
    outlier_ruc <- c(outlier_ruc, lower_outlier)
  }
  # 标记上1%异常值
  if(head){
    upper_outlier <- data_sub %>% 
      filter(!ruc %in% outlier_ruc) %>% 
      filter(across(where(is.numeric), ~ .x > quantile(.x, 0.99, na.rm = T))) %>% 
      pull(ruc) %>% 
      unique()
    outlier_ruc <- c(outlier_ruc, upper_outlier)
  }
  # 剔除当前年份的异常值，其余年份数据完整保留，供下一轮迭代使用
  data_clean <- data %>% 
    filter(!(year == .env$target_year & ruc %in% outlier_ruc))
  return(data_clean)
}

for循环实现方案 #

不同行业的清洗逻辑互相独立，按行业外层循环、年份内层顺序迭代即可，用列表存储结果避免生成大量零散变量：

# 定义待遍历的维度
ecSec_list <- c("A","C","F","G")
year_list <- 2012:2020
result_for <- list()

for(sec in ecSec_list){
  # 每个行业从原始全量数据开始迭代
  current_data <- data
  for(yr in year_list){
    current_data <- clean_fixed(current_data, target_year = yr, ecSec = sec)
  }
  result_for[[sec]] <- current_data
}
# 如需合并所有行业的清洗结果为单个数据框，执行以下代码即可
final_data_for <- bind_rows(result_for)

foreach并行实现方案 #

由于行业间清洗逻辑无依赖，可按行业并行加速，年份维度因为存在前后迭代依赖，不能并行：

library(foreach)
library(doParallel)
# 注册并行集群，核数按自身电脑配置调整，建议预留1-2核供系统使用
cl <- makeCluster(detectCores() - 2)
registerDoParallel(cl)

result_foreach <- foreach(sec = ecSec_list, 
                          .packages = c("tidyverse"),
                          .export = c("clean_fixed", "data", "year_list")) %dopar% {
  current_data <- data
  for(yr in year_list){
    current_data <- clean_fixed(current_data, target_year = yr, ecSec = sec)
  }
  return(current_data)
}
names(result_foreach) <- ecSec_list
# 关闭并行集群
stopCluster(cl)
# 合并结果的方式和for循环一致
final_data_foreach <- bind_rows(result_foreach)

小规模可复现样本抽取方法 #

无需上传全量数据，按以下规则抽样即可满足复现要求：

• 保证样本覆盖所有待测试的ciiu1类别、2012-2020的完整年份段
• 每个（行业、年份）分组抽取50-100条观测即可，不需要大样本
• 涉及企业ID等敏感信息时，可替换为随机生成的脱敏ID，数值列可整体乘以固定随机系数脱敏，不影响逻辑验证

参考抽样代码：

set.seed(123) # 固定随机种子保证结果可复现
sample_data <- data %>% 
  group_by(ciiu1, year) %>% 
  slice_sample(n = 100) %>% # 每个分组抽100条
  ungroup()

如果需要验证异常值剔除逻辑，可手动往样本中添加几个明显超出1%/99%分位数的极端值即可。

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