R语言使用purrr::compose或其他方案优化长周期嵌套函数运行效率

问题a：purrr::compose的正确实现方式 #

你之前报错的核心原因是compose用于拼接单参数函数，而你定义的func_1、func_2都需要传入dat和yr两个参数，直接拼接后无法传递yr参数，因此会触发未使用参数的报错。

正确实现逻辑如下：

# 封装单年度执行逻辑，固定年份后返回仅接收数据框的单参数函数
wrap_year_func <- function(yr) {
  # compose默认从右向左执行，因此先跑的func_1放在右侧，后跑的func_2放在左侧
  compose(
    \(dat) func_2(dat, yr),
    \(dat) func_1(dat, yr)
  )
}

joined_func_2 <- function(dat, beginning, ending) {
  # 生成所有年度的执行函数列表
  year_funcs <- purrr::map(seq(beginning, ending), wrap_year_func)
  # 按顺序执行所有年度逻辑，初始值为原始数据框
  purrr::reduce(year_funcs, \(current_dat, f) f(current_dat), .init = dat)
}

# 测试运行即可得到和原逻辑一致的结果
data_output_2 <- joined_func_2(dat, 1975, 1977)

问题b：运行效率优化方案 #

1. 改用data.table做原地修改 #

你当前的性能瓶颈主要来自dplyr逐次修改数据框产生的全量拷贝开销，换成data.table的原地修改操作，性能可以提升5~10倍，样本量越大提升越明显：

library(data.table)
# 转换为data.table格式，无拷贝开销
setDT(dat)
cut_off <- 3

func_1_dt <- function(dt, yr) {
  z_col <- paste0("z_", yr)
  x_col <- paste0("x_", yr)
  # :=为原地修改操作，不会生成新的数据拷贝
  dt[, (z_col) := fifelse(get(x_col) > cut_off, "Y", NA_character_)]
}

func_2_dt <- function(dt, yr) {
  x_next_col <- paste0("x_", yr+1)
  x_col <- paste0("x_", yr)
  z_col <- paste0("z_", yr)
  dt[, (x_next_col) := fifelse(get(z_col) == "Y", get(x_col)*2, get(x_col)*5)]
}

如果有20个同逻辑变量，可以把变量名存入向量批量处理，不用单独写每个变量的处理函数，进一步减少冗余。

2. 长格式分组计算替代宽格式逐列新增 #

如果所有变量的计算逻辑对齐，可先把数据转为长格式，按id、年份分组计算，无需每次迭代新增列，内存占用更低，计算逻辑也更统一：

library(tidyr)
# 宽转长
dat_long <- dat %>% 
  pivot_longer(cols = -id, names_to = c(".value", "year"), names_sep = "_") %>% 
  mutate(year = as.integer(year))
# 迭代时仅需操作x、z两列，计算完成后再转回宽格式即可

3. 向量化推导替代逐周期迭代 #

如果你的计算规则没有复杂的跨周期依赖，可以先向量化计算每个id第一次超过cutoff的年份，之后所有周期的x值直接通过公式推导得到，不需要逐次迭代，性能提升幅度最大，适合规则简单的场景。

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