R'deki bir dizedeki karakterleri verimli bir şekilde nasıl sıralayabilirim?

Bir vektördeki her dizenin karakterlerini nasıl verimli bir şekilde sıralayabilirim? Örneğin, dizelerin bir vektörü verildiğinde:

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)))

Her dizeyi bir vektöre bölmek, vektör sıralamak ve daha sonra çıktı daraltmak bir işlev yazdım:

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)

Ancak, bunu uygulamak için gereken dizeleri vektörü çok uzun ve bu işlev çok yavaş. Performansı nasıl artıracağına dair herhangi bir önerisi olan var mı?

Kesinlikle döngü sayısını en aza indirerek zamanı azaltabilir ve daha sonra parallelpaketi kullanarak yapabilirsiniz ... yaklaşımım dizeleri bir kez, sonra döngü sıralamasında yapıştırın:

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 saniye gibi tıraş olur, ama yine de o kadar hızlı değil ...

Düzenle

Tamam apply.. burada strateji kullanarak aşağı indi :

1) bölünmüş sınırlar yerine harfleri ayıklayın 2) sonuçlarla bir matris oluşturun 3) satır boyunca yineleme 4) Sırala 5)

Birden fazla döngü ve listeden kaçınmak .... IGNORE:? Uyarı dizeleri farklı uzunluklarda ise, applygibi boş veya NA kaldırmanız gerekiri[!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

Bizi 10,3 saniyeden 3,98'e götürür

Kullanarak yeniden uygulamak stringikabaca 4 kat hızlanır. Ben de düzenlenebilir sort_catkullanımına fixed = TRUEiçinde strsplitbir o yapar, biraz daha hızlı. Bizi biraz daha hızlandıran tek döngü önerisi için Carl'a teşekkürler.

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>

Bu yöntem paralel olarak da kullanılabilir. Daha hızlı gitmek istiyorsanız, hangi işlemlerin gerçekten en uzun sürdüğünü görmek için kodu profillemek iyi bir sonraki adım olacaktır.

Bu sürüm biraz daha hızlı

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])
}

Ama bence optimize edilebilir