Распараллелить для цикла в R - PullRequest
Новая
       22

Распараллелить для цикла в R

0 голосов
/ 11 марта 2019

Я пытаюсь узнать, как использовать параллельную обработку в R. Ниже приведен снимок данных и кода.

Создание грубого набора данных 

library(truncnorm)
#Creating a mock dataframe
Market =c('City1','City2','City3','City4','City5','City2','City4','City1','City3','City5')
Car_type = c('A','A','A','A','A','B','B','B','B','B')
Variable1=c(.34,.19,.85,.27,.32,.43,.22,.56,.17,.11)
Car_purchased = c(1,0,0,1,0,1,0,0,1,1)
Market_data = data.frame(Market,Car_type,Variable1,Car_purchased)    
Market_data2=do.call("rbind", replicate(100, Market_data, simplify = FALSE)) 
#Create a bigger dataset
Market_data2$Final_value = 0 #create a column of for future calculation
empty_list = list()

Написание функциии запуск функции 

Car_Value=function(data){
  market_list=unique(Market_data2$Market)
  for (m in market_list){
    market_subset = Market_data2[which(Market_data2$Market==m),]
    for (i in 1:nrow(market_subset)){
      if(market_subset[i,'Car_purchased']==1){
        market_subset[i,'Final_value'] = rtruncnorm(1,a=-10,b=0,mean=max(market_subset$Variable1),sd=1)
      } else{
        market_subset[i,'Final_value'] = rtruncnorm(1,a=-10,b=0,mean = market_subset[i,'Variable1'],sd=1)
      }
    }
    empty_list=rbind(empty_list,market_subset)
  }
  return(empty_list)
}

get_value = Car_Value(data=Market_data2)

. В приведенном выше примере всего 5 "Market" для автомобилей и 2 "Car_type".Потребители, возможно, купили автомобили на любом рынке.Я должен рассчитать значение ("Final_value") из данного усеченного нормального распределения.Это значение зависит только от значения Variable1 данного рынка.Вот почему я использую внешний цикл for.Средство усеченного нормального распределения зависит от значения Variable1 (max (Variable1) на рынке, если Car_purchased == 1, или заданного значения, если Car_purchased == 0).Эта версия кода работает идеально (хотя она не оптимизирована для скорости).

Проблема

Далее я хотел бы использовать параллельную обработку для внешнего цикла for, т.е. дляпетля между рынками, поскольку Final_value рынка зависит только от наблюдений внутри рынка.

К сожалению, я знаю, как реализовать параллельную обработку для каждой строки набора данных.Например,Мой код (приведенный ниже) назначает 1-ю строку 1-му ядру, 2-ю строку 2-му ядру и т. д. Это неэффективно и занимает много времени, так как каждая строка должна создать подмножество, а затем найти максимумподмножества.

Моя неэффективная версия 

library(parallel)
library(foreach)
library(doParallel)
library(iterators)
library(utils)
library(truncnorm)

cl=parallel::makeCluster(4,type="PSOCK") 
registerDoParallel(cl)
clusterEvalQ(cl, {library(truncnorm)})

Car_Value_Parallel <- function(market_data){
  output <- foreach(x = iter(market_data, by = "row"), .combine = rbind) %dopar% {
    market_subset = market_data[which(market_data$Market==x$Market),]
    if(x['Car_purchased']==1){
      x['Final_value'] = rtruncnorm(1,a=-10,b=0,mean=max(market_subset$Variable1),sd=1)
    } else{
      x['Final_value'] = rtruncnorm(1,a=-10,b=0,mean = x['Variable1'],sd=1)
    }
    return(x)
  }
  output
}

get_value_parallel = Car_Value_Parallel(market_data = Market_data2)
stopCluster(cl)

Это крайне неэффективно, если я запускаю его на наборе данных размером> 100 КБ (мой фактический набор данных составляет около 1,2 миллиона строк). Однако я не смог реализовать распараллеливание на уровне рынка, где параллельные вычисления будут выглядеть следующим образом: Запустите вычисления для City1 в 1-м ядре, City2 во 2-м ядре и т. Д. Может кто-нибудь помочь, пожалуйста?Любая помощь приветствуется.Спасибо.

PS Мои извинения за длинный вопрос.Я просто хотел показать все версии кода, которые я использовал.

1 Ответ

3 голосов
/ 11 марта 2019

Не вижу смысла проводить параллельную обработку с вашим набором данных.Вместо этого посмотрите на пакеты типа dplyr или data.table для более эффективного решения.

Исходя из моего понимания вашей проблемы, для каждого Market вы хотите применить rtruncnorm для создания переменной Final_value, где средний аргумент функции rtruncnorm зависит от переменной Car_purchased.

Мы можем сделать это без использования цикла for, используя dplyr. 

library(truncnorm)
library(dplyr)

# Creating a mock dataframe
Market <- c("City1", "City2", "City3", "City4", "City5", "City2", "City4", "City1", "City3", "City5")
Variable1 <- c(.34, .19, .85, .27, .32, .43, .22, .56, .17, .11)
Car_purchased <- c(1, 0, 0, 1, 0, 1, 0, 0, 1, 1)
Market_data <- data.frame(Market, Car_type, Variable1, Car_purchased)
Market_data2 <- replicate(100, Market_data, simplify = FALSE) %>% bind_rows()
#Create a bigger dataset
Market_data2$Final_value = 0 #create a column of for future calculation
empty_list = list()

Car_Value2 <- function(data) {
  data %>%
    group_by(Market) %>%
    mutate(
      Final_value = if_else(
        Car_purchased == 1,
        rtruncnorm(1, a = -10, b = 0, mean = max(Variable1), sd = 1),
        rtruncnorm(1, a = -10, b = 0, mean = Variable1, sd = 1)
      )
    )
}


microbenchmark::microbenchmark(
  Car_Value(Market_data2),
  Car_Value2(Market_data2),
  times = 100
)
#> Unit: milliseconds
#>                      expr       min        lq      mean   median        uq
#>   Car_Value(Market_data2) 66.109304 68.043575 69.030763 68.56569 69.681255
#>  Car_Value2(Market_data2)  1.073318  1.101578  1.204737  1.17583  1.230687
#>        max neval cld
#>  89.497035   100   b
#>   3.465425   100  a


# Even bigger dataframe
Market_data3 <- replicate(120000, Market_data, simplify = FALSE) %>% bind_rows()


microbenchmark::microbenchmark(
  Car_Value2(data = Market_data3),
  times = 100 
)
#> Unit: milliseconds
#>                             expr      min       lq     mean   median
#>  Car_Value2(data = Market_data3) 338.4615 341.7134 375.8769 397.7133
#>        uq      max neval
#>  399.8733 412.5134   100

Создано в 2019-03-10 с помощью представпакет (v0.2.1)

...