Group_by и мутировать медленно на большом фрейме данных

Question

Я работаю с большими (минимум 8 мил строк) dataframes и хочу сделать некоторые базовые вычисления на основе пары переменных группировки и rmultinom.Поскольку мой код остается в силе, для выполнения вычисления требуется не менее ~ 1 секунды, что не составило бы проблем, но мне нужно делать это тысячи раз, поэтому я действительно хотел бы ускорить это.

Яв настоящее время использую dataframes и tidyverse, но я не привязан ни к одному из них.Я пытался реализовать, используя data.table, но не мог понять это.Любые предложения о том, как я могу ускорить процесс, будут очень благодарны.

Пример (реальные данные могут быть на порядок больше или больше):

library(tidyverse)
library(microbenchmark)

# create dummy data
df <- data.frame(fact = rep(letters, each = 312000), 
                 month = rep(month.name, 26), 
                 num = rep(sample(10000:100000, 12), 26), 
                 prob = runif(312))

# Order by month     
df <- df[order(df$month), ]

# group by two factor variables and calculate new variable 
microbenchmark({
  df2 <- df %>%
    group_by(fact, month) %>%
    mutate(res = ifelse(prob > 0, c(rmultinom(1, num[1], prob = prob)), 0))}, times = 10)


 > Unit: milliseconds
 > min      lq       mean     median   uq        max         neval
 > 816.3126 822.4083 840.7966 834.6163 855.5139  879.9345    10

Answer 1

Слишком долго для комментария, поэтому я публикую его здесь.

Запуск

library(profr)
plot(profr(
df %>% group_by(fact, month) %>% 
   mutate(res = ifelse(prob > 0, c(rmultinom(1, num[1], prob = prob)), 0))
))

Я получаю следующее:

Итак, похоже, что вы действительно хотитечтобы найти более быструю реализацию для multinom, что кажется узким местом.Это узкое место одинаково для dplyr и data.table, что означает, что только ускорение rmultinorm даст вам существенное улучшение скорости.

Answer 2

Вы также можете уменьшить накладные расходы, вызванные оператором канала, в синтаксисе dplyr и DT.

Для иллюстрации накладных расходов, вызванных трубами:

microbenchmark(pipe = iris %>%
                 group_by(Species) %>% 
                 mutate(mean = mean(Sepal.Length)),
               no_pipe = mutate(group_by(iris, Species), mean = mean(Sepal.Length)),
               times = 100) %>% autoplot()

Answer 3

Используя data.table , вы можете сделать:

dt <- copy(df)
setDT(dt)

dt[, res := 0L][prob > 0, res := c(rmultinom(1, num[1], prob = prob)), by = .(fact, month)]

, что дает небольшое улучшение скорости:

microbenchmark(dp = df %>%
                 group_by(fact, month) %>%
                 mutate(res = ifelse(prob > 0, c(rmultinom(1, num[1], prob = prob)), 0)),
               dt = dt[, res := 0L][prob > 0, res := c(rmultinom(1, num[1], prob = prob)), by = .(fact, month)],
               times = 1)

Unit: seconds
 expr      min       lq     mean   median       uq      max neval
   dp 1.356745 1.356745 1.356745 1.356745 1.356745 1.356745     1
   dt 1.063363 1.063363 1.063363 1.063363 1.063363 1.063363     1