使用百万个观测值和数千个变量估计 R 中的 OLS 模型

Estimating an OLS model in R with million observations and thousands of variables

我正在尝试使用 biglm 估计具有约 100 万个观测值和约 50,000 个变量的大型 OLS 回归。

我计划 运行 每个估计使用大约 100 个观察值的块。我用小样本测试了这个策略,效果很好。

但是,在尝试为 biglm 函数定义公式时,我得到了真实数据 "Error: protect(): protection stack overflow"。

我已经试过了:

但错误仍然存​​在

我正在研究 Windows 并使用 Rstudio

# create the sample data frame (In my true case, I simply select 100 lines from the original data that contains ~1,000,000 lines)
DF <- data.frame(matrix(nrow=100,ncol=50000))
DF[,] <- rnorm(100*50000)
colnames(DF) <- c("y", paste0("x", seq(1:49999)))

# get names of covariates
my_xvars <- colnames(DF)[2:( ncol(DF) )]

# define the formula to be used in biglm
# HERE IS WHERE I GET THE ERROR :
my_f <- as.formula(paste("y~", paste(my_xvars, collapse = " + ")))

编辑 1: 我练习的最终目标是估计所有 50,000 个变量的平均效果。因此,简化模型选择更少的变量并不是我现在要寻找的解决方案。

第一个瓶颈(我不能保证不会有其他瓶颈)在公式的构建上。 R 无法从文本构造一个公式(细节太难看,现在无法探索)。下面我展示了 biglm 代码的黑客版本,它可以直接采用模型矩阵 X 和响应变量 y,而不是使用公式来构建它们。 但是:下一个瓶颈是内部函数 biglm:::bigqr.init(),它在 biglm 中被调用,试图分配一个大小为 choose(nc,2)=nc*(nc-1)/2 的数字向量(其中 nc 是列数。当我尝试使用 50000 列时,我得到

Error: cannot allocate vector of size 9.3 Gb

(当nc为25000时需要2.3Gb)。当 nc <- 10000 时,下面的代码在我的笔记本电脑上运行。

我对这种方法有一些注意事项:

  • 由于上述问题,除非您有至少 10G 的内存,否则您将无法处理具有 50000 列的问题。
  • 必须以并行方式修改 biglm:::update.biglm(这应该不会太难)
  • 不知道 p>>n 问题(适用于拟合初始块的级别)是否会影响您。当 运行 我下面的示例(有 10 行,10000 列)时,除了 10 个参数之外的所有参数都是 NA。我不知道这些 NA 值是否会污染结果,从而导致连续更新失败。如果是这样,我不知道是否有解决该问题的方法,或者它是否是基本问题(这样您至少需要 nr>nc 才能进行初始拟合)。 (做点小实验看看有没有问题就直接了,但是我已经在这上面花了太久了。。。)
  • 不要忘记,使用这种方法时,您必须明确地向模型矩阵添加一个截距列(例如 X <- cbind(1,X) 如果您想要一个。

例子(先把最下面的代码保存为my_biglm.R):

nr <- 10
nc <- 10000
DF <- data.frame(matrix(rnorm(nr*nc),nrow=nr))

respvars <- paste0("x", seq(nc-1))
names(DF) <- c("y", respvars)

# illustrate formula problem: fails somewhere in 15000 < nc < 20000
try(reformulate(respvars,response="y"))

source("my_biglm.R")
rr <- my_biglm(y=DF[,1],X=as.matrix(DF[,-1]))

my_biglm <- function (formula, data, weights = NULL, sandwich = FALSE,
                      y=NULL, X=NULL, off=0) {
    if (!is.null(weights)) {
        if (!inherits(weights, "formula")) 
            stop("`weights' must be a formula")
        w <- model.frame(weights, data)[[1]]
    } else w <- NULL
    if (is.null(X)) {
        tt <- terms(formula)
        mf <- model.frame(tt, data)
        if (is.null(off <- model.offset(mf))) 
            off <- 0
        mm <- model.matrix(tt, mf)
        y <- model.response(mf) - off
    } else {
        ## model matrix specified directly
        if (is.null(y)) stop("both y and X must be specified")
        mm <- X
        tt <- NULL
    }
    qr <- biglm:::bigqr.init(NCOL(mm))
    qr <- biglm:::update.bigqr(qr, mm, y, w)
    rval <- list(call = sys.call(), qr = qr, assign = attr(mm, 
        "assign"), terms = tt, n = NROW(mm), names = colnames(mm), 
        weights = weights)
    if (sandwich) {
        p <- ncol(mm)
        n <- nrow(mm)
        xyqr <- bigqr.init(p * (p + 1))
        xx <- matrix(nrow = n, ncol = p * (p + 1))
        xx[, 1:p] <- mm * y
        for (i in 1:p) xx[, p * i + (1:p)] <- mm * mm[, i]
        xyqr <- update(xyqr, xx, rep(0, n), w * w)
        rval$sandwich <- list(xy = xyqr)
    }
    rval$df.resid <- rval$n - length(qr$D)
    class(rval) <- "biglm"
    rval
}