Merge pull request #45 from poissonconsulting/multici

- Combine `multi_ci = TRUE` and `weight = TRUE` into `ci_method = "weighted_samples"`

NAMESPACE

@@ -95,6 +95,7 @@ export(ssd_hc)
 export(ssd_hc_bcanz)
 export(ssd_hc_burrlioz)
 export(ssd_hp)
+export(ssd_hp_bcanz)
 export(ssd_is_censored)
 export(ssd_match_moments)
 export(ssd_pal)

R/bcanz.R

@@ -51,13 +51,7 @@ ssd_dists_bcanz <- function(npars = c(2L, 5L)) {
 ssd_fit_bcanz <- function(data, left = "Conc", dists = ssd_dists_bcanz()) {
   ssd_fit_dists(data,
                 left = left,
-                dists = dists,
-                nrow = 6L,
-                rescale = FALSE,
-                reweight = FALSE,
-                computable = TRUE,
-                at_boundary_ok = FALSE,
-                min_pmix = 0
+                dists = dists
   )
 }
 
@@ -66,7 +60,7 @@ ssd_fit_bcanz <- function(data, left = "Conc", dists = ssd_dists_bcanz()) {
 #' Gets hazard concentrations with confidence intervals that protect
 #' 1, 5, 10 and 20% of species using settings adopted by
 #' BC, Canada, Australia and New Zealand for official guidelines.
-#' This function can take several minutes to run with required 10,000 iterations.
+#' This function can take several minutes to run with recommended 10,000 iterations.
 #'
 #' @inheritParams params
 #' @return A tibble of corresponding hazard concentrations.
@@ -76,15 +70,34 @@ ssd_fit_bcanz <- function(data, left = "Conc", dists = ssd_dists_bcanz()) {
 #' @examples
 #' fits <- ssd_fit_bcanz(ssddata::ccme_boron)
 #' ssd_hc_bcanz(fits, nboot = 100)
-ssd_hc_bcanz <- function(x, nboot = 10000, delta = 10, min_pboot = 0.95) {
+ssd_hc_bcanz <- function(x, nboot = 10000, min_pboot = 0.95) {
   ssd_hc(x,
          proportion = c(0.01, 0.05, 0.1, 0.2),
          ci = TRUE,
-         level = 0.95,
          nboot = nboot,
-         average = TRUE,
-         delta = delta,
-         min_pboot = min_pboot,
-         parametric = TRUE
+         min_pboot = min_pboot
+  )
+}
+
+#' BCANZ Hazard Proportion
+#'
+#' Gets  proportion of species affected at specified concentration(s)
+#' using settings adopted by BC, Canada, Australia and New Zealand for official guidelines.
+#' This function can take several minutes to run with recommended 10,000 iterations.
+#'
+#' @inheritParams params
+#' @return A tibble of corresponding hazard concentrations.
+#' @seealso [`ssd_hp()`].
+#' @family BCANZ
+#' @export
+#' @examples
+#' fits <- ssd_fit_bcanz(ssddata::ccme_boron)
+#' ssd_hp_bcanz(fits, nboot = 100)
+ssd_hp_bcanz <- function(x, conc = 1, nboot = 10000, min_pboot = 0.95) {
+  ssd_hp(x,
+         conc = conc,
+         ci = TRUE,
+         nboot = nboot,
+         min_pboot = min_pboot
   )
 }

R/hc.R

@@ -123,8 +123,7 @@ ssd_hc.fitdists <- function(
     nboot = 1000,
     min_pboot = 0.95,
     multi_est = TRUE,
-    multi_ci = TRUE,
-    weighted = TRUE,
+    ci_method = "weighted_samples",
     parametric = TRUE, 
     delta = 9.21, 
     samples = FALSE,
@@ -146,6 +145,11 @@ ssd_hc.fitdists <- function(
   chk_vector(proportion)
   chk_numeric(proportion)
   chk_range(proportion)
+  chk_string(ci_method)
+  chk_subset(ci_method, c("weighted_samples", "weighted_arithmetic", "multi_free", "multi_fixed"))
+
+  fix_weights <- ci_method %in% c("weighted_samples", "multi_fixed")
+  multi_ci <- ci_method %in% c("multi_free", "multi_fixed")
 
   hcp <- ssd_hcp_fitdists(
     x = x, 
@@ -159,7 +163,7 @@ ssd_hc.fitdists <- function(
     min_pboot = min_pboot,
     parametric = parametric,
     multi_ci = multi_ci,
-    fix_weights = weighted,
+    fix_weights = fix_weights,
     control = control,
     samples = samples,
     save_to = save_to,

R/hp.R

@@ -42,8 +42,7 @@ ssd_hp.fitdists <- function(
     nboot = 1000,
     min_pboot = 0.95,
     multi_est = TRUE,
-    multi_ci = TRUE,
-    weighted = TRUE,
+    ci_method = "weighted_samples",
     parametric = TRUE, 
     delta = 9.21, 
     samples = FALSE,
@@ -54,7 +53,13 @@ ssd_hp.fitdists <- function(
 
   chk_vector(conc)
   chk_numeric(conc)
+  chk_subset(ci_method, c("weighted_samples", "weighted_arithmetic", "multi_free", "multi_fixed"))
+
   chk_unused(...)
+
+
+  fix_weights <- ci_method %in% c("weighted_samples", "multi_fixed")
+  multi_ci <- ci_method %in% c("multi_free", "multi_fixed")
 
   hcp <- ssd_hcp_fitdists(
     x = x, 
@@ -68,11 +73,11 @@ ssd_hp.fitdists <- function(
     min_pboot = min_pboot,
     parametric = parametric, 
     multi_ci = multi_ci, 
+    fix_weights = fix_weights,
     control = control, 
     save_to = save_to, 
     samples = samples, 
-    hc = FALSE,  
-    fix_weights = weighted,
+    hc = FALSE
   )
   hcp <- dplyr::rename(hcp, conc = "value")
   hcp

R/params.R

@@ -62,7 +62,8 @@
 #' @param min_pmix A number between 0 and 0.5 specifying the minimum proportion in mixture models.
 #' @param npars A whole numeric vector specifying which distributions to include based on the number of parameters.
 #' @param all_estimates A flag specifying whether to calculate estimates for all implemented distributions.
-#' @param multi_ci A flag specifying whether to treat the distributions as constituting a single distribution which is now the recommended approach (as opposed to taking the mean) when calculating model averaged confidence intervals.
+#' @param ci_method A string specifying which method to use for estimating the bootstrap values. 
+#' Possible values are "multi_free" and "multi_fixed" which treat the distributions as constituting a single distribution but differ in whether the model weights are fixed and "weighted_samples" and "weighted_arithmetic" take bootstrap samples from each distribution proportional to its weight versus calculating the weighted arithmetic means of the lower and upper confidence limits.
 #' @param multi_est A flag specifying whether to treat the distributions as constituting a single distribution (as opposed to taking the mean) when calculating model averaged estimates.
 #' @param na.rm A flag specifying whether to silently remove missing values or 
 #' remove them with a warning.
@@ -105,10 +106,6 @@
 #' @param tails A flag or NULL specifying whether to only include distributions with both tails.
 #' @param trans A string which transformation to use by default `"log10"`.
 #' @param weight A string of the numeric column in data with positive weights less than or equal to 1,000 or NULL.
-#' @param weighted A flag which specifies whether to use the original model weights (as opposed to re-estimating for each bootstrap sample) unless `multi_ci = FALSE` in which case it specifies
-#' whether to take bootstrap samples from each distribution proportional to 
-#' its weight versus calculating the weighted arithmetic means of the lower 
-#' and upper confidence limits.
 #' @param x The object.
 #' @param xbreaks The x-axis breaks as one of:
 #'   - `NULL` for no breaks

R/predict.R

@@ -38,8 +38,7 @@ predict.fitdists <- function(
     nboot = 1000,
     min_pboot = 0.95,
     multi_est = TRUE,
-    multi_ci = TRUE,
-    weighted = TRUE,
+    ci_method = "weighted_samples",
     parametric = TRUE, 
     delta = 9.21, 
     control = NULL,
@@ -69,9 +68,7 @@ predict.fitdists <- function(
     average = average, 
     delta = delta, 
     parametric = parametric,
-    multi_ci = multi_ci, 
-    multi_est = multi_est,
-    weighted = weighted, 
+    ci_method = ci_method,
     control = control
   )
 }

data-raw/data-raw.R

@@ -36,5 +36,5 @@ use_data(dist_data, overwrite = TRUE)
 fits <- ssd_fit_dists(ssddata::ccme_boron)
 
 set.seed(99)
-boron_pred <- predict(fits, ci = TRUE, multi_ci = FALSE)
+boron_pred <- predict(fits, ci = TRUE, ci_method = "weighted bootstrap")
 use_data(boron_pred, overwrite = TRUE)

tests/testthat/_snaps/bcanz/hc_chloride.csv

@@ -1,5 +1,5 @@
 dist,proportion,est,se,lcl,ucl,wt,method,nboot,pboot,samples
-average,0.01,0.267258,0.110237,0.0373796,0.336603,1,parametric,10,0.8,numeric(0)
-average,0.05,1.25677,0.424954,0.395098,1.58659,1,parametric,10,0.8,numeric(0)
-average,0.1,2.38164,0.725674,1.01781,3.04841,1,parametric,10,0.8,numeric(0)
-average,0.2,4.81003,1.24442,2.733,6.16542,1,parametric,10,0.8,numeric(0)
+average,0.01,0.267258,0.337762,0.0476618,0.995392,1,parametric,10,1,numeric(0)
+average,0.05,1.25677,0.698581,0.469904,2.44697,1,parametric,10,1,numeric(0)
+average,0.1,2.38164,0.98634,1.21915,4.18705,1,parametric,10,1,numeric(0)
+average,0.2,4.81003,1.41415,3.28125,7.51421,1,parametric,10,1,numeric(0)

tests/testthat/_snaps/bcanz/hp_chloride.csv

@@ -0,0 +1,2 @@
+dist,conc,est,se,lcl,ucl,wt,method,nboot,pboot,samples
+average,1,3.89879,3.33023,1.2421,10.5385,1,parametric,10,1,numeric(0)