Merge pull request #43 from ncn-foreigners/dev

Dev
ncn-foreigners · Mar 14, 2024 · ba5411f · ba5411f
2 parents 2abd6a2 + d4848e9
commit ba5411f
Show file tree

Hide file tree

Showing 5 changed files with 19 additions and 42 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -44,7 +44,6 @@ Imports:
     Rcpp (>= 1.0.12),
     nleqslv,
     doParallel,
-    progress,
     foreach,
     parallel
 LinkingTo: 

diff --git a/R/boot_dr.R b/R/boot_dr.R
@@ -332,23 +332,19 @@ bootDR_multicore <- function(outcome,
       num_boot = num_boot,
       start_selection = start_selection,
       start_outcome = start_outcome,
-      cores = cores
+      cores = cores,
+      verbose
     )
     boot_var <- var_obj$var
     mu_hat_boot <- var_obj$mu
   } else {
     rep_weights <- survey::as.svrepdesign(svydesign, type = rep_type, replicates = num_boot)$repweights$weights
 
+    if (verbose) message("Multicores bootstrap in progress..")
+
     cl <- parallel::makeCluster(cores)
     doParallel::registerDoParallel(cl)
     on.exit(parallel::stopCluster(cl))
-    ## progress bar
-    # if (verbose) {
-    #   pb <- progress::progress_bar$new(total = num_boot)
-    #   opts <- list(progress = \(n) pb$tick())
-    # } else {
-    #   opts <- NULL
-    # }
     parallel::clusterExport(cl = cl, varlist = c(
       "internal_selection", "internal_outcome", "logit_model_nonprobsvy", "start_fit", "get_method", "controlSel", "theta_h_estimation",
       "mle", "mu_hatDR", "probit_model_nonprobsvy", "cloglog_model_nonprobsvy", "glm_nonprobsvy", "nn_nonprobsvy", "pmm_nonprobsvy",
@@ -443,7 +439,7 @@ bootDR_multicore <- function(outcome,
     } else {
       k <- 1:num_boot
       mu_hats <- foreach::`%dopar%`(
-        obj = foreach::foreach(k = k, .combine = c, .options.snow = opts),
+        obj = foreach::foreach(k = k, .combine = c),
         ex = {
           strap <- sample.int(replace = TRUE, n = n_nons, prob = 1 / weights)
           X_nons_strap <- SelectionModel$X_nons[strap, , drop = FALSE]

diff --git a/R/boot_dr_sel.R b/R/boot_dr_sel.R
@@ -130,7 +130,7 @@ bootDR_sel_multicore <- function(X,
                                  start_selection,
                                  start_outcome,
                                  cores,
-                                 verbose) { # TODO function to test
+                                 verbose) {
   mu_hats <- vector(mode = "numeric", length = num_boot)
   loc_nons <- which(R == 1)
   loc_rand <- which(R == 0)
@@ -141,16 +141,11 @@ bootDR_sel_multicore <- function(X,
 
   rep_weights <- survey::as.svrepdesign(svydesign, type = rep_type, replicates = num_boot)$repweights$weights
 
+  if (verbose) message("Multicores bootstrap in progress..")
+
   cl <- parallel::makeCluster(cores)
   doParallel::registerDoParallel(cl)
   on.exit(parallel::stopCluster(cl))
-  ## progress bar
-  # if (verbose) {
-  #   pb <- progress::progress_bar$new(total = num_boot)
-  #   opts <- list(progress = \(n) pb$tick())
-  # } else {
-  #   opts <- NULL
-  # }
   parallel::clusterExport(cl = cl, varlist = c(
     "internal_selection", "logit_model_nonprobsvy", "start_fit", "get_method", "controlSel", "mle",
     "probit_model_nonprobsvy", "cloglog_model_nonprobsvy", "mm", "u_theta_beta_dr",

diff --git a/R/boot_ipw.R b/R/boot_ipw.R
@@ -204,9 +204,9 @@ bootIPW_multicore <- function(X_rand,
                               control_selection,
                               control_inference,
                               cores,
-                              verbose,
                               pop_size,
                               pop_totals,
+                              verbose,
                               ...) {
   if (!is.null(weights_rand)) N <- sum(weights_rand)
   estimation_method <- get_method(est_method)
@@ -219,17 +219,11 @@ bootIPW_multicore <- function(X_rand,
   mu_hats_boot <- numeric(length = num_boot * mu_len)
   boot_vars <- numeric(length = mu_len)
 
+  if (verbose) message("Multicores bootstrap in progress..")
+
   cl <- parallel::makeCluster(cores)
   doParallel::registerDoParallel(cl)
   on.exit(parallel::stopCluster(cl))
-  ## progress bar
-  # if (verbose) {
-  #   pb <- progress::progress_bar$new(total = num_boot)
-  #   opts <- list(progress = \(n) pb$tick())
-  # } else {
-  #   opts <- NULL
-  # }
-  ###
   parallel::clusterExport(cl = cl, varlist = c(
     "internal_selection", "logit_model_nonprobsvy", "start_fit", "get_method", "controlSel",
     "mle", "mu_hatIPW", "probit_model_nonprobsvy", "cloglog_model_nonprobsvy", "theta_h_estimation"
@@ -238,7 +232,7 @@ bootIPW_multicore <- function(X_rand,
   rep_weights <- survey::as.svrepdesign(svydesign, type = rep_type, replicates = num_boot)$repweights$weights
 
   k <- 1:num_boot
-  mu_hats_boot <- foreach::`%dopar%`(
+  mu_hats_boot <- mu_hats_boot <- foreach::`%dopar%`(
     obj = foreach::foreach(k = k, .combine = c),
     ex = {
       if (is.null(pop_totals)) {

diff --git a/R/boot_mi.R b/R/boot_mi.R
@@ -468,18 +468,11 @@ bootMI_multicore <- function(X_rand,
     family_nonprobsvy <- family_nonprobsvy()
   }
 
+  if (verbose) message("Multicores bootstrap in progress..")
+
   cl <- parallel::makeCluster(cores)
   doParallel::registerDoParallel(cl)
   on.exit(parallel::stopCluster(cl))
-
-  ## progress bar
-  # if (verbose) {
-  #   pb <- progress::progress_bar$new(total = num_boot)
-  #   opts <- list(progress = \(n) pb$tick())
-  # } else {
-  #   opts <- NULL
-  # }
-  ###
   parallel::clusterExport(cl = cl, varlist = c(
     "internal_selection", "logit_model_nonprobsvy", "start_fit", "get_method", "controlSel",
     "mle", "mu_hatIPW", "probit_model_nonprobsvy", "cloglog_model_nonprobsvy", "nonprobMI_nn"
@@ -526,7 +519,7 @@ bootMI_multicore <- function(X_rand,
     } else if (method == "nn") {
       k <- 1:num_boot
       mu_hats <- foreach::`%dopar%`(
-        obj = foreach::foreach(k = k, .combine = c, .options.snow = opts),
+        obj = foreach::foreach(k = k, .combine = c),
         ex = {
           strap <- sample.int(replace = TRUE, n = n_nons, prob = 1 / weights)
           weights_strap <- weights[strap]
@@ -562,7 +555,7 @@ bootMI_multicore <- function(X_rand,
     } else if (method == "pmm") {
       k <- 1:num_boot
       mu_hats <- foreach::`%dopar%`(
-        obj = foreach::foreach(k = k, .combine = c, .options.snow = opts),
+        obj = foreach::foreach(k = k, .combine = c),
         ex = {
           strap <- sample.int(replace = TRUE, n = n_nons, prob = 1 / weights)
           weights_strap <- weights[strap]
@@ -630,7 +623,7 @@ bootMI_multicore <- function(X_rand,
     N <- pop_totals[1]
     if (method == "glm") {
       mu_hats <- foreach::`%dopar%`(
-        obj = foreach::foreach(k = 1:num_boot, .combine = c, .options.snow = opts),
+        obj = foreach::foreach(k = 1:num_boot, .combine = c),
         ex = {
           strap <- sample.int(replace = TRUE, n = n_nons, prob = 1 / weights)
           weights_strap <- weights[strap]
@@ -655,7 +648,7 @@ bootMI_multicore <- function(X_rand,
       )
     } else if (method == "nn") {
       mu_hats <- foreach::`%dopar%`(
-        obj = foreach::foreach(k = 1:num_boot, .combine = c, .options.snow = opts),
+        obj = foreach::foreach(k = 1:num_boot, .combine = c),
         ex = {
           strap <- sample.int(replace = TRUE, n = n_nons, prob = 1 / weights)
           weights_strap <- weights[strap]
@@ -674,7 +667,7 @@ bootMI_multicore <- function(X_rand,
       )
     } else if (method == "pmm") {
       mu_hats <- foreach::`%dopar%`(
-        obj = foreach::foreach(k = 1:num_boot, .combine = c, .options.snow = opts),
+        obj = foreach::foreach(k = 1:num_boot, .combine = c),
         ex = {
           strap <- sample.int(replace = TRUE, n = n_nons, prob = 1 / weights)
           weights_strap <- weights[strap]