優化代碼中的R爲在data.table

Question

矢量比較正如我的R中的程序的一部分，我必須比較對句子的一些功能（在一個IM表示這裏與相同數目的比較的句子的一個巨大的數字單詞和這兩個句子之間是否只有一個不同的單詞）

爲了使事情更快，我已經將所有單詞轉換爲整數，所以我正在處理整數向量，因此示例函數是一個非常簡單的單詞

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的）

我有一個表與候選對標識與功能測試上方DT相應的條目，遵循

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

這裏是我想要噸簡化o不要：

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 

編輯 它會有點長，張貼在這裏。我試圖從上面得出結論，並通過嘗試加速並使用unlist和手動索引來修改我的程序的源代碼。 新的實現實際上是慢這對我來說是一個驚喜，我不明白爲什麼......

Answer 2

現在我有時間的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))) 

影響最大不得不設置DT鑰匙，和is_pair_ok2()

多一點點使用快速索引（無功能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)))