From 42b14de61b7874f1497c3ccb888b9c044a9657d4 Mon Sep 17 00:00:00 2001 From: Jonathan Marshall Date: Tue, 22 Sep 2020 11:44:31 +1200 Subject: [PATCH 1/2] factor out the creation/destruction of clusters for parallel processing --- R/BandsPartition_TMLA.R | 13 ++----------- R/BlockPartition_TMLA.R | 13 +++---------- R/Ensemble_TMLA.R | 12 ++---------- R/FitENM_Parallel_TMLA.R | 15 +++------------ R/M_delimited_TMLA.R | 24 ++++-------------------- R/cluster.R | 18 ++++++++++++++++++ 6 files changed, 32 insertions(+), 63 deletions(-) create mode 100644 R/cluster.R diff --git a/R/BandsPartition_TMLA.R b/R/BandsPartition_TMLA.R index 65886c6..305d210 100644 --- a/R/BandsPartition_TMLA.R +++ b/R/BandsPartition_TMLA.R @@ -18,16 +18,7 @@ BandsPartition_TMLA <- function(evnVariables = NULL, #Development #Start Cluster - if (Sys.getenv("RSTUDIO") == "1" && - !nzchar(Sys.getenv("RSTUDIO_TERM")) && - Sys.info()["sysname"] == "Darwin" && - as.numeric(gsub('[.]', '', getRversion())) >= 360) { - cl <- parallel::makeCluster(cores,outfile="", setup_strategy = "sequential") - }else{ - cl <- parallel::makeCluster(cores,outfile="") - } - doParallel::registerDoParallel(cl) - + cl <- start_cluster(cores) #Separate data by groups RecordsData <- @@ -583,6 +574,6 @@ BandsPartition_TMLA <- function(evnVariables = NULL, sep = "\t", row.names = F ) - parallel::stopCluster(cl) + stop_cluster(cl) return(FinalResult) } diff --git a/R/BlockPartition_TMLA.R b/R/BlockPartition_TMLA.R index 3dc0ac9..5e562af 100644 --- a/R/BlockPartition_TMLA.R +++ b/R/BlockPartition_TMLA.R @@ -42,15 +42,7 @@ BlockPartition_TMLA <- function(evnVariables = NULL, # BestGridList <- rep(list(NULL),length(RecordsData)) #Start Cluster - if (Sys.getenv("RSTUDIO") == "1" && - !nzchar(Sys.getenv("RSTUDIO_TERM")) && - Sys.info()["sysname"] == "Darwin" && - as.numeric(gsub('[.]', '', getRversion())) >= 360) { - cl <- parallel::makeCluster(cores,outfile="", setup_strategy = "sequential") - }else{ - cl <- parallel::makeCluster(cores,outfile="") - } - doParallel::registerDoParallel(cl) + cl <- start_cluster(cores) # LOOP---- results <- @@ -598,7 +590,8 @@ BlockPartition_TMLA <- function(evnVariables = NULL, return(out) } - parallel::stopCluster(cl) + stop_cluster(cl) + FinalResult <- dplyr::bind_rows(lapply(results, function(x) x[[1]])) FinalInfoGrid <- dplyr::bind_rows(lapply(results, function(x) x[[2]])) diff --git a/R/Ensemble_TMLA.R b/R/Ensemble_TMLA.R index 95be8ee..806c0da 100644 --- a/R/Ensemble_TMLA.R +++ b/R/Ensemble_TMLA.R @@ -11,15 +11,7 @@ Ensemble_TMLA <- function(DirR, cores, ensemble_metric = NULL) { #Start Cluster---- - if (Sys.getenv("RSTUDIO") == "1" && - !nzchar(Sys.getenv("RSTUDIO_TERM")) && - Sys.info()["sysname"] == "Darwin" && - as.numeric(gsub('[.]', '', getRversion())) >= 360) { - cl <- parallel::makeCluster(cores,outfile="", setup_strategy = "sequential") - }else{ - cl <- parallel::makeCluster(cores,outfile="") - } - doParallel::registerDoParallel(cl) + cl <- start_cluster(cores) #Create Folders---- DirENS <- paste(DirR, "Ensemble", sep = "/") @@ -629,5 +621,5 @@ Ensemble_TMLA <- function(DirR, col.names = T, row.names = F ) - parallel::stopCluster(cl) + stop_cluster(cl) } diff --git a/R/FitENM_Parallel_TMLA.R b/R/FitENM_Parallel_TMLA.R index 77ac014..9412485 100644 --- a/R/FitENM_Parallel_TMLA.R +++ b/R/FitENM_Parallel_TMLA.R @@ -26,17 +26,8 @@ FitENM_TMLA_Parallel <- function(RecordsData, Ti <- Sys.time() options(warn = -1) - #Start Cluster - # temporary parallel package debug for macOS systems - if (Sys.getenv("RSTUDIO") == "1" && - !nzchar(Sys.getenv("RSTUDIO_TERM")) && - Sys.info()["sysname"] == "Darwin" && - as.numeric(gsub('[.]', '', getRversion())) >= 360) { - cl <- parallel::makeCluster(cores,outfile="", setup_strategy = "sequential") - }else{ - cl <- parallel::makeCluster(cores,outfile="") - } - doParallel::registerDoParallel(cl) + #Start Cluster if necessary + cl <- start_cluster(cores) # Directory to save---- folders <- paste(DirSave,"Algorithm",Algorithm,sep="/") @@ -4058,5 +4049,5 @@ InfoModeling <- list(c("######################################################## lapply(InfoModeling, write, paste(DirSave, "/InfoModeling.txt", sep=""), append=TRUE, ncolumns=20, sep='\t') - parallel::stopCluster(cl) + stop_cluster(cl) } diff --git a/R/M_delimited_TMLA.R b/R/M_delimited_TMLA.R index c5f1df1..d8bce4f 100644 --- a/R/M_delimited_TMLA.R +++ b/R/M_delimited_TMLA.R @@ -76,15 +76,7 @@ M_delimited <- function(var, return(x) }) - if (Sys.getenv("RSTUDIO") == "1" && - !nzchar(Sys.getenv("RSTUDIO_TERM")) && - Sys.info()["sysname"] == "Darwin" && - as.numeric(gsub('[.]', '', getRversion())) >= 360) { - cl <- parallel::makeCluster(cores,outfile="", setup_strategy = "sequential") - }else{ - cl <- parallel::makeCluster(cores,outfile="") - } - doParallel::registerDoParallel(cl) + cl <- start_cluster(cores) foreach(i = 1:length(M_list), .packages = c("raster")) %dopar% { if (Buffer_Opt == 2) { @@ -105,7 +97,7 @@ M_delimited <- function(var, format = "GTiff", overwrite = T) } - parallel::stopCluster(cl) + stop_cluster(cl) } if (method == 'MASK') { @@ -136,15 +128,7 @@ M_delimited <- function(var, x <- x[x != 0] }) - if (Sys.getenv("RSTUDIO") == "1" && - !nzchar(Sys.getenv("RSTUDIO_TERM")) && - Sys.info()["sysname"] == "Darwin" && - as.numeric(gsub('[.]', '', getRversion())) >= 360) { - cl <- parallel::makeCluster(cores,outfile="", setup_strategy = "sequential") - }else{ - cl <- parallel::makeCluster(cores,outfile="") - } - doParallel::registerDoParallel(cl) + cl <- start_cluster(cores) foreach(i = 1:length(sp.Ecoregions), .packages = c("raster")) %dopar% { EcoregionSp <- EcoregionsFile @@ -159,7 +143,7 @@ M_delimited <- function(var, overwrite = T ) } - parallel::stopCluster(cl) + stop_cluster(cl) } if (method == 'USER-DEFINED') { diff --git a/R/cluster.R b/R/cluster.R new file mode 100644 index 0000000..309de3f --- /dev/null +++ b/R/cluster.R @@ -0,0 +1,18 @@ + +start_cluster <- function(cores) { + cl <- NULL + if (Sys.getenv("RSTUDIO") == "1" && + !nzchar(Sys.getenv("RSTUDIO_TERM")) && + Sys.info()["sysname"] == "Darwin" && + as.numeric(gsub('[.]', '', getRversion())) >= 360) { + cl <- parallel::makeCluster(cores,outfile="", setup_strategy = "sequential") + }else{ + cl <- parallel::makeCluster(cores,outfile="") + } + doParallel::registerDoParallel(cl) + return(cl) +} + +stop_cluster <- function(cluster) { + parallel::stopCluster(cluster) +} From add241b806c62d7bab765f57503cd0256d2bbf72 Mon Sep 17 00:00:00 2001 From: Jonathan Marshall Date: Tue, 22 Sep 2020 11:45:29 +1200 Subject: [PATCH 2/2] only use parallel processing if cores > 1 --- R/cluster.R | 22 +++++++++++++--------- 1 file changed, 13 insertions(+), 9 deletions(-) diff --git a/R/cluster.R b/R/cluster.R index 309de3f..c3ec185 100644 --- a/R/cluster.R +++ b/R/cluster.R @@ -1,18 +1,22 @@ start_cluster <- function(cores) { cl <- NULL - if (Sys.getenv("RSTUDIO") == "1" && - !nzchar(Sys.getenv("RSTUDIO_TERM")) && - Sys.info()["sysname"] == "Darwin" && - as.numeric(gsub('[.]', '', getRversion())) >= 360) { - cl <- parallel::makeCluster(cores,outfile="", setup_strategy = "sequential") - }else{ - cl <- parallel::makeCluster(cores,outfile="") + if (cores > 1) { + if (Sys.getenv("RSTUDIO") == "1" && + !nzchar(Sys.getenv("RSTUDIO_TERM")) && + Sys.info()["sysname"] == "Darwin" && + as.numeric(gsub('[.]', '', getRversion())) >= 360) { + cl <- parallel::makeCluster(cores,outfile="", setup_strategy = "sequential") + }else{ + cl <- parallel::makeCluster(cores,outfile="") + } + doParallel::registerDoParallel(cl) } - doParallel::registerDoParallel(cl) return(cl) } stop_cluster <- function(cluster) { - parallel::stopCluster(cluster) + if (!is.null(cluster)) { + parallel::stopCluster(cluster) + } }