Add function input checks

DESCRIPTION

@@ -22,3 +22,6 @@ Suggests:
     rmarkdown
 VignetteBuilder: knitr
 URL: https://nhs-r-community.github.io/NHSRwaitinglist/
+Imports: 
+    cli,
+    rlang

R/average_wait.R

@@ -12,12 +12,18 @@
 #' @return Numeric value of target mean waiting time to achieve a given target wait.
 #' @export
 #'
-#' @examples 
+#' @examples
 #' # If the target wait is 52 weeks then the target mean wait with a factor of 4 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)
+  check_lengths_match(target_wait, factor)
+
   target_mean_wait <- target_wait / factor
+
   return(target_mean_wait)
+
 }

R/queue_load.R

@@ -13,13 +13,19 @@
 #' @return Numeric value of load which is the ratio between demand and capacity
 #' @export
 #'
-#' @examples 
+#' @examples
 #' # If 30 patients are added to the waiting list each week (demand) and 27 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)
+  check_lengths_match(demand, capacity)
+
   load <- demand / capacity
-  return (load)
+
+  return(load)
+
 }

R/relief_capacity.R

@@ -1,10 +1,10 @@
 #' @title Relief Capacity
 #'
 #' @description
-#' Calculates required relief capacity to achieve target queue size in a given period of time as a function of demand, queue size, target queue size and time period. 
-#' 
+#' Calculates required relief capacity to achieve target queue size in a given period of time as a function of demand, queue size, target queue size and time period.
+#'
 #' Relief Capacity is required if Queue Size > 2 * Target Queue Size.
-#' 
+#'
 #' Relief Capacity = Current Demand + (Queue Size - Target Queue Size)/Time Steps
 #'
 #' @param demand Numeric value of rate of demand in same units as target wait - e.g. if target wait is weeks, then demand in units of patients/week.
@@ -15,14 +15,20 @@
 #' @return A numeric value of the required rate of capacity to achieve a target queue size in a given period of time.
 #' @export
 #'
-#' @examples 
-#' # If demand is 30 patients per week, the current queue size is 1200 and the target is to achieve a queue size of 390 in 26 weeks, then 
-#' 
+#' @examples
+#' # If demand is 30 patients per week, the current queue size is 1200 and the target is to achieve a queue size of 390 in 26 weeks, then
+#'
 #' # Relief Capacity = 30 + (1200 - 390)/26 = 61.15 patients per week.
-#' 
+#'
 #' 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)
+  check_lengths_match(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

@@ -2,9 +2,9 @@
 #'
 #' @description
 #' Calculates the target capacity to achieve a given target waiting time as a function of observed demand, target waiting time and a variability of demand parameter F.
-#' 
+#'
 #' F defaults to 1.
-#' 
+#'
 #' Target Capacity = Demand + 2 * ( 1 + 4 * F ) / Target Wait
 #'
 #' @param demand Numeric value of rate of demand in same units as target wait - e.g. if target wait is weeks, then demand in units of patients/week.
@@ -14,13 +14,19 @@
 #' @export
 #'
 #' @examples
-#' 
+#'
 #' # 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)
+  check_lengths_match(demand, target_wait, F)
+
   target_cap <- demand +  2 * ( 1 + 4 * F ) / target_wait
+
   return(target_cap)
+
 }

R/target_queue_size.R

@@ -2,13 +2,13 @@
 #'
 #' @description
 #' Uses Little's Law to calculate the target queue size to achieve a target waiting time as a function of observed demand, target wait and a variability factor used in the target mean waiting time calculation.
-#' 
+#'
 #' Target Queue Size = Demand * Target Wait / 4.
 #'
-#' The average wait should sit somewhere between 
+#' The average wait should sit somewhere between
 #' target_wait/factor=6 < Average Waiting Time < target_wait/factor=4
 #' The factor defaults to 4.
-#' 
+#'
 #' Only applicable when Capacity > Demand.
 #'
 #' @param demand Numeric value of rate of demand in same units as target wait - e.g. if target wait is weeks, then demand in units of patients/week.
@@ -19,13 +19,19 @@
 #' @export
 #'
 #' @examples
-#' # If demand  is 30 patients per week and the target wait is 52 weeks, then the 
+#' # If demand  is 30 patients per week and the target wait is 52 weeks, then the
 #' # 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)
+  check_lengths_match(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
+#'     will be checked.
+#' @noRd
+check_class <- function(..., .expected_class = "numeric", .call = rlang::caller_env()) {
+
+  args <- rlang::dots_list(..., .named = TRUE)
+
+  args_class_lgl <- lapply(
+    args,
+    function(arg) inherits(arg, .expected_class)
+  )
+
+  failing_arg_names <- names(Filter(isFALSE, args_class_lgl))
+
+  if (length(failing_arg_names) > 0) {
+
+    failing_args <- args[names(args) %in% failing_arg_names]
+    failing_args_classes <- sapply(failing_args, class)
+
+    cli::cli_abort(
+      message = c(
+        "{.var {failing_arg_names}} must be of class {.cls {(.expected_class)}}",
+        x = "You provided input of class {.cls {failing_args_classes}}."
+      ),
+      call = .call
+    )
+  }
+
+}
+
+#' Check that Lengths of Argument Inputs Match
+#' @param ... Objects to be compared for length.
+#' @noRd
+check_lengths_match <- function(..., .call = rlang::caller_env()) {
+
+  args <- rlang::dots_list(..., .named = TRUE)
+
+  arg_lengths <- lengths(args)
+
+  lengths_are_equal <- length(unique(arg_lengths)) == 1
+
+  if (!lengths_are_equal) {
+    cli::cli_abort(
+      message = c(
+        "{.arg {names(args)}} must be the same length.",
+        x = "You provided inputs with lengths of {paste(arg_lengths)}."
+      ),
+      call = .call
+    )
+  }
+
+}

R/waiting_list_pressure.R

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