วิธีการจัดเรียงอักขระอย่างมีประสิทธิภาพในสตริงใน R?

ฉันจะจัดเรียงอักขระของแต่ละสตริงอย่างมีประสิทธิภาพได้อย่างไรในเวกเตอร์ ตัวอย่างเช่นกำหนดเวกเตอร์ของสตริง:

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)

อย่างไรก็ตามเวกเตอร์ของสตริงที่ฉันต้องการใช้กับมันยาวมากและฟังก์ชั่นนี้ช้าเกินไป ไม่มีใครมีคำแนะนำสำหรับวิธีการปรับปรุงประสิทธิภาพหรือไม่

คุณสามารถลดเวลาได้โดยการลดจำนวนลูปให้น้อยที่สุดและทำอย่างนั้นต่อไปโดยใช้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:? caveat คือถ้าสายยาวแตกต่างกันคุณจะต้องลบใด ๆ ที่ว่างเปล่าหรือ 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

การใช้งานซ้ำอีกครั้งstringiจะช่วยเพิ่มความเร็วได้ประมาณ 4x ฉันยังแก้ไข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>

วิธีนี้ยังสามารถใช้ในแบบคู่ขนาน การทำโปรไฟล์รหัสเพื่อดูว่าการดำเนินการใดที่ใช้เวลานานที่สุดจะเป็นขั้นตอนต่อไปที่ดีถ้าคุณต้องการที่จะทำงานได้เร็วขึ้น

รุ่นนี้เร็วขึ้นเล็กน้อย

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

แต่ฉันคิดว่ามันอาจจะเหมาะสมที่สุด