Пользовательская последняя функция rcpp замедляется с dplyr group_by и суммирует по сравнению с tapply

Я пытаюсь понять, как писать функции суммирования Rcpp, которые будут быстрыми с dplyr. Мотивация для этого - функция, для которой dplyr, похоже, не имеет эквивалента, однако для простоты я собираюсь использовать пример простого взятия последнего элемента вектора.

В приведенном ниже коде я рассматриваю три разные функции, чтобы получить последний элемент вектора и применить их, используя как tapply, так и dplyr group_by / summarize.

library(dplyr)
library(microbenchmark)
library(Rcpp)
n <- 5000
df <- data.frame(grp = factor(rep(1:n, 2)), valn = rnorm(2L*n), stringsAsFactors = F)

dplyr_num_last_element <- function() df %>% group_by(grp) %>% summarise(valn = last(valn))
dplyr_num_last_element_r <- function() df %>% group_by(grp) %>% summarise(valn = last_r(valn))
dplyr_num_last_element_rcpp <- function() df %>% group_by(grp) %>% summarise(val = last_rcpp(valn))
tapply_num_last_element <- function() tapply(df$valn, df$grp, FUN = last)
tapply_num_last_element_r <- function() tapply(df$valn, df$grp, FUN = last_r)
tapply_num_last_element_rcpp <- function() tapply(df$valn, df$grp, FUN = last_rcpp)

last_r <- function(x) {
  x[1]
}

cppFunction('double last_rcpp(NumericVector x) {
             int n = x.size();
             return x[n-1];
           }')

microbenchmark(dplyr_num_last_element(), dplyr_num_last_element_r(), dplyr_num_last_element_rcpp(), tapply_num_last_element(), tapply_num_last_element_r(), tapply_num_last_element_rcpp(), times = 10) 

Unit: milliseconds
                           expr        min         lq       mean     median         uq       max neval
       dplyr_num_last_element()   6.895850   7.088472   8.264270   7.766421   9.089424  11.00775    10
     dplyr_num_last_element_r() 205.375404 214.481520 220.995218 220.107130 225.971179 238.62544    10
  dplyr_num_last_element_rcpp() 211.593443 216.000009 222.247786 221.984289 228.801007 230.50220    10
      tapply_num_last_element()  97.082102  99.528712 101.955668 101.717887 104.370319 109.26982    10
    tapply_num_last_element_r()   6.101055   6.550065   7.386442   7.069754   7.589164   9.98025    10
 tapply_num_last_element_rcpp()  14.173171  15.145711  16.102816  15.400562  16.053229  22.00147    10

Мои общие вопросы:

1) Почему dplyr_num_last_element_r занимает в среднем 220 мс, а tapply_num_last_element_r занимает 7 мс.

2) Есть ли способ написать мою собственную последнюю функцию для использования с dplyr, но потребуется ли ей больше порядка 7 мс?

Спасибо!


r performance dplyr tapply
person user2506086    schedule 06.09.2017    source источник
comment
Попробуйте data.table: library(data.table); dt <- data.table(df); setkey(dt, grp); DT_num_last_element_r <- function() dt[, last_r(valn), grp]   -  person pogibas    schedule 06.09.2017
comment
Это работает, спасибо!   -  person user2506086    schedule 07.09.2017
comment
Я просто переместил свой комментарий в ответ. Если это помогло решить вашу проблему, вы можете принять это, и мы можем закрыть этот вопрос, тогда   -  person pogibas    schedule 22.09.2017
comment
если мое решение помогло решить вашу проблему, вы можете принять ответ, и мы сможем закрыть вопрос :)   -  person pogibas    schedule 23.09.2017

Ответы (1)


arrow_upward
3
arrow_downward

У меня есть результаты, которые отличаются от ваших. Обратите внимание, что я изменил last_r, чтобы вернуть последний элемент, и использовал dplyr::last (потому что есть также data.table::last).

library(dplyr)
library(microbenchmark)
library(Rcpp)
n <- 5000
df <- data.frame(
  grp = factor(rep(1:n, 2)), 
  valn = rnorm(2L*n), 
  stringsAsFactors = FALSE
)

last_r <- function(x) {
  tail(x, 1)
}

cppFunction('double last_rcpp(NumericVector x) {
            int n = x.size();
            return x[n-1];
            }')

dplyr_num_last_element <- function() df %>% group_by(grp) %>% summarise(valn = dplyr::last(valn))
dplyr_num_last_element_r <- function() df %>% group_by(grp) %>% summarise(valn = last_r(valn))
dplyr_num_last_element_rcpp <- function() df %>% group_by(grp) %>% summarise(val = last_rcpp(valn))
tapply_num_last_element <- function() tapply(df$valn, df$grp, FUN = dplyr::last)
tapply_num_last_element_r <- function() tapply(df$valn, df$grp, FUN = last_r)
tapply_num_last_element_rcpp <- function() tapply(df$valn, df$grp, FUN = last_rcpp)


library(data.table) 
dt <- data.table(df)
DT_num_last_element_r <- function() {
  setkey(dt, grp)
  dt[, last_r(valn), grp]
}
microbenchmark(
  DT_num_last_element_r(), 
  dplyr_num_last_element(), 
  dplyr_num_last_element_r(), 
  dplyr_num_last_element_rcpp(), 
  tapply_num_last_element(), 
  tapply_num_last_element_r(), 
  tapply_num_last_element_rcpp(), 
  times = 20
)

Контрольный показатель:

Unit: milliseconds
                           expr        min        lq      mean    median        uq       max neval
        DT_num_last_element_r()  53.956258  55.76482  57.08700  57.33898  58.50556  59.03580    20
       dplyr_num_last_element() 224.289272 228.97531 235.87757 233.73353 237.56040 293.77219    20
     dplyr_num_last_element_r() 178.778382 182.11143 187.40303 184.34760 187.00788 246.64526    20
  dplyr_num_last_element_rcpp() 107.510245 109.64476 111.56974 112.50635 113.63999 114.92428    20
      tapply_num_last_element()  55.999728  58.68948  60.68782  59.78769  63.78408  66.06941    20
    tapply_num_last_element_r()  54.591615  57.31017  58.29962  58.16951  59.98568  63.08996    20
 tapply_num_last_element_rcpp()   9.558151  10.66994  14.76226  11.54004  12.64156  73.87743    20

Мои результаты более последовательны. Можете ли вы протестировать с этими небольшими изменениями?

Это в Windows 10, R 3.4.0 (включен JIT-компилятор).

person F. Privé    schedule 07.09.2017