|
1 | | -#' Get results from each replication. |
| 1 | +#' Process the raw monitored arrivals and resources. |
2 | 2 | #' |
3 | | -#' For each replication (there can be one or many), calculate the: (1) number |
4 | | -#' of arrivals, (2) mean wait time for each resource, (3) mean activity time |
5 | | -#' for each resource, and (4) mean resource utilisation. |
| 3 | +#' For the provided replication, calculate the: |
| 4 | +#' (1) number of arrivals |
| 5 | +#' (2) mean wait time for each resource |
| 6 | +#' (3) mean activity time for each resource |
| 7 | +#' (4) mean resource utilisation. |
6 | 8 | #' |
7 | 9 | #' Credit: The utilisation calculation is taken from the |
8 | 10 | #' `plot.resources.utilization()` function in simmer.plot 0.1.18, which is |
|
18 | 20 | #' @param results Named list with `arrivals` containing output from |
19 | 21 | #' `get_mon_arrivals()` and `resources` containing output from |
20 | 22 | #' `get_mon_resources()` (`per_resource = TRUE` and `ongoing = TRUE`). |
| 23 | +#' @param run_number Integer representing index of current simulation run. |
21 | 24 | #' |
22 | 25 | #' @importFrom dplyr group_by summarise n_distinct mutate lead full_join |
| 26 | +#' @importFrom dplyr bind_cols |
23 | 27 | #' @importFrom purrr reduce |
24 | 28 | #' @importFrom rlang .data |
25 | 29 | #' @importFrom simmer get_mon_resources get_mon_arrivals now |
26 | 30 | #' @importFrom tidyr pivot_wider drop_na |
27 | 31 | #' @importFrom tidyselect any_of |
| 32 | +#' @importFrom tibble tibble |
28 | 33 | #' |
29 | | -#' @return Tibble with results from each replication. |
| 34 | +#' @return Tibble with processed results from replication. |
30 | 35 | #' @export |
31 | 36 |
|
32 | | -get_run_results <- function(results) { |
| 37 | +get_run_results <- function(results, run_number) { |
33 | 38 |
|
34 | 39 | # Remove patients who were still waiting and had not completed |
35 | 40 | results[["arrivals"]] <- results[["arrivals"]] %>% |
36 | 41 | drop_na(any_of("end_time")) |
37 | 42 |
|
38 | | - # Calculate the number of arrivals |
39 | | - calc_arr <- results[["arrivals"]] %>% |
40 | | - group_by(.data[["replication"]]) %>% |
41 | | - summarise(arrivals = n_distinct(.data[["name"]])) |
| 43 | + # If there are any arrivals... |
| 44 | + if (nrow(results[["arrivals"]]) > 0L) { |
42 | 45 |
|
43 | | - # Calculate the mean wait time for each resource |
44 | | - calc_wait <- results[["arrivals"]] %>% |
45 | | - mutate( |
46 | | - waiting_time = round( |
47 | | - .data[["end_time"]] - ( |
48 | | - .data[["start_time"]] + .data[["activity_time"]] |
49 | | - ), 10L |
50 | | - ) |
51 | | - ) %>% |
52 | | - group_by(.data[["resource"]], .data[["replication"]]) %>% |
53 | | - summarise(mean_waiting_time = mean(.data[["waiting_time"]])) %>% |
54 | | - pivot_wider(names_from = "resource", |
55 | | - values_from = "mean_waiting_time", |
56 | | - names_glue = "mean_waiting_time_{resource}") |
| 46 | + # Calculate the number of arrivals |
| 47 | + calc_arr <- results[["arrivals"]] %>% |
| 48 | + summarise(arrivals = n_distinct(.data[["name"]])) |
57 | 49 |
|
58 | | - # Calculate the mean time spent with each resource |
59 | | - calc_act <- results[["arrivals"]] %>% |
60 | | - group_by(.data[["resource"]], .data[["replication"]]) %>% |
61 | | - summarise(mean_activity_time = mean(.data[["activity_time"]])) %>% |
62 | | - pivot_wider(names_from = "resource", |
63 | | - values_from = "mean_activity_time", |
64 | | - names_glue = "mean_activity_time_{resource}") |
| 50 | + # Calculate the mean wait time for each resource |
| 51 | + calc_wait <- results[["arrivals"]] %>% |
| 52 | + mutate( |
| 53 | + waiting_time = round( |
| 54 | + .data[["end_time"]] - ( |
| 55 | + .data[["start_time"]] + .data[["activity_time"]] |
| 56 | + ), 10L |
| 57 | + ) |
| 58 | + ) %>% |
| 59 | + group_by(.data[["resource"]]) %>% |
| 60 | + summarise(mean_waiting_time = mean(.data[["waiting_time"]])) %>% |
| 61 | + pivot_wider(names_from = "resource", |
| 62 | + values_from = "mean_waiting_time", |
| 63 | + names_glue = "mean_waiting_time_{resource}") |
65 | 64 |
|
66 | | - # Calculate the mean resource utilisation |
67 | | - # Utilisation is given by the total effective usage time (`in_use`) over the |
68 | | - # total time intervals considered (`dt`). |
69 | | - calc_util <- results[["resources"]] %>% |
70 | | - group_by(.data[["resource"]], .data[["replication"]]) %>% |
71 | | - mutate(dt = lead(.data[["time"]]) - .data[["time"]]) %>% |
72 | | - mutate(capacity = pmax(.data[["capacity"]], .data[["server"]])) %>% |
73 | | - mutate(dt = ifelse(.data[["capacity"]] > 0L, .data[["dt"]], 0L)) %>% |
74 | | - mutate(in_use = .data[["dt"]] * .data[["server"]] / .data[["capacity"]]) %>% |
75 | | - summarise( |
76 | | - utilisation = sum(.data[["in_use"]], na.rm = TRUE) / |
77 | | - sum(.data[["dt"]], na.rm = TRUE) |
78 | | - ) %>% |
79 | | - pivot_wider(names_from = "resource", |
80 | | - values_from = "utilisation", |
81 | | - names_glue = "utilisation_{resource}") |
| 65 | + # Calculate the mean time spent with each resource |
| 66 | + calc_act <- results[["arrivals"]] %>% |
| 67 | + group_by(.data[["resource"]]) %>% |
| 68 | + summarise(mean_activity_time = mean(.data[["activity_time"]])) %>% |
| 69 | + pivot_wider(names_from = "resource", |
| 70 | + values_from = "mean_activity_time", |
| 71 | + names_glue = "mean_activity_time_{resource}") |
82 | 72 |
|
83 | | - # Combine all calculated metrics into a single dataframe |
84 | | - processed_result <- list(calc_arr, calc_wait, calc_act, calc_util) %>% |
85 | | - reduce(full_join, by = "replication") |
| 73 | + # Calculate the mean resource utilisation |
| 74 | + # Utilisation is given by the total effective usage time (`in_use`) over the |
| 75 | + # total time intervals considered (`dt`). |
| 76 | + calc_util <- results[["resources"]] %>% |
| 77 | + group_by(.data[["resource"]]) %>% |
| 78 | + # nolint start |
| 79 | + mutate(dt = lead(.data[["time"]]) - .data[["time"]]) %>% |
| 80 | + mutate(capacity = pmax(.data[["capacity"]], .data[["server"]])) %>% |
| 81 | + mutate(dt = ifelse(.data[["capacity"]] > 0L, .data[["dt"]], 0L)) %>% |
| 82 | + mutate(in_use = (.data[["dt"]] * .data[["server"]] / |
| 83 | + .data[["capacity"]])) %>% |
| 84 | + # nolint end |
| 85 | + summarise( |
| 86 | + utilisation = sum(.data[["in_use"]], na.rm = TRUE) / |
| 87 | + sum(.data[["dt"]], na.rm = TRUE) |
| 88 | + ) %>% |
| 89 | + pivot_wider(names_from = "resource", |
| 90 | + values_from = "utilisation", |
| 91 | + names_glue = "utilisation_{resource}") |
86 | 92 |
|
87 | | - return(processed_result) |
| 93 | + # Combine all calculated metrics into a single dataframe, and along with |
| 94 | + # the replication number |
| 95 | + processed_result <- dplyr::bind_cols( |
| 96 | + tibble(replication = run_number), |
| 97 | + calc_arr, calc_wait, calc_act, calc_util |
| 98 | + ) |
| 99 | + } else { |
| 100 | + # If there were no arrivals, return dataframe row with just the replication |
| 101 | + # number and arrivals column set to 0 |
| 102 | + processed_result <- tibble(replication = run_number, |
| 103 | + arrivals = nrow(results[["arrivals"]])) |
| 104 | + } |
| 105 | + |
| 106 | + return(processed_result) # nolint |
88 | 107 | } |
0 commit comments