Commit 3723f14f authored by de Lavenne Alban's avatar de Lavenne Alban
Browse files

feat: allow to distinguish number of cores for sampling and Ghosh distance

No related merge requests found
Showing with 12 additions and 7 deletions
+12 -7
...@@ -19,7 +19,9 @@ ...@@ -19,7 +19,9 @@
#' of length two to distinguish between parallelisation of sampling and Ghosh distance #' of length two to distinguish between parallelisation of sampling and Ghosh distance
#' (because sampling over large areas can be memory intensive) #' (because sampling over large areas can be memory intensive)
#' @param cores the number of cores to use for parallel execution if \code{parallel} is TRUE. #' @param cores the number of cores to use for parallel execution if \code{parallel} is TRUE.
#' If not specified, the number of cores is set to the value of \code{parallel::detectCores()} #' If not specified, the number of cores is set to the value of \code{parallel::detectCores()}.
#' Similarly to \code{parallel}, it could be a vector of length two to distinguish between
#' parallelisation of sampling and Ghosh distance
#' @param verbose boolean indicating if information messages should be written to the console #' @param verbose boolean indicating if information messages should be written to the console
#' @param ... further arguments passed to or from other methods #' @param ... further arguments passed to or from other methods
#' @return A matrix of class units with the catchments of \code{x} organised in rows #' @return A matrix of class units with the catchments of \code{x} organised in rows
...@@ -60,8 +62,9 @@ hdist.sfc <- function(x, y, method="rghosh", gres=5, ditself=FALSE, maxsample=2. ...@@ -60,8 +62,9 @@ hdist.sfc <- function(x, y, method="rghosh", gres=5, ditself=FALSE, maxsample=2.
if(verbose) cat("Sampling the catchments at a resolution of about",gres,"pts/km2\n") if(verbose) cat("Sampling the catchments at a resolution of about",gres,"pts/km2\n")
if(length(parallel)==1) parallel[1:2] <- parallel if(length(parallel)==1) parallel[1:2] <- parallel
if(any(parallel) & (missing(cores)|is.null(cores))) cores <- parallel::detectCores() if(any(parallel) & (missing(cores)|is.null(cores))) cores <- parallel::detectCores()
if(length(cores)==1) cores[1:2] <- cores
if(parallel[1]){ if(parallel[1]){
cl <- parallel::makeCluster(cores) cl <- parallel::makeCluster(cores[1])
doParallel::registerDoParallel(cl=cl) doParallel::registerDoParallel(cl=cl)
on.exit(parallel::stopCluster(cl)) on.exit(parallel::stopCluster(cl))
} }
...@@ -98,12 +101,12 @@ hdist.sfc <- function(x, y, method="rghosh", gres=5, ditself=FALSE, maxsample=2. ...@@ -98,12 +101,12 @@ hdist.sfc <- function(x, y, method="rghosh", gres=5, ditself=FALSE, maxsample=2.
} }
} }
if(verbose) cat("Computing Ghosh distance between catchments\n") if(verbose) cat("Computing Ghosh distance between catchments\n")
gdist <- loop_gdist(xdisc=xdisc, ydisc=ydisc, proj=proj, intersect=FALSE, parallel=parallel[2], cores=cores) gdist <- loop_gdist(xdisc=xdisc, ydisc=ydisc, proj=proj, intersect=FALSE, parallel=parallel[2], cores=cores[2])
if(ditself){ if(ditself){
if(verbose) cat("Computing Ghosh distance within catchments\n") if(verbose) cat("Computing Ghosh distance within catchments\n")
if(!identical(x,y)){ if(!identical(x,y)){
gdist <- cbind(gdist,sapply(xdisc,FUN=function(x){call_gdist(pts1=x, pts2=x, proj=proj, intersect=FALSE, rescale=FALSE, diag=TRUE, parallel=parallel[2], cores=cores)})) gdist <- cbind(gdist,sapply(xdisc,FUN=function(x){call_gdist(pts1=x, pts2=x, proj=proj, intersect=FALSE, rescale=FALSE, diag=TRUE, parallel=parallel[2], cores=cores[2])}))
gdist <- rbind(gdist,c(sapply(ydisc,FUN=function(x){call_gdist(pts1=x, pts2=x, proj=proj, intersect=FALSE, rescale=FALSE, diag=TRUE, parallel=parallel[2], cores=cores)}),NA)) gdist <- rbind(gdist,c(sapply(ydisc,FUN=function(x){call_gdist(pts1=x, pts2=x, proj=proj, intersect=FALSE, rescale=FALSE, diag=TRUE, parallel=parallel[2], cores=cores[2])}),NA))
}else{ }else{
gdist <- cbind(gdist,diag(gdist)) gdist <- cbind(gdist,diag(gdist))
gdist <- rbind(gdist,c(diag(gdist),NA)) gdist <- rbind(gdist,c(diag(gdist),NA))
...@@ -113,7 +116,7 @@ hdist.sfc <- function(x, y, method="rghosh", gres=5, ditself=FALSE, maxsample=2. ...@@ -113,7 +116,7 @@ hdist.sfc <- function(x, y, method="rghosh", gres=5, ditself=FALSE, maxsample=2.
if(method=="rghosh2"){ if(method=="rghosh2"){
gc() # Clean memory gc() # Clean memory
if(verbose) cat("Computing Ghosh distance within the shared areas\n") if(verbose) cat("Computing Ghosh distance within the shared areas\n")
idist <- loop_gdist(xdisc=xdisc, ydisc=ydisc, proj=proj, intersect=TRUE, parallel=parallel[2], cores=cores) idist <- loop_gdist(xdisc=xdisc, ydisc=ydisc, proj=proj, intersect=TRUE, parallel=parallel[2], cores=cores[2])
if(verbose) cat("Rescaling Ghosh distance\n") if(verbose) cat("Rescaling Ghosh distance\n")
gdist <- gdist-idist gdist <- gdist-idist
} }
......
...@@ -56,7 +56,9 @@ of length two to distinguish between parallelisation of sampling and Ghosh dista ...@@ -56,7 +56,9 @@ of length two to distinguish between parallelisation of sampling and Ghosh dista
(because sampling over large areas can be memory intensive)} (because sampling over large areas can be memory intensive)}
\item{cores}{the number of cores to use for parallel execution if \code{parallel} is TRUE. \item{cores}{the number of cores to use for parallel execution if \code{parallel} is TRUE.
If not specified, the number of cores is set to the value of \code{parallel::detectCores()}} If not specified, the number of cores is set to the value of \code{parallel::detectCores()}.
Similarly to \code{parallel}, it could be a vector of length two to distinguish between
parallelisation of sampling and Ghosh distance}
\item{verbose}{boolean indicating if information messages should be written to the console} \item{verbose}{boolean indicating if information messages should be written to the console}
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment