Question

作为我在R中的程序的一部分，我必须将大量的句子与一些函数进行比较（这里显示的是比较具有相同数量的单词的句子，以及是否只有一个不同的单词这两句话之间）

为了加快速度，我已将所有单词转换为整数，因此我处理整数向量，因此示例函数非常简单

is_sub_num <- function(a,b){sum(!(a==b))==1}

其中a，b是字符向量，例如

a = c(1,2,3); b=c(1,4,3) 
is_sub_num(a,b)
# [1] TRUE

我的数据将存储在data.table

中

Classes ‘data.table’ and 'data.frame':  100 obs. of  2 variables:
 $ ID: int  1 2 3 4 5 6 7 8 9 10 ...
 $ V2:List of 100
  ..$ : int  4 4 3 4
  ..$ : int  1 2 3 1

每个条目的长度可能不同（在下面的示例中，条目都是大小为4）

我有一个包含候选对ID的表，用以下函数测试DT中的相应条目，如下所示

is_pair_ok  <- function(pair){
            is_sub_num(DT[ID==pair[1],V2][[1]],DT[ID==pair[2],V2][[1]])}

这是我试图做的简化：

set.seed=234
z = lapply(1:100, function(x) sample(1:4,size=4,replace=TRUE))
is_sub_num <- function(a,b){sum(!(a==b))==1}
is_pair_ok  <- function(pair){
        is_sub_num(DT[ID==pair[1],V2][[1]],DT[ID==pair[2],V2][[1]])}

pair_list <- as.data.table(cbind(sample(1:100,10000,replace=TRUE),sample(1:100,10000,replace=TRUE)))

DT <- as.data.table(1:100)
DT$V2 <- z
colnames(DT) <- c("ID","V2")

print(system.time(tmp <-apply(pair_list,1,is_pair_ok)))

这在我的笔记本电脑上大约需要22秒，尽管只有10,000个条目且功能非常基本。

您对如何加快代码有任何建议吗？

Answer 1

我已经深入研究了这个问题，这是我的答案。我认为它是一个重要的，每个人都应该知道所以请投票给这篇文章，它不值得它的坏分数！

答案的代码如下。我已经添加了一些新参数来使问题更加通用。关键是使用unlist功能。每当我们使用apply到list个对象时，我们在R中的性能会非常差。它在爆炸物体和在矢量中进行手动索引时会有点痛苦，但加速是惊人的。

set.seed=234
N=100
nobs=10000
z = lapply(1:N, function(x) sample(1:4,size=sample(3:5),replace=TRUE))
is_sub_num <- function(a,b){sum(!(a==b))==1}
is_pair_ok  <- function(pair){
        is_sub_num(DT[ID==pair[1],V2][[1]],DT[ID==pair[2],V2][[1]])}

is_pair_ok1  <- function(pair){
        is_sub_num(zzz[pos_table[pair[1]]:(pos_table[pair[1]]+length_table[pair[1]] -1) ],
                   zzz[pos_table[pair[2]]:(pos_table[pair[2]]+length_table[pair[2]] -1) ]) }

pair_list <- as.data.table(cbind(sample(1:N,nobs,replace=TRUE),sample(1:N,nobs,replace=TRUE)))

DT <- as.data.table(1:N)
DT$V2 <- z
setnames(DT, c("ID","V2"))
setkey(DT, ID)

length_table <- sapply(z,length)
myfun <- function(i){sum(length_table[1:i])}
pos_table <- c(0,sapply(1:N,myfun))+1
zzz=unlist(z)

print(system.time(tmp_ref <- apply(pair_list,1,is_pair_ok)))
print(system.time(tmp <- apply(pair_list,1,is_pair_ok1)))
identical(tmp,tmp_ref)

这是输出

utilisateur     système      écoulé 
      20.96        0.00       20.96 
utilisateur     système      écoulé 
       0.70        0.00        0.71 
There were 50 or more warnings (use warnings() to see the first 50)
[1] TRUE

EDIT 在这里发帖会有点太长。我试图从上面得出结论并通过尝试加速并使用unlist和手动索引来修改我的程序的源代码。新的实现实际上是慢，这对我来说是一个惊喜，我不明白为什么......

优化R中的代码，用于data.table

1 个答案: