Skip to content

Instantly share code, notes, and snippets.

@JimGrange
Created July 20, 2019 07:50
Show Gist options
  • Save JimGrange/2d03394c1a3e9aa041e6937ea4aea184 to your computer and use it in GitHub Desktop.
Save JimGrange/2d03394c1a3e9aa041e6937ea4aea184 to your computer and use it in GitHub Desktop.
Examples of different parallelisations in R
# https://nceas.github.io/oss-lessons/parallel-computing-in-r/parallel-computing-in-r.html
library(parallel)
library(foreach)
library(doParallel)
library(snow)
set.seed(42)
n_subs <- 100000
n_trials <- 5000
mu <- rnorm(n_subs, 800, 50)
sigma <- rnorm(n_subs, 180, 10)
tau <- runif(n_subs, 1, 100)
data <- data.frame(
mu = mu,
sigma = sigma,
tau = tau)
# function that will be called in parallel
do_sim <- function(parameters, n_trials = 5000){
sub_parms <- as.numeric(parameters)
sub_rts <- rnorm(n_trials, sub_parms[1], sub_parms[2]) +
rexp(rexp(n_trials, 1 / sub_parms[3]))
sub_cdfs <- round(quantile(sub_rts, probs = c(.1, .3, .5, .7, .9)), 0)
out <- rbind(data.frame(), sub_cdfs)
sub_cdfs
}
do_reg <- function(){
# pass the data to a set of lists
split_data <- split(data, 1:nrow(data))
out_reg <- lapply(split_data, do_sim)
out_reg <- matrix(unlist(out_reg), ncol = 5, byrow = TRUE)
}
# parallel package
do_multi <- function(){
num_cores <- detectCores()
split_data <- split(data, 1:nrow(data))
out_multi <- mclapply(split_data, do_sim, mc.cores = num_cores)
out_multi <- matrix(unlist(out_multi), ncol = 5, byrow = TRUE)
}
# foreach package
do_for_each <- function(){
num_cores <- detectCores()
registerDoParallel(num_cores)
out_for_each <- foreach(i = 1:nrow(data)) %dopar% {
do_sim(data[i, ])
}
out_for_each<- matrix(unlist(out_for_each), ncol = 5, byrow = TRUE)
}
# snow package (https://hernanresnizky.com/2014/01/10/quick-guide-to-parallel-r-with-snow/)
do_snow <- function(){
num_cores <- detectCores()
clus <- makeCluster(num_cores)
clusterExport(clus, "n_trials")
split_data <- split(data, 1:nrow(data))
out_snow <- parRapply(clus, data, do_sim)
out_snow <- matrix(out_snow, ncol = 5, byrow = FALSE)
}
system.time(out_reg <- do_reg())
system.time(out_multi <- do_multi())
system.time(out_for_each <- do_for_each())
system.time(out_snow <- do_snow())
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment