fixing condition handling function + clean up nested tryCatch

harvard-ufds · Dec 18, 2023 · 9965e42 · 9965e42
1 parent eca21cc
commit 9965e42
Show file tree

Hide file tree

Showing 2 changed files with 12 additions and 27 deletions.
diff --git a/R/unit_zi.R b/R/unit_zi.R
@@ -158,20 +158,8 @@ unit_zi <- function(samp_dat,
       response = boot_pop_response
     )
 
-    # domain level estimates for bootstrap population data
-    boot_pop_param <- setNames(
-      aggregate(
-        response ~ domain,
-        data = boot_pop_data,
-        FUN = mean
-      ),
-      c("domain", "domain_est")
-    )
-
-
     ## bootstrapping -------------------------------------------------------------
 
-
     boot_pop_data <- cbind(pop_dat, boot_pop_data)
 
     # creating bootstrap formula to be used to fit zi-model to bootstrap samples

diff --git a/R/utils.R b/R/utils.R
@@ -76,9 +76,15 @@ boot_rep <- function(pop_boot,
   # capture warnings and messages silently when bootstrapping
   fit_zi_capture <- capture_all(fit_zi)
 
-  # if resampling doesn't fix things, just return properly formatted NAs
-  second_try <- function(samp_dat, pop_dat, lin_formula, log_formula , domain_level) {
-    return(
+  # nested tryCatch
+  # tries resampling once and if it fails again returns properly structured output filled with NAs
+  boot_samp_fit  <- tryCatch(
+    {
+      fit_zi_capture(boot_data, pop_boot, boot_lin_formula, boot_log_formula, domain_level)
+    },
+    error = function(cond) {
+      boot_data_ls <- purrr::map2(.x = by_domains, .y = num_plots$Freq, slice_samp)
+      boot_data <- do.call("rbind", boot_data_ls)
       tryCatch(
         {
           fit_zi_capture(boot_data, pop_boot, boot_lin_formula, boot_log_formula, domain_level)
@@ -90,17 +96,6 @@ boot_rep <- function(pop_boot,
           list(result = list(lmer = NA, glmer = NA, pred = zi_domain_preds), log = cond)
         }
       )
-    )
-  }
-
-  boot_samp_fit  <- tryCatch(
-    {
-      fit_zi_capture(boot_data, pop_boot, boot_lin_formula, boot_log_formula, domain_level)
-    },
-    error = function(cond) {
-      boot_data_ls <- purrr::map2(.x = by_domains, .y = num_plots$Freq, slice_samp)
-      boot_data <- do.call("rbind", boot_data_ls)
-      second_try(boot_data, pop_boot, boot_lin_formula, boot_log_formula, domain_level)
     }
   )
 
@@ -162,6 +157,9 @@ capture_all <- function(.f){
 
     if("error" %in% class(res)) {
       stop(res$message)
+    } else if (!any(c("warning", "message") %in% class(res))){
+      out$result <- try_out
+      out$log <- NA
     } else {
       out$result <- try_out
       out$log <- res$message
@@ -175,4 +173,3 @@ capture_all <- function(.f){
 
 
 
-