在lm lapply调用列表中使用权重参数

Question

这是我的问题(虚构数据,以便可重现):

set.seed(42)
df<-data.frame("x"=rnorm(1000),"y"=rnorm(1000),"z"=rnorm(1000))
df2<-data.frame("x"=rnorm(100),"y"=rnorm(100),"z"=rnorm(100))
breaks<-c(-1000,-0.68,-0.01315,0.664,1000)
divider<-cut(df$x,breaks)
divider2<-cut(df2$x,breaks)
subDF<-by(df,INDICES=divider,data.frame)
subDF2<-by(df2,INDICES=divider2,data.frame)
reg<-lapply(subDF,lm,formula=x~.)
pre<-lapply(1:4,function(x){predict(reg[[x]],subDF2[[x]])})
lapply(1:4,function(x){summary(reg[[x]])$r.squared})

上面的代码工作正常.我正在做的是:根据值x,我分成df4个数据帧并对每个数据帧进行回归,以便能够预测其他数据集的值.数据帧的分割是为了更好地预测,因为范围对x实际数据有很大影响.

我想要做的是为回归添加权重参数,以更加重视最新数据.我的权重参数是:weights<-0.999^seq(250,1,by=-1)如果有250个数据.种子为42,之前的断裂,所有4个维度都是250.

当我尝试做的时候reg<-lapply(subDF,lm,formula=x~.,weights=0.999^seq(250,1,by=-1)),我收到了这个错误:

Error in eval(expr, envir, enclos) : 
  ..2 used in an incorrect context, no ... to look in

这是一个很奇怪,因为lapply有一个...参数,在这里使用formula但它不接受weights.

所以我真的不知道如何添加这些权重.我应该在我的代码中纠正什么,或者我(几乎)完全改变它以便能够使用权重？

对于该示例并且为了使它(可能)更容易,我剪切了断点以使4个子集具有相同的维度,但理想情况下,即使4个子集不具有相同的维度,所以答案也将起作用(因此,breaks<-c(-1000,-0.75,0,0.75,1000)对于实例)

CrossValidated上的这篇文章有着相同的问题,但没有一个有效的解决方案,所以这对我没有帮助.

Answer 1

遗憾的是,您在R中遇到了第一手可疑的最糟糕的错误.即所谓的非标准评估(NSE)错误.

经过一些挖掘代码之后我觉得我找到了罪魁祸首.让我们一个接一个:

首先让我们来看看traceback():

weights <- 0.999^seq(250,1,by=-1)

lapply(subDF, lm, formula=x~., weights=weights)
Error in eval(expr, envir, enclos) : 
  ..2 used in an incorrect context, no ... to look in
> traceback()
8: eval(expr, envir, enclos)
7: eval(extras, data, env)
6: model.frame.default(formula = ..1, data = X[[1L]], weights = ..2, 
       drop.unused.levels = TRUE)
5: stats::model.frame(formula = ..1, data = X[[1L]], weights = ..2, 
       drop.unused.levels = TRUE)
4: eval(expr, envir, enclos)
3: eval(mf, parent.frame())
2: FUN(X[[1L]], ...)
1: lapply(subDF, lm, formula = x ~ ., weights = weights)

看起来问题发生在model.frame.default.那么,让我们来看看源代码.我不会发布完整的源代码,但是如果你输入model.frame.default控制台,你会看到中间的某个地方:

extras <- substitute(list(...))
extranames <- names(extras[-1L])
extras <- eval(extras, data, env)

最后一行是它失败的地方.第一行是所谓的NSE,由创建者创建substitute.substitute将创建所谓的,expression即让我们说出一个像以后要评估(即创建)的对象eval.正如您所看到的eval,extras将被评估data,然后如果没有找到env.对于公式,它是好的,因为它在数据中进行评估,并x~.告诉eval使用中的所有列data.weights虽然不在data.因此,eval将寻找它env.但是什么env呢？

显然,env是一个环境,并model.frame.default在行内创建:

env <- environment(formula$terms)

那么这是什么意思？让我们看另一个例子:

xtest <- function(x) {
  new_func <- function(x) {
    env <- environment(x)
    print(env)
  }
  new_func(x)
} 

> xtest(x~z)
<environment: R_GlobalEnv>

在功能上面我尝试在更少的线什么的复制env将是model.frame.default.如您所见,environment(formula)指向全球环境.

所以,它是在哪里env试图找到,..2即传入的第二个参数...(即weights),但由于...在全局环境中没有,你得到一个错误.希望现在很清楚!

最佳解决方案,我会做的是使用@Heroka的答案来解决它(或者你可以重写整个model.frame.default并lm从头开始,而无需使用NSE,但我认为首先是比较合理的:)).

Answer 2

我不知道你为什么会收到错误（我认为 -....参数是为此而做的。但是，我发现了一个轻微的解决方法，这符合你需要的方向吗？我所做的是创建一个“匿名” ' lapply 内部的函数，它计算权重（取决于数据的维度）并返回模型。

reg2 <- lapply(subDF, function(chunk){
  #calculate weights (!dependent on data ordering)
  weights <- 0.999^seq(nrow(chunk),1,by=-1)

  #fit model
  fit <- lm(x~., data=chunk, weights=weights)
  return(fit)
})