Обеспечение уникальных значений в dplyr :: sumrize () наиболее эффективным способом - PullRequest
Новая
       29

Обеспечение уникальных значений в dplyr :: sumrize () наиболее эффективным способом

1 голос
/ 05 апреля 2019

У меня обычно есть тиббл с большим количеством столбцов типа 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 пакетом представлением (v0.2.1)

1 Ответ

1 голос
/ 05 апреля 2019

В большем наборе данных мы увидим некоторые изменения в тестах относительно 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 с paste увеличил эффективность с 1,68 до 1,44 (make_uniqueпротив make_unique_4)

...