Блог

Обычно у меня есть tibble с большим количеством столбцов типа character (от 20 до 30) и только 3-4 столбцами типа numeric .

Группировка и суммирование числовых столбцов выполняется очень быстро, но мой подход к суммированию символьных столбцов при одновременном обеспечении уникальных значений для каждого значения переменной группировки в целом довольно медленный.

Просто интересно, есть ли какой-нибудь более быстрый способ, чем использовать paste() для этого.

 library(magrittr)

make_unique <- function(x, sep = "-") {
  ifelse(length(x_unique <- unique(x)) == 1, x_unique,
    paste(sort(x_unique), collapse = sep))
}

make_unique_2 <- function(x, sep = "-") {
  paste(sort(x), collapse = sep)
}

df <- tibble::tribble(
  ~id, ~country, ~value,
  "a",   "A",   10,
  "a",   "B",   20,
  "b",   "A",   5,
  "c",   "A",   100,
  "c",   "B",   1,
  "c",   "C",   25
)

df %>%
  dplyr::group_by(id) %>%
  dplyr::summarise_if(is.character, make_unique) %>%
  dplyr::ungroup()
#> # A tibble: 3 x 2
#>   id    country
#>   <chr> <chr>  
#> 1 a     A-B    
#> 2 b     A      
#> 3 c     A-B-C

microbenchmark::microbenchmark(
  "numeric" = df %>%
    dplyr::group_by(id) %>%
    dplyr::summarise_if(is.numeric, sum) %>%
    dplyr::ungroup(),
  "character_1" = df %>%
    dplyr::group_by(id) %>%
    dplyr::summarise_if(is.character, make_unique) %>%
    dplyr::ungroup(),
  "character_2" = df %>%
    dplyr::group_by(id) %>%
    dplyr::summarise_if(is.character, make_unique_2) %>%
    dplyr::ungroup()
)
#> Unit: milliseconds
#>         expr    min      lq     mean  median      uq    max neval
#>      numeric 1.0554 1.24160 1.918480 1.43135 1.90180 8.7733   100
#>  character_1 1.1907 1.37530 2.093501 1.60895 2.04235 7.7648   100
#>  character_2 1.2255 1.44185 2.474062 1.69260 2.38540 9.4851   100
  

Создано 2019-04-05 пакетом reprex (версия 0.2.1)

На более крупном наборе данных мы увидим некоторые изменения в контрольных показателях в отношении make_unique_2

-новая функция

 make_unique_3 <- function(x, sep="-") {
  x_unique <- unique(x)
  if(length(x_unique) == 1) x_unique else paste(sort(x_unique), collapse= sep)
   }

make_unique_4 <- function(x, sep="-") {
   x_unique <- unique(x)
   if(n_distinct(x_unique) == 1) x_unique else str_c(sort(x_unique), collapse=sep)

 }
  

-данные

  df <- df[rep(1:nrow(df), 1e5), ]
  

-бенчмарк

 library(microbenchmark)
microbenchmark::microbenchmark(
   "numeric" = df %>%
     dplyr::group_by(id) %>%
     dplyr::summarise_if(is.numeric, sum) %>%
     dplyr::ungroup(),
   "character_1" = df %>%
     dplyr::group_by(id) %>%
     dplyr::summarise_if(is.character, make_unique) %>%
     dplyr::ungroup(),
   "character_2" = df %>%
     dplyr::group_by(id) %>%
     dplyr::summarise_if(is.character, make_unique_2) %>%
     dplyr::ungroup(),
     "character_3" = df %>%
       dplyr::group_by(id) %>%
       dplyr::summarise_if(is.character, make_unique_3) %>%
       dplyr::ungroup(),
       "character_4" = df %>%
         dplyr::group_by(id) %>%
         dplyr::summarise_if(is.character, make_unique_4) %>%
         dplyr::ungroup(),   
       unit = "relative", times = 10L
 )
  

-вывод

 #Unit: relative
#        expr      min       lq     mean   median       uq      max neval cld
#     numeric 1.000000 1.000000 1.000000 1.000000 1.000000 1.000000    10  a 
# character_1 1.681810 1.614818 1.625383 1.636651 1.616881 1.489384    10  a 
# character_2 7.668509 7.207077 7.117084 6.992513 6.102214 9.102668    10   b
# character_3 1.671742 1.618976 1.632336 1.710828 1.587933 1.501431    10  a 
# character_4 1.444589 1.435881 1.504313 1.562996 1.515468 1.479626    10  a 
  

-комментарии

переход на str_c from paste повысил эффективность с 1,68 до 1,44 ( make_unique по make_unique_4 сравнению)