diff --git a/DESCRIPTION b/DESCRIPTION index 82e17c2..ba5650f 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: NHSRwaitinglist Title: R-package to implement a waiting list management approach -Version: 0.0.0.9000 +Version: 0.0.0.9001 Authors@R: c( person("Neil", "Walton", ,"neil.walton@durham.ac.uk", c("cre", "aut"), comment = c(ORCID ="0000-0002-5241-9765")), person("Jacqueline", "Grout", ,"jacqueline.grout1@nhs.net", "aut"), diff --git a/NAMESPACE b/NAMESPACE index c21e06d..17ea5ff 100755 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,13 +1,13 @@ # Generated by roxygen2: do not edit by hand -export(average_wait) +export(calc_queue_load) +export(calc_relief_capacity) +export(calc_target_capacity) +export(calc_target_mean_wait) +export(calc_target_queue_size) +export(calc_waiting_list_pressure) export(create_bulk_synthetic_data) export(create_waiting_list) -export(queue_load) -export(relief_capacity) -export(target_capacity) -export(target_queue_size) -export(waiting_list_pressure) export(wl_insert) export(wl_join) export(wl_queue_size) diff --git a/R/queue_load.R b/R/calc_queue_load.R old mode 100755 new mode 100644 similarity index 91% rename from R/queue_load.R rename to R/calc_queue_load.R index 4c7f1c6..cfed64a --- a/R/queue_load.R +++ b/R/calc_queue_load.R @@ -1,26 +1,26 @@ -#' @title Calculate Queue Load -#' -#' @description Calculates the queue load. The queue load is the number of -#' arrivals that occur for every patient leaving the queue (given that the -#' waiting list did not empty). It could also be described as the rate of -#' service at the queue. The queue load is calculated by dividing the demand -#' by the capacity: queue_load = demand / capacity. -#' -#' @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. -#' @param capacity Numeric value of the number of patients that can be served -#' (removals) from the waiting list each week. -#' -#' @return Numeric value of load which is the ratio between demand and capacity. -#' -#' @export -#' -#' @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) - load <- demand / capacity - return(load) -} +#' @title Calculate Queue Load +#' +#' @description Calculates the queue load. The queue load is the number of +#' arrivals that occur for every patient leaving the queue (given that the +#' waiting list did not empty). It could also be described as the rate of +#' service at the queue. The queue load is calculated by dividing the demand +#' by the capacity: queue_load = demand / capacity. +#' +#' @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. +#' @param capacity Numeric value of the number of patients that can be served +#' (removals) from the waiting list each week. +#' +#' @return Numeric value of load which is the ratio between demand and capacity. +#' +#' @export +#' +#' @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). +#' calc_queue_load(30, 27) +calc_queue_load <- function(demand, capacity) { + check_class(demand, capacity) + load <- demand / capacity + return(load) +} diff --git a/R/relief_capacity.R b/R/calc_relief_capacity.R similarity index 95% rename from R/relief_capacity.R rename to R/calc_relief_capacity.R index bc72833..c3b3b9b 100644 --- a/R/relief_capacity.R +++ b/R/calc_relief_capacity.R @@ -30,9 +30,9 @@ #' #' # Relief Capacity = 30 + (1200 - 390)/26 = 61.15 patients per week. #' -#' relief_capacity(30, 1200, 390, 26) +#' calc_relief_capacity(30, 1200, 390, 26) #' -relief_capacity <- function( +calc_relief_capacity <- function( demand, queue_size, target_queue_size, diff --git a/R/target_capacity.R b/R/calc_target_capacity.R similarity index 95% rename from R/target_capacity.R rename to R/calc_target_capacity.R index 34ae1d5..6118cb2 100644 --- a/R/target_capacity.R +++ b/R/calc_target_capacity.R @@ -29,10 +29,10 @@ #' target_wait <- 52 # weeks #' #' # number of operations per week to have mean wait of 52/4 -#' target_capacity(demand, target_wait) +#' calc_target_capacity(demand, target_wait) #' #' # TODO: Include a couple of standard deviations for errors in the mean demand -target_capacity <- function( +calc_target_capacity <- function( demand, target_wait, factor = 4, diff --git a/R/average_wait.R b/R/calc_target_mean_wait.R old mode 100755 new mode 100644 similarity index 92% rename from R/average_wait.R rename to R/calc_target_mean_wait.R index 5154d7e..ce9ae50 --- a/R/average_wait.R +++ b/R/calc_target_mean_wait.R @@ -1,30 +1,30 @@ -#' @title Average Waiting Time -#' -#' @description This calculates the target mean wait given the two inputs of -#' target_wait and a numerical value for factor. The average wait is actually -#' the target mean wait and is calculated as follows: target_wait / factor. If -#' we want to have a chance between 1.8%-0.2% of making a waiting time target, -#' then the average patient should have a waiting time between a quarter and a -#' sixth of the target. Therefore: The mean wait should sit somewhere between -#' target_wait/factor=6 < Average Waiting Time < target_wait/factor=4. -#' -#' @param target_wait Numeric value of the number of weeks that has been set as -#' the target within which the patient should be seen. -#' @param factor Numeric factor used in average wait calculation - to get a -#' quarter of the target use factor=4 and one sixth of the target use factor = -#' 6 etc. Defaults to 4. -#' -#' @return Numeric value of target mean waiting time to achieve a given target -#' wait. -#' -#' @export -#' -#' @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) - target_mean_wait <- target_wait / factor - return(target_mean_wait) -} +#' @title Average Waiting Time +#' +#' @description This calculates the target mean wait given the two inputs of +#' target_wait and a numerical value for factor. The average wait is actually +#' the target mean wait and is calculated as follows: target_wait / factor. If +#' we want to have a chance between 1.8%-0.2% of making a waiting time target, +#' then the average patient should have a waiting time between a quarter and a +#' sixth of the target. Therefore: The mean wait should sit somewhere between +#' target_wait/factor=6 < Average Waiting Time < target_wait/factor=4. +#' +#' @param target_wait Numeric value of the number of weeks that has been set as +#' the target within which the patient should be seen. +#' @param factor Numeric factor used in average wait calculation - to get a +#' quarter of the target use factor=4 and one sixth of the target use factor = +#' 6 etc. Defaults to 4. +#' +#' @return Numeric value of target mean waiting time to achieve a given target +#' wait. +#' +#' @export +#' +#' @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. +#' calc_target_mean_wait(52, 4) +calc_target_mean_wait <- function(target_wait, factor = 4) { + check_class(target_wait, factor) + target_mean_wait <- target_wait / factor + return(target_mean_wait) +} diff --git a/R/waiting_list_pressure.R b/R/calc_waiting_list_pressure.R old mode 100755 new mode 100644 similarity index 88% rename from R/waiting_list_pressure.R rename to R/calc_waiting_list_pressure.R index 9c8134e..8bcf6c1 --- a/R/waiting_list_pressure.R +++ b/R/calc_waiting_list_pressure.R @@ -1,25 +1,25 @@ -#' @title Calculate Waiting List Pressure -#' -#' @description For a waiting list with target waiting time, the pressure on the -#' waiting list is twice the mean delay divided by the waiting list target. -#' The pressure of any given waiting list should be less than 1. If the -#' pressure is greater than 1 then the waiting list is most likely going to -#' miss its target. The waiting list pressure is calculated as follows: -#' pressure = 2 * mean_wait / target_wait. -#' -#' @param mean_wait Numeric value of target mean waiting time to achieve a given -#' target wait. -#' @param target_wait Numeric value of the number of weeks that has been set as -#' the target within which the patient should be seen. -#' -#' @return Numeric value of wait_pressure which is the waiting list pressure. -#' -#' @export -#' -#' @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) -} +#' @title Calculate Waiting List Pressure +#' +#' @description For a waiting list with target waiting time, the pressure on the +#' waiting list is twice the mean delay divided by the waiting list target. +#' The pressure of any given waiting list should be less than 1. If the +#' pressure is greater than 1 then the waiting list is most likely going to +#' miss its target. The waiting list pressure is calculated as follows: +#' pressure = 2 * mean_wait / target_wait. +#' +#' @param mean_wait Numeric value of target mean waiting time to achieve a given +#' target wait. +#' @param target_wait Numeric value of the number of weeks that has been set as +#' the target within which the patient should be seen. +#' +#' @return Numeric value of wait_pressure which is the waiting list pressure. +#' +#' @export +#' +#' @examples +#' calc_waiting_list_pressure(63, 52) +calc_waiting_list_pressure <- function(mean_wait, target_wait) { + check_class(mean_wait, target_wait) + wait_pressure <- 2 * mean_wait / target_wait + return(wait_pressure) +} diff --git a/R/target_queue_size.R b/R/target_queue_size.R index 0e4d2ad..1601e4f 100644 --- a/R/target_queue_size.R +++ b/R/target_queue_size.R @@ -28,11 +28,11 @@ #' # 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) +#' calc_target_queue_size(30, 52, 4) #' -target_queue_size <- function(demand, target_wait, factor = 4) { +calc_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 + target_mean_wait <- calc_target_mean_wait(target_wait, factor) + target_queue_length <- demand * target_mean_wait return(target_queue_length) } diff --git a/R/wl_stats.R b/R/wl_stats.R index c89cb47..3f13d52 100755 --- a/R/wl_stats.R +++ b/R/wl_stats.R @@ -98,7 +98,7 @@ wl_stats <- function(waiting_list, # load q_load <- - queue_load(referral_stats$demand.weekly, removal_stats$capacity.weekly) + calc_queue_load(referral_stats$demand.weekly, removal_stats$capacity.weekly) # load too big q_load_too_big <- (q_load >= 1.) @@ -107,7 +107,7 @@ wl_stats <- function(waiting_list, q_size <- utils::tail(queue_sizes, n = 1)[, 2] # target queue size - q_target <- target_queue_size(referral_stats$demand.weekly, target_wait) + q_target <- calc_target_queue_size(referral_stats$demand.weekly, target_wait) # queue too big q_too_big <- (q_size > 2 * q_target) @@ -122,12 +122,12 @@ wl_stats <- function(waiting_list, # target capacity if (!q_too_big) { - target_cap <- target_capacity( - referral_stats$demand.weekly, - target_wait, - 4, - referral_stats$demand.cov, - removal_stats$capacity.cov) + target_cap <- calc_target_capacity( + referral_stats$demand.weekly, + target_wait, + 4, + referral_stats$demand.cov, + removal_stats$capacity.cov) # target_cap_weekly <- target_cap_daily * 7 } else { target_cap <- NA @@ -136,13 +136,13 @@ wl_stats <- function(waiting_list, # relief capacity if (q_too_big) { relief_cap <- - relief_capacity(referral_stats$demand.weekly, q_size, q_target) + calc_relief_capacity(referral_stats$demand.weekly, q_size, q_target) } else { relief_cap <- NA } # pressure - # pressure <- waiting_list_pressure(mean_wait, target_wait) + # pressure <- calc_waiting_list_pressure(mean_wait, target_wait) # TODO: talk to Neil about using *2 (in this function), # or *4 in the formula below diff --git a/man/queue_load.Rd b/man/calc_queue_load.Rd old mode 100755 new mode 100644 similarity index 85% rename from man/queue_load.Rd rename to man/calc_queue_load.Rd index 0792025..7a1bd9d --- a/man/queue_load.Rd +++ b/man/calc_queue_load.Rd @@ -1,30 +1,30 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/queue_load.R -\name{queue_load} -\alias{queue_load} -\title{Calculate Queue Load} -\usage{ -queue_load(demand, capacity) -} -\arguments{ -\item{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.} - -\item{capacity}{Numeric value of the number of patients that can be served -(removals) from the waiting list each week.} -} -\value{ -Numeric value of load which is the ratio between demand and capacity. -} -\description{ -Calculates the queue load. The queue load is the number of -arrivals that occur for every patient leaving the queue (given that the -waiting list did not empty). It could also be described as the rate of -service at the queue. The queue load is calculated by dividing the demand -by the capacity: queue_load = demand / capacity. -} -\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) -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/calc_queue_load.R +\name{calc_queue_load} +\alias{calc_queue_load} +\title{Calculate Queue Load} +\usage{ +calc_queue_load(demand, capacity) +} +\arguments{ +\item{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.} + +\item{capacity}{Numeric value of the number of patients that can be served +(removals) from the waiting list each week.} +} +\value{ +Numeric value of load which is the ratio between demand and capacity. +} +\description{ +Calculates the queue load. The queue load is the number of +arrivals that occur for every patient leaving the queue (given that the +waiting list did not empty). It could also be described as the rate of +service at the queue. The queue load is calculated by dividing the demand +by the capacity: queue_load = demand / capacity. +} +\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). +calc_queue_load(30, 27) +} diff --git a/man/relief_capacity.Rd b/man/calc_relief_capacity.Rd old mode 100755 new mode 100644 similarity index 84% rename from man/relief_capacity.Rd rename to man/calc_relief_capacity.Rd index 6e03263..5cbf351 --- a/man/relief_capacity.Rd +++ b/man/calc_relief_capacity.Rd @@ -1,10 +1,15 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/relief_capacity.R -\name{relief_capacity} -\alias{relief_capacity} +% Please edit documentation in R/calc_relief_capacity.R +\name{calc_relief_capacity} +\alias{calc_relief_capacity} \title{Relief Capacity} \usage{ -relief_capacity(demand, queue_size, target_queue_size, time_to_target = 26) +calc_relief_capacity( + demand, + queue_size, + target_queue_size, + time_to_target = 26 +) } \arguments{ \item{demand}{Numeric value of rate of demand in same units as target wait @@ -41,6 +46,6 @@ or if demand is per day then time_to_target is per day # Relief Capacity = 30 + (1200 - 390)/26 = 61.15 patients per week. -relief_capacity(30, 1200, 390, 26) +calc_relief_capacity(30, 1200, 390, 26) } diff --git a/man/target_capacity.Rd b/man/calc_target_capacity.Rd similarity index 88% rename from man/target_capacity.Rd rename to man/calc_target_capacity.Rd index 1ccc171..fe27c83 100644 --- a/man/target_capacity.Rd +++ b/man/calc_target_capacity.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/target_capacity.R -\name{target_capacity} -\alias{target_capacity} +% Please edit documentation in R/calc_target_capacity.R +\name{calc_target_capacity} +\alias{calc_target_capacity} \title{Target Capacity} \usage{ -target_capacity( +calc_target_capacity( demand, target_wait, factor = 4, @@ -47,7 +47,7 @@ demand <- 4 # weeks target_wait <- 52 # weeks # number of operations per week to have mean wait of 52/4 -target_capacity(demand, target_wait) +calc_target_capacity(demand, target_wait) # TODO: Include a couple of standard deviations for errors in the mean demand } diff --git a/man/average_wait.Rd b/man/calc_target_mean_wait.Rd old mode 100755 new mode 100644 similarity index 85% rename from man/average_wait.Rd rename to man/calc_target_mean_wait.Rd index 7bd04b1..6f3f0ed --- a/man/average_wait.Rd +++ b/man/calc_target_mean_wait.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/average_wait.R -\name{average_wait} -\alias{average_wait} +% Please edit documentation in R/calc_target_mean_wait.R +\name{calc_target_mean_wait} +\alias{calc_target_mean_wait} \title{Average Waiting Time} \usage{ -average_wait(target_wait, factor = 4) +calc_target_mean_wait(target_wait, factor = 4) } \arguments{ \item{target_wait}{Numeric value of the number of weeks that has been set as @@ -30,5 +30,5 @@ target_wait/factor=6 < Average Waiting Time < target_wait/factor=4. \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) +calc_target_mean_wait(52, 4) } diff --git a/man/target_queue_size.Rd b/man/calc_target_queue_size.Rd similarity index 89% rename from man/target_queue_size.Rd rename to man/calc_target_queue_size.Rd index 4579942..cb3dbec 100644 --- a/man/target_queue_size.Rd +++ b/man/calc_target_queue_size.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/target_queue_size.R -\name{target_queue_size} -\alias{target_queue_size} +\name{calc_target_queue_size} +\alias{calc_target_queue_size} \title{Target Queue Size} \usage{ -target_queue_size(demand, target_wait, factor = 4) +calc_target_queue_size(demand, target_wait, factor = 4) } \arguments{ \item{demand}{Numeric value of rate of demand in same units as target wait @@ -39,6 +39,6 @@ Only applicable when Capacity > Demand. # 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) +calc_target_queue_size(30, 52, 4) } diff --git a/man/waiting_list_pressure.Rd b/man/calc_waiting_list_pressure.Rd old mode 100755 new mode 100644 similarity index 79% rename from man/waiting_list_pressure.Rd rename to man/calc_waiting_list_pressure.Rd index 5bedff5..58bde24 --- a/man/waiting_list_pressure.Rd +++ b/man/calc_waiting_list_pressure.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/waiting_list_pressure.R -\name{waiting_list_pressure} -\alias{waiting_list_pressure} +% Please edit documentation in R/calc_waiting_list_pressure.R +\name{calc_waiting_list_pressure} +\alias{calc_waiting_list_pressure} \title{Calculate Waiting List Pressure} \usage{ -waiting_list_pressure(mean_wait, target_wait) +calc_waiting_list_pressure(mean_wait, target_wait) } \arguments{ \item{mean_wait}{Numeric value of target mean waiting time to achieve a given @@ -25,5 +25,5 @@ miss its target. The waiting list pressure is calculated as follows: pressure = 2 * mean_wait / target_wait. } \examples{ -waiting_list_pressure(63, 52) +calc_waiting_list_pressure(63, 52) } diff --git a/tests/testthat/test-average_wait.R b/tests/testthat/test-average_wait.R deleted file mode 100755 index c8e4fd2..0000000 --- a/tests/testthat/test-average_wait.R +++ /dev/null @@ -1,37 +0,0 @@ -test_that("wrong input class causes an error", { - msg_fragment <- "must be of class" - expect_error(average_wait(1, "x"), msg_fragment) - expect_error(average_wait("x", 1), msg_fragment) -}) - -test_that("it returns expected result with fixed single values vs arithmetic", { - em <- "average_wait(): arithmetic error with single value inputs." - expect_equal(average_wait(52, 4), 52 / 4) -}) - -test_that("it returns an expected result with fixed single values", { - em <- "average_wait(): arithmetic error with single value inputs." - expect_equal(average_wait(52, 4), 13) -}) - - - -test_that("it returns an expected result with vector of fixed values", { - em <- "average_wait(): aritmetic error with vector of values as inputs." - expect_equal( - average_wait( - c(35, 30, 52), - c(4, 4, 6) - ), - c(8.75, 7.5, 8.6666667) - ) -}) - - -test_that("it returns the same length output as provided on input", { - n <- round(runif(1, 0, 30)) - in1 <- rnorm(n = n, 50, 20) - in2 <- rnorm(n = n, 4, 2) - em <- "target_queue_size(): output vector length != input vector length." - expect_length(average_wait(in1, in2), length(in1)) -}) diff --git a/tests/testthat/test-queue_load.R b/tests/testthat/test-calc_queue_load.R old mode 100755 new mode 100644 similarity index 51% rename from tests/testthat/test-queue_load.R rename to tests/testthat/test-calc_queue_load.R index 951dae7..61cbaf8 --- a/tests/testthat/test-queue_load.R +++ b/tests/testthat/test-calc_queue_load.R @@ -1,36 +1,36 @@ -test_that("wrong input class causes an error", { - msg_fragment <- "must be of class" - expect_error(queue_load(1, "x"), msg_fragment) - expect_error(queue_load("x", 1), msg_fragment) -}) - -test_that("it returns expected result with fixed single values vs arithmetic", { - em <- "queue_load(): arithmetic error with single value inputs." - expect_equal(queue_load(30, 27), 30 / 27) -}) - -test_that("it returns an expected result with fixed single values", { - em <- "queue_load(): arithmetic error with single value inputs." - expect_equal(queue_load(30, 27), 1.11111111) -}) - - -test_that("it returns an expected result with vector of fixed values", { - em <- "queue_load(): arithmetic error with vector of values as inputs." - expect_equal( - queue_load( - c(35, 30, 52), - c(27, 25, 42) - ), - c(1.2962963, 1.2, 1.23809524) - ) -}) - - -test_that("it returns the same length output as provided on input", { - n <- round(runif(1, 0, 30)) - in1 <- rnorm(n = n, 50, 20) - in2 <- rnorm(n = n, 30, 5) - em <- "target_queue_size(): output vector length != input vector length." - expect_length(queue_load(in1, in2), length(in1)) -}) +test_that("wrong input class causes an error", { + msg_fragment <- "must be of class" + expect_error(calc_queue_load(1, "x"), msg_fragment) + expect_error(calc_queue_load("x", 1), msg_fragment) +}) + +test_that("it returns expected result with fixed single values vs arithmetic", { + em <- "calc_queue_load(): arithmetic error with single value inputs." + expect_equal(calc_queue_load(30, 27), 30 / 27) +}) + +test_that("it returns an expected result with fixed single values", { + em <- "calc_queue_load(): arithmetic error with single value inputs." + expect_equal(calc_queue_load(30, 27), 1.11111111) +}) + + +test_that("it returns an expected result with vector of fixed values", { + em <- "calc_queue_load(): arithmetic error with vector of values as inputs." + expect_equal( + calc_queue_load( + c(35, 30, 52), + c(27, 25, 42) + ), + c(1.2962963, 1.2, 1.23809524) + ) +}) + + +test_that("it returns the same length output as provided on input", { + n <- round(runif(1, 0, 30)) + in1 <- rnorm(n = n, 50, 20) + in2 <- rnorm(n = n, 30, 5) + em <- "target_queue_load(): output vector length != input vector length." + expect_length(calc_queue_load(in1, in2), length(in1)) +}) diff --git a/tests/testthat/test-calc_relief_capacity.R b/tests/testthat/test-calc_relief_capacity.R new file mode 100644 index 0000000..40f910d --- /dev/null +++ b/tests/testthat/test-calc_relief_capacity.R @@ -0,0 +1,42 @@ +test_that("wrong input class causes an error", { + msg_fragment <- "must be of class" + expect_error(calc_relief_capacity("x", 2, 3, 4), msg_fragment) + expect_error(calc_relief_capacity(1, "x", 3, 4), msg_fragment) + expect_error(calc_relief_capacity(1, 2, "x", 4), msg_fragment) + expect_error(calc_relief_capacity(1, 2, 3, "x"), msg_fragment) +}) + +test_that("it returns expected result with fixed single values vs arithmetic", { + em <- "calc_relief_capacity(): arithmetic error with single value inputs." + expect_equal(calc_relief_capacity(30, 1200, 390, 26), 30 + (1200 - 390) / 26) +}) + +test_that("it returns an expected result with fixed single values", { + em <- "calc_relief_capacity(): arithmetic error with single value inputs." + expect_equal(calc_relief_capacity(30, 1200, 390, 26), 61.153846) +}) + +test_that("it returns an expected result with vector of fixed values", { + em <- "calc_relief_capacity(): arithmetic error with vector of input values." + expect_equal( + calc_relief_capacity( + c(30, 33, 35), + c(1200, 800, 250), + c(390, 200, 100), + c(26, 30, 15) + ), + c(61.153846, 53, 45) + ) +}) + + +test_that("it returns the same length output as provided on input", { + n <- round(runif(1, 0, 30)) + in1 <- rnorm(n = n, 50, 20) + in2 <- in1 * (15 * runif(1, 0, 1.5)) + in3 <- in1 * (5 * runif(1, 1, 1.5)) + in4 <- in1 * (runif(1, 0.5, 1.5)) + + em <- "calc_relief_capacity(): output vector length != input vector length." + expect_length(calc_relief_capacity(in1, in2, in3, in4), length(in1)) +}) diff --git a/tests/testthat/test-calc_target_capacity.R b/tests/testthat/test-calc_target_capacity.R new file mode 100644 index 0000000..50d456c --- /dev/null +++ b/tests/testthat/test-calc_target_capacity.R @@ -0,0 +1,44 @@ +test_that("wrong input class causes an error", { + msg_fragment <- "must be of class" + expect_error(calc_target_capacity("x", 2, 3, 4, 5), msg_fragment) + expect_error(calc_target_capacity(1, "x", 3, 4, 5), msg_fragment) + expect_error(calc_target_capacity(1, 2, "x", 4, 5), msg_fragment) + expect_error(calc_target_capacity(1, 2, 3, "x", 5), msg_fragment) + expect_error(calc_target_capacity(1, 2, 3, 4, "x"), msg_fragment) +}) + +test_that("it returns expected result with fixed single values vs arithmetic", { + em <- "calc_target_capacity(): arithmetic error with single value inputs." + expect_equal( + calc_target_capacity(30, 52, 3, 1.1, 1.2), + 30 + (((1.1^2 + 1.2^2) / 2) * (3 / 52)) + ) +}) + +test_that("it returns an expected result with fixed single values", { + em <- "calc_target_capacity(): arithmetic error with single value inputs." + expect_equal(calc_target_capacity(30, 52, 3, 1.1, 1.2), 30.076442) +}) + +test_that("it returns an expected result with vector of fixed values", { + em <- "calc_target_capacity(): arithmetic error with vector of input values." + expect_equal( + calc_target_capacity( + c(30, 42, 35), + c(52, 65, 50), + c(3, 2, 1), + c(1.1, 1.2, 1.3), + c(1.4, 1.5, 1.6) + ), + c(30.0914423, 42.0567692, 35.0425) + ) +}) + + +test_that("it returns the same length output as provided on input", { + n <- round(runif(1, 0, 30)) + in1 <- rnorm(n = n, 50, 20) + in2 <- in1 * runif(1, 0.5, 1.5) + em <- "calc_target_capacity(): output vector length != input vector length." + expect_length(calc_target_capacity(in1, in2), length(in1)) +}) diff --git a/tests/testthat/test-calc_target_mean_wait.R b/tests/testthat/test-calc_target_mean_wait.R new file mode 100644 index 0000000..0ba8f93 --- /dev/null +++ b/tests/testthat/test-calc_target_mean_wait.R @@ -0,0 +1,38 @@ +test_that("wrong input class causes an error", { + msg_fragment <- "must be of class" + expect_error(calc_target_mean_wait(1, "x"), msg_fragment) + expect_error(calc_target_mean_wait("x", 1), msg_fragment) +}) + +test_that("it returns expected result with fixed single values vs arithmetic", { + em <- "calc_target_mean_wait(): arithmetic error with single value inputs." + expect_equal(calc_target_mean_wait(52, 4), 52 / 4) +}) + +test_that("it returns an expected result with fixed single values", { + em <- "calc_target_mean_wait(): arithmetic error with single value inputs." + expect_equal(calc_target_mean_wait(52, 4), 13) +}) + + + +test_that("it returns an expected result with vector of fixed values", { + em <- "calc_target_mean_wait(): + aritmetic error with vector of values as inputs." + expect_equal( + calc_target_mean_wait( + c(35, 30, 52), + c(4, 4, 6) + ), + c(8.75, 7.5, 8.6666667) + ) +}) + + +test_that("it returns the same length output as provided on input", { + n <- round(runif(1, 0, 30)) + in1 <- rnorm(n = n, 50, 20) + in2 <- rnorm(n = n, 4, 2) + em <- "calc_target_mean_wait(): output vector length != input vector length." + expect_length(calc_target_mean_wait(in1, in2), length(in1)) +}) diff --git a/tests/testthat/test-calc_target_queue_size.R b/tests/testthat/test-calc_target_queue_size.R new file mode 100644 index 0000000..7cf2788 --- /dev/null +++ b/tests/testthat/test-calc_target_queue_size.R @@ -0,0 +1,35 @@ +test_that("wrong input class causes an error", { + msg_fragment <- "must be of class" + expect_error(calc_target_queue_size("x", 2, 3), msg_fragment) + expect_error(calc_target_queue_size(1, "x", 3), msg_fragment) + expect_error(calc_target_queue_size(1, 2, "x"), msg_fragment) +}) + +test_that("it returns an expected result with fixed single values", { + em <- "calc_target_queue_size(): arithmetic error with single value inputs." + expect_equal(calc_target_queue_size(30, 52), 390) + expect_equal(calc_target_queue_size(30, 50), 375) + expect_equal(calc_target_queue_size(30, 50, 6), 250) +}) + +test_that("it returns an expected result with vector of fixed values", { + em <- "calc_target_queue_size(): + arithmetic error with vector of values as inputs." + expect_equal( + calc_target_queue_size( + c(30, 30, 30), + c(52, 50, 50), + c(4, 4, 6) + ), + c(390, 375, 250) + ) +}) + + +test_that("it returns the same length output as provided on input", { + n <- round(runif(1, 0, 30)) + in1 <- rnorm(n = n, 50, 20) + in2 <- in1 * (1.2 + runif(1, 0, 1.5)) + em <- "calc_target_queue_size(): output vector length != input vector length." + expect_length(calc_target_queue_size(in1, in2), length(in1)) +}) diff --git a/tests/testthat/test-calc_waiting_list_pressure.R b/tests/testthat/test-calc_waiting_list_pressure.R new file mode 100644 index 0000000..f7af845 --- /dev/null +++ b/tests/testthat/test-calc_waiting_list_pressure.R @@ -0,0 +1,39 @@ +test_that("wrong input class causes an error", { + msg_fragment <- "must be of class" + expect_error(calc_waiting_list_pressure("x", 2), msg_fragment) + expect_error(calc_waiting_list_pressure(1, "x"), msg_fragment) +}) + +test_that("it returns expected result with fixed single values vs arithmetic", { + em <- "calc_waiting_list_pressure(): + arithmetic error with single value inputs." + expect_equal(calc_waiting_list_pressure(63, 52), 2 * 63 / 52) +}) + +test_that("it returns an expected result with fixed single values", { + em <- "calc_waiting_list_pressure(): + arithmetic error with single value inputs." + expect_equal(calc_waiting_list_pressure(63, 52), 2.42307692) +}) + +test_that("it returns an expected result with vector of fixed values", { + em <- "calc_waiting_list_pressure(): + arithmetic error with vector of input values." + expect_equal( + calc_waiting_list_pressure( + c(63, 42, 55), + c(52, 24, 50) + ), + c(2.42307692, 3.5, 2.2) + ) +}) + + +test_that("it returns the same length output as provided on input", { + n <- round(runif(1, 0, 30)) + in1 <- rnorm(n = n, 50, 20) + in2 <- in1 * (1.2 + runif(1, 0, 1.5)) + em <- "calc_waiting_list_pressure(): + output vector length != input vector length." + expect_length(calc_waiting_list_pressure(in1, in2), length(in1)) +}) diff --git a/tests/testthat/test-relief_capacity.R b/tests/testthat/test-relief_capacity.R deleted file mode 100755 index 8f14de2..0000000 --- a/tests/testthat/test-relief_capacity.R +++ /dev/null @@ -1,42 +0,0 @@ -test_that("wrong input class causes an error", { - msg_fragment <- "must be of class" - expect_error(relief_capacity("x", 2, 3, 4), msg_fragment) - expect_error(relief_capacity(1, "x", 3, 4), msg_fragment) - expect_error(relief_capacity(1, 2, "x", 4), msg_fragment) - expect_error(relief_capacity(1, 2, 3, "x"), msg_fragment) -}) - -test_that("it returns expected result with fixed single values vs arithmetic", { - em <- "relief_capacity(): arithmetic error with single value inputs." - expect_equal(relief_capacity(30, 1200, 390, 26), 30 + (1200 - 390) / 26) -}) - -test_that("it returns an expected result with fixed single values", { - em <- "relief_capacity(): arithmetic error with single value inputs." - expect_equal(relief_capacity(30, 1200, 390, 26), 61.153846) -}) - -test_that("it returns an expected result with vector of fixed values", { - em <- "relief_capacity(): arithmetic error with vector of input values." - expect_equal( - relief_capacity( - c(30, 33, 35), - c(1200, 800, 250), - c(390, 200, 100), - c(26, 30, 15) - ), - c(61.153846, 53, 45) - ) -}) - - -test_that("it returns the same length output as provided on input", { - n <- round(runif(1, 0, 30)) - in1 <- rnorm(n = n, 50, 20) - in2 <- in1 * (15 * runif(1, 0, 1.5)) - in3 <- in1 * (5 * runif(1, 1, 1.5)) - in4 <- in1 * (runif(1, 0.5, 1.5)) - - em <- "relief_capacity(): output vector length != input vector length." - expect_length(relief_capacity(in1, in2, in3, in4), length(in1)) -}) diff --git a/tests/testthat/test-target_capacity.R b/tests/testthat/test-target_capacity.R deleted file mode 100755 index 821b8f2..0000000 --- a/tests/testthat/test-target_capacity.R +++ /dev/null @@ -1,44 +0,0 @@ -test_that("wrong input class causes an error", { - msg_fragment <- "must be of class" - expect_error(target_capacity("x", 2, 3, 4, 5), msg_fragment) - expect_error(target_capacity(1, "x", 3, 4, 5), msg_fragment) - expect_error(target_capacity(1, 2, "x", 4, 5), msg_fragment) - expect_error(target_capacity(1, 2, 3, "x", 5), msg_fragment) - expect_error(target_capacity(1, 2, 3, 4, "x"), msg_fragment) -}) - -test_that("it returns expected result with fixed single values vs arithmetic", { - em <- "target_capacity(): arithmetic error with single value inputs." - expect_equal( - target_capacity(30, 52, 3, 1.1, 1.2), - 30 + (((1.1^2 + 1.2^2) / 2) * (3 / 52)) - ) -}) - -test_that("it returns an expected result with fixed single values", { - em <- "target_capacity(): arithmetic error with single value inputs." - expect_equal(target_capacity(30, 52, 3, 1.1, 1.2), 30.076442) -}) - -test_that("it returns an expected result with vector of fixed values", { - em <- "target_capacity(): arithmetic error with vector of input values." - expect_equal( - target_capacity( - c(30, 42, 35), - c(52, 65, 50), - c(3, 2, 1), - c(1.1, 1.2, 1.3), - c(1.4, 1.5, 1.6) - ), - c(30.0914423, 42.0567692, 35.0425) - ) -}) - - -test_that("it returns the same length output as provided on input", { - n <- round(runif(1, 0, 30)) - in1 <- rnorm(n = n, 50, 20) - in2 <- in1 * runif(1, 0.5, 1.5) - em <- "target_capacity(): output vector length != input vector length." - expect_length(target_capacity(in1, in2), length(in1)) -}) diff --git a/tests/testthat/test-target_queue_size.R b/tests/testthat/test-target_queue_size.R deleted file mode 100755 index 5c80cc8..0000000 --- a/tests/testthat/test-target_queue_size.R +++ /dev/null @@ -1,34 +0,0 @@ -test_that("wrong input class causes an error", { - msg_fragment <- "must be of class" - expect_error(target_queue_size("x", 2, 3), msg_fragment) - expect_error(target_queue_size(1, "x", 3), msg_fragment) - expect_error(target_queue_size(1, 2, "x"), msg_fragment) -}) - -test_that("it returns an expected result with fixed single values", { - em <- "target_queue_size(): arithmetic error with single value inputs." - expect_equal(target_queue_size(30, 52), 390) - expect_equal(target_queue_size(30, 50), 375) - expect_equal(target_queue_size(30, 50, 6), 250) -}) - -test_that("it returns an expected result with vector of fixed values", { - em <- "target_queue_size(): arithmetic error with vector of values as inputs." - expect_equal( - target_queue_size( - c(30, 30, 30), - c(52, 50, 50), - c(4, 4, 6) - ), - c(390, 375, 250) - ) -}) - - -test_that("it returns the same length output as provided on input", { - n <- round(runif(1, 0, 30)) - in1 <- rnorm(n = n, 50, 20) - in2 <- in1 * (1.2 + runif(1, 0, 1.5)) - em <- "target_queue_size(): output vector length != input vector length." - expect_length(target_queue_size(in1, in2), length(in1)) -}) diff --git a/tests/testthat/test-waiting_list_pressure.R b/tests/testthat/test-waiting_list_pressure.R deleted file mode 100755 index 95b7025..0000000 --- a/tests/testthat/test-waiting_list_pressure.R +++ /dev/null @@ -1,35 +0,0 @@ -test_that("wrong input class causes an error", { - msg_fragment <- "must be of class" - expect_error(waiting_list_pressure("x", 2), msg_fragment) - expect_error(waiting_list_pressure(1, "x"), msg_fragment) -}) - -test_that("it returns expected result with fixed single values vs arithmetic", { - em <- "waiting_list_pressure(): arithmetic error with single value inputs." - expect_equal(waiting_list_pressure(63, 52), 2 * 63 / 52) -}) - -test_that("it returns an expected result with fixed single values", { - em <- "waiting_list_pressure(): arithmetic error with single value inputs." - expect_equal(waiting_list_pressure(63, 52), 2.42307692) -}) - -test_that("it returns an expected result with vector of fixed values", { - em <- "waiting_list_pressure(): arithmetic error with vector of input values." - expect_equal( - waiting_list_pressure( - c(63, 42, 55), - c(52, 24, 50) - ), - c(2.42307692, 3.5, 2.2) - ) -}) - - -test_that("it returns the same length output as provided on input", { - n <- round(runif(1, 0, 30)) - in1 <- rnorm(n = n, 50, 20) - in2 <- in1 * (1.2 + runif(1, 0, 1.5)) - em <- "waiting_list_pressure(): output vector length != input vector length." - expect_length(waiting_list_pressure(in1, in2), length(in1)) -}) diff --git a/vignettes/example_walkthrough.Rmd b/vignettes/example_walkthrough.Rmd index dd7678e..1d3d4b6 100644 --- a/vignettes/example_walkthrough.Rmd +++ b/vignettes/example_walkthrough.Rmd @@ -58,7 +58,7 @@ std_dev_procedures <- 160 > Fact 1: Capacity must be larger than demand, otherwise the waiting list size will grow indefinitely. ```{r} -load <- queue_load(demand, capacity) +load <- calc_queue_load(demand, capacity) load ``` @@ -80,11 +80,11 @@ In the case of P2 customers, the target is 4 weeks. Thus, the mean wait of a typical patient should be under one week. ```{r} -average_wait <- average_wait(waiting_time_target) -average_wait +target_mean_wait <- calc_target_mean_wait(waiting_time_target) +target_mean_wait ``` -We see that the average wait is `r average_wait` weeks. +We see that the target mean wait is `r target_mean_wait` weeks. ## Target queue length @@ -97,7 +97,7 @@ If, as given in Fact 4 above, we want the average waiting time to be a quarter o > Fact 6: Target queue size is demand multiplied by target wait, divided by 4. ```{r} -target_queue_size <- target_queue_size(demand, waiting_time_target) +target_queue_size <- calc_target_queue_size(demand, waiting_time_target) target_queue_size queue_ratio <- queue_size / target_queue_size @@ -116,7 +116,7 @@ If the waiting list size is over twice the target queue size, then we consider t ```{r} weeks_until_target_acheived <- 26 -relief_capacity <- relief_capacity( +relief_capacity <- calc_relief_capacity( demand = demand, queue_size = queue_size, target_queue_size = target_queue_size, @@ -133,7 +133,7 @@ To do this, the capacity needed is `r round(relief_capacity, 1)` procedures per As discussed above if the queue size is more than double its target then capacity should be increased temporarily. However, once the queue size is within an acceptable range, we can maintain the waiting time target with what is potentially a much smaller capacity allocation to the waiting list. -We know the waiting time (`r average_wait` weeks) and queue size (`r target_queue_size` patients) of a waiting list operating at its target equilibrium. +We know the mean waiting time (`r target_mean_wait` weeks) and queue size (`r target_queue_size` patients) of a waiting list operating at its target equilibrium. Now we calculate a capacity allocation that will maintain this equilibrium in the long run. > Fact 8: Target capacity formula, based on the Pollaczek-Khinchine formula. @@ -148,7 +148,7 @@ Higher values represent more variability, which in turn will increase the capaci # set the "F" variability parameter f_1 <- 1 -target_capacity_1 <- target_capacity( +target_capacity_1 <- calc_target_capacity( demand = demand, target_wait = waiting_time_target ) @@ -160,7 +160,7 @@ If F is `r f_1`, we can see that the capacity required is `r round(target_capaci ```{r} f_2 <- 6.58 -target_capacity_2 <- target_capacity( +target_capacity_2 <- calc_target_capacity( demand = demand, target_wait = waiting_time_target ) @@ -187,9 +187,9 @@ For the P4 ENT example we have been following: ```{r} waiting_list_pressure_p4 <- - waiting_list_pressure( - avg_waiting_time, - waiting_time_target) + calc_waiting_list_pressure( + avg_waiting_time, + waiting_time_target) waiting_list_pressure_p4 ``` @@ -206,9 +206,9 @@ avg_waiting_time_p2 <- 24 waiting_time_target_p2 <- 4 waiting_list_pressure_p2 <- - waiting_list_pressure( - avg_waiting_time_p2, - waiting_time_target_p2) + calc_waiting_list_pressure( + avg_waiting_time_p2, + waiting_time_target_p2) waiting_list_pressure_p2 ``` diff --git a/vignettes/functions_table.md b/vignettes/functions_table.md index ee6da5d..02c1c9f 100755 --- a/vignettes/functions_table.md +++ b/vignettes/functions_table.md @@ -1,8 +1,8 @@ | Function | Purpose | |------------------:|:---------------------------------------------------| - | `queue_load()` | To understand the ratio between demand and capacity. | - | `average_wait()` | To understand the average waiting time for a queue in equilibrium. | - | `target_queue_size()` | To understand the queue size for a queue in equilibrium. | - | `relief_capacity()` | To calculate the relief capacity needed to bring a very large queue under control. | - | `target_capacity()` | To understand the capacity required to keep a queue in equilibrium, depending on how much variability it experiences. | - | `waiting_list_pressure()` | A pressure measure, which can be used to compare multiple waiting lists for planning purposes. | + | `calc_queue_load()` | To understand the ratio between demand and capacity. | + | `calc_target_mean_wait()` | To understand the average waiting time for a queue in equilibrium. | + | `calc_target_queue_size()` | To understand the queue size for a queue in equilibrium. | + | `calc_relief_capacity()` | To calculate the relief capacity needed to bring a very large queue under control. | + | `calc_target_capacity()` | To understand the capacity required to keep a queue in equilibrium, depending on how much variability it experiences. | + | `calc_waiting_list_pressure()` | A pressure measure, which can be used to compare multiple waiting lists for planning purposes. |