R：可以矢量化/加速这个双循环吗？

Question

This is a high-level, general question. There are some similar ones around with different, and more concise, examples. Perhaps it cannot be answered. conn is a matrix.

     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
                }
           }
      }

This comes straight out of cluscomp from the clusterCons package.

My question is simply: is it possible to speed up the loop or to vectorise it? As an R beginner, I cannot see it and don't want to end up with frustration because it may not be possible. I'll accept any answer that can say yes or no and hint towards the potential amount of effort involved.

Answer 1

Here is how I would have written it, using outer as a substitute for the double loop. Note that it is still doing more computations than needed, but is certainly faster. I have assumed conn is a square matrix.

The original code:

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)
}

My suggestion:

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)
}

Some sample data:

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

The results:

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

A bigger example, with time comparison:

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

Maybe not the fastest method you can get (I have no doubt other people here can find much faster using eg compiler or Rcpp), but short and fast enough for you I hope.

---

Edit: since it has been pointed out (from the context of where this code was pulled from) that conn is a symmetric matrix, my solution can be shortened a bit:

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

Non-matrixy solution - should be pretty damn fast, assuming conn is non-negative and symmetric...

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
}

Some test code using earlier benchmarking. (Original code is implemented as orig() , f2() is earlier suggestion.)

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

Note that f2 actually fails for conn containing 0, but not my problem, eh? conn with negative values can be dealt with simply by eg increasing the relevant values by a safe offset. Non-symmetric conn will require more thought, but should be doable...

The general lesson is that sort is fast compared to pairwise comparison. Pairwise comparison is O(N^2), while the slowest sort algorithm in R is O(N^4/3). Once the data is sorted, comparisons become trivial.

Answer 3

Several things come to mind.

First, you can cut the time about in half by only looping through the entries below the diagonal or above the diagonal. If the matrix is square either will work. If dim(conn)[1] > dim(conn)[2] then you'll want to loop through the bottom-left triangle using something like

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

Second, one might try to use apply and it's ilk because they usually generate significant time decreases. However, in this case each [i,j] cell refers back to both the column head [1,j] and the row head [i,1] , which means we can't just send a cell, row or column to *pply. For code clarity, I would probably keep the for loops. Any *pply-based trick that worked would be so clever that I'd forget how it worked a year from now.

Finally, this seems like a classic example of something that would be much, much faster using C called from R. This might seem like a lot of work, but it's a lot easier than you might think, even (for this particular example) if you don't know C. The first brief example of calling C from R that made sense to me was here , but it doesn't leverage Rcpp, so I wouldn't stop there. Alternatively, if you start with any simple example of working Rcpp code then you could modify it to do what you want here. If you just want to modify someone else's code, start with this StackOverflow thread .