Merge pull request #334 from poissonconsulting/dev

save estimates as well as data

R/boot.R

@@ -44,12 +44,12 @@ generate_data <- function(dist, data, args, weighted, censoring, parametric) {
   sample_parametric(dist, args = args, weighted = weighted, censoring = censoring)
 }
 
-boot_filename <- function(i, dist) {
-  paste0("boot_", stringr::str_pad(i, width = 9, pad = "0"), "_", dist, ".csv")
+boot_filename <- function(i, dist, prefix, ext) {
+  paste0(prefix, "_", stringr::str_pad(i, width = 9, pad = "0"), "_", dist, ext)
 }
 
-boot_filepath <- function(i, dist, save_to) {
-  file.path(save_to, boot_filename(i, dist))
+boot_filepath <- function(i, dist, save_to, prefix = "data", ext = ".csv") {
+  file.path(save_to, boot_filename(i, dist, prefix = prefix, ext = ext))
 }
 
 sample_parameters <- function(i, dist, fun, data, args, pars, weighted, censoring, min_pmix, range_shape1, range_shape2, parametric, control, save_to, wts = NULL) {
@@ -66,10 +66,12 @@ sample_parameters <- function(i, dist, fun, data, args, pars, weighted, censorin
     pars <- slnorm_lnorm(new_data)
   }
   if(dist == "multi") {
-    dist <- names(pars)
+    dist2 <- names(pars)
+  } else {
+    dist2 <- dist
   }
 
-  fit <- fun(new_data, dist,
+  fit <- fun(new_data, dist2,
     min_pmix = min_pmix, range_shape1 = range_shape1,
     range_shape2 = range_shape2, control = control, pars = pars, hessian = FALSE,
     censoring = censoring, weighted = weighted
@@ -79,6 +81,11 @@ sample_parameters <- function(i, dist, fun, data, args, pars, weighted, censorin
     return(NULL)
   }
   est <- estimates(fit, multi = TRUE)
+
+  if(!is.null(save_to)) {
+    saveRDS(est, boot_filepath(i, dist, save_to, prefix = "estimates", ext = ".rds"))
+  }
+
   if(!is.null(wts)) {
     est[names(wts)] <- unname(wts)
   }
@@ -93,13 +100,6 @@ boot_estimates <- function(fun, dist, estimates, pars, nboot, data, weighted, ce
 
   data <- data[c("left", "right", "weight")]
 
-  if(!is.null(save_to)) {
-    if(!requireNamespace("readr", quietly = TRUE)) {
-      err("Package 'readr' must be installed.")
-    }
-    readr::write_csv(data, boot_filepath(0, dist, save_to))
-  }
-
   seeds <- seed_streams(nboot)
 
   if(fix_weights) {
@@ -108,6 +108,14 @@ boot_estimates <- function(fun, dist, estimates, pars, nboot, data, weighted, ce
     wts <- NULL
   }
 
+  if(!is.null(save_to)) {
+    if(!requireNamespace("readr", quietly = TRUE)) {
+      err("Package 'readr' must be installed.")
+    }
+    readr::write_csv(data, boot_filepath(0, dist, save_to))
+    saveRDS(estimates, boot_filepath(0, dist, save_to, prefix = "estimates", ext = ".rds"))
+  }
+
   estimates <- future_map(1:nboot, sample_parameters,
     dist = dist, fun = sfun,
     data = data, args = args, pars = pars,
@@ -117,6 +125,6 @@ boot_estimates <- function(fun, dist, estimates, pars, nboot, data, weighted, ce
     wts = wts,
     .options = furrr::furrr_options(seed = seeds)
   )
-
+  
   estimates[!vapply(estimates, is.null, TRUE)]
 }

tests/testthat/_snaps/hc/hc.csv

@@ -1,7 +1,7 @@
-dist,percent,est,se,lcl,ucl,wt,method,nboot
-gamma,5,1.07428,0.983875,0.709111,3.19472,0.356574,parametric,10
-lgumbel,5,1.76939,0.401763,1.39032,2.63032,0.0134466,parametric,10
-llogis,5,1.56226,0.834776,0.851639,3.37274,0.0656452,parametric,10
-lnorm,5,1.68117,0.823601,0.8894,3.02109,0.177236,parametric,10
-lnorm_lnorm,5,1.54141,0.329119,0.952154,1.82195,0.0296268,parametric,10
-weibull,5,1.08673,0.895134,0.819219,3.40858,0.357472,parametric,10
+dist,percent,est,se,lcl,ucl,wt,method,nboot,pboot
+gamma,5,1.07428,0.983875,0.709111,3.19472,0.356574,parametric,10,1
+lgumbel,5,1.76939,0.401763,1.39032,2.63032,0.0134466,parametric,10,1
+llogis,5,1.56226,0.834776,0.851639,3.37274,0.0656452,parametric,10,1
+lnorm,5,1.68117,0.823601,0.8894,3.02109,0.177236,parametric,10,1
+lnorm_lnorm,5,1.54141,0.329119,0.952154,1.82195,0.0296268,parametric,10,1
+weibull,5,1.08673,0.895134,0.819219,3.40858,0.357472,parametric,10,1

tests/testthat/_snaps/hc/hc_30.csv

@@ -1,2 +1,2 @@
-dist,percent,est,se,lcl,ucl,wt,method,nboot
-average,5,0.9294,0.0164012,0.886164,0.940088,1,parametric,100
+dist,percent,est,se,lcl,ucl,wt,method,nboot,pboot
+average,5,0.9294,0.0164012,0.886164,0.940088,1,parametric,100,0.93

tests/testthat/_snaps/hc/hc_boron.csv

@@ -1,2 +1,2 @@
-dist,percent,est,se,lcl,ucl,wt,method,nboot
-invpareto,5,0.386944,0.347873,0.195882,1.10643,1,non-parametric,10
+dist,percent,est,se,lcl,ucl,wt,method,nboot,pboot
+invpareto,5,0.386944,0.347873,0.195882,1.10643,1,non-parametric,10,1

tests/testthat/_snaps/hc/hc_burrIII3.csv

@@ -1,2 +1,2 @@
-dist,percent,est,se,lcl,ucl,wt,method,nboot
-burrIII3,5,0.0180122,0.0330222,0.00257335,0.0960996,1,non-parametric,10
+dist,percent,est,se,lcl,ucl,wt,method,nboot,pboot
+burrIII3,5,0.0180122,0.0330222,0.00257335,0.0960996,1,non-parametric,10,1

tests/testthat/_snaps/hc/hc_burrIII3_parametric.csv

@@ -1,2 +1,2 @@
-dist,percent,est,se,lcl,ucl,wt,method,nboot
-burrIII3,5,0.0180122,0.0149874,0.00621681,0.0503455,1,parametric,10
+dist,percent,est,se,lcl,ucl,wt,method,nboot,pboot
+burrIII3,5,0.0180122,0.0149874,0.00621681,0.0503455,1,parametric,10,1

tests/testthat/_snaps/hc/hc_fix.csv

@@ -1,2 +1,2 @@
-dist,percent,est,se,lcl,ucl,wt,method,nboot
-average,5,1.68947,0.528952,0.921861,2.95419,1,parametric,100
+dist,percent,est,se,lcl,ucl,wt,method,nboot,pboot
+average,5,1.68947,0.528952,0.921861,2.95419,1,parametric,100,1

tests/testthat/_snaps/hc/hc_fixmulti.csv

@@ -0,0 +1,3 @@
+dist,percent,est,se,lcl,ucl,wt,method,nboot,pboot
+average,5,1.68947,0.528952,0.921861,2.95419,1,parametric,100,1
+average,10,2.62057,0.716268,1.55146,4.31158,1,parametric,100,1

tests/testthat/_snaps/hc/hc_notallestimates.csv

@@ -0,0 +1,2 @@
+dist,percent,est,se,lcl,ucl,wt,method,nboot,pboot
+average,5,1.64901,0.384673,1.36309,2.46218,1,parametric,10,0.9

tests/testthat/_snaps/hc/hc_save_to.csv

@@ -1,2 +1,2 @@
-dist,percent,est,se,lcl,ucl,wt,method,nboot
-average,5,1.68117,0.515645,1.13096,2.11007,1,parametric,3
+dist,percent,est,se,lcl,ucl,wt,method,nboot,pboot
+average,5,1.68117,0.515645,1.13096,2.11007,1,parametric,3,1

tests/testthat/_snaps/hc/hc_save_to1.csv

@@ -1,2 +1,2 @@
-dist,percent,est,se,lcl,ucl,wt,method,nboot
-average,5,1.68117,0.515645,1.13096,2.11007,1,parametric,3
+dist,percent,est,se,lcl,ucl,wt,method,nboot,pboot
+average,5,1.68117,0.515645,1.13096,2.11007,1,parametric,3,1

tests/testthat/_snaps/hc/hc_save_to11.csv

@@ -1,2 +1,2 @@
-dist,percent,est,se,lcl,ucl,wt,method,nboot
-average,5,1.68117,NA,1.10678,1.10678,1,parametric,1
+dist,percent,est,se,lcl,ucl,wt,method,nboot,pboot
+average,5,1.68117,NA,1.10678,1.10678,1,parametric,1,1

tests/testthat/_snaps/hc/hc_save_to1_not_multi.csv

@@ -1,2 +1,2 @@
-dist,percent,est,se,lcl,ucl,wt,method,nboot
-average,5,1.68117,0.52617,1.30753,2.28691,1,parametric,3
+dist,percent,est,se,lcl,ucl,wt,method,nboot,pboot
+average,5,1.68117,0.52617,1.30753,2.28691,1,parametric,3,1

tests/testthat/_snaps/hc/hc_save_to1_not_multi_default.csv

@@ -1,2 +1,2 @@
-dist,percent,est,se,lcl,ucl,wt,method,nboot
-average,5,1.24152,NA,1.62613,1.62613,1,parametric,1
+dist,percent,est,se,lcl,ucl,wt,method,nboot,pboot
+average,5,1.24152,NA,1.62613,1.62613,1,parametric,1,1

tests/testthat/_snaps/hc/hc_save_to1_rescale.csv

@@ -1,2 +1,2 @@
-dist,percent,est,se,lcl,ucl,wt,method,nboot
-average,5,1.68117,0.515645,1.13096,2.11007,1,parametric,3
+dist,percent,est,se,lcl,ucl,wt,method,nboot,pboot
+average,5,1.68117,0.515645,1.13096,2.11007,1,parametric,3,1

tests/testthat/_snaps/hc/hc_save_to1data.csv

@@ -1,2 +1,2 @@
-dist,percent,est,se,lcl,ucl,wt,method,nboot
-average,5,1.68117,0.515645,1.13096,2.11007,1,parametric,3
+dist,percent,est,se,lcl,ucl,wt,method,nboot,pboot
+average,5,1.68117,0.515645,1.13096,2.11007,1,parametric,3,1

tests/testthat/_snaps/hc/hc_save_to_not_multi.csv

@@ -1,2 +1,2 @@
-dist,percent,est,se,lcl,ucl,wt,method,nboot
-average,5,1.68117,0.52617,1.30753,2.28691,1,parametric,3
+dist,percent,est,se,lcl,ucl,wt,method,nboot,pboot
+average,5,1.68117,0.52617,1.30753,2.28691,1,parametric,3,1

tests/testthat/_snaps/hc/hc_save_to_not_multi_default.csv

@@ -1,2 +1,2 @@
-dist,percent,est,se,lcl,ucl,wt,method,nboot
-average,5,1.24152,NA,1.62613,1.62613,1,parametric,1
+dist,percent,est,se,lcl,ucl,wt,method,nboot,pboot
+average,5,1.24152,NA,1.62613,1.62613,1,parametric,1,1

tests/testthat/_snaps/hc/hc_save_to_rescale.csv

@@ -1,2 +1,2 @@
-dist,percent,est,se,lcl,ucl,wt,method,nboot
-average,5,1.68117,0.515645,1.13096,2.11007,1,parametric,3
+dist,percent,est,se,lcl,ucl,wt,method,nboot,pboot
+average,5,1.68117,0.515645,1.13096,2.11007,1,parametric,3,1

tests/testthat/_snaps/hc/hc_unfix.csv

@@ -1,2 +1,2 @@
-dist,percent,est,se,lcl,ucl,wt,method,nboot
-average,5,1.68947,0.592316,1.02258,3.29178,1,parametric,100
+dist,percent,est,se,lcl,ucl,wt,method,nboot,pboot
+average,5,1.68947,0.592316,1.02258,3.29178,1,parametric,100,1

tests/testthat/_snaps/hc/hc_unfixmulti.csv

@@ -0,0 +1,3 @@
+dist,percent,est,se,lcl,ucl,wt,method,nboot,pboot
+average,5,1.68947,0.592316,1.02258,3.29178,1,parametric,100,1
+average,10,2.62057,0.74108,1.65497,4.39447,1,parametric,100,1

tests/testthat/_snaps/hp/hc_fix.csv

@@ -1,2 +1,2 @@
-dist,conc,est,se,lcl,ucl,wt,method,nboot
-average,1,1.87688,1.5501,0.365892,5.53175,1,parametric,100
+dist,conc,est,se,lcl,ucl,wt,method,nboot,pboot
+average,1,1.87688,1.5501,0.365892,5.53175,1,parametric,100,1

tests/testthat/_snaps/hp/hc_unfix.csv

@@ -1,2 +1,2 @@
-dist,conc,est,se,lcl,ucl,wt,method,nboot
-average,1,1.87688,1.37401,0.0959776,4.81697,1,parametric,100
+dist,conc,est,se,lcl,ucl,wt,method,nboot,pboot
+average,1,1.87688,1.37401,0.0959776,4.81697,1,parametric,100,1

tests/testthat/_snaps/hp/hp_30.csv

@@ -1,2 +1,2 @@
-dist,conc,est,se,lcl,ucl,wt,method,nboot
-average,1,14.0388,3.71053,7.63528,26.3366,1,parametric,100
+dist,conc,est,se,lcl,ucl,wt,method,nboot,pboot
+average,1,14.0388,3.71053,7.63528,26.3366,1,parametric,100,0.93

tests/testthat/_snaps/zzz-unstable/hc_err.csv

@@ -1,2 +1,2 @@
-dist,percent,est,se,lcl,ucl,wt,method,nboot
-average,5,0.934681,0.33094,0.839423,2.35185,1,parametric,100
+dist,percent,est,se,lcl,ucl,wt,method,nboot,pboot
+average,5,0.934681,0.33094,0.839423,2.35185,1,parametric,100,0.97

tests/testthat/_snaps/zzz-unstable/hc_err_na.csv

@@ -1,2 +1,2 @@
-dist,percent,est,se,lcl,ucl,wt,method,nboot
-average,5,0.934681,NA,NA,NA,1,parametric,100
+dist,percent,est,se,lcl,ucl,wt,method,nboot,pboot
+average,5,0.934681,NA,NA,NA,1,parametric,100,0.94

tests/testthat/_snaps/zzz-unstable/hc_nonpara.csv

@@ -1,2 +1,2 @@
-dist,percent,est,se,lcl,ucl,wt,method,nboot
-average,5,1.42635,0.0298623,1.37466,1.45809,1,non-parametric,10
+dist,percent,est,se,lcl,ucl,wt,method,nboot,pboot
+average,5,1.42635,0.0298623,1.37466,1.45809,1,non-parametric,10,1

tests/testthat/_snaps/zzz-unstable/hp_err.csv

@@ -1,2 +1,2 @@
-dist,conc,est,se,lcl,ucl,wt,method,nboot
-average,1,9.18236,5.44367,2.45953e-42,21.8494,1,parametric,100
+dist,conc,est,se,lcl,ucl,wt,method,nboot,pboot
+average,1,9.18236,5.44367,2.45953e-42,21.8494,1,parametric,100,0.97

tests/testthat/_snaps/zzz-unstable/hp_err_na.csv

@@ -1,2 +1,2 @@
-dist,conc,est,se,lcl,ucl,wt,method,nboot
-average,1,9.18236,NA,NA,NA,1,parametric,100
+dist,conc,est,se,lcl,ucl,wt,method,nboot,pboot
+average,1,9.18236,NA,NA,NA,1,parametric,100,0.94

tests/testthat/_snaps/zzz-unstable/hp_nonpara.csv

@@ -1,2 +1,2 @@
-dist,conc,est,se,lcl,ucl,wt,method,nboot
-average,1,2.27801,0.129041,2.14227,2.50138,1,non-parametric,10
+dist,conc,est,se,lcl,ucl,wt,method,nboot,pboot
+average,1,2.27801,0.129041,2.14227,2.50138,1,non-parametric,10,1

tests/testthat/_snaps/zzz-unstable/hp_para.csv

@@ -1,2 +1,2 @@
-dist,conc,est,se,lcl,ucl,wt,method,nboot
-average,1,2.27801,0.0639425,2.2218,2.41308,1,parametric,10
+dist,conc,est,se,lcl,ucl,wt,method,nboot,pboot
+average,1,2.27801,0.0639425,2.2218,2.41308,1,parametric,10,1