R：可以矢量化/加速這個雙循環嗎？

Question

這是一個高層次的普遍問題。 周圍也有一些相似的例子，但有不同且更簡潔的示例。 也許無法回答。 conn是一個矩陣。

     for (i in 2:dim(conn)[1]) {
        for (j in 2:dim(conn)[1]) {
          if ((conn[i, 1] == conn[1, j]) & conn[i, 1] != 0) {
              conn[i, j] <- 1
              conn[j, i] <- 1
              }
              else {
                conn[i, j] <- 0
                conn[j, i] <- 0
                }
           }
      }

這都直出cluscomp從clusterCons包。

我的問題很簡單：是否可以加快循環速度或使其向量化？ 作為R的初學者，我看不到它，也不想以失敗而告終，因為它可能無法實現。 我會接受任何可以回答“是”或“否”的答案，並暗示可能涉及的工作量。

Answer 1

這是我用outer代替雙循環的方式編寫的。 請注意，它仍在進行比所需更多的計算，但是肯定更快。 我假設conn是一個方矩陣。

原始代碼：

f1 <- function(conn) {
   for (i in 2:dim(conn)[1]) {
      for (j in 2:dim(conn)[1]) {
         if ((conn[i, 1] == conn[1, j]) & conn[i, 1] != 0) {
            conn[i, j] <- 1
            conn[j, i] <- 1
         } else {
            conn[i, j] <- 0
            conn[j, i] <- 0
         }
      }
   }
   return(conn)
}

我的建議：

f2 <- function(conn) {
   matches <- 1*outer(conn[-1,1], conn[1,-1], `==`)
   matches[conn[-1,1] == 0, ] <- 0
   ind <- upper.tri(matches)
   matches[ind] <- t(matches)[ind]
   conn[-1,-1] <- matches
   return(conn)
}

一些樣本數據：

set.seed(12345678)
conn <- matrix(sample(1:2, 5*5, replace=TRUE), 5, 5)
conn
#      [,1] [,2] [,3] [,4] [,5]
# [1,]    2    2    1    2    1
# [2,]    1    1    2    2    1
# [3,]    2    2    1    2    1
# [4,]    2    2    2    2    1
# [5,]    1    1    2    2    1

結果：

f1(conn)
#      [,1] [,2] [,3] [,4] [,5]
# [1,]    2    2    1    2    1
# [2,]    1    0    1    1    0
# [3,]    2    1    0    0    1
# [4,]    2    1    0    1    0
# [5,]    1    0    1    0    1

identical(f1(conn), f2(conn))
# [1] TRUE

一個更大的例子，帶有時間比較：

set.seed(12345678)
conn <- matrix(sample(1:2, 1000*1000, replace=TRUE), 1000, 1000)

system.time(a1 <- f1(conn))
# user  system elapsed 
# 59.840   0.000  57.094 

system.time(a2 <- f2(conn))
# user  system elapsed 
# 0.844   0.000   0.950 

identical(a1, a2)
# [1] TRUE

也許不是您可以獲得的最快方法（我毫無疑問，這里的其他人可以使用編譯器或Rcpp找到更快的方法），但我希望它足夠簡短。

---

編輯：由於已經指出（從提取此代碼的上下文中） conn是對稱矩陣，因此我的解決方案可以縮短一點：

f2 <- function(conn) {
   matches <- outer(conn[-1,1], conn[1,-1],
                    function(i,j)ifelse(i==0, FALSE, i==j)) 
   conn[-1,-1] <- as.numeric(matches)
   return(conn)
}

Answer 2

非矩陣解-假設conn為非負且對稱的...

connmake = function(conn){
  ordering = order(conn[,1])
  breakpoints = which(diff(conn[ordering,1]) != 0)
  if (conn[ordering[1], 1] != 0){
    breakpoints = c(1, breakpoints + 1, nrow(conn) + 1)
  } else {
    breakpoints = c(breakpoints + 1, nrow(conn) +1)
  }
  output = matrix(0, nrow(conn), nrow(conn))

  for (i in 1:(length(breakpoints) - 1)){
    output[ ordering[breakpoints[i]:(breakpoints[i+1] -1)],
        ordering[breakpoints[i]:(breakpoints[i+1] -1)]] =  1
  }
  output[,1] = conn[,1]
  output[1,] = conn[,1]
  output
}

一些使用早期基准測試的測試代碼。 （原始代碼實現為orig() ， f2()是較早的建議。）

size = 2000
conn  = matrix(0, size, size)
conn[1,] = sample( 1:20, size, replace = T)
conn[,1] = conn[1,]

system.time(orig(conn) -> out1)
#user  system elapsed 
#20.54    0.00   20.54 
system.time(f2(conn) -> out2)
#user  system elapsed
#0.39    0.02    0.41 
system.time(connmake(conn) -> out3)
#user  system elapsed 
#0.02    0.00    0.01 
identical(out1, out2)
#[1] TRUE
identical(out1, out3)
#[1] TRUE

請注意，對於包含0的conn，f2實際上失敗，但是不是我的問題，是嗎？ 帶有負值的conn可以簡單地通過例如將相關值增加一個安全偏移來處理。 非對稱conn需要更多思考，但應該可行。

一般的教訓是，與成對比較相比，排序速度更快。 成對比較是O（N ^ 2），而R中最慢的排序算法是O（N ^ 4/3）。 數據排序后，比較變得無關緊要。

Answer 3

我想到了幾件事。

首先，您可以僅循環瀏覽對角線以下或對角線上方的條目，從而將時間縮短一半。 如果矩陣是正方形，則兩者都可以工作。 如果dim(conn)[1] > dim(conn)[2]則需要使用類似以下的方法遍歷左下三角形

for (j in 2:dim(conn)[2]) {
  for (i in j:dim(conn)[1]) {
    ...
  }
}

其次，人們可能會嘗試使用apply ，這是很麻煩的，因為它們通常會減少大量時間。 但是，在這種情況下，每個[i，j]單元格都指向列頭[1,j]和行頭[i,1] ，這意味着我們不能只將單元格，行或列發送給* pply。 為了清楚起見，我可能會保留for循環。 任何基於* pply的技巧都非常聰明，以至於我忘了一年后它是如何運作的。

最后，這似乎是一個經典的示例，它使用從R調用的C可以使速度大大提高。這似乎是很多工作，但比您想象的要容易得多，即使（對於此特定示例）如果您不了解C。對我來說，從R調用C的第一個簡短示例在這里 ，但是它沒有利用Rcpp，因此我不會就此止步。 另外，如果您從工作Rcpp代碼的任何簡單示例開始，那么您可以對其進行修改以執行您想要的操作。 如果您只想修改其他人的代碼，請從此StackOverflow線程開始。