按組進行快速線性回歸

Question

我有50 萬用戶，我需要為每個用戶計算線性回歸（帶截距） 。

每個用戶大約有 30 條記錄。

我試過dplyr和lm ，這太慢了。 用戶約 2 秒。

  df%>%                       
      group_by(user_id, add =  FALSE) %>%
      do(lm = lm(Y ~ x, data = .)) %>%
      mutate(lm_b0 = summary(lm)$coeff[1],
             lm_b1 = summary(lm)$coeff[2]) %>%
      select(user_id, lm_b0, lm_b1) %>%
      ungroup()
    )

我嘗試使用已知速度更快的lm.fit ，但它似乎與dplyr不兼容。

有沒有一種快速的方法可以按組進行線性回歸？

Answer 1

您可以只使用基本公式來計算斜率和回歸。 如果你只關心這兩個數字， lm會做很多不必要的事情。 在這里，我使用data.table進行聚合，但您也可以在基礎 R（或dplyr ）中進行：

system.time(
  res <- DT[, 
    {
      ux <- mean(x)
      uy <- mean(y)
      slope <- sum((x - ux) * (y - uy)) / sum((x - ux) ^ 2)
      list(slope=slope, intercept=uy - slope * ux)
    }, by=user.id
  ]
)

為 500K 用戶生成 ~30 個 obs（以秒為單位）：

 user  system elapsed 
 7.35    0.00    7.36 

或者每個用戶大約15 微秒。

更新：我最終寫了一堆博客文章也涉及到這個問題。

並確認這是按預期工作的：

> summary(DT[user.id==89663, lm(y ~ x)])$coefficients
             Estimate Std. Error   t value  Pr(>|t|)
(Intercept) 0.1965844  0.2927617 0.6714826 0.5065868
x           0.2021210  0.5429594 0.3722580 0.7120808
> res[user.id == 89663]
   user.id    slope intercept
1:   89663 0.202121 0.1965844

數據：

set.seed(1)
users <- 5e5
records <- 30
x <- runif(users * records)
DT <- data.table(
  x=x, y=x + runif(users * records) * 4 - 2, 
  user.id=sample(users, users * records, replace=T)
)

Answer 2

如果你想要的只是系數，我只會使用user_id作為回歸中的一個因素。 使用@miles2know 的模擬數據代碼（雖然重命名，因為共享該名稱的exp()以外的對象對我來說看起來很奇怪）

dat <- data.frame(id = rep(c("a","b","c"), each = 20),
                  x = rnorm(60,5,1.5),
                  y = rnorm(60,2,.2))

mod = lm(y ~ x:id + id + 0, data = dat)

我們不擬合全局截距 ( + 0 )，因此每個 id 的截距是id系數，而沒有x本身，因此x:id交互作用是每個id的斜率：

coef(mod)
#      ida      idb      idc    x:ida    x:idb    x:idc 
# 1.779686 1.893582 1.946069 0.039625 0.033318 0.000353 

因此，對於id a水平， ida系數 1.78 是截距，而x:ida系數 0.0396 是斜率。

我將把這些系數收集到數據框的適當列中留給你......

此解決方案應該非常快，因為您不必處理數據幀的子集。 使用fastLm等可能會加快速度。

關於可擴展性的注意事項：

我只是在@nrussell 的模擬全尺寸數據上嘗試過這個，但遇到了內存分配問題。 取決於您擁有多少內存，它可能無法一次性工作，但您可能可以分批使用用戶 ID。 他的答案和我的答案的某種組合可能是整體最快的——或者 nrussell 的可能更快——將用戶 ID 因子擴展為數千個虛擬變量可能在計算上效率不高，因為我已經等了不止一個現在只需幾分鍾即可運行 5000 個用戶 ID。

Answer 3

更新：正如 Dirk 所指出的，可以通過直接指定x和Y而不是使用fastLm的基於公式的接口來大大改進我的原始方法，這會產生（相當大的）處理開銷。 為了比較，使用原始全尺寸數據集，

R> system.time({
  dt[,c("lm_b0", "lm_b1") := as.list(
    unname(fastLm(x, Y)$coefficients))
    ,by = "user_id"]
})
#  user  system elapsed 
#55.364   0.014  55.401 
##
R> system.time({
  dt[,c("lm_b0","lm_b1") := as.list(
    unname(fastLm(Y ~ x, data=.SD)$coefficients))
    ,by = "user_id"]
})
#   user  system elapsed 
#356.604   0.047 356.820

這個簡單的改變產生了大約6.5 倍的加速。

---

[原始方法]

可能還有一些改進的空間，但以下在運行 64 位 R 的 Linux VM（2.6 GHz 處理器）上花費了大約 25 分鍾：

library(data.table)
library(RcppArmadillo)
##
dt[
  ,c("lm_b0","lm_b1") := as.list(
    unname(fastLm(Y ~ x, data=.SD)$coefficients)),
  by=user_id]
##
R> dt[c(1:2, 31:32, 61:62),]
   user_id   x         Y     lm_b0    lm_b1
1:       1 1.0 1674.8316 -202.0066 744.6252
2:       1 1.5  369.8608 -202.0066 744.6252
3:       2 1.0  463.7460 -144.2961 374.1995
4:       2 1.5  412.7422 -144.2961 374.1995
5:       3 1.0  513.0996  217.6442 261.0022
6:       3 1.5 1140.2766  217.6442 261.0022

---

數據：

dt <- data.table(
  user_id = rep(1:500000,each=30))
##
dt[, x := seq(1, by=.5, length.out=30), by = user_id]
dt[, Y := 1000*runif(1)*x, by = user_id]
dt[, Y := Y + rnorm(
  30, 
  mean = sample(c(-.05,0,0.5)*mean(Y),1), 
  sd = mean(Y)*.25), 
  by = user_id]

Answer 4

您可以嘗試使用 data.table 像這樣。 我剛剛創建了一些玩具數據，但我想 data.table 會有所改進。 這是相當快的。 但這是一個相當大的數據集，因此也許可以在較小的樣本上對這種方法進行基准測試，以查看速度是否要好得多。 祝你好運。

    library(data.table)

    exp <- data.table(id = rep(c("a","b","c"), each = 20), x = rnorm(60,5,1.5), y = rnorm(60,2,.2))
    # edit: it might also help to set a key on id with such a large data-set
    # with the toy example it would make no diff of course
    exp <- setkey(exp,id)
    # the nuts and bolts of the data.table part of the answer
    result <- exp[, as.list(coef(lm(y ~ x))), by=id]
    result
       id (Intercept)            x
    1:  a    2.013548 -0.008175644
    2:  b    2.084167 -0.010023549
    3:  c    1.907410  0.015823088

Answer 5

使用 Rfast 的示例。

假設一個響應和 50 萬個預測變量。

y <- rnorm(30)
x <- matrnorm(500*1000,30)
system.time( Rfast::univglms(y, x,"normal") )  ## 0.70 seconds

假設有 500K 響應變量和單個預測變量。

system.time( Rfast::mvbetas(x,y) )  ## 0.60 seconds

注：以上次數將在近期減少。