Как эффективно переупорядочить буквы в строке в R?

Question

У меня есть следующая функция для переупорядочения букв в символьном векторе.

reorder_letter <- function(x){
  sapply(strsplit(x,split = ""),function(x) paste(sort(toupper(x)),collapse = ""))
}

reorder_letter(c("trErty","Bca","def"))
#> [1] "ERRTTY" "ABC"    "DEF"

^{Создано в 2020-04-29 пакетом Представления (v0.3.0)}

По сути, я хочу вернуть ту же букву символа, но в верхнем регистре и отсортированном порядке.

В настоящее время для запуска вектора длиной 1,5 миллиона требуется около 1 минуты.

РЕДАКТИРОВАТЬ: Я также пытался распараллелить, используя пакет future.apply, который в 3 раза быстрее, чем решение base R (также легко изменить текущий код)

reorder_letter <- function(x){
  future_sapply(strsplit(x,split = ""),function(x) paste(sort(toupper(x)),collapse = ""))
}

---

Мне просто интересно

1. как мне эффективно достичь своей цели?
2. как лучше всего найти узкое место функции? Например, у меня есть эта функция завершена. Какой следующий шаг?

Answer 1

Возможно utf8ToInt и intToUtf8 быстрее, чем strsplit и paste.

x <- c("trErty","Bca","def")
unlist(lapply(x, function(y) {intToUtf8(sort(utf8ToInt(toupper(y))))}))
#[1] "ERRTTY" "ABC"    "DEF"   

Время: (Это не быстрее ... извините)

Но stringi быстрее, а написание функции C ++ еще быстрее (и может быть улучшено, но уже в 10 раз быстрее).

FrankZhang <- function(x) {
  unlist(lapply(strsplit(toupper(x),NULL),function(x) paste(sort(x),collapse = "")))}
GKi <- function(x) {
  unlist(lapply(toupper(x), function(y) {intToUtf8(sort(utf8ToInt(y)))}))
}
library(stringi)
stringi <- function(y) {
  vapply(stri_split_boundaries(toupper(y), type = "character"), function(x) stri_c(x[stri_order(x)], collapse = ""), "")
}
library(Rcpp)
cppFunction("std::string GKiC(std::string &str) {
  std::sort(str.begin(), str.end());
  return(str);}")
GKi2 <- function(x) {unlist(lapply(toupper(x), GKiC))}

x <- apply(expand.grid(letters, LETTERS), 1, paste, collapse = "")
microbenchmark::microbenchmark(FrankZhang(x), GKi(x), stringi(x), GKi2(x), control=list(order="block"))
#Unit: milliseconds
#          expr       min        lq      mean    median        uq       max neval  cld
# FrankZhang(x) 17.533428 18.686879 20.380002 19.719311 21.014381 33.836692   100    d
#        GKi(x) 16.551358 17.665436 18.656223 18.271688 19.343088 23.225199   100   c 
#    stringi(x)  4.644196  4.844622  5.082298  5.011344  5.237714  7.355251   100  b  
#       GKi2(x)  1.527124  1.624337  1.997725  1.691099  2.242797  5.593543   100 a   

Чтобы узнать, что занимает много времени, вы можете использовать Rprof например:

reorder_letter <- function(x) { #Function
  sapply(strsplit(x,split = ""),function(x) paste(sort(toupper(x)),collapse = ""))}
x <- apply(expand.grid(letters, LETTERS, letters), 1, paste, collapse = "") #Data

Rprof()
y <- reorder_letter(x)
Rprof(NULL)
summaryRprof()
#$by.self
#               self.time self.pct total.time total.pct
#"FUN"               0.12    20.69       0.54     93.10
#"sort.int"          0.10    17.24       0.22     37.93
#"paste"             0.08    13.79       0.42     72.41
#"sort"              0.06    10.34       0.34     58.62
#"sort.default"      0.06    10.34       0.28     48.28
#"match.arg"         0.04     6.90       0.10     17.24
#"eval"              0.04     6.90       0.04      6.90
#"sapply"            0.02     3.45       0.58    100.00
#"lapply"            0.02     3.45       0.56     96.55
#".doSortWrap"       0.02     3.45       0.02      3.45
#"formals"           0.02     3.45       0.02      3.45
#
#$by.total
#                 total.time total.pct self.time self.pct
#"sapply"               0.58    100.00      0.02     3.45
#"reorder_letter"       0.58    100.00      0.00     0.00
#"lapply"               0.56     96.55      0.02     3.45
#"FUN"                  0.54     93.10      0.12    20.69
#"paste"                0.42     72.41      0.08    13.79
#"sort"                 0.34     58.62      0.06    10.34
#"sort.default"         0.28     48.28      0.06    10.34
#"sort.int"             0.22     37.93      0.10    17.24
#"match.arg"            0.10     17.24      0.04     6.90
#"eval"                 0.04      6.90      0.04     6.90
#".doSortWrap"          0.02      3.45      0.02     3.45
#"formals"              0.02      3.45      0.02     3.45
#
#$sample.interval
#[1] 0.02
#
#$sampling.time
#[1] 0.58