Check class of inputs to functions

DESCRIPTION

@@ -1,26 +1,29 @@
-Package: NHSRwaitinglist
-Title: R-package to implement a waiting list management approach
-Version: 0.0.0.9000
-Authors@R: c(
-          person("Neil", "Walton", ,"[email protected]", c("cre", "aut"), comment = c(ORCID ="0000-0002-5241-9765")),
-          person("Yasser", "Mustaq", ,"[email protected]", "aut"),
-          person("Jacqueline", "Grout", ,"[email protected]", "aut"),
-          person("Zoë", "Turner", , "[email protected]", "aut", comment = c(ORCID = "0000-0003-1033-9158")),
-          person("Marcos", "Fabietti", ,"[email protected]", "aut"),
-          person("Tom", "Smith", ,"[email protected]", "aut"),
-          person("Chris", "Mainey", ,"[email protected]", "aut", comment = c(ORCID ="0000-0002-3018-6171")),
-          person("NHS-R community", email = "[email protected]", role = "cph")
-          )
-Maintainer: Tom Smith <[email protected]>
-Description: R-package to implement the waiting list management approach described in this paper by Fong et al 2022.
-License: MIT + file LICENSE
-Encoding: UTF-8
-Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.2.3
-Suggests: 
-    knitr,
-    rmarkdown,
-    testthat (>= 3.0.0)
-VignetteBuilder: knitr
-URL: https://nhs-r-community.github.io/NHSRwaitinglist/
-Config/testthat/edition: 3
+Package: NHSRwaitinglist
+Title: R-package to implement a waiting list management approach
+Version: 0.0.0.9000
+Authors@R: c(
+          person("Neil", "Walton", ,"[email protected]", c("cre", "aut"), comment = c(ORCID ="0000-0002-5241-9765")),
+          person("Yasser", "Mustaq", ,"[email protected]", "aut"),
+          person("Jacqueline", "Grout", ,"[email protected]", "aut"),
+          person("Zoë", "Turner", , "[email protected]", "aut", comment = c(ORCID = "0000-0003-1033-9158")),
+          person("Marcos", "Fabietti", ,"[email protected]", "aut"),
+          person("Tom", "Smith", ,"[email protected]", "aut"),
+          person("Chris", "Mainey", ,"[email protected]", "aut", comment = c(ORCID ="0000-0002-3018-6171")),
+          person("NHS-R community", email = "[email protected]", role = "cph")
+          )
+Maintainer: Tom Smith <[email protected]>
+Description: R-package to implement the waiting list management approach described in this paper by Fong et al 2022.
+License: MIT + file LICENSE
+Encoding: UTF-8
+Roxygen: list(markdown = TRUE)
+RoxygenNote: 7.2.3
+VignetteBuilder: knitr
+URL: https://nhs-r-community.github.io/NHSRwaitinglist/
+Config/testthat/edition: 3
+Imports: 
+    cli,
+    rlang
+Suggests: 
+    knitr,
+    rmarkdown,
+    testthat (>= 3.0.0)

R/average_wait.R

@@ -24,6 +24,7 @@
 #' # would be 13 weeks and with a factor of 6 it would be 8.67 weeks.
 #' average_wait(52, 4)
 average_wait <- function(target_wait, factor = 4) {
+  check_class(target_wait, factor)
   target_mean_wait <- target_wait / factor
   return(target_mean_wait)
 }

R/queue_load.R

@@ -20,6 +20,7 @@
 #' # removed (capacity) this results in a queue load of 1.11 (30/27).
 #' queue_load(30,27)
 queue_load <- function(demand, capacity) {
+  check_class(demand, capacity)
   load <- demand / capacity
   return(load)
 }

R/relief_capacity.R

@@ -30,6 +30,7 @@
 #' relief_capacity(30, 1200, 390, 26)
 relief_capacity <- function(
     demand, queue_size, target_queue_size, weeks_to_target) {
+  check_class(demand, queue_size, target_queue_size, weeks_to_target)
   rel_cap <- demand + (queue_size - target_queue_size) / weeks_to_target
   return(rel_cap)
 }

R/target_capacity.R

@@ -24,7 +24,8 @@
 #' # If the target wait is 52 weeks, demand is 30 patients per week and F = 3
 #' # then Target capacity = 30 + 2 * (1 + 4 * 3)/52 = 30.5 patients per week.
 #' target_capacity(30,52,3)
 target_capacity <- function(demand, target_wait, F = 1) {
+  check_class(demand, target_wait, F)
   target_cap <- demand +  2 * (1 + 4 * F) / target_wait
   return(target_cap)
 }

R/target_queue_size.R

@@ -28,6 +28,7 @@
 #' # Target queue size = 30 * 52 / 4 = 390 patients.
 #' target_queue_size(30, 52, 4)
 target_queue_size <- function(demand, target_wait, factor = 4) {
+  check_class(demand, target_wait, factor)
   mean_wait <- average_wait(target_wait, factor)
   target_queue_length <- demand * mean_wait
   return(target_queue_length)

R/utils.R

@@ -0,0 +1,54 @@
+#' Check Class of Argument Inputs
+#' @param ... Objects to be checked for class.
+#' @param .expected_class Character. The name of the class against which objects
+#'     should be checked.
+#' @param .call The environment in which this function is to be
+#'     called.
+#' @noRd
+check_class <- function(
+  ...,
+  .expected_class = c("numeric", "character"),
+  .call = rlang::caller_env()
+) {
+
+  .expected_class <- match.arg(.expected_class)
+
+  args <- rlang::dots_list(..., .named = TRUE)
+
+  args_are_class <- lapply(
+    args,
+    function(arg) {
+      switch(
+        .expected_class,
+        numeric   = is.numeric(arg),
+        character = is.character(arg),
+      )
+    }
+  )
+
+  fails_names <- names(Filter(isFALSE, args_are_class))
+
+  if (length(fails_names) > 0) {
+
+    fails <- args[names(args) %in% fails_names]
+    fails_classes <- sapply(fails, class)
+
+    fails_bullets <- stats::setNames(
+      paste0(
+        "{.var ", names(fails_classes), "} with class {.cls ",
+        fails_classes, "}"
+      ),
+      rep("*", length(fails_classes))
+    )
+
+    cli::cli_abort(
+      message = c(
+        "{.var {fails_names}} must be of class {.cls {(.expected_class)}}",
+        x = "You provided:",
+        fails_bullets
+      ),
+      call = .call
+    )
+  }
+
+}

R/waiting_list_pressure.R

@@ -19,6 +19,7 @@
 #' @examples
 #' waiting_list_pressure(63, 52)
 waiting_list_pressure <- function(mean_wait, target_wait) {
+  check_class(mean_wait, target_wait)
   wait_pressure <- 2 * mean_wait / target_wait
   return(wait_pressure)
 }