Home Articles

R中张量的doParallel性能

Asked
Viewed 970 times
0

我需要对张量执行一些操作,我想让它并行 . 请考虑以下示例:

# 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秒 . 因此,我认为时间方面没有任何改善 . 有谁知道这是什么原因?

2 Answers

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

    以上在我的系统中完成了17.978秒,使用了2个并行工作程序 .

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

Related