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


9

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?


1
Schauen Sie sich das Stringi-Paket an - es bietet eine Beschleunigung gegenüber der Basis. Die Antwort von Rich Scriven enthält weitere Details: stackoverflow.com/questions/5904797/…
user2474226

Die lettershaben nicht immer die Länge drei wie in Ihrem Beispiel, oder?
Jay.sf

Nein, die Länge der Saiten kann variieren.
Powege

Ich denke , dass das Hinzufügen fixed = TRUEin strsplit()kann die Leistung verbessern , da es nicht die Verwendung von Regex beteiligen.
tmfmnk

Antworten:


3

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


Was ist die Beschleunigung, wenn Sie die ursprüngliche Funktion parallel ausführen?
Slava-Kohut

um etwas mehr als 50% gesenkt. tmp <- strsplit(strings, split="") unlist(mclapply(tmp, function(i){ paste0(sort(i), collapse = "") }))
Carl Boneri

@ Gregor tut es. Gerade getestet und scheint zu?
Carl Boneri

Cool, nur nachschauen :)
Gregor Thomas

Nein, überhaupt nicht ... hatte selbst die gleiche Frage ... was bedeutet, dass ich den Hinweis, den ich in der Antwort zum Entfernen von NA / leer eingefügt habe, weglasse ... brauche ihn nicht. stringiist bei weitem mein Lieblingspaket Mann ...
Carl Boneri

4

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.


1
Ich denke, dies wird schneller enden als anwenden und nicht darauf angewiesen sein, leere Werte zu entfernen, wenn unterschiedliche Längen vorliegen. könnte jedoch vorschlagen, dass eine Schleife in die Liste aufgenommen wird?
Carl Boneri

1
Single Loop verbessert die Geschwindigkeit ein bisschen mehr, danke!
Gregor Thomas

ja Mann. das nervt mich aber immer noch. Ich habe das Gefühl, ich vermisse einen sehr offensichtlichen und einfacheren Weg, um diese ganze Sache zu machen ...
Carl Boneri

Ich meine, es wäre wahrscheinlich ziemlich einfach, eine RCPP-Funktion zu schreiben, die dies einfach macht und blitzschnell wäre. Ich denke, wir arbeiten innerhalb von R und beschränken uns darauf, diese Schritte grundsätzlich auszuführen.
Gregor Thomas

Das habe ich mir gedacht: C ++
Carl Boneri

1

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


Funktioniert nur, wenn die Länge aller Zeichenfolgen gleich ist. Schön und schnell!
Gregor Thomas
Durch die Nutzung unserer Website bestätigen Sie, dass Sie unsere Cookie-Richtlinie und Datenschutzrichtlinie gelesen und verstanden haben.
Licensed under cc by-sa 3.0 with attribution required.