使用 foreach 函数和 doParallel 库在 R 中嵌套 for 循环

Posted 2023-02-15

【中文标题】使用 foreach 函数和 doParallel 库在 R 中嵌套 for 循环

【英文标题】：Nested for loops in R using foreach function and doParallel library

【发布时间】：2015-03-17 17:49:37

【问题描述】：

我正在尝试计算矩阵中列之间的余弦相似度。我可以使用标准 for 循环让它工作，但是当我尝试让它并行运行以使代码运行得更快时，它并没有给我相同的答案。问题是我无法使用 foreach 循环方法得到相同的答案。我怀疑我没有使用正确的语法，因为我有单个 foreach 循环工作。我试图使第二个循环成为一个常规的 for 循环，并且我在 foreach 循环中使用了 %:% 参数，但是该函数甚至没有运行。

请在下面查看我的附加代码。提前感谢您的帮助。

## Function that calculates cosine similarity using paralel functions.

#for calculating parallel processing
library(doParallel)

## Set up cluster on 8 cores

cl = makeCluster(8)

registerDoParallel(cl)

#create an example data
x=array(data=sample(1000*100), dim=c(1000, 100))

## Cosine similarity function using sequential for loops

cosine_seq =function (x) 

  co = array(0, c(ncol(x), ncol(x)))

  for (i in 2:ncol(x)) 
    for (j in 1:(i - 1)) 

      co[i, j] = crossprod(x[, i], x[, j])/sqrt(crossprod(x[, i]) * crossprod(x[, j]))
    
  

  co = co + t(co)

  diag(co) = 1

  return(as.matrix(co))



## Cosine similarity function using parallel for loops

cosine_par =function (x) 

  co = array(0, c(ncol(x), ncol(x)))

  foreach (i=2:ncol(x)) %dopar% 

    for (j in 1:(i - 1)) 

      co[i, j] = crossprod(x[, i], x[, j])/sqrt(crossprod(x[, i]) * crossprod(x[, j]))
    
  

  co = co + t(co)

  diag(co) = 1

  return(as.matrix(co))



## Calculate cosine similarity

tm_seq=system.time(


  x_cosine_seq=cosine_seq(x)

)

tm_par=system.time(


  x_cosine_par=cosine_par(x)

)

## Test equality of cosine similarity functions

all.equal(x_cosine_seq, x_cosine_par)

#stop cluster
stopCluster(cl)

【参考方案1】：

嵌套循环的正确并行化使用%:%（阅读here）。

library(foreach)
library(doParallel)
registerDoParallel(detectCores())    
cosine_par1 <- function (x)   
  co <- foreach(i=1:ncol(x)) %:%
    foreach (j=1:ncol(x)) %dopar%     
      co = crossprod(x[, i], x[, j])/sqrt(crossprod(x[, i]) * crossprod(x[, j]))
    
  matrix(unlist(co), ncol=ncol(x))

我建议你用 Rcpp 编写它，而不是并行运行它，因为foreach(i=2:n, .combine=cbind) 不会总是以正确的顺序绑定列。另外，在上面的代码中，我只删除了下三角条件，但是运行时间比未并行化的代码时间要慢很多。

set.seed(186)
x=array(data=sample(1000*100), dim=c(1000, 100))
cseq <- cosine_seq(x)
cpar <- cosine_par1(x)
 all.equal(cpar, cseq)
#[1] TRUE
head(cpar[,1])
#[1] 1.0000000 0.7537411 0.7420011 0.7496145 0.7551984 0.7602620
head(cseq[,1])
#[1] 1.0000000 0.7537411 0.7420011 0.7496145 0.7551984 0.7602620

附录：对于这个特定的问题，cosine_seq 的（半）向量化是可能的； cosine_vec 比 cosine_seq 快大约 40-50 倍。

cosine_vec <- function(x)
  crossprod(x) / sqrt(tcrossprod(apply(x, 2, crossprod)))

all.equal(cosine_vec(x), cosine_seq(x))
#[1] TRUE
library(microbenchmark)
microbenchmark(cosine_vec(x), cosine_seq(x), times=20L, unit="relative")
#Unit: relative
#          expr      min       lq     mean   median       uq      max neval
# cosine_vec(x)  1.00000  1.00000  1.00000  1.00000  1.00000  1.00000    20
# cosine_seq(x) 55.81694 52.80404 50.36549 52.17623 49.56412 42.94437    20

【讨论】：

感谢您的帮助，但我仍然无法使用“all.equal”R 函数验证并行表示。当我使用 %:% 语法时， cosine_par 代码实际上只给出单位矩阵，而 cosine_seq 使用余弦相似度给出正确的矩阵。我也在看 Rcpp 函数，但我不太清楚如何做到这一点。也许您可以附上执行此操作的代码并显示 2 个输出是等效的？谢谢。

感谢 cosine_vec 函数更快！我试图通过使用 mclapply 而不是 apply 来使其更快，因为我将使用比这个 1000x100 示例更大的矩阵。您创建的 cosine_par1 函数确实具有相同的输出，但速度要慢得多。但是，它不需要遍历所有 i,j 组合，因为输出是对称的（这就是我使用下三角条件的原因）。 foreach 函数不会与我原来的 i,j for 循环条件语句一起使用，然后添加下三角条件吗？

如果需要在两个“foreach”之间插入一些命令，怎么做？我收到类似"%:%" was passed an illegal right operand

的错误

【参考方案2】：

在foreach中做嵌套循环并使用并行实现，有两种方法。

%:% + %dopar% %dopar% + %do%

请注意，对于 (1)，它实际上创建了一个 foreach 对象，您不能在其间添加任何内容。否则，您将收到错误消息："%:%" was passed an illegal right operand。

对于 (2)，您可以在两者之间插入任何您想要的内容。但请记住将foreach 添加到外部循环中的.package 参数中，因为内部foreach 使用foreach 包。

以下是解决余弦矩阵问题的一种巧妙方法。请注意，为了说明（2），我多加了一行，请记住将其删除以进行余弦矩阵计算。

testfunc <- function (x) 
  cl<-makeCluster(4)
  registerDoParallel(cl)
  co <- foreach(i=1:ncol(x), .combine = 'rbind', .packages = c('foreach', 'stats')) %dopar% 
    k <- rnorm(3)
    foreach (j=1:ncol(x), .combine = 'c') %do% 
      crossprod(x[, i], x[, j])/sqrt(crossprod(x[, i]) * crossprod(x[, j])) + k - k
    
  
  stopCluster(cl)
  co

x <- array(data=sample(20*10), dim=c(20, 10))
testfunc(x)