R语言批量计算所有日期与分类对应系数并生成汇总表咨询

实现逻辑 #

• 将原有单组参数计算逻辑封装为自定义函数，输入目标日期和分类，输出对应系数
• 提取数据集中所有唯一的「日期+分类」组合
• 批量遍历所有组合调用函数，自动合并为汇总表格

完整可运行代码 #

# 加载依赖包
library(dplyr)
library(tidyverse)
library(lubridate)
library(purrr)

# 原始数据集
df1 <- structure(
  list(date1= c("2021-06-28","2021-06-28","2021-06-28","2021-06-28"),
       date2 = c("2021-06-30","2021-06-30","2021-07-01","2021-07-01"),
       Category = c("FDE","ABC","FDE","ABC"),
       Week= c("Wednesday","Wednesday","Friday","Friday"),
       DR1 = c(4,1,6,3),
       DR01 = c(4,1,4,3), DR02= c(4,2,6,2),DR03= c(9,5,4,7),
       DR04 = c(5,4,3,2),DR05 = c(5,4,5,4),
       DR06 = c(2,4,3,2),DR07 = c(2,5,4,4),
       DR08 = c(3,4,5,4),DR09 = c(2,3,4,4)),
  class = "data.frame", row.names = c(NA, -4L))

# 封装单组参数计算函数
calculate_b2 <- function(target_date, target_cat, raw_df = df1) {
  # 原有计算逻辑替换参数
  x <- raw_df %>% select(starts_with("DR0"))
  x <- cbind(raw_df, setNames(raw_df$DR1 - x, paste0(names(x), "_PV")))
  PV <- select(x, date2, Week, Category, DR1, ends_with("PV"))
  
  med <- PV %>%
    group_by(Category, Week) %>%
    summarize(across(ends_with("PV"), median), .groups = "drop")
  
  SPV <- raw_df %>%
    inner_join(med, by = c('Category', 'Week')) %>%
    mutate(across(matches("^DR0\\d+$"), ~.x + get(paste0(cur_column(), '_PV')),
                  .names = '{col}_{col}_PV')) %>%
    select(date1:Category, DR01_DR01_PV:last_col())
  SPV <- data.frame(SPV)
  
  mat1 <- raw_df %>%
    filter(date2 == target_date, Category == target_cat) %>%
    select(starts_with("DR0")) %>%
    pivot_longer(cols = everything()) %>%
    arrange(desc(row_number())) %>%
    mutate(cs = cumsum(value)) %>%
    filter(cs == 0) %>%
    pull(name)
  dropnames <- paste0(mat1,"_",mat1, "_PV")
  
  SPV <- SPV %>%
    filter(date2 == target_date, Category == target_cat) %>%
    select(-any_of(dropnames))
  
  datas <- SPV %>%
    filter(date2 == ymd(target_date)) %>%
    group_by(Category) %>%
    summarize(across(starts_with("DR0"), sum), .groups = "drop") %>%
    pivot_longer(cols= -Category, names_pattern = "DR0(.+)", values_to = "val") %>%
    mutate(name = readr::parse_number(name))
  colnames(datas)[-1] <- c("Days","Numbers")
  
  datas <- datas %>% 
    group_by(Category) %>% 
    slice((as.Date(target_date) - min(as.Date(raw_df$date1)[raw_df$Category == first(Category)])):max(Days)+1) %>%
    ungroup
  
  mod <- nls(Numbers ~ b1*Days^2+b2, start = list(b1 = 0,b2 = 0), data = datas, algorithm = "port")
  return(coef(mod)[[2]])
}

# 提取所有唯一的日期+分类组合
all_combinations <- distinct(df1, date2, Category)

# 批量计算生成汇总表
summary_table <- all_combinations %>%
  mutate(系数 = map2_dbl(date2, Category, ~calculate_b2(.x, .y)))

# 查看最终汇总表
print(summary_table)

输出说明 #

运行代码后summary_table就是所需的汇总表，包含3列：date2（目标日期）、Category（分类）、系数（对应计算结果），和预期输出格式一致。

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