R语言自定义gamlss包装函数异常：首次调用失败，交互式运行正常

问题复现 #

以下是可复现的最小示例：

加载依赖包 #

library(data.table)
library(gamlss)

定义包装函数 #

fun.wrapper <- function(dt, cores){
  all_vars <- colnames(dt)[colnames(dt) > "b"]
  scope_vars <- all_vars[1:ceiling(length(all_vars)/2)]
  formula_full <- as.formula(paste0("a ~ ", paste(all_vars, collapse = " + ")))
  mod0 <- gamlss(formula = formula_full, data = dt, family = "NO", trace = FALSE)
  droper <- drop1All(object = mod0, scope = scope_vars, print = FALSE, parallel = ifelse(cores>1, "multicore", "no"), ncpus = cores)
  return(droper)
}

初始化测试数据 #

data <- data.table(
  x = rbinom(size = 1, prob = 0.3, n = 10),
  y = rbinom(size = 1, prob = 0.1, n = 10),
  z = rbinom(size = 1, prob = 0.2, n = 10),
  a = rnorm(n = 10)^2)

问题现象 #

• 首次调用函数失败：

res_f1 <- fun.wrapper(dt = data, cores = 1)

• 逐行交互式运行代码可正常得到结果；
• 交互式运行后，再次调用函数可成功：

res_f2 <- fun.wrapper(dt = data, cores = 1)

问题根源 #

核心原因是环境作用域不匹配：

• as.formula()默认使用全局环境创建公式，而函数内部的数据集dt仅存在于函数的局部环境中；
• 首次调用时，gamlss模型虽然能正确拟合，但drop1All在尝试查找模型相关变量时，无法定位到函数局部环境中的数据；
• 交互式运行后，相关变量被加载到全局环境，后续函数调用时drop1All就能找到所需数据，因此恢复正常。

解决方案 #

修改函数中公式的创建逻辑，显式指定公式的环境为当前函数的局部环境，确保gamlss和drop1All能正确关联到函数内的数据集。

修改后的函数：

fun.wrapper <- function(dt, cores){
  all_vars <- colnames(dt)[colnames(dt) > "b"]
  scope_vars <- all_vars[1:ceiling(length(all_vars)/2)]
  # 显式指定公式的环境为当前函数环境
  formula_full <- as.formula(paste0("a ~ ", paste(all_vars, collapse = " + ")), env = environment())
  mod0 <- gamlss(formula = formula_full, data = dt, family = "NO", trace = FALSE)
  droper <- drop1All(object = mod0, scope = scope_vars, print = FALSE, parallel = ifelse(cores>1, "multicore", "no"), ncpus = cores)
  return(droper)
}

替代方案 #

如果上述方法无效，还可以在创建模型后，显式将模型的公式环境绑定到当前函数环境：

fun.wrapper <- function(dt, cores){
  all_vars <- colnames(dt)[colnames(dt) > "b"]
  scope_vars <- all_vars[1:ceiling(length(all_vars)/2)]
  formula_full <- as.formula(paste0("a ~ ", paste(all_vars, collapse = " + ")))
  mod0 <- gamlss(formula = formula_full, data = dt, family = "NO", trace = FALSE)
  # 修改模型公式的环境为当前函数环境
  environment(mod0$formula) <- environment()
  droper <- drop1All(object = mod0, scope = scope_vars, print = FALSE, parallel = ifelse(cores>1, "multicore", "no"), ncpus = cores)
  return(droper)
}

验证 #

修改后，首次调用函数即可正常执行：

res_f1 <- fun.wrapper(dt = data, cores = 1)

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