return unique combinations of items R?

user_9059865 0
Viewed 118

Given multiple vectors I'd like to return the unique combinations of columns across the vectors. Here is an example that works but isn't as fast as computationally fast as I'd like:

library(dplyr)

c_sort_collapse <- function(...){
  c(...) %>% 
    sort() %>% 
    paste(collapse = ".")
}

unique_set <- function(...){
  list(...) %>% 
    purrr::pmap_chr(c_sort_collapse) %>% 
    unique()
}

unique_set(c("a", "b", "a"), c("a", "a", "b"))
#> [1] "a.a" "a.b"

Is there a way to do this that is faster / better vectorized, i.e. doesn't depend on looping through each item (like happens in the purrr::pmap_chr() step)?

purrr vector r unique
3 Answers

This solution only works when there is two vectors to combine, but is pretty fast. I took the liberty of giving other methods the advantage of stringi::stri_sort() which already is an order of magnitude faster.

library(dplyr)
library(stringi)

set.seed(123)
x <- sample(letters, 1000, replace = TRUE)

set.seed(12)
y <- sample(letters, 1000, replace = TRUE)

c_sort_collapse <- function(...){
  c(...) |> 
    stri_sort() |> 
    paste(collapse = ".")
}

unique_set <- function(...){
  list(...) |> 
    purrr::pmap_chr(c_sort_collapse) |> 
    unique()
}

unique_set_matrix <- function(...){
  matrix(c(...), nrow = length(list(...)), byrow = TRUE) |>
    apply(2, stri_sort) |>
    asplit(2) |>
    unique() |>
    sapply(paste, collapse = ".")
}

pminmax <- function(x, y) {
  paste(pmin.int(x, y), pmax.int(x, y), sep = ".") |> unique()
}

all.equal(sort(unique_set(x, y)), sort(pminmax(x, y)))
#> [1] TRUE

bench::mark(
  tidy = unique_set(x, y),
  matrix = unique_set_matrix(x, y),
  Map = Map(\(x,y) paste0(stri_sort(c(x,y)) , collapse = ".") , x , y) |>
    unique() |> unlist(FALSE, FALSE),
  pminmax = pminmax(x, y),
  iterations = 20, check = FALSE
)
#> # A tibble: 4 × 6
#>   expression      min   median `itr/sec` mem_alloc `gc/sec`
#>   <bch:expr> <bch:tm> <bch:tm>     <dbl> <bch:byt>    <dbl>
#> 1 tidy         6.13ms   6.24ms      160.    45.4KB     17.8
#> 2 matrix       5.18ms   5.55ms      168.   229.8KB     29.7
#> 3 Map           5.7ms   6.83ms      151.    33.4KB     16.7
#> 4 pminmax     484.6µs 487.85µs     2035.    49.6KB      0

Created on 2022-08-05 by the reprex package (v2.0.1)

user_113748270

We can use Base R Map function

library(stringi)

Map(\(x,y) paste0(stri_sort(c(x,y)) , collapse = ".") , x , y) |>
   unique() |> unlist()
  • output
[1] "a.a" "a.b"
  • data
x <- c("a", "b", "a")
y <- c("a", "a", "b")

Edited

I think using stri_sort from stringi library make good results in my microbenchmark tests , try it.

library(stringi)

x <- c("a", "b", "a")
y <- c("a", "a", "b")

microbenchmark::microbenchmark(
    tidy = unique_set(x, y),
    base = Map(\(x,y) paste0(stri_sort(c(x,y)) , collapse = ".") , x , y) |>
        unique() |> unlist(),
    times = 1000
)

#<============ Results ===============>#

Unit: microseconds
 expr    min      lq      mean   median       uq      max neval
 tidy 93.284 96.8405 102.09465 100.1805 103.4035  244.337  1000
 base 37.271 39.2190  44.15599  41.6520  43.5285 1860.692  1000
user_191983370

Here is another solution that works only for two vectors. It's based on fifelse from data.table package. I also compare with pminmax from @teunbrand solution:

library(data.table)

pminmax <- function(x, y) {
  paste(pmin.int(x, y), pmax.int(x, y), sep = ".") |> unique()
}

dtfifelse = function(x, y) {
  {idx=x<y; paste0(fifelse(idx, x, y), ".", fifelse(idx, y, x)) |> unique()}
}

compare = function(n) {
  set.seed(0123)
  # random sample of strings with up to 10 characters
  x = stringi::stri_rand_strings(n, sample(10, n, TRUE))   
  y = stringi::stri_rand_strings(n, sample(10, n, TRUE))   
  #
  bench::mark(
    pminmax = pminmax(x, y),
    dt_fifelse = dtfifelse(x, y),
    iterations = 5, 
    check = TRUE
  )[1:9]
}

compare(1e3)
# A tibble: 2 x 9
  expression      min   median `itr/sec` mem_alloc `gc/sec` n_itr  n_gc total_time
  <bch:expr> <bch:tm> <bch:tm>     <dbl> <bch:byt>    <dbl> <int> <dbl>   <bch:tm>
1 pminmax      1.99ms   2.03ms      468.    43.4KB        0     5     0    10.68ms
2 dt_fifelse   1.61ms   1.72ms      546.    47.4KB        0     5     0     9.16ms

compare(1e4)
# A tibble: 2 x 9
  expression      min   median `itr/sec` mem_alloc `gc/sec` n_itr  n_gc total_time
  <bch:expr> <bch:tm> <bch:tm>     <dbl> <bch:byt>    <dbl> <int> <dbl>   <bch:tm>
1 pminmax     10.42ms  11.03ms      89.6     480KB        0     5     0     55.8ms
2 dt_fifelse   8.16ms   8.34ms     120.      519KB        0     5     0     41.7ms

compare(1e5)
# A tibble: 2 x 9
  expression      min   median `itr/sec` mem_alloc `gc/sec` n_itr  n_gc total_time
  <bch:expr> <bch:tm> <bch:tm>     <dbl> <bch:byt>    <dbl> <int> <dbl>   <bch:tm>
1 pminmax       124ms    127ms      7.74    4.43MB     1.93     4     1      517ms
2 dt_fifelse    100ms    105ms      9.51    4.81MB     0        5     0      526ms

compare(1e6)
# A tibble: 2 x 9
  expression      min   median `itr/sec` mem_alloc `gc/sec` n_itr  n_gc total_time
  <bch:expr> <bch:tm> <bch:tm>     <dbl> <bch:byt>    <dbl> <int> <dbl>   <bch:tm>
1 pminmax       1.31s    1.34s     0.748    42.3MB     1.12     2     3      2.67s
2 dt_fifelse    1.07s    1.07s     0.932    46.1MB     1.40     2     3      2.15s
user_108488980
Related