r-使用mgcv::gam的非标准评估

Question

我正在制作一个函数，它将对回归函数的未求值调用作为输入，创建一些数据，然后对调用求值。这里有一个例子：

library(lme4)
compute_fit <- function(m){
# Generate some data
df <- data.frame(x = rnorm(100), y = rnorm(100) + x, ID = sample(4, 100, replace = TRUE))
# Evaluate the call
eval(m, envir = df)
}
# Create a list of models
models <- list(
lm = call("lm", quote(list(formula = y ~ x))),
glm = call("glm", quote(list(formula = y ~ x))),
lmer = call("lmer", quote(list(formula = y ~ x + (1 | ID))))
)
# Evaluate the call (this works fine)
model_fits <- lapply(models, compute_fit)

我这样做的原因是，我正在进行一项模拟研究，在许多蒙特卡洛样本上拟合许多不同的模型。该函数是内部包的一部分，我想提供模型列表，然后在包中对其进行评估。

我也想使用mgcv中的gam函数。在gam的文档中，关于它的data自变量如下所述，它实际上等效于例如lm的文档：

包含模型响应变量和公式所需协变量的数据帧或列表。默认情况下，变量取自环境(公式(：通常是调用gam的环境。

因此，我尝试使用相同的逻辑来计算gam，认为上面定义的compute_fit函数中的eval(m, envir = df)应该在df:的环境中评估公式

# Try with gam
library(mgcv)
gamcall = call("gam", quote(list(formula = y ~ x)))    
compute_fit(gamcall)  

但是，此操作失败，并显示错误消息：

eval中的错误(predvars、data、env(：找不到对象'y'

我意识到这个错误可能与这个问题有关，但我的问题是，是否有人能想出一个变通方法，让我像使用其他建模函数一样使用gam？据我所知，相关问题并不能解决这个问题。

这是一个完整的代表：

set.seed(1)
library(lme4)
#> Loading required package: Matrix
compute_fit <- function(m){
# Generate some data
df <- data.frame(x = rnorm(100), ID = rep(1:50, 2))
df$y <- df$x + rnorm(100, sd = .1)
# Evaluate the call
eval(m, envir = df)
}
# Create a list of models
models <- list(
lm = call("lm", quote(list(formula = y ~ x))),
glm = call("glm", quote(list(formula = y ~ x))),
lmer = call("lmer", quote(list(formula = y ~ x + (1 | ID))))
)
# Evaluate the call (this works fine)
model_fits <- lapply(models, compute_fit)
# Try with gam
library(mgcv)
#> Loading required package: nlme
#> 
#> Attaching package: 'nlme'
#> The following object is masked from 'package:lme4':
#> 
#>     lmList
#> This is mgcv 1.8-26. For overview type 'help("mgcv-package")'.
gamcall = call("gam", quote(list(formula = y ~ x)))    
compute_fit(gamcall)    
#> Error in eval(predvars, data, env): object 'y' not found

Answer 1

我会将df添加到调用中，而不是在df:中求值

compute_fit <- function(m){
# Generate some data
set.seed(1)
df <- data.frame(x <- rnorm(100), y = rnorm(100) + x^3, ID = sample(4, 100, replace = TRUE))
#add data parameter to call
m[["data"]] <- quote(df)
# Evaluate the call
eval(m)
}
# Create a list of models
models <- list(
lm = quote(lm(formula = y ~ x)),
glm = quote(glm(formula = y ~ x)),
lmer = quote(lmer(formula = y ~ x + (1 | ID))),
gam = quote(gam(formula = y ~ s(x)))
)
model_fits <- lapply(models, compute_fit)
#works but lmer reports singular fit