Why does grouping function work slow when fitting lm models - r

Question

I have data frame with 5 column and about 12 000 000 rows.
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
I try to use groping function to it
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(.)))
It works for about 30-37 minutes.
Tell me please what is the reason?
How should I make this code work faster.
As I understood I should remove unused vectors and data.frame.

Answer 1

library(data.table)
result2 <- table[,
data.frame(val=gromov_analise_fuction(.SD)),
by = number]
See how much faster data.table is! (BTW, check Hadley Wickham's GitHub repo, he has been re-writing dplyr verbs with the data.table backend to make these faster.)
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
And here are the outputs from your code with dplyr and the data.table way (with the data you provided in your question, I agree with #Roland though when it comes to providing data!):
> 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

You can speed up fitting the models significantly, but the slow part is calculating the model summaries. The "low-hanging fruit" is limiting the calls to summary to one call per model, obviously. You might want to create your own function that calculates only the values of interest, i.e., the p-values for the slopes (see there for the calculation of the standard errors). For the coefficients you can just use the function coef which is fast.
Here is an approach that fits the models much faster (but still uses 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,]