run styler::style_pkg()

R/queue_load.R

@@ -18,7 +18,7 @@
 #' @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(30, 27)
 queue_load <- function(demand, capacity) {
   check_class(demand, capacity)
   load <- demand / capacity

R/relief_capacity.R

@@ -27,9 +27,8 @@
 #'
 #' 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
+  rel_cap <- demand + (queue_size - target_queue_size) / time_to_target
   return(rel_cap)
 }

R/target_capacity.R

@@ -21,15 +21,14 @@
 #'
 #' @examples
 #'
-#' demand = 4 # weeks
-#' target_wait = 52 # weeks
+#' demand <- 4 # weeks
+#' target_wait <- 52 # weeks
 #'
 #' target_capacity(demand, target_wait) # number of operations per week to have mean wait of 52/4
 #'
-#' #TODO: Include a couple of standard deviations for errors in the mean demand
-
+#' # 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) {
-    check_class(demand, target_wait, factor, cv_demand, cv_capacity)
-    target_cap <- demand + ( (cv_demand**2 + cv_capacity**2) / 2 ) * ( factor / target_wait )
-    return (target_cap)
-  }
+  check_class(demand, target_wait, factor, cv_demand, cv_capacity)
+  target_cap <- demand + ((cv_demand**2 + cv_capacity**2) / 2) * (factor / target_wait)
+  return(target_cap)
+}

R/target_queue_size.R

@@ -23,8 +23,7 @@
 #' # 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(30, 52, 4)
 #'
 target_queue_size <- function(demand, target_wait, factor = 4) {
   check_class(demand, target_wait, factor)

R/utils.R

@@ -6,20 +6,17 @@
 #'     called.
 #' @noRd
 check_class <- function(
-  ...,
-  .expected_class = c("numeric", "character"),
-  .call = rlang::caller_env()
-) {
-
+    ...,
+    .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,
+      switch(.expected_class,
         numeric   = is.numeric(arg),
         character = is.character(arg),
       )
@@ -29,7 +26,6 @@ check_class <- function(
   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)
 
@@ -50,5 +46,4 @@ check_class <- function(
       call = .call
     )
   }
-
 }

R/wl_insert.R

@@ -10,23 +10,22 @@
 #' @export
 #'
 #' @examples
-#' referrals <- c.Date("2024-01-01","2024-01-04","2024-01-10","2024-01-16")
-#' removals <- c.Date("2024-01-08",NA,NA,NA)
-#' waiting_list <- data.frame("referral" = referrals ,"removal" = removals )
-#' additions <- c.Date("2024-01-03","2024-01-05","2024-01-18")
+#' referrals <- c.Date("2024-01-01", "2024-01-04", "2024-01-10", "2024-01-16")
+#' removals <- c.Date("2024-01-08", NA, NA, NA)
+#' waiting_list <- data.frame("referral" = referrals, "removal" = removals)
+#' additions <- c.Date("2024-01-03", "2024-01-05", "2024-01-18")
 #' longer_waiting_list <- wl_insert(waiting_list, additions)
 #'
 #' # TODO: What if more columns
 #' # Check column types
-
 wl_insert <- function(waiting_list, additions, referral_index = 1) {
-
-new_rows = data.frame("referral" = additions,
-                      "removal" =  rep(as.Date(NA), length(additions))
-                      )
+  new_rows <- data.frame(
+    "referral" = additions,
+    "removal" = rep(as.Date(NA), length(additions))
+  )
 
   # recombine to update list
-  updated_list <- rbind(waiting_list,new_rows)
-  updated_list <- updated_list[order(updated_list[,referral_index]),]
-  return (updated_list)
-}
+  updated_list <- rbind(waiting_list, new_rows)
+  updated_list <- updated_list[order(updated_list[, referral_index]), ]
+  return(updated_list)
+}

R/wl_join.R

@@ -20,10 +20,9 @@
 #' # removals <- c.Date("2024-01-09",NA,"2024-01-19",NA)
 #' # wl_2 <- data.frame("referral" = referrals ,"removal" = removals )
 #' # wl_join(wl_1,wl_2)
-
 wl_join <- function(wl_1, wl_2, referral_index = 1) {
   # combine and sort to update list
-  updated_list <- rbind(wl_1,wl_2)
-  updated_list <- updated_list[order(updated_list[,referral_index]),]
-  return (updated_list)
-}
+  updated_list <- rbind(wl_1, wl_2)
+  updated_list <- updated_list[order(updated_list[, referral_index]), ]
+  return(updated_list)
+}

R/wl_queue_sizes.R

@@ -11,38 +11,35 @@
 #' @export
 #'
 #' @examples
-#' referrals <- c.Date("2024-01-01","2024-01-04","2024-01-10","2024-01-16")
-#' removals <- c.Date("2024-01-08",NA,NA,NA)
-#' waiting_list <- data.frame("referral" = referrals ,"removal" = removals )
+#' referrals <- c.Date("2024-01-01", "2024-01-04", "2024-01-10", "2024-01-16")
+#' removals <- c.Date("2024-01-08", NA, NA, NA)
+#' waiting_list <- data.frame("referral" = referrals, "removal" = removals)
 #' wl_queue_size(waiting_list)
-
-
 wl_queue_size <- function(waiting_list, start_date = NULL, end_date = NULL) {
   wl <- waiting_list
 
-  if ( is.null(start_date) ) {
-    start_date = min(wl[,1])
+  if (is.null(start_date)) {
+    start_date <- min(wl[, 1])
   }
-  if ( is.null(end_date) ) {
-    end_date = max(wl[,1])
+  if (is.null(end_date)) {
+    end_date <- max(wl[, 1])
   }
 
-  wl[wl$referral<start_date,1] <-start_date
-  arrival_counts <- data.frame(table(wl[,1]))
+  wl[wl$referral < start_date, 1] <- start_date
+  arrival_counts <- data.frame(table(wl[, 1]))
 
-  dates <- seq(as.Date(start_date), as.Date(end_date), by="day")
-  queues <- data.frame(dates,rep(0,length(dates)))
+  dates <- seq(as.Date(start_date), as.Date(end_date), by = "day")
+  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[which(queues[, 1] %in% arrival_counts[, 1]), 2] <- arrival_counts[, 2]
+  queues$cummulative_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])
+  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$queue_size <- queues$cummulative_arrivals - queues$cummulative_departures
 
-  return (queues[,c(1,6)])
-
-}
+  return(queues[, c(1, 6)])
+}

R/wl_referral_stats.R

@@ -12,53 +12,51 @@
 #' @examples
 #' referrals <- c.Date("2024-01-01", "2024-01-04", "2024-01-10", "2024-01-16")
 #' removals <- c.Date("2024-01-08", NA, NA, NA)
-#' waiting_list <- data.frame("referral" = referrals , "removal" = removals)
+#' waiting_list <- data.frame("referral" = referrals, "removal" = removals)
 #' referral_stats <- wl_referral_stats(waiting_list)
-
 # TODO : referral <- arrival
 # debug and test
 # simplify notation
 # add detail to params above
 # arrival mean and variance
-
 wl_referral_stats <- function(waiting_list,
-                            start_date = NULL,
-                            end_date = NULL){
-
-  if ( !is.null(start_date) ) {
+                              start_date = NULL,
+                              end_date = NULL) {
+  if (!is.null(start_date)) {
     start_date <- as.Date(start_date)
   } else {
-    start_date <- min(waiting_list[,1])
+    start_date <- min(waiting_list[, 1])
   }
-  if ( !is.null(end_date) ) {
+  if (!is.null(end_date)) {
     end_date <- as.Date(end_date)
   } else {
-    end_date <- max(waiting_list[,1])
+    end_date <- max(waiting_list[, 1])
   }
 
-  arrival_dates <- c(as.Date(start_date),
-                     waiting_list[
-                       which( start_date <= waiting_list[,1]
-                              & waiting_list[,1] <= end_date
-                       ),1
-                     ],
-                     as.Date(end_date))
+  arrival_dates <- c(
+    as.Date(start_date),
+    waiting_list[
+      which(start_date <= waiting_list[, 1] &
+        waiting_list[, 1] <= end_date), 1
+    ],
+    as.Date(end_date)
+  )
 
-  inter_arrival_times <- diff(arrival_dates,lags=-1)
+  inter_arrival_times <- diff(arrival_dates, lags = -1)
   mean_arrival <- as.numeric(mean(inter_arrival_times))
   sd_arrival <- sd(inter_arrival_times)
-  cv_arrival <- sd_arrival/mean_arrival
+  cv_arrival <- sd_arrival / mean_arrival
   num_arrivals <- length(inter_arrival_times)
-  demand <- 1/mean_arrival
-  demand_weekly <- 7*demand
+  demand <- 1 / mean_arrival
+  demand_weekly <- 7 * demand
 
 
   referral_stats <- data.frame(
-                                "demand.weekly" = demand_weekly,
-                                "demand.daily" = demand,
-                                "demand.cov" = cv_arrival,
-                                "demand.count" = num_arrivals
-                              )
+    "demand.weekly" = demand_weekly,
+    "demand.daily" = demand,
+    "demand.cov" = cv_arrival,
+    "demand.count" = num_arrivals
+  )
 
-  return (referral_stats)
+  return(referral_stats)
 }

R/wl_removal_stats.R

@@ -12,63 +12,64 @@
 #' @examples
 #' referrals <- c.Date("2024-01-01", "2024-01-04", "2024-01-10", "2024-01-16")
 #' removals <- c.Date("2024-01-08", NA, NA, NA)
-#' waiting_list <- data.frame("referral" = referrals , "removal" = removals)
+#' waiting_list <- data.frame("referral" = referrals, "removal" = removals)
 #' removal_stats <- wl_removal_stats(waiting_list)
-
 # TODO : referral <- arrival
 # debug and test
 # simplify notation
 # add detail to params above
 # arrival mean and variance
-
 wl_removal_stats <- function(waiting_list,
-                              start_date = NULL,
-                              end_date = NULL){
-  if ( !is.null(start_date) ) {
+                             start_date = NULL,
+                             end_date = NULL) {
+  if (!is.null(start_date)) {
     start_date <- as.Date(start_date)
   } else {
-    start_date <- min(waiting_list[,1])
+    start_date <- min(waiting_list[, 1])
   }
-  if ( !is.null(end_date) ) {
+  if (!is.null(end_date)) {
     end_date <- as.Date(end_date)
   } else {
-    end_date <- max(waiting_list[,1])
+    end_date <- max(waiting_list[, 1])
   }
 
-  removal_dates <- c(as.Date(start_date),waiting_list[,2],as.Date(end_date))
+  removal_dates <- c(as.Date(start_date), waiting_list[, 2], as.Date(end_date))
   removal_dates <- sort(removal_dates[!is.na(removal_dates)])
 
   queue_sizes <- wl_queue_size(waiting_list)
-  zero_dates <- queue_sizes[which(queue_sizes[,2]==0),1]
+  zero_dates <- queue_sizes[which(queue_sizes[, 2] == 0), 1]
 
-  zeros_df <- data.frame("dates"=zero_dates,
-                         "non_zero_queue"=rep(FALSE,length(zero_dates))
-                         )
-  removals_df <- data.frame("dates"=removal_dates,
-                            "non_zero_queue"=rep(TRUE,length(removal_dates))
-                            )
-  removals_and_zeros <- rbind(zeros_df,removals_df)
-  removals_and_zeros <- removals_and_zeros[order(removals_and_zeros[,1],
-                                                 removals_and_zeros[,2]),
-                                           ]
+  zeros_df <- data.frame(
+    "dates" = zero_dates,
+    "non_zero_queue" = rep(FALSE, length(zero_dates))
+  )
+  removals_df <- data.frame(
+    "dates" = removal_dates,
+    "non_zero_queue" = rep(TRUE, length(removal_dates))
+  )
+  removals_and_zeros <- rbind(zeros_df, removals_df)
+  removals_and_zeros <- removals_and_zeros[order(
+    removals_and_zeros[, 1],
+    removals_and_zeros[, 2]
+  ), ]
   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))
-  sd_removal <- sd(differences,na.rm=TRUE)
-  cv_removal <- sd_removal/mean_removal
+  differences <- removals_and_zeros[which(removals_and_zeros[, 2] == TRUE), 4]
+  mean_removal <- as.numeric(mean(differences, na.rm = TRUE))
+  sd_removal <- sd(differences, na.rm = TRUE)
+  cv_removal <- sd_removal / mean_removal
   num_removals <- length(differences)
-  capacity <- 1/mean_removal
-  capacity_weekly <- 7/mean_removal
+  capacity <- 1 / mean_removal
+  capacity_weekly <- 7 / mean_removal
 
-removal_stats <- data.frame(
-  "capacity.weekly" = capacity_weekly,
-  "capcity.daily" = capacity,
-  "capacity.cov" = cv_removal,
-  "removal.count" = num_removals
-)
+  removal_stats <- data.frame(
+    "capacity.weekly" = capacity_weekly,
+    "capcity.daily" = capacity,
+    "capacity.cov" = cv_removal,
+    "removal.count" = num_removals
+  )
 
-  return (removal_stats)
+  return(removal_stats)
 }