How to efficiently apply cumprod to all columns in the tidyverse

user_14888758 0
Viewed 211

I have a large-ish random matrix (either 500 x 100,000 or 500 by 10,000) and I want to apply cumprod to every column. On the 500 x 10,000 my code runs in 13 seconds. On the 500 x 100,000 it runs in 32 minutes. Is there a more efficient or better scaling way than the below to do this within the tidyverse?

library(tidyverse)
library(mc2d)

n.rows = 500  #Number of times
n.cols = 100000  #Number of samples
outcomes = as_tibble(matrix(1 + ifelse(rbern(n.rows * n.cols, .5), .5, -.4), 
                            nrow = n.rows)) %>% 
  modify(cumprod)
tidyverse r performance
3 Answers

With tidyverse, an option is across to loop over the columns

out2 <- df1 %>%
    mutate(across(everything(), cumprod))

-checking with OP's output

out1 <- df1 %>%
         modify(cumprod)

identical(out1, out2)
#[1] TRUE

If it is still slow, then can use data.table methods

library(data.table)
setDT(df1)[, (seq_along(df1)) := lapply(.SD, cumprod)]

Benchmarks

Using the bigger data, an option is also use lapply

n.rows <- 500  #Number of time
n.cols <- 100e3  #Number of samples

raw_data  <- as_tibble(matrix(1 + ifelse(rbern(n.rows * n.cols, .5), .5, -.4), nrow = n.rows))


system.time({out = raw_data %>% map_df(cumprod)})
#   user  system elapsed 
#  1.819   0.125   1.943 
system.time({raw_data[] <- lapply(raw_data, cumprod)})
#   user  system elapsed 
#  0.432   0.088   0.520

data

df1 <- as_tibble(matrix(1 + ifelse(rbern(n.rows * n.cols, .5), .5, -.4), 
                         nrow = n.rows))
user_37322710

If you fixed number of rows for your tibble data, you actually can use Reduce to implement cumprod, which seems a faster option

do.call(rbind, Reduce("*", asplit(df, 1), accumulate = TRUE))

Benchmark (thank @akrun's solutions for this)

> system.time({
+   out1 <- do.call(rbind, Reduce("*", asplit(df, 1), accumulate = TRUE))
+ })
   user  system elapsed 
   6.55    0.22    6.76

> system.time({
+   out2 <- setDT(df)[, lapply(.SD, cumprod)]
+ })
   user  system elapsed 
  44.93    0.02   45.01

> all.equal(out1, as.matrix(out2))
[1] TRUE

where the dummy data df is given as

set.seed(1)
nr <- 500
df <- as_tibble(matrix(rnorm(5e7), nr), nrow = nr)
user_121587570

I benchmarked a bunch of solutions. @ThomaslsCoding's solution was the fastest of those offered but I seem to have found a simpler and equally fast solution-- the use of map_df.

> library(tidyverse)
> library(mc2d)
> library(data.table)
> 
> n.rows = 500  #Number of time
> n.cols = 100e3  #Number of samples
> 
> raw_data = as_tibble(matrix(1 + ifelse(rbern(n.rows * n.cols, .5), .5, -.4), nrow = n.rows))
> 
> system.time({out = raw_data %>% modify(cumprod)})
    user   system  elapsed 
1184.269   21.915 1207.873 
> system.time({out = raw_data %>% mutate(across(everything(), cumprod))})
    user   system  elapsed 
3495.240   15.792 3516.903 
> system.time({out = setDT(raw_data)[, lapply(.SD, cumprod)]})
   user  system elapsed 
 48.245   0.280  48.745 
> system.time({out = do.call(rbind, Reduce("*", asplit(raw_data, 1), accumulate = TRUE))})
   user  system elapsed 
  2.099   0.127   2.230 
> system.time({out = raw_data %>% map_df(cumprod)})
   user  system elapsed 
  1.306   0.008   1.316

NEW TESTS BELOW

> system.time({out = do.call(rbind, Reduce("*", asplit(raw_data, 1), accumulate = TRUE))})
   user  system elapsed 
  1.777   0.032   1.814 
> system.time({out = raw_data %>% map_df(cumprod)})
   user  system elapsed 
  1.393   0.012   1.410 
> system.time({out[] = lapply(raw_data, cumprod)})
   user  system elapsed 
  0.278   0.003   0.282 
> system.time({out = apply(raw_data, 2, cumprod)})
   user  system elapsed 
  1.126   0.012   1.142

lapply is fastest for me too

user_148887580
Related