优化dplyr summarise运行scam模型性能及报错排查

问题背景 #

需要按X、Y分组运行scam模型，优化分组计算效率，最终目标是得到预测变量A=0时的响应值。已将数据转为data.table提升性能，发现gam比scam快很多；使用dtplyr的fgroup_by+fsummarise时出现报错：Error in bfgs_gcv.ubre(gcv.ubre_grad, rho = rho, G = G, env = env, control = control) : object 'old.alpha' not found

初始代码 #

library(dplyr)
library(data.table)
library(dtplyr)
library(scam)

dt <- data.table(df)

ptm <- proc.time()
new_dat <- dt %>% 
   summarise(scam_model=list(scam(B ~ s(A, bs="mpi"))), .by = c(X,Y))
proc.time() - ptm

预测代码 #

pred_df <- data.frame(A = 0)
scam_predict <- function(m) predict(m,pred_df)
new_dat$scam_pred_0 <-sapply(new_dat$scam_model,scam_predict)

更新后报错代码 #

ptm <- proc.time()
new_dat <- dt %>% 
   fgroup_by(X,Y) %>%
   fsummarise(scam_model=list(scam(B ~ s(A, bs="mpi"))))
proc.time() - ptm

解决方案 #

报错原因 #

dtplyr的延迟计算机制与scam内部优化函数的环境交互冲突，导致内部变量old.alpha无法被找到。以下是两种高效的解决思路：

方案1：使用data.table原生语法（推荐） #

直接用data.table原生分组计算，避免延迟计算问题，同时不存储完整模型对象，直接生成预测值，大幅节省内存与时间：

library(data.table)
library(scam)

setDT(df) # 直接转换为data.table

ptm <- proc.time()
result_dt <- df[, .(scam_pred_0 = {
  # 分组内运行模型并直接预测A=0的值
  mod <- scam(B ~ s(A, bs = "mpi"))
  predict(mod, newdata = data.frame(A = 0))
}), by = .(X, Y)]
proc.time() - ptm

方案2：坚持使用dplyr（避免延迟计算） #

定义分组计算函数，用cur_data()传递分组数据，绕过dtplyr的延迟计算问题：

library(dplyr)
library(data.table)
library(scam)

dt <- as.data.table(df)

# 定义分组内计算函数
get_scam_pred <- function(data) {
  mod <- scam(B ~ s(A, bs = "mpi"), data = data)
  predict(mod, newdata = data.frame(A = 0))
}

ptm <- proc.time()
result_dt <- dt %>%
  group_by(X, Y) %>%
  summarise(scam_pred_0 = get_scam_pred(cur_data()), .groups = "drop")
proc.time() - ptm

优化要点 #

• 直接计算并返回预测值，不存储完整模型对象，减少内存占用，提升运行速度
• data.table原生语法在分组复杂计算上性能优于dplyr/dtplyr，且避免了延迟计算带来的环境冲突问题

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