案例研究:加速R中的Mapply

时间:2015-12-21 14:36:53

标签: r performance mapply

我必须做一个找到“相似”句子的程序。 在这种情况下,句子只是整数向量。 (我们可以假设我们已经在这里预处理了字符串和单词句子到整数向量)。为了简单起见,我们所有的句子都具有相同的长度,如果只有 ONE 单词替换为另一个

,则两个句子相似

例如(4,3,1,2)和(4,2,1,2)是相似的,因为它们的区别仅在于第二个数字3被2代替。

句子存储在data.table DT中。有2列,1是ID,另一列是char矢量。

我们在ID_pair中获得了对ID的列表,我们需要检查DT中的相应句子是否相似。

以下是代码示例。 现在,我对mapply的实现不满意,因为我发现它太慢了。 (10秒对只有10万对检查!) 我相信这可以更有效地完成。 [而且我需要为这个项目扫描数百或数亿的支票!]

注释: (1)我试图实现hash_table。奇怪的是,它不会让事情变得更快。 (2)也许这必须这样做DT的列V是一个列表并导致问题?我有什么选择? (3)如果有一个解决方案做得更快,我需要在第二部分,寻找另一个相似的概念,其中2个句子的不同之处在于只添加(任意)一个字。这就是为什么我在这个例子中选择一个列表来存储数据,以便能够放入不同长度的相同列句。 也许这是错的?

感谢

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]

修改

感谢@Khashaa的回答。 这很有效,因为第一种相似性的简单矢量化形式。

如果2个句子的差异只是1次插入,那么比较的问题呢

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])

is_pair_edit1检查引用的句子是否相互插入一个。 例如,我添加了2000个随机句子(长度为5的字符向量)并创建了另一组100,000个ID对以检查此函数is_pair_edit1

这个功能还有一个很好的解决方案吗?我担心它没有矢量化。

为什么mapply的性能如此缓慢,即使是像这些简单的函数一样?

顺便说一下,我不是100%肯定以下,但在我的主要代码中(这里的代码只是一个简化的例子),我在循环中运行这两个函数(其参数是LENGTH)句子)。 我已经用Khashaa提出的替代对解决方案纠正了代码,它确实超级快......如果我单独运行这段代码, BUT “奇怪”,因为在同一个循环中,我是运行BOTH mapply,总运行时间没有减少,(当然如果在循环中我会忘记第二个函数并将其放在注释中,并且只是在循环内运行is_pair_sub的修改代码),它会减少。

0 个答案:

没有答案