summarize_across.() is slower than dtplyr about tidytable HOT 11 CLOSED

library(bench)
library(data.table)
library(dtplyr)
library(dplyr)
library(tidytable)
library(ggplot2)

diamonds2 <- lazy_dt(diamonds)
dt <- as.data.table(diamonds)

tidytable_func <- function() {
  dt %>%
    summarize_across.(c(depth, table, price, carat), 
                      mean,
                      by = c(cut, color, clarity))
}

dplyr_func <- function() {
  diamonds %>% 
    group_by(cut, color, clarity) %>% 
    summarise_at(vars(depth, table, price, carat), mean)
  
}

dplyr_acr_func <- function() {
  diamonds %>% 
    group_by(cut, color, clarity) %>% 
    summarise(across(c(depth, table, price, carat), mean))
  
}

dtplyr_func <- function() {
  diamonds2 %>% 
    group_by(cut, color, clarity) %>% 
    summarise_at(vars(depth, table, price, carat), mean) %>% 
    as_tibble()
}

cols <- c("depth", "table", "price", "carat")

dt_func <- function() {
  dt[ 
    , lapply(.SD, mean)
    , by = .(cut, color, clarity)
    , .SDcols = cols]
}

bench::mark(
  dplyr_func(),
  dplyr_acr_func(),
  dtplyr_func(),
  tidytable_func(),
  dt_func(),
  check = FALSE, iterations = 30, time_unit = 'ms'
)

#> # A tibble: 5 x 6
#>   expression          min median `itr/sec` mem_alloc `gc/sec`
#>   <bch:expr>        <dbl>  <dbl>     <dbl> <bch:byt>    <dbl>
#> 1 dplyr_func()      17.0   19.2      51.0     9.49MB    18.7 
#> 2 dplyr_acr_func() 187.   207.        4.59    2.92MB    17.3 
#> 3 dtplyr_func()      5.98   7.54    131.      3.52MB     8.73
#> 4 tidytable_func()  17.5   20.9      46.0     7.94MB    19.9 
#> 5 dt_func()          2.57   3.03    308.      1.54MB    20.5

map.(c(1,2,3), ~ .x + 1)

library(data.table)
library(tidytable)
library(ggplot2)
library(rlang)

dt <- as.data.table(diamonds)

cols <- c("depth", "table", "price", "carat")
by <- c("cut", "color", "clarity")

bench::mark(lapply = dt[, lapply(.SD, mean), .SDcols = cols, by = by],
            map = dt[, map.(.SD, mean), .SDcols = cols, by = by],
            as_fn = dt[, lapply(.SD, as_function(mean)), .SDcols = cols, by = by],
            lapply_base = dt[, lapply(.SD, base::mean), .SDcols = cols, by = by],
            check = FALSE, iterations = 30)
#> # A tibble: 4 x 6
#>   expression       min   median `itr/sec` mem_alloc `gc/sec`
#>   <bch:expr>  <bch:tm> <bch:tm>     <dbl> <bch:byt>    <dbl>
#> 1 lapply         2.6ms   3.31ms     291.     3.11MB    10.0 
#> 2 map          10.52ms   12.1ms      82.0    4.87MB    20.5 
#> 3 as_fn         6.55ms   7.19ms     138.   319.36KB     9.88
#> 4 lapply_base  10.91ms  11.47ms      85.7  319.36KB    21.4

pacman::p_load(bench, data.table, tidytable, dtplyr, dplyr, ggplot2)

diamonds_tbl <- as_tibble(ggplot2::diamonds)
diamonds_dt <- as_tidytable(diamonds_tbl)
diamonds_lazy <- lazy_dt(diamonds_dt)

tidytable_func <- function() {
  diamonds_dt %>%
    summarize_across.(c(depth, table, price, carat), 
                      mean,
                      by = c(cut, color, clarity))
}

dplyr_func <- function() {
  diamonds_tbl %>% 
    group_by(cut, color, clarity) %>% 
    summarise_at(vars(depth, table, price, carat), mean)
  
}

dtplyr_func <- function() {
  diamonds_lazy %>% 
    group_by(cut, color, clarity) %>% 
    summarise_at(vars(depth, table, price, carat), mean) %>% 
    as_tibble()
}

cols <- c("depth", "table", "price", "carat")

dt_func <- function() {
  diamonds_dt[ 
    , lapply(.SD, mean)
    , by = .(cut, color, clarity)
    , .SDcols = cols]
}

bench::mark(
  dplyr_func(),
  dtplyr_func(),
  tidytable_func(),
  dt_func(),
  check = FALSE, iterations = 30, time_unit = 'ms'
)
#> # A tibble: 4 x 6
#>   expression         min median `itr/sec` mem_alloc `gc/sec`
#>   <bch:expr>       <dbl>  <dbl>     <dbl> <bch:byt>    <dbl>
#> 1 dplyr_func()     16.9   17.7       55.1     9.3MB     20.0
#> 2 dtplyr_func()     7.49   7.78     123.     3.52MB     13.6
#> 3 tidytable_func()  9.97  10.7       91.9  418.75KB     23.0
#> 4 dt_func()         2.41   2.86     336.     1.54MB     11.6

pacman::p_load(bench, data.table, tidytable, ggplot2)

diamonds_dt <- ggplot2::diamonds %>%
  mutate_across.(where(is.factor), as.character) %>%
  replicate(10, ., simplify = FALSE) %>%
  bind_rows.()

cols <- c("depth", "table", "price", "carat")

normal_fn <- function() {
  diamonds_dt[ 
    , lapply(.SD, mean)
    , by = .(cut, color, clarity)
    , .SDcols = cols]
}

# Create a simple alias for mean
fn <- mean

alias_fn <- function() {
  diamonds_dt[ 
    , lapply(.SD, fn)
    , by = .(cut, color, clarity)
    , .SDcols = cols]
}

bench::mark(
  normal_fn(),
  alias_fn(),
  check = FALSE, iterations = 30, time_unit = 'ms'
)
#> # A tibble: 2 x 6
#>   expression    min median `itr/sec` mem_alloc `gc/sec`
#>   <bch:expr>  <dbl>  <dbl>     <dbl> <bch:byt>    <dbl>
#> 1 normal_fn()  27.0   30.9      31.1   14.85MB    18.0 
#> 2 alias_fn()   35.6   37.9      25.8    2.54MB     1.84

mutate_if. <- function(.data, .predicate, .funs, ..., by = NULL) {

  mutate_across.(.data, where(.predicate), .funs, ..., by = {{by}})

}

mutate_all. <- function(.data, .funs, ..., by = NULL) {

  mutate_across.(.data, everything(), .funs, ..., by = {{by}})

}