fix: provide cores=1 when gdist is not parallelised

R/hdist.R

@@ -38,7 +38,7 @@
 #' @examples
 #' data(Oudon)
 #' catchments <- st_geometry(Oudon$obs)
-#' hdist(x = catchments[1:2], y = catchments[3:5], gres = 5, method = "rghosh")
+#' hdist(x = catchments[1:2], y = catchments[3:5], gres = 5, method = "rghosh", parallel=c(FALSE, TRUE), cores=2)
 #' @import sf stars doParallel foreach
 #' @importFrom units set_units drop_units
 #' @useDynLib transfR, .registration = TRUE
@@ -97,12 +97,12 @@ hdist.sfc <- function(x, y, method="rghosh", gres=5, ditself=FALSE, maxsample=2.
       }
     }
     if(verbose) cat("Computing Ghosh distance between catchments\n")
-    gdist <- loop_gdist(xdisc=xdisc, ydisc=ydisc, proj=proj, intersect=FALSE, parallel=c(FALSE, parallel[2]), cores=cores)
+    gdist <- loop_gdist(xdisc=xdisc, ydisc=ydisc, proj=proj, intersect=FALSE, parallel=parallel[2], cores=cores)
     if(ditself){
       if(verbose) cat("Computing Ghosh distance within catchments\n")
       if(!identical(x,y)){
-        gdist <- cbind(gdist,sapply(xdisc,FUN=function(x){call_gdist(pts1=x, pts2=x, proj=proj, rescale=FALSE, diag=TRUE, cores=cores, intersect=FALSE)}))
-        gdist <- rbind(gdist,c(sapply(ydisc,FUN=function(x){call_gdist(pts1=x, pts2=x, proj=proj, rescale=FALSE, diag=TRUE, cores=cores, intersect=FALSE)}),NA))
+        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 <- 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))
       }else{
         gdist <- cbind(gdist,diag(gdist))
         gdist <- rbind(gdist,c(diag(gdist),NA))
@@ -112,7 +112,7 @@ hdist.sfc <- function(x, y, method="rghosh", gres=5, ditself=FALSE, maxsample=2.
     if(method=="rghosh2"){
       gc() # Clean memory
       if(verbose) cat("Computing Ghosh distance within the shared areas\n")
-      idist <- loop_gdist(xdisc=xdisc, ydisc=ydisc, proj=proj, intersect=TRUE, parallel=c(FALSE, parallel[2]), cores=cores)
+      idist <- loop_gdist(xdisc=xdisc, ydisc=ydisc, proj=proj, intersect=TRUE, parallel=parallel[2], cores=cores)
       if(verbose) cat("Rescaling Ghosh distance\n")
       gdist <- gdist-idist
     }
@@ -185,13 +185,14 @@ hdist.transfR <- function(x, y, method="rghosh", weightO=0.8, weightC=0.2, ...){
   return(mdist)
 }
 
-call_gdist <- function(pts1, pts2, proj, rescale, diag, cores, intersect){
+call_gdist <- function(pts1, pts2, proj, intersect, rescale, diag, parallel, cores){
+  if(!parallel) cores = 1
   if(intersect){
     # Compute the Ghosh distance matrix for common points only
     iseq <- st_equals(pts1, pts2, sparse = FALSE)
     pts_inter <- pts1[apply(iseq, MARGIN = 1, FUN = any)]
     if(length(pts_inter)>0){
-      call_gdist(pts1=pts_inter, pts2=pts_inter, proj=proj, rescale=FALSE, diag=FALSE, cores=cores, intersect=FALSE)
+      call_gdist(pts1=pts_inter, pts2=pts_inter, proj=proj, intersect=FALSE, rescale=FALSE, diag=FALSE, parallel=parallel, cores=cores)
     }else{
       return(0)
     }
@@ -203,28 +204,12 @@ call_gdist <- function(pts1, pts2, proj, rescale, diag, cores, intersect){
 }
 
 loop_gdist <- function(xdisc, ydisc, proj, intersect, parallel, cores){
-  if(length(parallel)==1) parallel[1:2] <- parallel
-  if(parallel[1]){ # Never used by the package, FORTRAN/openMP parallelization is preferred
-    if(!identical(xdisc,ydisc)){
-      res <- foreach::"%dopar%"(foreach::foreach(i=1:length(xdisc),.packages="sf"),
-                                sapply(ydisc,FUN=function(x){call_gdist(pts1=x, pts2=xdisc[[i]], proj=proj, rescale=FALSE, diag=FALSE, cores=1, intersect=intersect)}))
-      gdist <- matrix(unlist(res), nrow = length(xdisc), ncol = length(ydisc), byrow = TRUE)
-    }else{
-      res <- foreach::"%dopar%"(foreach::foreach(i=1:length(xdisc),.packages="sf"),{
-        tmp <- sapply(ydisc[i:length(xdisc)],FUN=function(x){call_gdist(pts1=x, pts2=xdisc[[i]], proj=proj, rescale=FALSE, diag=FALSE, cores=1, intersect=intersect)})
-        c(rep(NA,i-1),tmp)
-      })
-      gdist <- matrix(unlist(res), nrow = length(xdisc), ncol = length(ydisc), byrow = TRUE)
-      for(i in 1:length(xdisc)) gdist[,i] <- gdist[i,]
-    }
+  if(!parallel) cores = 1
+  gdist <- matrix(NA,nrow=length(xdisc),ncol=length(ydisc))
+  if(!identical(xdisc,ydisc)){
+    for(i in 1:length(xdisc)) gdist[i,] <- sapply(ydisc,FUN=function(x){call_gdist(pts1=x, pts2=xdisc[[i]], proj=proj, intersect=intersect, rescale=FALSE, diag=FALSE, parallel=parallel, cores=cores)})
   }else{
-    if(!parallel[2]) cores = 1
-    gdist <- matrix(NA,nrow=length(xdisc),ncol=length(ydisc))
-    if(!identical(xdisc,ydisc)){
-      for(i in 1:length(xdisc)) gdist[i,] <- sapply(ydisc,FUN=function(x){call_gdist(pts1=x, pts2=xdisc[[i]], proj=proj, rescale=FALSE, diag=FALSE, cores=cores, intersect=intersect)})
-    }else{
-      for(i in 1:length(xdisc)) gdist[i,i:length(xdisc)] <- gdist[i:length(xdisc),i] <- sapply(ydisc[i:length(xdisc)],FUN=function(x){call_gdist(pts1=x, pts2=xdisc[[i]], proj=proj, rescale=FALSE, diag=FALSE, cores=cores, intersect=intersect)})
-    }
+    for(i in 1:length(xdisc)) gdist[i,i:length(xdisc)] <- gdist[i:length(xdisc),i] <- sapply(ydisc[i:length(xdisc)],FUN=function(x){call_gdist(pts1=x, pts2=xdisc[[i]], proj=proj, intersect=intersect, rescale=FALSE, diag=FALSE, parallel=parallel, cores=cores)})
   }
   units(gdist) <- units(st_distance(xdisc[[1]][1],ydisc[[1]][1])) #units are lost by some operations
   return(gdist)

man/hdist.Rd

@@ -51,9 +51,9 @@ It will add one row and one column in the distance matrix. Only used if method i
 \item{proj}{logical indicating if spatial layer are using a projection. If TRUE, euclidean
 distance is used. If FALSE, the great-circle distance is used}
 
-\item{parallel}{logical indicating if the computation should be parallelised. Could be a vector
+\item{parallel}{logical indicating whether the computation should be parallelised. Could be a vector
 of length two to distinguish between parallelisation of sampling and Ghosh distance
-(as sampling 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.
 If not specified, the number of cores is set to the value of \code{parallel::detectCores()}}