Feature: MPI parallel

.Rbuildignore

@@ -9,6 +9,7 @@ src/libgwmodel/Doxygen\.zh-Hans
 src/libgwmodel/\.readthedocs\.yaml
 src/libgwmodel/test
 src/libgwmodel/docs
+tests/others
 ^_pkgdown\.yml$
 ^docs$
 ^pkgdown$

.github/workflows/cran-check.yml

@@ -38,7 +38,7 @@ jobs:
           check-dir: '"check"'
 
   check_macos:
-    runs-on: macos-12
+    runs-on: macos-14
     steps:
       - name: Checkout
         uses: actions/checkout@v3
@@ -49,7 +49,9 @@ jobs:
         with:
           r-version: 'release'
       - name: Install Dependencies
-        run: brew install gsl pandoc
+        run: brew install gsl pandoc open-mpi
+      - name: Install Rmpi
+        run: Rscript -e 'install.packages("Rmpi", configure.args = c("--with-Rmpi-include=/opt/homebrew/include/", "--with-Rmpi-libpath=/opt/homebrew/lib/", "--with-Rmpi-type=OPENMPI"))'
       - name: Install R Dependencies
         uses: r-lib/actions/setup-r-dependencies@v2
         with:

.github/workflows/pages.yml

@@ -34,7 +34,7 @@ jobs:
       - name: Install C++ dependencies
         run: |
           sudo apt-get update -qq
-          sudo apt-get install -qq libgsl-dev
+          sudo apt-get install -qq libgsl-dev libopenmpi-dev
 
       - name: Set up R
         uses: r-lib/actions/setup-r@v2

.gitignore

@@ -62,3 +62,5 @@ docs
 /doc/
 /Meta/
 *.lib
+*.log
+*.out

DESCRIPTION

@@ -47,6 +47,7 @@ RoxygenNote: 7.2.3
 Suggests: 
     testthat (>= 3.0.0),
     knitr,
-    rmarkdown
+    rmarkdown,
+    Rmpi
 Config/testthat/edition: 3
 VignetteBuilder: knitr

R/gwr_basic.R

@@ -67,6 +67,15 @@ gwr_basic <- function(
     kernel = match.arg(kernel)
     parallel_method = match.arg(parallel_method)
     attr(data, "na.action") <- getOption("na.action")
+    is_mpi_workers <- F
+    if (is.loaded("mpi_initialize")) {
+        if (requireNamespace("Rmpi", quietly = TRUE)) {
+            if (Rmpi::mpi.comm.size(0) > 1) {
+                parallel_method <- paste0("mpi.", parallel_method)
+                is_mpi_workers <- Rmpi::mpi.comm.rank(0) > 0
+            }
+        }
+    }
 
     ### Extract coords
     data <- do.call(na.action(data), args = list(data))
@@ -116,6 +125,11 @@ gwr_basic <- function(
     ), error = function (e) {
         stop("Error:", conditionMessage(e))
     })
+
+    if (is_mpi_workers) {
+        return(NULL)
+    }
+
     if (optim_bw)
         bw <- c_result$bandwidth
     betas <- c_result$betas

R/gwr_multiscale.R

@@ -115,6 +115,15 @@ gwr_multiscale <- function(
     parallel_method <- match.arg(parallel_method)
     criterion <- match.arg(criterion)
     attr(data, "na.action") <- getOption("na.action")
+    is_mpi_workers <- F
+    if (is.loaded("mpi_initialize")) {
+        if (requireNamespace("Rmpi", quietly = TRUE)) {
+            if (Rmpi::mpi.comm.size(0) > 1) {
+                parallel_method <- paste0("mpi.", parallel_method)
+                is_mpi_workers <- Rmpi::mpi.comm.rank(0) > 0
+            }
+        }
+    }
 
     ### Extract coords
     data <- do.call(na.action(data), args = list(data))
@@ -216,6 +225,10 @@ gwr_multiscale <- function(
     ), error = function (e) {
         stop("Error:", conditionMessage(e))
     })
+    if (is_mpi_workers) {
+        return(NULL)
+    }
+
     bw_value <- c_result$bw_value
     betas <- c_result$betas
     fitted <- c_result$fitted

R/utils.R

@@ -172,10 +172,12 @@ enum_list <- function(x, labels, default = labels[[1]]) {
 }
 
 parallel_types <- list(
-    "none" = 1,
+    "no" = 1,
     "omp" = 2,
     "cuda" = 4,
-    "cluster" = 8
+    "mpi.no" = 9,
+    "mpi.omp" = 10,
+    "mpi.cuda" = 12
 )
 
 kernel_enums <- c("gaussian", "exp", "bisquare", "tricube", "boxcar")