doParallel производительность по тензору в R

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% времени выполнения были накладными. Это связано с гранулярностью задачи. Различные типы задач выигрывают от различных типов детализации. В вашем случае вы можете извлечь выгоду из разделения ваших задач в грубой форме. Это в основном означает, что вы группируете количество задач таким образом, чтобы уменьшить накладные расходы на связь:

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 должен ждать завершения всех параллельных рабочих, но, возможно, у вас есть другие причины, возможно, поддержание отзывчивости системы.

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)