r语言 - 为什么分组功能在拟合 lm 模型时工作缓慢

Question

我有 5 列和大约 12 000 000 行的数据框。

lon   lat       for_R_WDEP_SOX number year
2        -29.95 30.05      128.44461      1 2000
624002   -29.95 30.05      320.17755      1 2001
1248002  -29.95 30.05      192.20628      1 2002
1872002  -29.95 30.05      325.44336      1 2003
2496002  -29.95 30.05      368.46976      1 2004
3120002  -29.95 30.05      409.80154      1 2005
3744002  -29.95 30.05      265.71161      1 2006
4368002  -29.95 30.05      147.92351      1 2007
4992002  -29.95 30.05      279.87851      1 2008
5616002  -29.95 30.05      136.38370      1 2009
6240002  -29.95 30.05      223.43958      1 2010
6864002  -29.95 30.05      132.92253      1 2011
7488002  -29.95 30.05      112.68416      1 2012
8112002  -29.95 30.05       83.81801      1 2013
8736002  -29.95 30.05       80.33523      1 2014
9360002  -29.95 30.05       71.58231      1 2015
9984002  -29.95 30.05       91.07822      1 2016
10608002 -29.95 30.05       98.69281      1 2017

我尝试使用摸索功能来对待它

gromov_analise_fuction <- function(table)
{
x <- table$year
y <- table$for_R_WDEP_SOX
line<- lm(y~x)

p_value_coef <- summary(line)$coefficients["x","Estimate"]/abs(summary(line)$coefficients["x","Estimate"])*(1 -summary(line)$coefficients["x","Pr(>|t|)"])
k <- summary(line)$coefficients["x","Estimate"]
B_K <- summary(line)$coefficients["x","Estimate"]*1800/summary(line)$coefficients["(Intercept)","Estimate"]
result_vector <- c(p_value_coef,k,B_K)
return (result_vector)     
}


result <- table %>%
group_by(number) %>% 
do(data.frame(val=gromov_analise_fuction(.)))

它的工作时间约为 30-37 分钟。 请告诉我是什么原因？ 我应该如何使这段代码更快地工作。

据我了解，我应该删除未使用的向量和数据帧。

Answer 1

library(data.table)
result2 <- table[,
data.frame(val=gromov_analise_fuction(.SD)),
by = number]

看看data.table有多快！(顺便说一句，查看 Hadley Wickham 的 GitHub 存储库，他一直在使用 data.table 后端重写 dplyr 动词，以使这些动词更快。

Unit: nanoseconds
expr     min      lq       mean  median        uq      max neval cld
dplyr 3717853 4262732 5028474.44 4526830 5648242.0 15919477   100   b
data.table      35      39     316.29      41     603.5     3024   100  a

以下是您的代码与dplyr和data.table方式的输出(根据您在问题中提供的数据，我同意@Roland，但在提供数据方面

！

> result (dplyr)
# A tibble: 3 x 2
# Groups:   number [1]
number     val
<int>   <dbl>
1      1  -0.998
2      1 -13.9  
3      1  -0.890
> result2 (data.table)
number         val
1:      1  -0.9979470
2:      1 -13.8587730
3:      1  -0.8900289

Answer 2

您可以显著加快拟合模型的速度，但较慢的部分是计算模型摘要。显然，"唾手可得的果实"是对摘要的调用限制为每个模型一次调用。您可能希望创建自己的函数，该函数仅计算感兴趣的值，即斜率的 p 值(有关标准误差的计算，请参阅此处(。对于系数，您可以只使用快速的函数coef。

这是一种更快地适合模型的方法(但仍使用summary(：

library(data.table)
n <- 1e5
set.seed(42)
DT <- data.table(x = 1:10, y = rnorm(n), g = rep(seq_len(n/10), each = 10))
#fit each model separately
system.time({
res <- DT[, .(pslope = summary(lm(y ~ x, data = .SD))$coefficients["x","Pr(>|t|)"]), by = g]
})    
#user  system elapsed 
#5.89    0.01    6.02
#use the fact that the models have all the same design matrix
system.time({
DT1 <- dcast(DT, x ~ g, value.var = "y")
setnames(DT1, make.names(names(DT1)))
fit <- lm(as.formula(sprintf("cbind(%s) ~ x", paste(names(DT1)[-1], collapse = ","))), data = DT1)
pslope <- vapply(summary(fit), function(fitsum) fitsum$coefficients["x","Pr(>|t|)"], FUN.VALUE = 1.0)
})
#user  system elapsed 
#4.34    0.00    4.42
#same result
all.equal(unname(pslope), res[["pslope"]])
#[1] TRUE
#intercepts
coef(fit)[1,]
#slopes
coef(fit)[2,]