Wie können die Zeichen in einer Zeichenfolge in R effizient sortiert werden?

Wie kann ich die Zeichen jeder Zeichenfolge in einem Vektor effizient sortieren? Beispiel: Geben Sie einen Vektor von Zeichenfolgen an:

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

Ich habe eine Funktion geschrieben, die jede Zeichenfolge in einen Vektor aufteilt, den Vektor sortiert und dann die Ausgabe reduziert:

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)

Der Vektor der Zeichenfolgen, auf den ich dies anwenden muss, ist jedoch sehr lang und diese Funktion ist zu langsam. Hat jemand Vorschläge zur Verbesserung der Leistung?

Sie können die Zeit verkürzen, indem Sie die Anzahl der Schleifen sicher minimieren, und dies auch mithilfe des parallelPakets. Mein Ansatz wäre, Zeichenfolgen einmal zu teilen und dann in der Schleife zu sortieren und einzufügen:

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

Rasiert sich wie 4 Sekunden, aber es ist immer noch nicht so schnell ...

Bearbeiten

Okay, ich habe es mit der applyStrategie hier geschafft:

1) Buchstaben extrahieren anstatt Grenzen zu teilen 2) eine Matrix mit den Ergebnissen erstellen 3) zeilenweise durchlaufen 4) sortieren 5) verbinden

Sie vermeiden , mehrere Schleifen und Entadressierung .... IGNORE: ? Nachteil ist , wenn Strings unterschiedlicher Länge, werden Sie eine leere oder NA im entfernen müssen apply, wiei[!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

Bringt uns von 10,3 Sekunden auf 3,98

Eine erneute Implementierung mit stringiführt zu einer ungefähr 4-fachen Beschleunigung. Ich habe auch bearbeitet sort_cat, um fixed = TRUEin der zu verwenden strsplit, was es ein wenig schneller macht. Und danke an Carl für den Single-Loop-Vorschlag, der uns ein bisschen mehr beschleunigt.

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>

Diese Methode könnte auch parallel angewendet werden. Das Profilieren des Codes, um festzustellen, welche Vorgänge tatsächlich am längsten dauern, ist ein guter nächster Schritt, wenn Sie noch schneller arbeiten möchten.

Diese Version ist etwas schneller

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

Aber ich denke, es könnte optimiert werden