是否有简单回归的快速估计（仅具有截距和斜率的回归线）？

时间：2016-10-19 21:22:36

标签： r regression linear-regression lm

这个问题与机器学习特征选择程序有关。

我有一个很大的特征矩阵 - 列是主题（行）的特征：

set.seed(1)
features.mat <- matrix(rnorm(10*100),ncol=100)
colnames(features.mat) <- paste("F",1:100,sep="")
rownames(features.mat) <- paste("S",1:10,sep="")

在不同条件下（S）测量每个受试者（C）的反应，因此看起来像这样：

response.df <-
data.frame(S = c(sapply(1:10, function(x) rep(paste("S", x, sep = ""),100))),
           C = rep(paste("C", 1:100, sep = ""), 10),
           response = rnorm(1000), stringsAsFactors = F)

所以我匹配response.df中的主题：

match.idx <- match(response.df$S, rownames(features.mat))

我正在寻找一种快速计算每个特征和响应的单变量回归的方法。

比这还要快吗？：

fun <- function(f){
  fit <- lm(response.df$response ~ features.mat[match.idx,f])
  beta <- coef(summary(fit))
  data.frame(feature = colnames(features.mat)[f], effect = beta[2,1],
             p.val = beta[2,4], stringsAsFactors = F))
  }

res <- do.call(rbind, lapply(1:ncol(features.mat), fun))

我对边缘提升感兴趣，即通过mclapply或mclapply2使用并行计算以外的方法。

1 个答案:

答案 0 :(得分：5)

我会提供一个轻量级玩具例程来估计一个简单的回归模型：y ~ x，即只有截距和斜率的回归线。 可以看出，这比lm + summary.lm快36倍。 

## toy data
set.seed(0)
x <- runif(50)
y <- 0.3 * x + 0.1 + rnorm(50, sd = 0.05)

## fast estimation of simple linear regression: y ~ x 
simplelm <- function (x, y) {
  ## number of data
  n <- length(x)
  ## centring
  y0 <- sum(y) / length(y); yc <- y - y0
  x0 <- sum(x) / length(x); xc <- x - x0
  ## fitting an intercept-free model: yc ~ xc + 0
  xty <- c(crossprod(xc, yc))
  xtx <- c(crossprod(xc))
  slope <- xty / xtx
  rc <- yc - xc * slope
  ## Pearson estimate of residual standard error
  sigma2 <- c(crossprod(rc)) / (n - 2)
  ## standard error for slope
  slope_se <- sqrt(sigma2 / xtx)
  ## t-score and p-value for slope
  tscore <- slope / slope_se
  pvalue <- 2 * pt(abs(tscore), n - 2, lower.tail = FALSE)
  ## return estimation summary for slope
  c("Estimate" = slope, "Std. Error" = slope_se, "t value" = tscore, "Pr(>|t|)" = pvalue)
  }

让我们进行测试：

simplelm(x, y)

#    Estimate   Std. Error      t value     Pr(>|t|) 
#2.656737e-01 2.279663e-02 1.165408e+01 1.337380e-15

另一方面，lm + summary.lm给出：

coef(summary(lm(y ~ x)))

#             Estimate Std. Error   t value     Pr(>|t|)
#(Intercept) 0.1154549 0.01373051  8.408633 5.350248e-11
#x           0.2656737 0.02279663 11.654079 1.337380e-15

所以结果匹配。如果你需要R平方并调整R平方，它也可以很容易地计算出来。

让我们有一个基准：

set.seed(0)
x <- runif(10000)
y <- 0.3 * x + 0.1 + rnorm(10000, sd = 0.05)

library(microbenchmark)

microbenchmark(coef(summary(lm(y ~ x))), simplelm(x, y))

#Unit: microseconds
#                     expr      min       lq       mean   median       uq
# coef(summary(lm(y ~ x))) 14158.28 14305.28 17545.1544 14444.34 17089.00
#           simplelm(x, y)   235.08   265.72   485.4076   288.20   319.46
#      max neval cld
# 114662.2   100   b
#   3409.6   100  a

<强>圣!!!我们有36次提升！

备注-1（求解正规方程）

simplelm基于通过Cholesky分解求解正规方程。但由于它很简单，因此不涉及实际的矩阵计算。如果我们需要使用多个协变量进行回归，我们可以使用lm.chol defined in my this answer。

也可以使用LU分解来求解正规方程。我不会谈到这一点，但如果你感兴趣，请问：Solving normal equation gives different coefficients from using lm?。

备注-2（替代cor.test）

simplelm是我的回答Monte Carlo simulation of correlation between two Brownian motion (continuous random walk)中fastsim的扩展名。另一种方法是基于cor.test。它也比lm + summary.lm快得多，但如该答案所示，它比我上面的建议慢。

备注-3（通过QR方法替代）

也可以使用基于QR的方法，在这种情况下，我们要使用.lm.fit，qr.default，qr.coef，qr.fitted和{{1}的轻量级包装器在C级。以下是我们如何将此选项添加到qr.resid：

simplelm

对于我们的玩具数据，QR方法和Cholesky方法都给出了相同的结果：

## fast estimation of simple linear regression: y ~ x 
simplelm <- function (x, y, QR = FALSE) {
  ## number of data
  n <- length(x)
  ## centring
  y0 <- sum(y) / length(y); yc <- y - y0
  x0 <- sum(x) / length(x); xc <- x - x0
  ## fitting intercept free model: yc ~ xc + 0
  if (QR) {
    fit <- .lm.fit(matrix(xc), yc)
    slope <- fit$coefficients
    rc <- fit$residuals
    } else {
    xty <- c(crossprod(xc, yc))
    xtx <- c(crossprod(xc))
    slope <- xty / xtx
    rc <- yc - xc * slope
    }
  ## Pearson estimate of residual standard error
  sigma2 <- c(crossprod(rc)) / (n - 2)
  ## standard error for slope
  if (QR) {
    slope_se <- sqrt(sigma2) / abs(fit$qr[1])
    } else {
    slope_se <- sqrt(sigma2 / xtx)
    }
  ## t-score and p-value for slope
  tscore <- slope / slope_se
  pvalue <- 2 * pt(abs(tscore), n - 2, lower.tail = FALSE)
  ## return estimation summary for slope
  c("Estimate" = slope, "Std. Error" = slope_se, "t value" = tscore, "Pr(>|t|)" = pvalue)
  }

已知QR方法比Cholesky方法慢2~3倍（详细解释请阅读我的回答Why the built-in lm function is so slow in R?）。这是一个快速检查：

set.seed(0)
x <- runif(50)
y <- 0.3 * x + 0.1 + rnorm(50, sd = 0.05)

simplelm(x, y, TRUE)

#    Estimate   Std. Error      t value     Pr(>|t|) 
#2.656737e-01 2.279663e-02 1.165408e+01 1.337380e-15 

simplelm(x, y, FALSE)

#    Estimate   Std. Error      t value     Pr(>|t|) 
#2.656737e-01 2.279663e-02 1.165408e+01 1.337380e-15

确实如此，set.seed(0) x <- runif(10000) y <- 0.3 * x + 0.1 + rnorm(10000, sd = 0.05) library(microbenchmark) microbenchmark(simplelm(x, y, TRUE), simplelm(x, y)) #Unit: microseconds # expr min lq mean median uq max neval cld # simplelm(x, y, TRUE) 776.88 873.26 1073.1944 908.72 933.82 3420.92 100 b # simplelm(x, y) 238.32 292.02 441.9292 310.44 319.32 3515.08 100 a 。

备注-4（GLM的简单回归）

如果我们继续使用GLM，还有一个基于908 / 310 = 2.93的快速，轻量级版本。您可以阅读我的答案R loop help: leave out one observation and run glm one variable at a time并使用此处定义的函数glm.fit。目前f已定制为逻辑回归，但我们可以轻松地将其推广到其他响应。

相关问题
最新问题