Automated build.

jeksterslab · Dec 29, 2024 · d1e8ce4 · d1e8ce4
1 parent b3bdbcb
commit d1e8ce4
Show file tree

Hide file tree

Showing 16 changed files with 1,250 additions and 536 deletions.
diff --git a/R/cTMed-boot-med-dot.R b/R/cTMed-boot-med-dot.R
@@ -9,58 +9,116 @@
   par <- FALSE
   if (!is.null(ncores)) {
     ncores <- as.integer(ncores)
+    R <- length(phi)
+    if (ncores > R) {
+      ncores <- R
+    }
     if (ncores > 1) {
       par <- TRUE
     }
   }
   if (par) {
-    cl <- parallel::makeCluster(ncores)
-    on.exit(
-      parallel::stopCluster(cl = cl)
-    )
-    output <- lapply(
-      X = delta_t,
-      FUN = function(i) {
-        thetahatstar <- parallel::parLapply(
-          cl = cl,
-          X = phi,
-          fun = .Med,
-          delta_t = i,
-          from = from,
-          to = to,
-          med = med
-        )
-        thetahatstar <- do.call(
-          what = "rbind",
-          args = thetahatstar
-        )
-        colnames(thetahatstar) <- c(
-          "total",
-          "direct",
-          "indirect",
-          "interval"
-        )
-        est <- .Med(
-          phi = phi_hat,
-          delta_t = i,
-          from = from,
-          to = to,
-          med = med
-        )
-        names(est) <- c(
-          "total",
-          "direct",
-          "indirect",
-          "interval"
-        )
-        out <- list(
-          delta_t = i,
-          est = est,
-          thetahatstar = thetahatstar
-        )
-        return(out)
-      }
-    )
+    os_type <- Sys.info()["sysname"]
+    if (os_type == "Darwin") {
+      fork <- TRUE
+    } else if (os_type == "Linux") {
+      fork <- TRUE
+    } else {
+      fork <- FALSE
+    }
+    if (fork) {
+      output <- lapply(
+        X = delta_t,
+        FUN = function(i) {
+          thetahatstar <- parallel::mclapply(
+            X = phi,
+            FUN = .Med,
+            delta_t = i,
+            from = from,
+            to = to,
+            med = med,
+            mc.cores = ncores
+          )
+          thetahatstar <- do.call(
+            what = "rbind",
+            args = thetahatstar
+          )
+          colnames(thetahatstar) <- c(
+            "total",
+            "direct",
+            "indirect",
+            "interval"
+          )
+          est <- .Med(
+            phi = phi_hat,
+            delta_t = i,
+            from = from,
+            to = to,
+            med = med
+          )
+          names(est) <- c(
+            "total",
+            "direct",
+            "indirect",
+            "interval"
+          )
+          out <- list(
+            delta_t = i,
+            est = est,
+            thetahatstar = thetahatstar
+          )
+          return(out)
+        }
+      )
+    } else {
+      cl <- parallel::makeCluster(ncores)
+      on.exit(
+        parallel::stopCluster(cl = cl)
+      )
+      output <- lapply(
+        X = delta_t,
+        FUN = function(i) {
+          thetahatstar <- parallel::parLapply(
+            cl = cl,
+            X = phi,
+            fun = .Med,
+            delta_t = i,
+            from = from,
+            to = to,
+            med = med
+          )
+          thetahatstar <- do.call(
+            what = "rbind",
+            args = thetahatstar
+          )
+          colnames(thetahatstar) <- c(
+            "total",
+            "direct",
+            "indirect",
+            "interval"
+          )
+          est <- .Med(
+            phi = phi_hat,
+            delta_t = i,
+            from = from,
+            to = to,
+            med = med
+          )
+          names(est) <- c(
+            "total",
+            "direct",
+            "indirect",
+            "interval"
+          )
+          out <- list(
+            delta_t = i,
+            est = est,
+            thetahatstar = thetahatstar
+          )
+          return(out)
+        }
+      )
+    }
     # nocov end
   } else {
     output <- lapply(

diff --git a/R/cTMed-delta-beta-std.R b/R/cTMed-delta-beta-std.R
@@ -260,6 +260,10 @@ DeltaBetaStd <- function(phi,
   par <- FALSE
   if (!is.null(ncores)) {
     ncores <- as.integer(ncores)
+    R <- length(delta_t)
+    if (ncores > R) {
+      ncores <- R
+    }
     if (ncores > 1) {
       par <- TRUE
     }

diff --git a/R/cTMed-delta-beta.R b/R/cTMed-delta-beta.R
@@ -229,22 +229,44 @@ DeltaBeta <- function(phi,
   par <- FALSE
   if (!is.null(ncores)) {
     ncores <- as.integer(ncores)
+    R <- length(delta_t)
+    if (ncores > R) {
+      ncores <- R
+    }
     if (ncores > 1) {
       par <- TRUE
     }
   }
   if (par) {
-    cl <- parallel::makeCluster(ncores)
-    on.exit(
-      parallel::stopCluster(cl = cl)
-    )
-    output <- parallel::parLapply(
-      cl = cl,
-      X = delta_t,
-      fun = .DeltaBeta,
-      phi = phi,
-      vcov_phi_vec = vcov_phi_vec
-    )
+    os_type <- Sys.info()["sysname"]
+    if (os_type == "Darwin") {
+      fork <- TRUE
+    } else if (os_type == "Linux") {
+      fork <- TRUE
+    } else {
+      fork <- FALSE
+    }
+    if (fork) {
+      output <- parallel::mclapply(
+        X = delta_t,
+        FUN = .DeltaBeta,
+        phi = phi,
+        vcov_phi_vec = vcov_phi_vec,
+        mc.cores = ncores
+      )
+    } else {
+      cl <- parallel::makeCluster(ncores)
+      on.exit(
+        parallel::stopCluster(cl = cl)
+      )
+      output <- parallel::parLapply(
+        cl = cl,
+        X = delta_t,
+        fun = .DeltaBeta,
+        phi = phi,
+        vcov_phi_vec = vcov_phi_vec
+      )
+    }
     # nocov end
   } else {
     output <- lapply(

diff --git a/R/cTMed-delta-indirect-central.R b/R/cTMed-delta-indirect-central.R
@@ -226,23 +226,46 @@ DeltaIndirectCentral <- function(phi,
   par <- FALSE
   if (!is.null(ncores)) {
     ncores <- as.integer(ncores)
+    R <- length(delta_t)
+    if (ncores > R) {
+      ncores <- R
+    }
     if (ncores > 1) {
       par <- TRUE
     }
   }
   if (par) {
-    cl <- parallel::makeCluster(ncores)
-    on.exit(
-      parallel::stopCluster(cl = cl)
-    )
-    output <- parallel::parLapply(
-      cl = cl,
-      X = delta_t,
-      fun = .DeltaCentral,
-      phi = phi,
-      vcov_phi_vec = vcov_phi_vec,
-      total = total
-    )
+    os_type <- Sys.info()["sysname"]
+    if (os_type == "Darwin") {
+      fork <- TRUE
+    } else if (os_type == "Linux") {
+      fork <- TRUE
+    } else {
+      fork <- FALSE
+    }
+    if (fork) {
+      output <- parallel::mclapply(
+        X = delta_t,
+        FUN = .DeltaCentral,
+        phi = phi,
+        vcov_phi_vec = vcov_phi_vec,
+        total = total,
+        mc.cores = ncores
+      )
+    } else {
+      cl <- parallel::makeCluster(ncores)
+      on.exit(
+        parallel::stopCluster(cl = cl)
+      )
+      output <- parallel::parLapply(
+        cl = cl,
+        X = delta_t,
+        fun = .DeltaCentral,
+        phi = phi,
+        vcov_phi_vec = vcov_phi_vec,
+        total = total
+      )
+    }
     # nocov end
   } else {
     output <- lapply(

diff --git a/R/cTMed-delta-med-std.R b/R/cTMed-delta-med-std.R
@@ -298,26 +298,52 @@ DeltaMedStd <- function(phi,
   par <- FALSE
   if (!is.null(ncores)) {
     ncores <- as.integer(ncores)
+    R <- length(delta_t)
+    if (ncores > R) {
+      ncores <- R
+    }
     if (ncores > 1) {
       par <- TRUE
     }
   }
   if (par) {
-    cl <- parallel::makeCluster(ncores)
-    on.exit(
-      parallel::stopCluster(cl = cl)
-    )
-    output <- parallel::parLapply(
-      cl = cl,
-      X = delta_t,
-      fun = .DeltaMedStd,
-      phi = phi,
-      sigma = sigma,
-      vcov_theta = vcov_theta,
-      from = from,
-      to = to,
-      med = med
-    )
+    os_type <- Sys.info()["sysname"]
+    if (os_type == "Darwin") {
+      fork <- TRUE
+    } else if (os_type == "Linux") {
+      fork <- TRUE
+    } else {
+      fork <- FALSE
+    }
+    if (fork) {
+      output <- parallel::mclapply(
+        X = delta_t,
+        FUN = .DeltaMedStd,
+        phi = phi,
+        sigma = sigma,
+        vcov_theta = vcov_theta,
+        from = from,
+        to = to,
+        med = med,
+        mc.cores = ncores
+      )
+    } else {
+      cl <- parallel::makeCluster(ncores)
+      on.exit(
+        parallel::stopCluster(cl = cl)
+      )
+      output <- parallel::parLapply(
+        cl = cl,
+        X = delta_t,
+        fun = .DeltaMedStd,
+        phi = phi,
+        sigma = sigma,
+        vcov_theta = vcov_theta,
+        from = from,
+        to = to,
+        med = med
+      )
+    }
     # nocov end
   } else {
     output <- lapply(