在 data.table 中优化 R 中的向量比较代码

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）

我有一个 table 和候选对 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

现在我有 60% 的空闲时间:

library(data.table)
set.seed(234)

is_sub_num <- function(a,b) sum(!(a==b))==1
is_pair_ok2  <- function(p1, p2) is_sub_num(DT[p1,V2][[1]],DT[p2,V2][[1]]) 

DT <- as.data.table(1:100)
DT$V2 <- lapply(1:100, function(x) sample(1:4,size=4,replace=TRUE)) 
setnames(DT, c("ID","V2"))
setkey(DT, ID)

pair_list <- as.data.table(cbind(sample(1:100,10000,replace=TRUE),sample(1:100,10000,replace=TRUE)))
print(system.time(tmp <- mapply(FUN=is_pair_ok2, pair_list$V1, pair_list$V2)))

最有效的是在 is_pair_ok2()

中为 DT 设置密钥并使用快速索引

多一点（没有函数is_sub_num()）：

is_pair_ok3  <- function(p1, p2) sum(DT[p1,V2][[1]]!=DT[p2,V2][[1]])==1
print(system.time(tmp <- mapply(FUN=is_pair_ok3, pair_list$V1, pair_list$V2)))

Answer 2

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

答案代码如下。我已经添加了一些新参数来使问题更普遍一些。重点是使用unlist函数。每当我们对 list 对象使用 apply 时，我们在 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

编辑在这里 post 有点太长了。我试图从上面得出结论，并通过尝试加速并使用 unlist 和手动索引来修改我的程序的源代码。新的实现实际上是 slower 这让我感到惊讶，我不明白为什么...

在 data.table 中优化 R 中的向量比较代码

optimizing code in R for vector comparisons in data.table

optimization

r

lapply

data.table