doParallel производительность по тензору в R - PullRequest
Новая
       11

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

0 голосов
/ 11 июня 2018

Мне нужно выполнить некоторые операции над тензором, и я хотел бы сделать эту параллель.Рассмотрим следующий пример: 

# 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 ]

0 голосов
/ 11 июня 2018

Вам нужно знать определенные вещи, когда вы хотите использовать распараллеливание.Первый - это накладные расходы из-за связи и, возможно, сериализации.В качестве очень грубого примера рассмотрим следующее: 

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

0 голосов
/ 11 июня 2018

Только что заметил, что ваш код работает, если вы установили тип кластера "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)
...