比较数据帧中行的更快方法

Question

请考虑下面的数据框架。我希望将每一行与下面的行进行比较，然后接受多于3个值中相等的行。

下面是我编写的代码，但是如果您有一个大的数据框架，它会非常慢。

我怎么能做得更快？

data <- as.data.frame(matrix(c(10,11,10,13,9,10,11,10,14,9,10,10,8,12,9,10,11,10,13,9,13,13,10,13,9), nrow=5, byrow=T))
rownames(data)<-c("sample_1","sample_2","sample_3","sample_4","sample_5")

>data
          V1 V2 V3 V4 V5
sample_1  10 11 10 13  9
sample_2  10 11 10 14  9
sample_3  10 10  8 12  9
sample_4  10 11 10 13  9
sample_5  13 13 10 13  9

output <- data.frame(sample = NA, duplicate = NA, matches = NA)
dfrow <- 1
for(i in 1:nrow(data)) {
    sample <- data[i, ]
    for(j in (i+1):nrow(data)) if(i+1 <= nrow(data)) {
    matches <- 0
        for(V in 1:ncol(data)) {
            if(data[j,V] == sample[,V]) {       
                matches <- matches + 1
            }
        }
        if(matches > 3) {
            duplicate <- data[j, ]
            pair <- cbind(rownames(sample), rownames(duplicate), matches)
            output[dfrow, ] <- pair
            dfrow <- dfrow + 1
        }
    }
}

>output
   sample    duplicate    matches
1 sample_1   sample_2     4
2 sample_1   sample_4     5
3 sample_2   sample_4     4

Answer 1

这是一个Rcpp解决方案。但是，如果结果矩阵太大(即点击次数过多)，则会引发错误。我运行两次循环，首先得到结果矩阵的必要大小，然后填充它。也许还有更好的可能性。而且，很明显，这只适用于整数。如果你的矩阵是数字的，你必须处理浮点的精度。

library(Rcpp)
library(inline)

#C++ code:
body <- '
const IntegerMatrix        M(as<IntegerMatrix>(MM));
const int                  m=M.ncol(), n=M.nrow();
long                        count1;
int                         count2;
count1 = 0;
for (int i=0; i<(n-1); i++)
{
   for (int j=(i+1); j<n; j++)
   {
     count2 = 0;
     for (int k=0; k<m; k++) {
        if (M(i,k)==M(j,k)) count2++;
     }
     if (count2>3) count1++;
   } 
}
IntegerMatrix              R(count1,3);
count1 = 0;
for (int i=0; i<(n-1); i++)
{
   for (int j=(i+1); j<n; j++)
   {
     count2 = 0;
     for (int k=0; k<m; k++) {
        if (M(i,k)==M(j,k)) count2++;
     }
     if (count2>3) {
        count1++;
        R(count1-1,0) = i+1;
        R(count1-1,1) = j+1;
        R(count1-1,2) = count2;
     }
   } 
}
return  wrap(R);
'

fun <- cxxfunction(signature(MM = "matrix"), 
                     body,plugin="Rcpp")

#with your data
fun(as.matrix(data))
#      [,1] [,2] [,3]
# [1,]    1    2    4
# [2,]    1    4    5
# [3,]    2    4    4

#Benchmarks
set.seed(42)
mat1 <- matrix(sample(1:10,250*26,TRUE),ncol=26)
mat2 <- matrix(sample(1:10,2500*26,TRUE),ncol=26)
mat3 <- matrix(sample(1:10,10000*26,TRUE),ncol=26)
mat4 <- matrix(sample(1:10,25000*26,TRUE),ncol=26)
library(microbenchmark)
microbenchmark(
  fun(mat1),
  fun(mat2),
  fun(mat3),
  fun(mat4),
  times=3
  )
# Unit: milliseconds
#      expr          min           lq       median           uq          max neval
# fun(mat1)     2.675568     2.689586     2.703603     2.732487     2.761371     3
# fun(mat2)   272.600480   274.680815   276.761151   276.796217   276.831282     3
# fun(mat3)  4623.875203  4643.634249  4663.393296  4708.067638  4752.741979     3
# fun(mat4) 29041.878164 29047.151348 29052.424532 29235.839275 29419.254017     3

Answer 2

编辑:不知道我昨晚在想什么，当我减去行时，考虑到我可以直接测试是否相等。从下面的代码中删除了这个不可思议的步骤。

这里有一种方法，可能有点聪明，或者考虑得很糟糕……但希望是前者。这样做的想法是，与其逐行进行一系列比较，不如执行一些矢量化操作，从数据帧的其余部分减去行，然后查看等于零的元素数。以下是该方法的简单实现：

> library(data.table)
> data <- as.data.frame(matrix(c(10,11,10,13,9,10,11,10,14,9,10,10,8,12,9,10,11,10,13,9,13,13,10,13,9), nrow=5, byrow=T))
> rownames(data)<-c("sample_1","sample_2","sample_3","sample_4","sample_5")
> 
> findMatch <- function(i,n){
+   tmp <- colSums(t(data[-(1:i),]) == unlist(data[i,]))
+   tmp <- tmp[tmp > n]
+   if(length(tmp) > 0) return(data.table(sample=rownames(data)[i],duplicate=names(tmp),match=tmp))
+   return(NULL)
+ }
> 
> system.time(tab <- rbindlist(lapply(1:(nrow(data)-1),findMatch,n=3)))
   user  system elapsed 
  0.003   0.000   0.003 
> tab
     sample duplicate match
1: sample_1  sample_2     4
2: sample_1  sample_4     5
3: sample_2  sample_4     4

编辑:这里是version2，它使用矩阵并预先处理数据，所以您只需要这样做一次。它应该能更好地扩展到您的示例中，其中包含大量的数据。

library(data.table)
data <- matrix(round(runif(26*250000,0,25)),ncol=26)
tdata <- t(data)

findMatch <- function(i,n){
    tmp <- colSums(tdata[,-(1:i)] == data[i,])
    j <- which(tmp > n)
    if(length(tmp) > 0) return(data.table(sample=i,duplicate=j+1,match=tmp[j]))
    return(NULL)
}

tab <- rbindlist(lapply(1:(nrow(data)-1),findMatch,n=3))

我在机器上跑了一会儿，在15分钟内完成了第一次1500次迭代，一个完整的250,000 x 26矩阵，需要600 Mb内存。由于以前的迭代不会影响将来的迭代，因此您当然可以将其分成几个部分，并在需要时单独运行。

Answer 3

这不是一个完整的答案，只是一个快速的锻炼，在脑海中是使用矩阵，而不是data.frame (那些是相当慢的tbh)。矩阵在R中的速度是相当快的，通过至少完成其中的一些运算，然后在向量中添加列名将导致显著的速度增长。

只是一个简单的演示：

data <- matrix(c(10,11,10,13,9,10,11,10,14,9,10,10,8,12,9,10,11,10,13,9,13,13,10,13,9), nrow=5, byrow=T)rownames(data)<-c("sample_1","sample_2","sample_3","sample_4","sample_5")
mu<-c("sample_1","sample_2","sample_3","sample_4","sample_5")

t=proc.time()
tab <- data.frame(sample = NA, duplicate = NA, matches = NA)
dfrow <- 1
for(i in 1:nrow(data)) {
    sample <- data[i, ]
    for(j in (i+1):nrow(data)) if(i+1 <= nrow(data)) {
    matches <- 0
        for(V in 1:ncol(data)) {
            if(data[j,V] == sample[V]) {       
                matches <- matches + 1
            }
        }
        if(matches > 3) {
            duplicate <- data[j, ]
            pair <- cbind(mu[i], mu[j], matches)
            tab[dfrow, ] <- pair
            dfrow <- dfrow + 1
        }
    }
}
proc.time()-t

平均来说，在我的机器上，

   user  system elapsed 
   0.00    0.06    0.06 

而在你的情况下我得到

 user  system elapsed 
   0.02    0.06    0.08 

我不确定是否有比矩阵更快的东西。您也可以使用并行化，但是对于循环，经常使用C++代码内联(package Rcpp)。