Làm thế nào để sắp xếp hiệu quả các ký tự trong một chuỗi trong R?

Làm thế nào tôi có thể sắp xếp hiệu quả các ký tự của mỗi chuỗi trong một vectơ? Ví dụ, đưa ra một vectơ của chuỗi:

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

Tôi đã viết một hàm sẽ chia mỗi chuỗi thành một vectơ, sắp xếp vectơ và sau đó thu gọn đầu ra:

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)

Tuy nhiên, vectơ của chuỗi tôi cần áp dụng điều này rất dài và chức năng này quá chậm. Có ai có bất kỳ đề nghị cho làm thế nào để cải thiện hiệu suất?

Bạn có thể giảm thời gian bằng cách giảm thiểu số lượng vòng lặp cho chắc chắn, và làm như vậy bằng cách sử dụng parallelgói ... cách tiếp cận của tôi sẽ được chia chuỗi một lần, sau đó trong sắp xếp vòng lặp và dá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

Rung như 4 giây, nhưng nó vẫn không nhanh như vậy ...

Biên tập

Được rồi, sử dụng apply.. chiến lược ở đây:

1) trích xuất các chữ cái thay vì phân chia ranh giới 2) tạo ma trận với kết quả 3) lặp qua hàng thông minh 4) Sắp xếp 5) Tham gia

Bạn tránh nhiều vòng lặp và không niêm yết .... IGNORE : ? Hãy cẩn thận nếu các chuỗi có độ dài khác nhau, bạn sẽ cần xóa bất kỳ khoảng trống hoặc NA nào trong phạm vi applynhư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

Đưa chúng tôi từ 10,3 giây đến 3,98

Việc thực hiện lại bằng cách sử dụng stringicho tốc độ tăng gấp 4 lần. Tôi cũng thay đổi nội dung sort_catđể sử dụng fixed = TRUEtrong strsplit, mà làm cho nó một chút nhanh hơn. Và cảm ơn Carl vì gợi ý vòng lặp đơn, giúp chúng tôi tăng thêm một chút nữa.

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>

Phương pháp này cũng có thể được sử dụng song song. Cấu hình mã để xem hoạt động nào thực sự mất nhiều thời gian nhất sẽ là bước tiếp theo tốt nếu bạn muốn đi nhanh hơn nữa.

Phiên bản này nhanh hơn một chút

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

Nhưng tôi nghĩ nó có thể được tối ưu hóa