fix cran and bug if using multi functions with lnorm not included

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: ssdtools
 Title: Species Sensitivity Distributions
-Version: 2.0.0
+Version: 2.0.0.9001
 Authors@R: c(
     person("Joe", "Thorley", , "[email protected]", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0002-7683-4592")),

NAMESPACE

@@ -118,6 +118,7 @@ export(ssd_plot_cdf)
 export(ssd_plot_cf)
 export(ssd_plot_data)
 export(ssd_pmulti)
+export(ssd_pmulti_fitdists)
 export(ssd_pweibull)
 export(ssd_qburrIII3)
 export(ssd_qgamma)
@@ -129,6 +130,7 @@ export(ssd_qllogis_llogis)
 export(ssd_qlnorm)
 export(ssd_qlnorm_lnorm)
 export(ssd_qmulti)
+export(ssd_qmulti_fitdists)
 export(ssd_qweibull)
 export(ssd_rburrIII3)
 export(ssd_rgamma)
@@ -140,6 +142,7 @@ export(ssd_rllogis_llogis)
 export(ssd_rlnorm)
 export(ssd_rlnorm_lnorm)
 export(ssd_rmulti)
+export(ssd_rmulti_fitdists)
 export(ssd_rweibull)
 export(ssd_sort_data)
 export(ssd_wqg_bc)

NEWS.md

@@ -1,5 +1,15 @@
 <!-- NEWS.md is maintained by https://fledge.cynkra.com, contributors should not edit this file -->
 
+# ssdtools 2.0.0.9001
+
+- Add `ssd_xxmulti_fitdists()` functions to accept object of class fitdists.
+
+
+# ssdtools 2.0.0.9000
+
+- Set `ssd_xxmulti(lnorm.weight = 0)` (instead of 1) to avoid incorrect values with `do.call("ssd_xxmulti", c(..., estimates(fits))` if `fits` does not include the log-normal distribution.
+
+
 # ssdtools 2.0.0
 
 `ssdtools` v2.0.0, which now includes David Fox and Rebecca Fisher as co-authors, is the second major release of `ssdtools`.

R/multi.R

@@ -20,7 +20,7 @@
 #' @examples
 #'
 #' # multi
-#' ssd_pmulti(1)
+#' ssd_pmulti(1, gamma.weight = 0.5, lnorm.weight = 0.5)
 ssd_pmulti <- function(
     q,
     burrIII3.weight = 0,
@@ -48,7 +48,7 @@ ssd_pmulti <- function(
     llogis_llogis.locationlog2 = 1,
     llogis_llogis.scalelog2 = 1,
     llogis_llogis.pmix = 0.5,
-    lnorm.weight = 1,
+    lnorm.weight = 0,
     lnorm.meanlog = 0,
     lnorm.sdlog = 1,
     lnorm_lnorm.weight = 0,
@@ -109,7 +109,7 @@ ssd_pmulti <- function(
 #' @examples
 #'
 #' # multi
-#' ssd_qmulti(0.5)
+#' ssd_qmulti(0.5, gamma.weight = 0.5, lnorm.weight = 0.5)
 ssd_qmulti <- function(
     p,
     burrIII3.weight = 0,
@@ -137,7 +137,7 @@ ssd_qmulti <- function(
     llogis_llogis.locationlog2 = 1,
     llogis_llogis.scalelog2 = 1,
     llogis_llogis.pmix = 0.5,
-    lnorm.weight = 1,
+    lnorm.weight = 0,
     lnorm.meanlog = 0,
     lnorm.sdlog = 1,
     lnorm_lnorm.weight = 0,
@@ -199,10 +199,7 @@ ssd_qmulti <- function(
 #'
 #' # multi
 #' set.seed(50)
-#' hist(ssd_rmulti(1000), breaks = 100)
-#'
-#' fits <- ssd_fit_dists(ssddata::ccme_boron)
-#' do.call("ssd_rmulti", c(n = 10, estimates(fits)))
+#' hist(ssd_rmulti(1000, gamma.weight = 0.5, lnorm.weight = 0.5), breaks = 100)
 ssd_rmulti <- function(
     n,
     burrIII3.weight = 0,
@@ -230,7 +227,7 @@ ssd_rmulti <- function(
     llogis_llogis.locationlog2 = 1,
     llogis_llogis.scalelog2 = 1,
     llogis_llogis.pmix = 0.5,
-    lnorm.weight = 1,
+    lnorm.weight = 0,
     lnorm.meanlog = 0,
     lnorm.sdlog = 1,
     lnorm_lnorm.weight = 0,
@@ -296,24 +293,48 @@ ssd_emulti <- function() {
   as.list(unlist(emulti))
 }
 
-.ssd_pmulti_fitdists <- function(q, fitdists, lower.tail = TRUE, log.p = FALSE) {
-  args <- estimates(fitdists, all_estimates = TRUE)
+#' @describeIn ssd_p Cumulative Distribution Function for Multiple Distributions
+#' @export
+#' @examples
+#'
+#' # multi fitdists
+#' fit <- ssd_fit_dists(ssddata::ccme_boron)
+#' ssd_pmulti_fitdists(1, fit)
+ssd_pmulti_fitdists <- function(q, fitdists, lower.tail = TRUE, log.p = FALSE) {
+  chk_s3_class(fitdists, "fitdists")
+  args <- estimates(fitdists)
   args$q <- q
   args$lower.tail <- lower.tail
   args$log.p <- log.p
   do.call("ssd_pmulti", args)
 }
 
-.ssd_qmulti_fitdists <- function(p, fitdists, lower.tail = TRUE, log.p = FALSE) {
-  args <- estimates(fitdists, all_estimates = TRUE)
+#' @describeIn ssd_q Quantile Function for Multiple Distributions
+#' @export
+#' @examples
+#'
+#' # multi fitdists
+#' fit <- ssd_fit_dists(ssddata::ccme_boron)
+#' ssd_qmulti_fitdists(0.5, fit)
+ssd_qmulti_fitdists <- function(p, fitdists, lower.tail = TRUE, log.p = FALSE) {
+  chk_s3_class(fitdists, "fitdists")
+  args <- estimates(fitdists)
   args$p <- p
   args$lower.tail <- lower.tail
   args$log.p <- log.p
   do.call("ssd_qmulti", args)
 }
 
-.ssd_rmulti_fitdists <- function(n, fitdists, chk = TRUE) {
-  args <- estimates(fitdists, all_estimates = TRUE)
+#' @describeIn ssd_r Random Generation for Multiple Distributions
+#' @export
+#' @examples
+#'
+#' # multi fitdists
+#' fit <- ssd_fit_dists(ssddata::ccme_boron)
+#' ssd_rmulti_fitdists(2, fit)
+ssd_rmulti_fitdists <- function(n, fitdists, chk = TRUE) {
+  chk_s3_class(fitdists, "fitdists")
+  args <- estimates(fitdists)
   args$n <- n
   args$chk <- chk
   do.call("ssd_rmulti", args)

R/params.R

@@ -40,6 +40,7 @@
 #' Distributions with an absolute AIC difference greater than delta are excluded from the calculations.
 #' @param digits A whole number specifying the number of significant figures.
 #' @param dists A character vector of the distribution names.
+#' @param fitdists An object of class fitdists.
 #' @param hc A value between 0 and 1 indicating the proportion hazard concentration (or NULL).
 #' @param label A string of the column in data with the labels.
 #' @param left A string of the column in data with the concentrations.

R/test-helpers.R

@@ -94,6 +94,15 @@ test_dist <- function(dist, qroottolerance = 1.490116e-08, upadj = 0, multi = FA
                c(ssd_p{dist}(1, 1, 3), ssd_p{dist}(2, 2, 4)))"))
     ep(glue::glue("expect_equal(ssd_p{dist}(1:2, c(1, NA), 3:4),
                c(ssd_p{dist}(1, 1, 3), NA_real_))"))
+    ep(glue::glue("expect_gt(ssd_q{dist}(0.5000001), ssd_q{dist}(0.5))"))
+    ep(glue::glue("expect_identical(ssd_q{dist}(log(0.75), log.p = TRUE), ssd_q{dist}(0.75))"))
+    ep(glue::glue("expect_identical(ssd_q{dist}(0.75, lower.tail = FALSE), ssd_q{dist}(0.25))"))
+    ep(glue::glue("expect_identical(ssd_q{dist}(log(0.75), lower.tail = FALSE, log.p = TRUE), ssd_q{dist}(0.25))"))
+  } else {
+    ep(glue::glue("expect_gt(ssd_q{dist}(0.5000001, lnorm.weight = 1), ssd_q{dist}(0.5, lnorm.weight = 1))"))
+    ep(glue::glue("expect_identical(ssd_q{dist}(log(0.75), log.p = TRUE, lnorm.weight = 1), ssd_q{dist}(0.75, lnorm.weight = 1))"))
+    ep(glue::glue("expect_identical(ssd_q{dist}(0.75, lower.tail = FALSE, lnorm.weight = 1), ssd_q{dist}(0.25, lnorm.weight = 1))"))
+    ep(glue::glue("expect_identical(ssd_q{dist}(log(0.75), lower.tail = FALSE, log.p = TRUE, lnorm.weight = 1), ssd_q{dist}(0.25, lnorm.weight = 1))"))
   }
 
   ep(glue::glue("expect_identical(ssd_q{dist}(numeric(0)), numeric(0))"))
@@ -106,11 +115,6 @@ test_dist <- function(dist, qroottolerance = 1.490116e-08, upadj = 0, multi = FA
   ep(glue::glue("expect_identical(ssd_q{dist}(-Inf), NaN)"))
   ep(glue::glue("expect_identical(ssd_q{dist}(Inf), NaN)"))
   ep(glue::glue("expect_identical(ssd_q{dist}(0.75, log.p = TRUE), NaN)"))
-  ep(glue::glue("expect_gt(ssd_q{dist}(0.5000001), ssd_q{dist}(0.5))"))
-  ep(glue::glue("expect_identical(ssd_q{dist}(log(0.75), log.p = TRUE), ssd_q{dist}(0.75))"))
-  ep(glue::glue("expect_identical(ssd_q{dist}(0.75, lower.tail = FALSE), ssd_q{dist}(0.25))"))
-  ep(glue::glue("expect_identical(ssd_q{dist}(log(0.75), lower.tail = FALSE, log.p = TRUE), ssd_q{dist}(0.25))"))
-
   ep(glue::glue("expect_identical(ssd_q{dist}(c(NA, NaN, 0, Inf, -Inf)), c(NA, NaN, 0, NaN, NaN))"))
 
   if (!multi) {
@@ -126,12 +130,13 @@ test_dist <- function(dist, qroottolerance = 1.490116e-08, upadj = 0, multi = FA
   ep(glue::glue("expect_identical(ssd_r{dist}(0), numeric(0))"))
   ep(glue::glue("expect_error(ssd_r{dist}(NA))"))
   ep(glue::glue("expect_error(ssd_r{dist}(-1))"))
-  ep(glue::glue("expect_identical(length(ssd_r{dist}(1)), 1L)"))
-  ep(glue::glue("expect_identical(length(ssd_r{dist}(2)), 2L)"))
-  ep(glue::glue("expect_identical(length(ssd_r{dist}(3:4)), 2L)"))
-  ep(glue::glue("expect_identical(length(ssd_r{dist}(c(NA, 1))), 2L)"))
 
   if (!multi) {
+    ep(glue::glue("expect_identical(length(ssd_r{dist}(1)), 1L)"))
+    ep(glue::glue("expect_identical(length(ssd_r{dist}(2)), 2L)"))
+    ep(glue::glue("expect_identical(length(ssd_r{dist}(3:4)), 2L)"))
+    ep(glue::glue("expect_identical(length(ssd_r{dist}(c(NA, 1))), 2L)"))
+
     ests <- ep(glue::glue("ssd_e{dist}()"))
     testthat::expect_true(vld_list(ests))
     testthat::expect_true(vld_all(ests, vld_number))
@@ -156,5 +161,10 @@ test_dist <- function(dist, qroottolerance = 1.490116e-08, upadj = 0, multi = FA
     tidy <- merge(tidy, default, by = "term", all = "TRUE")
     testthat::expect_true(all(tidy$default > tidy$lower - upadj))
     testthat::expect_true(all(tidy$default < tidy$upper + upadj))
+  } else {
+    ep(glue::glue("expect_identical(length(ssd_r{dist}(1, lnorm.weight = 1)), 1L)"))
+    ep(glue::glue("expect_identical(length(ssd_r{dist}(2, lnorm.weight = 1)), 2L)"))
+    ep(glue::glue("expect_identical(length(ssd_r{dist}(3:4, lnorm.weight = 1)), 2L)"))
+    ep(glue::glue("expect_identical(length(ssd_r{dist}(c(NA, 1), lnorm.weight = 1)), 2L)")) 
   }
 }

_pkgdown.yml

@@ -125,3 +125,6 @@ articles:
   - articles/confidence-intervals
   - customising-plots
   - additional-technical-details
+
+development:
+  mode: auto