fix all linting errors

R/relief_capacity.R

@@ -32,7 +32,11 @@
 #'
 #' relief_capacity(30, 1200, 390, 26)
 #'
-relief_capacity <- function(demand, queue_size, target_queue_size, time_to_target = 26) {
+relief_capacity <- function(
+    demand,
+    queue_size,
+    target_queue_size,
+    time_to_target = 26) {
   check_class(demand, queue_size, target_queue_size, time_to_target)
   rel_cap <- demand + (queue_size - target_queue_size) / time_to_target
   return(rel_cap)

R/target_capacity.R

@@ -20,7 +20,7 @@
 #' @param cv_capacity coefficient of variation between removals due to
 #'   operations completed
 #'
-#' @return A numeric value of target capacity required to achieve a target waiting time.
+#' @return numeric. The capacity required to achieve a target waiting time.
 #' @export
 #'
 #' @examples
@@ -32,8 +32,14 @@
 #' target_capacity(demand, target_wait)
 #'
 #' # TODO: Include a couple of standard deviations for errors in the mean demand
-target_capacity <- function(demand, target_wait, factor = 4, cv_demand = 1, cv_capacity = 1) {
+target_capacity <- function(
+    demand,
+    target_wait,
+    factor = 4,
+    cv_demand = 1,
+    cv_capacity = 1) {
   check_class(demand, target_wait, factor, cv_demand, cv_capacity)
-  target_cap <- demand + ((cv_demand**2 + cv_capacity**2) / 2) * (factor / target_wait)
+  target_cap <-
+    demand + ((cv_demand**2 + cv_capacity**2) / 2) * (factor / target_wait)
   return(target_cap)
 }

R/wl_queue_sizes.R

@@ -32,16 +32,17 @@ wl_queue_size <- function(waiting_list, start_date = NULL, end_date = NULL) {
   queues <- data.frame(dates, rep(0, length(dates)))
 
   queues[which(queues[, 1] %in% arrival_counts[, 1]), 2] <- arrival_counts[, 2]
-  queues$cummulative_arrivals <- cumsum(queues[, 2])
+  queues$cummul_arrivals <- cumsum(queues[, 2])
 
   departure_counts <- data.frame(
     table(wl[which((start_date <= wl[, 2]) & (wl[, 2] <= end_date)), 2])
   )
   queues$departures <- rep(0, length(dates))
-  queues[which(queues[, 1] %in% departure_counts[, 1]), 4] <- departure_counts[, 2]
-  queues$cummulative_departures <- cumsum(queues[, 4])
+  queues[which(queues[, 1] %in% departure_counts[, 1]), 4] <-
+    departure_counts[, 2]
+  queues$cummul_departures <- cumsum(queues[, 4])
 
-  queues$queue_size <- queues$cummulative_arrivals - queues$cummulative_departures
+  queues$queue_size <- queues$cummul_arrivals - queues$cummul_departures
 
   return(queues[, c(1, 6)])
 }

R/wl_referral_stats.R

@@ -39,7 +39,7 @@ wl_referral_stats <- function(waiting_list,
     as.Date(start_date),
     waiting_list[
       which(start_date <= waiting_list[, 1] &
-        waiting_list[, 1] <= end_date), 1
+              waiting_list[, 1] <= end_date), 1
     ],
     as.Date(end_date)
   )

R/wl_removal_stats.R

@@ -56,7 +56,8 @@ wl_removal_stats <- function(waiting_list,
   ), ]
   rownames(removals_and_zeros) <- NULL
   removals_and_zeros$lag_dates <- dplyr::lag(removals_and_zeros$dates)
-  removals_and_zeros$diff <- as.numeric(removals_and_zeros[, 1]) - as.numeric(removals_and_zeros[, 3])
+  removals_and_zeros$diff <-
+    as.numeric(removals_and_zeros[, 1]) - as.numeric(removals_and_zeros[, 3])
 
   differences <- removals_and_zeros[which(removals_and_zeros[, 2] == TRUE), 4]
   mean_removal <- as.numeric(mean(differences, na.rm = TRUE))

R/wl_schedule.R

@@ -39,7 +39,7 @@ wl_schedule <- function(
   # schedule
   i <- 1
   for (op in as.list(schedule)) {
-    if (op > wl[i, referral_index] & i <= nrow(wl)) {
+    if (op > wl[i, referral_index] && i <= nrow(wl)) {
       wl[i, removal_index] <- as.Date(op)
       i <- i + 1
     }

R/wl_simulator.R

@@ -1,25 +1,35 @@
 #' @title Simple simulator to create a waiting list
 #'
-#' @description Creates a simulated waiting list comprising referral dates, and removal dates
+#' @description Creates a simulated waiting list comprising referral dates,
+#' and removal dates
 #'
 #' @param start_date date. The start date for the simulation
 #' @param end_date date. The end date for the simulation
 #' @param demand numeric. Weekly demand (ie. typical referrals per week)
 #' @param capacity numeric. Weekly capacity (ie. typical removals per week)
 #' @param waiting_list integer. The number of patients on the waiting list
-#' @param referral_index integer. The column number in the waiting_list which contains the referral dates
+#' @param referral_index integer. The column number in the waiting_list which
+#'   contains the referral dates
 #'
 #' @return dataframe. A df of simulated referrals and removals
 #' @export
 #'
 #' @examples
 #'
-#' over_capacity_simulation <- wl_simulator("2024-01-01", "2024-03-31", 100, 110)
-#' under_capacity_simulation <- wl_simulator("2024-01-01", "2024-03-31", 100, 90)
+#' over_capacity_simulation <-
+#'   wl_simulator("2024-01-01", "2024-03-31", 100, 110)
+#' under_capacity_simulation <-
+#'   wl_simulator("2024-01-01", "2024-03-31", 100, 90)
 #'
 #' # TODO
 #' # error messages (e.g. start_date > end_date)
-wl_simulator <- function(start_date, end_date, demand, capacity, waiting_list = NULL, referral_index = 1) {
+wl_simulator <- function(
+    start_date,
+    end_date,
+    demand,
+    capacity,
+    waiting_list = NULL,
+    referral_index = 1) {
   start_date <- as.Date(start_date)
   end_date <- as.Date(end_date)
   number_of_days <- as.numeric(end_date) - as.numeric(start_date)
@@ -29,7 +39,10 @@ wl_simulator <- function(start_date, end_date, demand, capacity, waiting_list =
 
   # allowing for fluctuations in predicted demand give a arrival list
   realized_demand <- rpois(1, total_demand)
-  referral <- sample(seq(as.Date(start_date), as.Date(end_date), by = "day"), realized_demand, replace = TRUE)
+  referral <-
+    sample(
+           seq(as.Date(start_date), as.Date(end_date), by = "day"),
+           realized_demand, replace = TRUE)
 
   referral <- referral[order(referral)]
   removal <- rep(as.Date(NA), length(referral))
@@ -40,7 +53,11 @@ wl_simulator <- function(start_date, end_date, demand, capacity, waiting_list =
   }
 
   # create an operating schedule
-  schedule <- as.Date(as.numeric(start_date) + ceiling(seq(0, number_of_days - 1, 1 / daily_capacity)), origin = "1970-01-01")
+  schedule <-
+    as.Date(
+            as.numeric(start_date) +
+              ceiling(seq(0, number_of_days - 1, 1 / daily_capacity)),
+            origin = "1970-01-01")
 
   wl_simulated <- wl_schedule(wl_simulated, schedule)
 

R/wl_stats.R

@@ -82,7 +82,8 @@ wl_stats <- function(waiting_list,
   #                                          ]
   # rownames(removals_and_zeros) <- NULL
   # removals_and_zeros$lag_dates <- dplyr::lag(removals_and_zeros$dates)
-  # removals_and_zeros$diff <- as.numeric(removals_and_zeros[,1]) - as.numeric(removals_and_zeros[,3])
+  # removals_and_zeros$diff <-
+  #   as.numeric(removals_and_zeros[,1]) - as.numeric(removals_and_zeros[,3])
   #
   # differences <- removals_and_zeros[which(removals_and_zeros[,2] == TRUE),4]
   # mean_removal <- as.numeric(mean(differences,na.rm=TRUE))
@@ -96,7 +97,8 @@ wl_stats <- function(waiting_list,
   removal_stats <- wl_removal_stats(waiting_list, start_date, end_date)
 
   # load
-  q_load <- queue_load(referral_stats$demand.weekly, removal_stats$capacity.weekly)
+  q_load <-
+    queue_load(referral_stats$demand.weekly, removal_stats$capacity.weekly)
 
   # load too big
   q_load_too_big <- (q_load >= 1.)
@@ -111,27 +113,38 @@ wl_stats <- function(waiting_list,
   q_too_big <- (q_size > 2 * q_target)
 
   # mean wait
-  waiting_patients <- waiting_list[which((waiting_list[, 2] > end_date | is.na(waiting_list[, 2]) & waiting_list[, 1] <= end_date)), ]
+  waiting_patients <-
+    waiting_list[which((waiting_list[, 2] > end_date |
+                          is.na(waiting_list[, 2]) &
+                            waiting_list[, 1] <= end_date)), ]
   wait_times <- as.numeric(end_date) - as.numeric(waiting_patients[, 1])
   mean_wait <- mean(wait_times)
 
   # 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 <- 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
   }
 
   # relief capacity
   if (q_too_big) {
-    relief_cap <- relief_capacity(referral_stats$demand.weekly, q_size, q_target)
+    relief_cap <-
+      relief_capacity(referral_stats$demand.weekly, q_size, q_target)
   } else {
     relief_cap <- NA
   }
 
   # pressure
-  pressure <- waiting_list_pressure(mean_wait, target_wait)
+  # pressure <- waiting_list_pressure(mean_wait, target_wait)
+  # TODO: talk to Neil about using *2 (in this function),
+  # or *4 in the formula below
 
   waiting_stats <- data.frame(
     "mean.demand" = referral_stats$demand.weekly,

tests/testthat/test-target_capacity.R

@@ -9,7 +9,10 @@ test_that("wrong input class causes an error", {
 
 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)))
+  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", {

vignettes/example_walkthrough.Rmd

@@ -186,7 +186,10 @@ Measuring waiting list pressure can give a comparative measure with which to com
 For the P4 ENT example we have been following:
 
 ```{r}
-waiting_list_pressure_p4 <- waiting_list_pressure(avg_waiting_time, waiting_time_target)
+waiting_list_pressure_p4 <-
+  waiting_list_pressure(
+                        avg_waiting_time,
+                        waiting_time_target)
 waiting_list_pressure_p4
 ```
 
@@ -202,7 +205,10 @@ queue_size_p2 <- 220
 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)
+waiting_list_pressure_p2 <-
+  waiting_list_pressure(
+                        avg_waiting_time_p2,
+                        waiting_time_target_p2)
 waiting_list_pressure_p2
 ```