Как эффективно отсортировать символы в строке в R?

Question

Как я могу эффективно отсортировать символы каждой строки в векторе? Например, учитывая вектор строк:

set.seed(1)
strings <- c(do.call(paste0, replicate(4, sample(LETTERS, 10000, TRUE), FALSE)),
do.call(paste0, replicate(3, sample(LETTERS, 10000, TRUE), FALSE)),
do.call(paste0, replicate(2, sample(LETTERS, 10000, TRUE), FALSE)))

Я написал функцию, которая будет разбивать каждую строку на вектор, сортировать вектор, а затем свернуть вывод:

sort_cat <- function(strings){
  tmp <- strsplit(strings, split="")
  tmp <- lapply(tmp, sort)
  tmp <- lapply(tmp, paste0, collapse = "")
  tmp <- unlist(tmp)
  return(tmp)
}
sorted_strings <- sort_cat(strings)

Однако вектор строк, к которым мне нужно применить это, очень длинный, и эта функция слишком медленная. У кого-нибудь есть предложения по улучшению производительности?

Answer 1

Повторная реализация с использованием stringi дает примерно 4-кратное ускорение. Я также отредактировал sort_cat, чтобы использовать fixed = TRUE в strsplit, что делает его немного быстрее. И спасибо Карлу за предложение одного цикла, которое ускоряет нас немного больше.

sort_cat <- function(strings){
  tmp <- strsplit(strings, split="", fixed = TRUE)
  tmp <- lapply(tmp, sort)
  tmp <- lapply(tmp, paste0, collapse = "")
  tmp <- unlist(tmp)
  return(tmp)
}

library(stringi)
sort_stringi = function(s) {
  s = stri_split_boundaries(s, type = "character")
  s = lapply(s, stri_sort)
  s = lapply(s, stri_join, collapse = "")
  unlist(s)
}

sort_stringi_loop = function(s) {
  s = stri_split_boundaries(s, type = "character")
  for (i in seq_along(s)) {
    s[[i]] = stri_join(stri_sort(s[[i]]), collapse = "")
  }
  unlist(s)
}

bench::mark(
  sort_cat(strings),
  sort_stringi(strings),
  sort_stringi_loop(strings)
)
# # A tibble: 3 x 13
#   expression                    min median `itr/sec` mem_alloc `gc/sec` n_itr  n_gc total_time result memory
#   <bch:expr>                 <bch:> <bch:>     <dbl> <bch:byt>    <dbl> <int> <dbl>   <bch:tm> <list> <list>
# 1 sort_cat(strings)          23.01s 23.01s    0.0435    31.2MB     2.17     1    50     23.01s <chr ~ <Rpro~
# 2 sort_stringi(strings)       6.16s  6.16s    0.162     30.5MB     2.11     1    13      6.16s <chr ~ <Rpro~
# 3 sort_stringi_loop(strings)  5.75s  5.75s    0.174     15.3MB     1.74     1    10      5.75s <chr ~ <Rpro~
# # ... with 2 more variables: time <list>, gc <list>

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

Answer 2

Вы можете сократить время, минимизировав количество циклов, и в дальнейшем сделайте это, используя пакет parallel ... Мой подход заключается в разбиении строк один раз, затем в цикле сортировка и вставка:

sort_cat <- function(strings){
    tmp <- strsplit(strings, split="")
    tmp <- lapply(tmp, sort)
    tmp <- lapply(tmp, paste0, collapse = "")
    tmp <- unlist(tmp)
    return(tmp)
}

sort_cat2 <- function(strings){
    unlist(mcMap(function(i){
        stri_join(sort(i), collapse = "")
    }, stri_split_regex(strings, "|", omit_empty = TRUE, simplify = F), mc.cores = 8L))
}

> microbenchmark::microbenchmark(
+     old = sort_cat(strings[1:500000]),
+     new = sort_cat2(strings[1:500000]),
+     times = 1
+ )
Unit: seconds
 expr        min         lq       mean     median         uq        max neval
  old 9.62673395 9.62673395 9.62673395 9.62673395 9.62673395 9.62673395     1
  new 5.10547437 5.10547437 5.10547437 5.10547437 5.10547437 5.10547437     1

Бреется, как 4 секунды, но все еще не так быстро ...

Редактировать

Хорошо, теперь все в порядке, используя стратегию apply ..:

1) извлекать буквы, а не разбивать границы 2) создавать матрицу с результатами 3) перебирать по строкам 4) сортировать 5) объединять

Вы избегаете многократных циклов и списков ... IGNORE: ? Предостережение: если строки различной длины, вам необходимо удалить все пустые или NA в пределах apply, такие как i[!is.na(i) && nchar(i) > 0]

sort_cat3 <- function(strings){
    apply(stri_extract_all_regex(strings, "\\p{L}", simplify = TRUE), 1, function(i){
        stri_join(stri_sort(i), collapse = "")
    })
}

> microbenchmark::microbenchmark(
+     old = sort_cat(strings[1:500000]),
+     mapping = sort_cat2(strings[1:500000]),
+     applying = sort_cat3(strings[1:500000]),
+     times = 1
+ )
Unit: seconds
     expr         min          lq        mean      median          uq         max neval
      old 10.35101934 10.35101934 10.35101934 10.35101934 10.35101934 10.35101934     1
  mapping  5.12771799  5.12771799  5.12771799  5.12771799  5.12771799  5.12771799     1
 applying  3.97775326  3.97775326  3.97775326  3.97775326  3.97775326  3.97775326     1

Занимает у нас от 10,3 с до 3,98

Answer 3

Эта версия немного быстрее

sort_cat2=function(strings){
A=matrix(unlist(strsplit(strings,split="")),ncol=3,byrow=TRUE)
B=t(apply(A,1,sort))
paste0(B[,1],B[,2],B[,3])
}

Но я думаю, что она может быть оптимизирована