R：计算从字符串开头匹配多少个字母

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

怎么样，使用 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
        }
  })
})}

快速测试（使用 shorter_length <- ifelse(nx < ny, nx, ny) 的函数）：

v11 <- rep(v1, 100)
v22 <- rep(v2, 100) 

system.time(test1 <- count.first.character.matches(v11, v22))   
# user  system elapsed 
# 12.20    0.02   12.29

system.time(test2 <- count.first.character.matches2(v11, v22)) 
# user  system elapsed 
# 3.86    0.00    3.96

all.equal(test1, test2)  
# [1] TRUE

有点乱，但速度更快。

Answer 2

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

1) nchar 是一个函数，与 length 不同，它必须计算其参数的字符数而不是获取属性。您要为每个 "v1" 计算 "v2" 的 nchar，但也为每个 "v2" 计算 "v1" 的 nchar。您可以将 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) if else 的块在比较 'length == 1' 向量时比 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

除了您的方法之外，另一个想法可能是（在更改 "OP2" 以保持最短长度之后）：

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

R：计算从字符串开头匹配多少个字母

R: count how many letters match from beginning of string

r

string-matching

similarity