R语言迭代group_by、summarise并基于df生成唯一输出名的最优方法

核心思路 #

将重复的汇总逻辑封装为自定义函数，通过配置表定义所有需要处理的时段参数，使用purrr包的map系列函数完成批量计算、工作表生成与数据写入，完全替代冗余的重复代码。

完整实现代码 #

library(tidyverse)
library(openxlsx)
library(janitor)
library(lubridate)
library(purrr)

rm(list=ls())

# 原始数据读入与预处理部分保持不变
data <- tribble(
  ~Category, ~Date,        ~Area,     ~Count,
  "Fight",   "2021-01-04", "Area 1",  2,
  "Hug",     "2021-02-01", "Area 2",  4,
  "Dance",   "2021-03-21", "Area 3",  6,
  "Sleep",   "2021-04-18", "Area 3",  8,
  "Hug",     "2021-05-06", "Area 2",  2,
  "Dance",   "2021-06-30", "Area 1",  4,
  "Sleep",   "2021-01-29", "Area 1",  6,
  "Fight",   "2021-02-28", "Area 2",  8,
  "Dance",   "2021-03-15", "Area 3",  2,
  "Sleep",   "2021-04-08", "Area 3",  4,
  "Fight",   "2021-05-30", "Area 2",  6,
  "Hug",     "2021-06-10", "Area 1",  8
)

areas <- c("Area 1", "Area 2","Area 3")
cats <- c("Fight", "Hug", "Dance","Sleep")
data$Area <- factor(data$Area, levels = areas, ordered = TRUE)
data$Category <- factor(data$Category, levels = cats, ordered = TRUE)

# ---------------------- 函数式迭代实现部分 ----------------------
# 1. 定义时段配置表：新增时段仅需在此添加对应行即可
ref_date <- ymd("2021-06-30") # 统一基准日期
periods <- tibble(
  sheet_name = c("this_14", "last_14", "prev_14"), # 自定义工作表名称
  start_offset = c(13, 27, 41), # 时段起始日期 = 基准日期 - start_offset
  end_offset = c(0, 14, 28) # 时段结束日期 = 基准日期 - end_offset
)

# 2. 封装单时段汇总通用函数
summarise_single_period <- function(start_off, end_off, ref_date, df) {
  df %>%
    filter(ymd(Date) >= ref_date - start_off, ymd(Date) <= ref_date - end_off) %>%
    group_by(Category, Area, .drop = FALSE) %>%
    summarise(total = sum(Count), .groups = "drop") %>%
    pivot_wider(names_from = Area, values_from = total) %>%
    adorn_totals(where = c("row", "col")) %>%
    mutate(across(everything(), ~replace_na(.x, 0)))
}

# 3. 批量生成所有时段的汇总表，返回带工作表名称的命名列表
summary_table_list <- pmap(periods, function(sheet_name, start_offset, end_offset) {
  summarise_single_period(start_offset, end_offset, ref_date, data)
}) %>% set_names(periods$sheet_name)

# 4. 批量写入Excel文件
wb <- createWorkbook()
# iwalk可同时读取列表的名称（作为工作表名）和值（作为待写入数据）
iwalk(summary_table_list, function(data_df, sheet_name) {
  addWorksheet(wb, sheet_name)
  writeData(wb, sheet = sheet_name, x = data_df)
})

saveWorkbook(wb, file = "Dev/output_tables_eff.xlsx", overwrite = TRUE)

方案说明 #

• 可扩展性：新增时段仅需修改periods配置表，无需调整后续逻辑，支持任意数量的汇总表生成
• 命名自动化：工作表名称直接复用配置表的sheet_name字段，如需导出为多个独立Excel文件，仅需将写入逻辑替换为write.xlsx(data_df, file = paste0(sheet_name, ".xlsx"))即可
• 效率优化：避免了冗余的中间对象生成，针对大型数据集的处理效率远高于手动重复编码

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