squashed switch options into do.call in create_prob_dist

R/create_prob_dist.R

@@ -49,31 +49,17 @@ create_prob_dist <- function(prob_dist,
                              discretise,
                              truncation) {
 
-  if (isTRUE(discretise)) {
+  if (discretise) {
+    prob_dist <- match.arg(prob_dist, choices = c("gamma", "lnorm", "weibull"))
     # create discretised probability distribution object
-    prob_dist <- switch(prob_dist,
-      gamma = distcrete::distcrete(
-        name = "gamma",
+    prob_dist <- do.call(
+      distcrete::distcrete,
+      c(
+        name = prob_dist,
         interval = 1,
-        shape = prob_dist_params[["shape"]],
-        scale = prob_dist_params[["scale"]],
-        w = 1
-      ),
-      lnorm = distcrete::distcrete(
-        name = "lnorm",
-        interval = 1,
-        meanlog = prob_dist_params[["meanlog"]],
-        sdlog = prob_dist_params[["sdlog"]],
+        as.list(prob_dist_params),
         w = 1
-      ),
-      weibull = distcrete::distcrete(
-        name = "weibull",
-        interval = 1,
-        shape = prob_dist_params[["shape"]],
-        scale = prob_dist_params[["scale"]],
-        w = 1
-      ),
-      stop("Did not recognise distribution name", call. = FALSE)
+      )
     )
   } else {
     # create non-discretised probability distribution object

R/epidist.R

@@ -280,7 +280,7 @@ epidist <- function(disease,
   checkmate::assert_list(metadata)
   checkmate::assert_list(method_assess)
   checkmate::assert_number(truncation, na.ok = TRUE)
-  checkmate::assert_logical(discretise)
+  checkmate::assert_logical(discretise, len = 1)
   checkmate::assert_character(notes, null.ok = TRUE)
 
   # check whether ci has been provided for each parameter

tests/testthat/test-create_prob_dist.R

@@ -162,7 +162,7 @@ test_that("create_prob_dist fails for unrecognised discretised dist", {
       discretise = TRUE,
       truncation = NA
     ),
-    regexp = "Did not recognise distribution name"
+    regexp = "(arg)*(should be one of)*(gamma)*(lnorm)*(weibull)"
   )
 })
 

tests/testthat/test-epidist.R

@@ -257,6 +257,7 @@ test_that("new_epidist works with minimal viable input", {
         title = "Ebola incubation",
         journal = "Journal of Epi"
       ),
+      discretise = FALSE,
       truncation = NA
     )
   )
@@ -295,6 +296,7 @@ test_that("validate_epidist passes when expected", {
         journal = "Journal of Epi",
         DOI = "10.1872372hc"
       ),
+      discretise = FALSE,
       truncation = NA
     )
   )
@@ -324,6 +326,7 @@ test_that("validate_epidist catches class faults when expected", {
       )
     ),
     citation = "Smith (2002) <10.128372837>",
+    discretise = FALSE,
     truncation = NA
   )
 
@@ -355,6 +358,7 @@ test_that("validate_epidist catches class faults when expected", {
       )
     ),
     citation = "Smith (2002) <10.128372837>",
+    discretise = FALSE,
     truncation = NA
   )
 
@@ -386,6 +390,7 @@ test_that("validate_epidist catches class faults when expected", {
       )
     ),
     citation = "Smith (2002) <10.128372837>",
+    discretise = FALSE,
     truncation = NA
   )