案例研究：在R中加速Mapply

我必须做一个程序，找出“相似”的句子。 在这种情况下，句子只是整数向量。（我们可以假设我们已经将字符串和单词句子预处理为整数向量）。为了简单起见，我们所有的句子都有相同的长度，如果两个句子只有一个单词被另一个单词所代替，那么它们是相似的

例如，（4,3,1,2）和（4,2,1,2）是相似的，因为它们的区别只是第二个数字3被2代替

句子存储在data.table

DT

中。有两列，一列是ID，另一列是char向量

我们在

ID\u pair

中得到了一个对ID列表，我们需要检查

DT

中的相应句子是否相似

下面是一个代码示例。 现在，我对

mapply

的实现不满意，因为我发现它太慢了。（10秒仅用于100000对检查！！） 我相信这样做会更有效率。[我需要这样做，因为我必须为该项目扫描数千万或数亿张支票！]

注: （1） 我试图实现一个哈希表。奇怪的是，它并没有让事情变得更快。 （2） 也许这是因为

DT

的第V列是一个列表，这会导致问题吗？我还有什么选择？ （3） 如果有一个解决方案可以加快速度，我需要在第二部分中寻找另一个相似性的概念，其中两个句子不同，只需添加（任何地方）一个单词。这就是为什么我在本例中选择了一个列表来存储数据，以便能够将不同长度的句子放在同一列中。 也许这是错的

谢谢

library(hash)
library(data.table)

is_pair_sub <- function(ID1,ID2){
        sum(!DT$V[[which(DT$ID==ID1)]]==DT$V[[which(DT$ID==ID2)]])==1
        # sum(!values(s_hash,ID1)[,1]==values(s_hash,ID2)[,1])==1
}

set.seed(123)

N <- 2000
k <- 4 #size of alphabet

V <- lapply(1:N,function(x){sample(1:k,4,replace=TRUE)})
DT <- data.table(ID=sample(1:N),V)

N_pair_sub <- 100000
ID_pair <- data.table(matrix(sample(1:N,2*N_pair_sub,replace=TRUE),nrow=N_pair_sub,ncol=2))

s_hash <- hash(DT$ID,DT$V)

print(system.time({
x <- mapply(is_pair_sub,ID_pair$V1,ID_pair$V2) }))

ID_pair[x]

库（散列）
库（数据表）
is\u pair\u sub这不是很可靠，但是
adist
对于这个特定的示例很有效。分析您的代码，您将看到大部分时间实际上都花在了
is\u sub
函数上。如果您不能使用其中一个可用的距离函数（从base R或一些用C编写的包中），您必须用C编写自己的距离函数（例如，使用Rcpp）。当然，C更快。但是在R中，有什么改进是可能的？现有的距离函数是用C实现的，这是一个原因。纯R无法获得足够的性能。@Roland在本例中，我应该自己编写函数，因为我没有发现任何R包提供我需要的正确函数。。。但要获得更高的性能，最好的方法是。。。简单地说，不要用R来解决这类问题！至少看起来是这样！
is_pair_edit1 <- function(ID1, ID2) { #ID1 and #ID2 should be 1 length apart}

        split1=values(s_hash,ID1)[,1]
        split2=values(s_hash,ID2)[,1]
        l2=length(split2)

        l1=l2-1 #this is by construction


        #         if (! (len1==len2)){return(FALSE) }
        #         this has been already tested

        index = 1
        diff = 0
        if (l1==l2) {return(FALSE)}
        if (l1>l2) {

                while ( index < l1) {
                        if( diff==0) {
                                if (split1[index] != split2[index]) {diff=1}
                                else {index <- index + 1}
                        }
                        else { #diff==1
                                if (split1[index+1]!=split2[index]) {return(FALSE)}
                                else {index <- index + 1}
                        }
                } #end of while
                return (TRUE) #should be TRUE anyway if we get there 
        } #end of if

        else {

                while ( index < l2) {
                        if( diff==0) {
                                if (split1[index] != split2[index]) {diff=1}
                                else {index <- index + 1}
                        }
                        else { #diff==1
                                if (split2[index+1]!=split1[index]) {return(FALSE)}
                                else {index <- index + 1}
                        }
                } #end of while
                return (TRUE) #should be TRUE anyway if we get there 
        } #end of else #(l2>l1)

}  #end of function is_pair_edit1

V <- lapply(1:N,function(x){sample(1:k,5,replace=TRUE)})
DT1= data.table(ID=sample((N+1):(2*N)),V)
DT = rbindlist(list(DT,DT1))
ID_pair1 <- ID_pair
ID_pair1$V2 <- ID_pair1$V2+N #to generate IDs referencing sentences of length 5.

s_hash <- hash(DT$ID,DT$V)

print(system.time({
        y <- mapply(is_pair_edit1,ID_pair1$V1,ID_pair1$V2) }))

print(DT[ID==ID_pair1[y][1,]$V1])
print(DT[ID==ID_pair1[y][1,]$V2])