能否更正我在R中使用的paste0（），使此函数的运行速度与原始Python示例一样快？

我正在尝试使用最近发现的一些R代码，这些代码模仿Python编写的部分代码；特别是，我正在努力找出正确的方法来实现R中的

edit2

功能：

def拆分（字）：
return[（word[：i]，word[i:]
对于范围内的i（len（word）+1）]
def edits1（word）：
成对=拆分（字）
deletes=[a+b[1:]表示（a，b），如果b]
如果len（b）>1，则成对（a，b）的转置=[a+b[1]+b[0]+b[2:]
在字母表中，如果b为c，则成对替换（a，b）的=[a+c+b[1:]
inserts=[a+c+b表示（a，b）成对表示字母表中的c]
返回集（删除+转置+替换+插入）
def edits2（word）：
返回集（edits1（word）中e1的e2用于edits1（e1）中e2的e2）

然而，在我的基准测试中，似乎使用stringr中的

paste0

（或

str_c

，或stringi中的

stri_join

）在R中生成数千个小字符串会导致代码比Norvig显示的Python实现慢大约10倍（或~100倍，或~50倍）。（是的，有趣的是，基于stringr和stringi的函数甚至比使用

paste0

还要慢）我的问题是（我想解决的主要问题是#3）：

我这样做是否正确（代码是否“正确”）

如果是这样的话，这是R（非常慢的字符串连接）的一个已知问题吗

我能做些什么来让这个显著地更快（至少一个或多个数量级），而无需在Rcpp11或类似的东西中重写整个函数

这是我为

edit2

功能准备的R代码：

# 1. generate a list of all binary splits of a word
binary.splits <- function(w) {
  n <- nchar(w)
  lapply(0:n, function(x)
         c(stri_sub(w, 0, x), stri_sub(w, x + 1, n)))
}

# 2. generate a list of all bigrams for a word
bigram.unsafe <- function(word)
  sapply(2:nchar(word), function(i) substr(word, i-1, i))
bigram <- function(word)
  if (nchar(word) > 1) bigram.unsafe(word) else word

# 3. four edit types: deletion, transposition, replacement, and insertion
alphabet = letters
deletions <- function(splits) if (length(splits) > 1) {
   sapply(1:(length(splits)-1), function(i)
          paste0(splits[[i]][1], splits[[i+1]][2]), simplify=FALSE) 
} else {
    splits[[1]][2]
}   
transpositions <- function(splits) if (length(splits) > 2) {
  swaps <- rev(bigram.unsafe(stri_reverse(splits[[1]][2])))
  sapply(1:length(swaps), function(i)
         paste0(splits[[i]][1], swaps[i], splits[[i+2]][2]), simplify=FALSE)
} else {
  stri_reverse(splits[[1]][2])
} 
replacements <- function(splits) if (length(splits) > 1) {
  sapply(1:(length(splits)-1), function(i)
         lapply(alphabet, function(symbol)
                paste0(splits[[i]][1], symbol, splits[[i+1]][2])))
} else {
  alphabet
} 
insertions <- function(splits)
  sapply(splits, function(pair)
         lapply(alphabet, function(symbol)
                paste0(pair[1], symbol, pair[2]))) 

# 4. create a vector of all words at edit distance 1 given the input word
edit.1 <- function(word) {
  splits <- binary.splits(word)
  unique(unlist(c(deletions(splits),
                  transpositions(splits),
                  replacements(splits),
                  insertions(splits))))
}

# 5. create a simple function to generate all words of edit distance 1 and 2
edit.2 <- function(word) { 
  e1 <- edit.1(word)
  unique(c(unlist(lapply(e1, edit.1)), e1))
} 

在我的Core i5 MacBook Air上，这大约需要8秒，而相应的Python基准测试（运行相应的

edit2

函数20次）大约需要0.6秒，即大约快10-15倍

我曾尝试使用

expand.grid

来摆脱内部的

lappy

，但这使代码速度变慢，而不是变快。我知道用

lappy

代替

sapply

可以让我的代码更快一点，但我不认为用“错误”函数（我想要一个向量返回）来实现小的减速有什么意义。但是，在纯R中，生成

edit.2

函数的结果可能要快得多？

R的paste0与python的''相比的性能 最初的标题询问R中的paste0是否比python中的字符串连接慢10倍。如果是的话，那么就没有希望编写一个在R中严重依赖字符串连接的算法，该算法与相应的python算法一样快

我有

> R.version.string
[1] "R version 3.1.0 Patched (2014-05-31 r65803)"

及

这是第一个比较

> library(microbenchmark)
> microbenchmark(paste0("a", "b"), times=1e6)
Unit: nanoseconds
             expr min   lq median   uq      max neval
 paste0("a", "b") 951 1071   1162 1293 21794972 1e+06

> x = y = sample(LETTERS, 1e7, TRUE); system.time(z <- paste0(x, y))
   user  system elapsed 
  1.479   0.009   1.488 

（所有重复大约1s）与

我猜这就是原始海报观察到的10倍性能差异。 然而，R在向量上工作得更好，并且该算法涉及向量 不管怎么说，我们可能对比较感兴趣

> library(microbenchmark)
> microbenchmark(paste0("a", "b"), times=1e6)
Unit: nanoseconds
             expr min   lq median   uq      max neval
 paste0("a", "b") 951 1071   1162 1293 21794972 1e+06

> x = y = sample(LETTERS, 1e7, TRUE); system.time(z <- paste0(x, y))
   user  system elapsed 
  1.479   0.009   1.488 

这表明，如果我们的R算法 运行速度为python的1/4；OP发现了10倍的优势 不同，所以看起来有改进的余地

R迭代与矢量化 OP使用迭代（

lappy

和friends），而不是矢量化。我们可以将向量版本与各种迭代方法进行比较，如下所示

f0 = paste0

f1 = function(x, y) 
   vapply(seq_along(x), function(i, x, y) paste0(x[i], y[i]), character(1), x, y)

f2 = function(x, y) Map(paste0, x, y)

f3 = function(x, y) {
    z = character(length(x))
    for (i in seq_along(x)) 
        z[i] = paste0(x[i], y[i])
    z 
}

f3c = compiler::cmpfun(f3)    # explicitly compile

f4 = function(x, y) {
    z = character()
    for (i in seq_along(x)) 
        z[i] = paste0(x[i], y[i])
    z 
}

向后缩放数据，将“矢量化”解决方案定义为f0，以及 比较这些方法

> x = y = sample(LETTERS, 100000, TRUE)
> library(microbenchmark)
> microbenchmark(f0(x, y), f1(x, y), f2(x, y), f3(x, y), f3c(x, y), times=5)
Unit: milliseconds
      expr       min        lq    median        uq       max neval
  f0(x, y)  14.69877  14.70235  14.75409  14.98777  15.14739     5
  f1(x, y) 241.34212 250.19018 268.21613 279.01582 292.21065     5
  f2(x, y) 198.74594 199.07489 214.79558 229.50684 271.77853     5
  f3(x, y) 250.64388 251.88353 256.09757 280.04688 296.29095     5
 f3c(x, y) 174.15546 175.46522 200.09589 201.18543 214.18290     5

由于

f4

速度太慢，无法包含

> system.time(f4(x, y))
   user  system elapsed 
 24.325   0.000  24.330 

因此，从这一点可以看出Tierney博士的建议，对那些

lappy

调用进行向量化可能有好处

进一步矢量化更新后的原始帖子 @fnl通过部分展开循环采用了原始代码。还有更多同样的机会，例如

replacements <- function(splits) if (length(splits$left) > 1) {
  lapply(1:(length(splits$left)-1), function(i)
         paste0(splits$left[i], alphabet, splits$right[i+1]))
} else {
  splits$right[1]
}

OP显示他们的原始版本比原始版本慢10倍 python，并且他们最初的修改产生了一个5x 加速。我们获得了1.2倍的加速，因此我们可能在

---

使用R的paste0的算法的预期性能。下一步是询问替代算法或实现是否更具性能，特别是

substr

可能更具前景。

遵循@LukeTierney在问题中关于向量化

paste0

调用和返回两个向量

二进制.splits

的提示，我编辑了要正确矢量化的函数。我还添加了@MartinMorgan在其回答中描述的附加修改：使用单个后缀而不是选择范围删除项目（即，

“[-1]”“

而不是

”[2:n]”“

，等等；但是注意：对于多个后缀，如

换位中使用的，这实际上较慢），尤其是，使用
rep
进一步矢量化
paste0
调用
replacements
和
insertions

这就产生了最好的答案（到目前为止？）在R中实现
edit.2
（谢谢你，Luke和Martin！）。换句话说，根据Luke提供的主要提示和Martin随后的一些改进，R实现的速度大约是Python的一半（但请参见Martin在下面的回答中的最后评论）。（如上图所示，
edit.1
、
edit.2
和
bigram.unsafe
功能保持不变。）

binary.splits我可以用类似于
x=y=sample（字母，1e7，TRUE）的东西来回答标题的R部分；system.time（粘贴（x，y））
我如何衡量python中的等价物？既然您似乎愿意至少尝试使用
stringi
包，那么您是否有理由将答案限制在纯R（许多/大部分
stringi
有趣的东西）上
> system.time(f4(x, y))
   user  system elapsed 
 24.325   0.000  24.330 

replacements <- function(splits) if (length(splits$left) > 1) {
  lapply(1:(length(splits$left)-1), function(i)
         paste0(splits$left[i], alphabet, splits$right[i+1]))
} else {
  splits$right[1]
}

replacements1 <- function(splits) if (length(splits$left) > 1) {
    len <- length(splits$left)
    paste0(splits$left[-len], rep(alphabet, each = len - 1), splits$right[-1])
} else {
  splits$right[1]
}

deletions1 <- function(splits) if (length(splits$left) > 1) {
  paste0(splits$left[-length(splits$left)], splits$right[-1])
} else {
  splits$right[1]
}

insertions1 <- function(splits)
    paste0(splits$left, rep(alphabet, each=length(splits$left)), splits$right)

edit.1.1 <- function(word) {
  splits <- binary.splits(word)
  unique(c(deletions1(splits),
           transpositions(splits),
           replacements1(splits),
           insertions1(splits)))
}

> identical(sort(edit.1("word")), sort(edit.1.1("word")))
[1] TRUE
> microbenchmark(edit.1("word"), edit.1.1("word"))
Unit: microseconds
             expr     min       lq   median       uq     max neval
   edit.1("word") 354.125 358.7635 362.5260 372.9185 521.337   100
 edit.1.1("word") 296.575 298.9830 300.8305 307.3725 369.419   100

binary.splits <- function(w) {
  n <- nchar(w)
  list(left=stri_sub(w, rep(0, n + 1), 0:n),
       right=stri_sub(w, 1:(n + 1), rep(n, n + 1)))
}

deletions <- function(splits) {
  n <- length(splits$left)
  if (n > 1) paste0(splits$left[-n], splits$right[-1])
  else splits$right[1]
}
transpositions <- function(splits) if (length(splits$left) > 2) {
  swaps <- rev(bigram.unsafe(stri_reverse(splits$right[1])))
  paste0(splits$left[1:length(swaps)], swaps,
         splits$right[3:length(splits$right)])
} else {
  stri_reverse(splits$right[1])
}
replacements <- function(splits) {
  n <- length(splits$left)
  if (n > 1) paste0(splits$left[-n],
                    rep(alphabet, each=n-1),
                    splits$right[-1])
  else alphabet
}
insertions <- function(splits)
  paste0(splits$left,
         rep(alphabet, each=length(splits$left)),
         splits$right)