R中张量的doParallel性能

Question

我需要在张量上执行一些操作，我想将其并行化。考虑以下示例：

# first part without doParallel

N = 8192
M = 128
F = 64

ma <- function(x,n=5){filter(x,rep(1/n,n), sides=2)}


m <- array(rexp(N*M*F), dim=c(N,M,F))

new_m <- array(0, dim=c(N,M,F))

system.time ( for(i in 1:N) {
        for(j in 1:F) {
            ma_r <- ma(m[i,,j],2)
            ma_r <- c(ma_r[-length(ma_r)], ma_r[(length(ma_r)-1)])
            new_m[i,,j] <- ma_r       
        }
    }
)

在我的笔记本电脑上，这大约需要38秒。以下是与doParallel相关的内容：

# second part with doParallel

library(doParallel)  
no_cores <- detectCores() - 1  
cl <- makeCluster(no_cores, type="FORK")  
registerDoParallel(cl)


calcMat <- function(x){

    n <- dim(x)[1]
    m <- dim(x)[2]

    new_x <- matrix(0, nrow=n, ncol=m)

    for(j in 1:ncol(x)) {
        ma_r <- ma(x[,j],2)
        ma_r <- c(ma_r[-length(ma_r)], ma_r[(length(ma_r)-1)])
        new_x[,j] <- ma_r       
    }

    return(new_x)

}


system.time ( a_list <- foreach(i=1:N) %dopar% {
    m_m <- m[i,,]
    new_m_m <- calcMat(m_m)
 }
)


Y <- array(unlist(a_list), dim = c(nrow(a_list[[1]]), ncol(a_list[[1]]), length(a_list)))
Y <- aperm(Y, c(3,1,2))


stopCluster(cl) 

第二个大约需要36秒。因此，我看不到在时间方面有任何改进。有人知道这是什么原因吗？

Answer 1

当你想要使用并行化的时候，你需要注意某些事情。第一个是由于通信和可能的序列化而产生的开销。作为一个非常粗糙的示例，请考虑以下内容：

num_cores <- 2L
cl <- makeCluster(num_cores, type="FORK")
registerDoParallel(cl)

exec_time <- system.time({
    a_list <- foreach(i=1L:2L) %dopar% {
        system.time({
            m_m <- m[i,,]
            new_m_m <- calcMat(m_m)
        })
    }
})

在我的系统中，exec_time显示的运行时间为1.264秒，而a_list中的运行时间显示为0.003秒。因此，以一种非常简单的方式，我们可以说99.7%的执行时间是开销。这与task granularity有关。不同类型的任务受益于不同类型的粒度。在您的情况下，您可以受益于以粗略的方式将任务分块。这基本上意味着您以一种减少通信开销的方式对任务数量进行分组：

chunks <- splitIndices(N, num_cores)
str(chunks)
List of 2
 $ : int [1:4096] 1 2 3 4 5 6 7 8 9 10 ...
 $ : int [1:4096] 4097 4098 4099 4100 4101 4102 4103 4104 4105 4106 ...

每个块都有几个任务的索引，因此您需要适当地修改代码：

exec_time_chunking <- system.time({
    a_list <- foreach(chunk=chunks, .combine=c) %dopar% {
        lapply(chunk, function(i) {
            m_m <- m[i,,]
            calcMat(m_m)
        })
    }
})

在我的系统中，使用2个并行工作线程，上述操作在17.978秒内完成。

编辑:作为附注，我认为通常没有很好的理由将并行工作进程的数量设置为detectCores() - 1L，因为主R进程必须等待所有并行工作进程完成，但也许您有其他原因，可能是为了保持系统响应能力。

Answer 2

我注意到如果你把集群类型设置为"SOCK“，你的代码就能正常工作。

cl <- makeCluster(numberofcores, type = "SOCK")

注意:在Windows上这不起作用，我使用了doSNOW包(我发现它在多个操作系统上有更好的兼容性)

下面的代码运行得更快

library(parallel)
library(doSNOW)

numberofcores = detectCores()  # review what number of cores does for your environment

cl <- makeCluster(numberofcores, type = "SOCK")
# Register cluster so that caret will know to train in parallel.
registerDoSNOW(cl)

system.time ( foreach(i = 1:N) %dopar% {
  for(j in 1:F)  {
    ma_r <- ma(m[i,,j],2)
    ma_r <- c(ma_r[-length(ma_r)], ma_r[(length(ma_r)-1)])
    new_m[i,,j] <- ma_r       
  }
}
)

stopCluster(cl)