Question

我正在编写一些更大的ML脚本来检测数据库中的同义词和缩写。单词相似性的度量之一是两个字符串中的首字母匹配多少。所以我有2个载体：

v1 <- c("rejtan", "reiki","rejon")
v2 <- c("rejtan", "rejtan", "beiki")

我希望得到这个结果（来自匹配单词开头的字母的百分比）：

       rejtan     reiki rejon
rejtan      1 0.3333333   0.5
rejtan      1 0.3333333   0.5
beiki       0 0.0000000   0.0

我想出了这个功能：

count.first.character.matches <- function(vec1,vec2) { 
  sapply(X = vec1 , FUN= function(x) {
    sapply(X = vec2, FUN = function(y) {
      ny <- nchar(y)
      nx <- nchar(x)
      shorter_length <- ifelse(nx > ny, nx, ny)
      matches <- sum(sapply( 1:shorter_length, FUN=function(i,x,y) {  substr(x,1,i) == substr(y,1,i)}, x,y ))
      matches / shorter_length
    })
  })

我的问题是：如何才能提高这个功能的性能？我有65K的向量对，每个700-1K字，所以我最终计算这个度量很多，根据Rprof，这需要约。 25％的时间。

Answer 1

按原样使用您的方法，您可以更改一些内容以提高效率。

1）nchar是一个函数，与length不同，它必须计算其参数的字符数而不是属性。你为＆＃34; v2＆＃34;重新计算nchar为每一个＆＃34; v1＆＃34;但是，nchar对于＆＃34; v1＆＃34;每个＆＃34; v2＆＃34;。您可以将nchar(x)置于第二个sapply之外，或者更好地利用nchar的向量化特性，并在任何sapply之前和之前计算所有内容。特别是，

x = replicate(1e3, paste0(sample(letters, sample(4:10, 1), TRUE), collapse = "")) 
y = replicate(1e3, paste0(sample(letters, sample(4:10, 1), TRUE), collapse = ""))

而不是

system.time({
    nx = nchar(x)
    ny = nchar(y)
})
#user  system elapsed 
#   0       0       0

你使用

system.time({
sapply(x, function(X) 
            sapply(y, function(Y) {
                        nX = nchar(X)
                        nY = nchar(Y)
                      }))
})  
#user  system elapsed 
#8.08    0.00    8.27

2）substring被矢量化，因此可以避免第三个sapply。（此外，在检查字符串的单个字符时，strsplit可能更快，并且本身可以在任何循环之外计算。）

3）当比较长度== 1＆＃39;时，if else的块比ifelse快。向量。当然，这完全是次要的，但是在两个嵌套的sapply之后，它增加了额外的计算时间，而不需要：

microbenchmark::microbenchmark(replicate(1e4, if(2 < 3 && 5 > 3) 1 else 0), 
                               replicate(1e4, ifelse(2 < 3 && 5 > 3, 1, 0)))
#Unit: milliseconds
#                                           expr      min       lq   median       uq      max neval
# replicate(10000, if (2 < 3 && 5 > 3) 1 else 0) 14.22543 14.85759 15.09545 15.78781 56.84884   100
# replicate(10000, ifelse(2 < 3 && 5 > 3, 1, 0)) 29.77642 31.44824 36.20305 37.85782 65.72473   100

所以，记住这些：

OP2 = function(v1, v2) 
{ 
    nc1 = nchar(v1)
    nc2 = nchar(v2)
    sv2 = seq_along(v2)

    sapply(seq_along(v1), 
           function(i) {
              sapply(sv2, 
                     function(j) {
                       len = if(nc1[[i]] > nc2[[j]]) nc1[[i]] else nc2[[j]]
                       ind = seq_len(len)
                       sum(substring(v1[[i]], 1, ind) == substring(v2[[j]], 1, ind)) / len
                     })
           })
}

与你的比较：

set.seed(007)          
v1b = replicate(1e2, paste0(sample(letters[1:5], sample(4:10, 1), TRUE), collapse = ""))
v2b = replicate(1e2, paste0(sample(letters[1:5], sample(4:10, 1), TRUE), collapse = ""))

sum(count.first.character.matches(v1b, v2b) != OP2(v1b, v2b))
#[1] 0
microbenchmark::microbenchmark(count.first.character.matches(v1b, v2b), OP2(v1b, v2b), times = 20)
#Unit: milliseconds
                                    expr      min       lq   median       uq       max neval
# count.first.character.matches(v1b, v2b) 932.2840 949.3697 969.6321 985.2237 1081.2882    20
#                           OP2(v1b, v2b) 161.7503 185.1102 192.3019 197.5060  213.6818    20

除了你的方法之外，另一个想法可能是（改变＆＃34; OP2＆＃34;以保持最短的长度）：

ff = function(x, y)
{
    sx = strsplit(x, "", fixed = TRUE)
    sy = strsplit(y, "", fixed = TRUE)
    array(mapply(function(X, Y) { 
                   slen = seq_len(min(length(X), length(Y)))
                   wh = X[slen] == Y[slen]
                   if(all(wh)) return(1) else (which.min(wh) - 1) / length(slen)
                 }, 
                 rep(sx, each = length(sy)), sy), 
          c(length(x), length(y)), list(y, x))
}  
sum(ff(v1b, v2b) != OP2(v1b, v2b))
#[1] 0
microbenchmark::microbenchmark(ff(v1b, v2b), OP2(v1b, v2b), times = 20)
#Unit: milliseconds
#          expr       min        lq    median        uq      max neval
#  ff(v1b, v2b)  72.72661  80.43703  85.85113  89.16066 110.5722    20
# OP2(v1b, v2b) 165.13991 168.15051 176.01596 182.11389 213.9557    20

Answer 2

如何使用<canvas id="test" width="300" height="300"></canvas>：

Project > Build Settings > All > Build Options > Enable Bitcode = NO

快速测试（功能为strsplit）：

count.first.character.matches2 <- function(vec1,vec2) { 
  sapply(X = vec1 , FUN= function(x) {
    sapply(X = vec2, FUN = function(y) {
    ny <- nchar(y)
    nx <- nchar(x)
    shorter_length <- ifelse(nx < ny, nx, ny)
    ind <- strsplit(x, "")[[1]][1 : shorter_length] == strsplit(y, "")[[1]][1 : shorter_length]
    if(sum(ind) == shorter_length) return(1) else {
      matches <- min(which(!ind)) - 1
      matches / shorter_length
        }
  })
})}

有点凌乱但速度更快。

R：计算从字符串开头匹配的字母数

2 个答案: