比较记录结果和双循环

Question

我有一个双循环，我不仅不喜欢，而且需要 14 天才能在我的计算机上运行，​​因为它以大约 0.12 次迭代的速度运行超过 3200 条记录和 1090 个变量。

更小的可重现位。它只是检查两条记录之间的同一列中有多少数字，不包括 NA。然后它将结果附加到原始数据框。

y <- data.frame(c(1,2,1,NA,NA),c(3,3,3,4,NA),c(5,4,5,7,7),c(7,8,7,9,10))
resultdf <- NULL
for(i in 1:nrow(y))
{
  results <- NULL
  for(j in 1:nrow(y))
  {
    results <- c(results,sum((y[i,]==y[j,]),na.rm=TRUE))
  }
  resultdf <- cbind(resultdf,results)
}
y <- cbind(y,resultdf)

我有重复计算，可能需要 7 天才能避免。

如果我理解正确的话，C 中的一些应用函数可能会更快。不过，我还没有得到任何工作。我也很好奇是否有一个运行得更快的包。谁能帮忙加快计算速度？

谢谢！

Answer 1

确实，您可以使用应用功能。鉴于先前暗示矩阵工作得更快，我会尝试：

ym <- as.matrix(y)
resultdf <- apply(ym, 1, function(r1) apply(ym, 1, function(r2) sum(r1==r2, na.rm=TRUE)))

Answer 2

这是另一个解决方案，使用outer。

f <- function(i,j) sum(y[i,] == y[j,], na.rm=TRUE)
d <- outer( 1:nrow(y), 1:nrow(y), Vectorize(f) )

Answer 3

我已经根据您的规范创建了数据，并使用了@BenBolker 关于使用矩阵的建议：

> y <- matrix(sample(c(1:9, NA), 3200 * 1090, replace = TRUE),
+             nrow = 3200, ncol = 1090)

并比较了三种不同实现的计算时间：

f1 由@Andrei 建议：

> f1 <- function(y)apply(y, 1, function(r1)
+                  apply(y, 1, function(r2)sum(r1==r2, na.rm=TRUE)))

> system.time(r1 <- f1(y))
   user  system elapsed 
 523.51    0.77  528.73 

f2 是由@VincentZoonekynd 推荐的：

> f2 <- function(y) {
+   f <- function(i,j) sum(y[i,] == y[j,], na.rm=TRUE)
+   d <- outer( 1:nrow(y), 1:nrow(y), Vectorize(f) )
+   return(d)
+ }
> system.time(r2 <- f2(y))
   user  system elapsed 
 658.94    1.96  710.67

f3 是@BenBolker 建议的上三角形上的双循环。它也比您的 OP 更有效，因为它预先分配了输出矩阵：

> f3 <- function(y) {
+   result <- matrix(NA, nrow(y), nrow(y))
+   for (i in 1:nrow(y)) {
+     row1 <- y[i, ]
+     for (j in i:nrow(y)) {
+       row2 <- y[j, ]
+       num.matches  <- sum(row1 == row2, na.rm = TRUE)
+       result[i, j] <- num.matches
+       result[j, i] <- num.matches
+     }
+   }
+   return(result)
+ }

> system.time(r3 <- f3(y))
   user  system elapsed 
 167.66    0.08  168.72 

所以双循环是所有三个中最快的，虽然不如其他两个答案优雅和紧凑。

Answer 4

您可以摆脱内部循环（使用@flodel 答案中的y 和f3）：

ty <- t(y)
ix <- rep(1:nrow(y),each = ncol(y))
f4 <- function(y){
    result <- matrix(0L, nrow(y), nrow(y))
    for(r in 1:nrow(y))
        result[r,] <- rowsum(as.numeric(ty == y[r,]), ix, na.rm = T)
    result
}



> system.time(out <- f4(y))
   user  system elapsed 
 52.616  21.061  74.000 
> system.time(out <- f3(y))
   user  system elapsed 
244.751   0.136 244.954 
> 

它实际上做了额外的计算两次相同的事情，但仍然快 5 倍。您可以通过使用 rowsum 的内部工作原理使其速度再快 4 倍。有关示例，请参阅此 question。