Skip to content

Commit 8c10985

Browse files
amyheatheramyheather
authored
Merge pull request #2 from pythonhealthdatascience/dev
Dev
2 parents 3448333 + e89333c commit 8c10985

25 files changed

+2562
-13
lines changed

‎DESCRIPTION‎

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -20,6 +20,5 @@ RoxygenNote: 7.3.2
2020
Imports:
2121
simmer
2222
Suggests:
23-
testthat (>= 3.0.0),
24-
lintr
23+
devtools
2524
Config/testthat/edition: 3

‎NAMESPACE‎

Lines changed: 29 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,29 @@
1+
# Generated by roxygen2: do not edit by hand
2+
3+
export(add_patient_generator)
4+
export(create_asu_arrivals)
5+
export(create_asu_los)
6+
export(create_asu_routing)
7+
export(create_asu_trajectory)
8+
export(create_parameters)
9+
export(create_rehab_arrivals)
10+
export(create_rehab_los)
11+
export(create_rehab_routing)
12+
export(create_rehab_trajectory)
13+
export(model)
14+
export(sample_routing)
15+
export(transform_to_lnorm)
16+
importFrom(simmer,add_generator)
17+
importFrom(simmer,branch)
18+
importFrom(simmer,get_attribute)
19+
importFrom(simmer,get_mon_arrivals)
20+
importFrom(simmer,get_mon_resources)
21+
importFrom(simmer,log_)
22+
importFrom(simmer,set_attribute)
23+
importFrom(simmer,simmer)
24+
importFrom(simmer,timeout)
25+
importFrom(simmer,trajectory)
26+
importFrom(simmer,wrap)
27+
importFrom(stats,rexp)
28+
importFrom(stats,rlnorm)
29+
importFrom(utils,capture.output)

‎R/add_patient_generator.R‎

Lines changed: 35 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,35 @@
1+
#' Add patient generator to Simmer environment.
2+
#'
3+
#' Creates a patient generator using an exponential inter-arrival distribution.
4+
#' The generator name is automatically constructed as \{unit\}_\{patient_type\}.
5+
#'
6+
#' @param env Simmer environment object. The simulation environment where
7+
#' generators will be added.
8+
#' @param trajectory Simmer trajectory object. Defines patient journey logic
9+
#' through the healthcare system.
10+
#' @param unit Character string specifying the care unit. Must be either "asu"
11+
#' (Acute Stroke Unit) or "rehab" (Rehabilitation Unit). Used to access correct
12+
#' parameter set and name the generator.
13+
#' @param patient_type Character string specifying patient category. Must be
14+
#' one of: "stroke", "tia", "neuro", or "other". Determines which arrival rate
15+
#' parameter is used.
16+
#' @param param Nested list containing simulation parameters. Must have
17+
#' structure \code{param$<unit>_arrivals$<patient_type>} containing numeric
18+
#' arrival intervals (e.g., \code{param$asu_arrivals$stroke = 10}).
19+
#'
20+
#' @importFrom simmer add_generator
21+
#' @importFrom stats rexp
22+
#'
23+
#' @return The modified Simmer environment with the new patient generator added.
24+
#' @export
25+
26+
add_patient_generator <- function(env, trajectory, unit, patient_type, param) {
27+
add_generator(
28+
.env = env,
29+
name_prefix = paste0(unit, "_", patient_type),
30+
trajectory = trajectory,
31+
distribution = function() {
32+
rexp(1L, 1L / param[[paste0(unit, "_arrivals")]][[patient_type]])
33+
}
34+
)
35+
}

‎R/create_asu_trajectory.R‎

Lines changed: 94 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,94 @@
1+
#' Create acute stroke unit (ASU) patient trajectory.
2+
#'
3+
#' Represents patient stay in the ASU - samples their (1) destination after
4+
#' the ASU, and (2) length of stay (LOS) on the ASU.
5+
#'
6+
#' @param env Simmer environment object. The simulation environment where
7+
#' generators will be added.
8+
#' @param patient_type Character string specifying patient category. Must be
9+
#' one of: "stroke", "tia", "neuro", or "other". Determines which arrival rate
10+
#' parameter is used.
11+
#' @param param Nested list containing simulation parameters. Must have
12+
#' structure \code{param$asu_routing$<patient_type>} containing the probability
13+
#' of routing to each destination (e.g.
14+
#' \code{param$asu_routing$stroke$rehab = 0.24}).
15+
#'
16+
#' @importFrom simmer branch get_attribute log_ set_attribute timeout trajectory
17+
#' @importFrom stats rlnorm
18+
#'
19+
#' @return Simmer trajectory object. Defines patient journey logic through the
20+
#' healthcare system.
21+
#' @export
22+
23+
create_asu_trajectory <- function(env, patient_type, param) {
24+
25+
# Set up simmer trajectory object...
26+
trajectory(paste0("ASU_", patient_type, "_path")) |>
27+
28+
log_("🚶 Arrived at ASU") |>
29+
30+
# Sample destination after ASU (as destination influences length of stay)
31+
set_attribute("post_asu_destination", function() {
32+
sample_routing(prob_list = param[["asu_routing"]][[patient_type]])
33+
}) |>
34+
35+
log_(function() {
36+
# Retrieve attribute, and use to get post-ASU destination as a string
37+
dest_index <- get_attribute(env, "post_asu_destination")
38+
dest_names <- names(param[["asu_routing"]][[patient_type]])
39+
dest <- dest_names[dest_index]
40+
# Create log message
41+
paste0("🎯 Planned ASU -> ", dest_index, " (", dest, ")")
42+
}) |>
43+
44+
set_attribute("asu_los", function() {
45+
# Retrieve attribute, and use to get post-ASU destination as a string
46+
dest_index <- get_attribute(env, "post_asu_destination")
47+
dest_names <- names(param[["asu_routing"]][[patient_type]])
48+
dest <- dest_names[dest_index]
49+
50+
# Determine which LOS distribution to use
51+
if (patient_type == "stroke") {
52+
los_params <- switch(
53+
dest,
54+
esd = param[["asu_los_lnorm"]][["stroke_esd"]],
55+
rehab = param[["asu_los_lnorm"]][["stroke_noesd"]],
56+
other = param[["asu_los_lnorm"]][["stroke_mortality"]],
57+
stop("Stroke post-asu destination '", dest, "' invalid",
58+
call. = FALSE)
59+
)
60+
} else {
61+
los_params <- param[["asu_los_lnorm"]][[patient_type]]
62+
}
63+
64+
# Sample LOS from lognormal
65+
rlnorm(
66+
n = 1L,
67+
meanlog = los_params[["meanlog"]],
68+
sdlog = los_params[["sdlog"]]
69+
)
70+
}) |>
71+
72+
log_(function() {
73+
paste0("⏳ ASU length of stay: ",
74+
round(get_attribute(env, "asu_los"), 3L))
75+
}) |>
76+
77+
timeout(function() get_attribute(env, "asu_los")) |>
78+
79+
log_("🏁 ASU stay completed") |>
80+
81+
# If that patient's destination is rehab, then start on that trajectory
82+
branch(
83+
option = function() {
84+
# Retrieve attribute, and use to get post-ASU destination as a string
85+
dest_index <- get_attribute(env, "post_asu_destination")
86+
dest_names <- names(param[["asu_routing"]][[patient_type]])
87+
dest <- dest_names[dest_index]
88+
# Return 1 for rehab and 0 otherwise
89+
if (dest == "rehab") 1L else 0L
90+
},
91+
continue = FALSE, # Do not continue main trajectory after branch
92+
create_rehab_trajectory(env, patient_type, param)
93+
)
94+
}

‎R/create_rehab_trajectory.R‎

Lines changed: 79 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,79 @@
1+
#' Create rehab patient trajectory.
2+
#'
3+
#' Represents patient stay on the rehabilitation unit - samples their (1)
4+
#' destination after rehab, and (2) length of stay (LOS) on the unit.
5+
#'
6+
#' @param env Simmer environment object. The simulation environment where
7+
#' generators will be added.
8+
#' @param patient_type Character string specifying patient category. Must be
9+
#' one of: "stroke", "tia", "neuro", or "other". Determines which arrival rate
10+
#' parameter is used.
11+
#' @param param Nested list containing simulation parameters. Must have
12+
#' structure \code{param$rehab_routing$<patient_type>} containing the
13+
#' probability of routing to each destination (e.g.
14+
#' \code{param$rehab_routing$stroke$esd = 0.40}).
15+
#'
16+
#' @importFrom simmer get_attribute log_ set_attribute timeout trajectory
17+
#' @importFrom stats rlnorm
18+
#'
19+
#' @return Simmer trajectory object. Defines patient journey logic through the
20+
#' healthcare system.
21+
#' @export
22+
23+
create_rehab_trajectory <- function(env, patient_type, param) {
24+
25+
# Set up simmer trajectory object...
26+
trajectory(paste0("rehab_", patient_type, "_path")) |>
27+
28+
log_("🚶 Arrived at rehab") |>
29+
30+
# Sample destination after rehab (as destination influences length of stay)
31+
set_attribute("post_rehab_destination", function() {
32+
sample_routing(prob_list = param[["rehab_routing"]][[patient_type]])
33+
}) |>
34+
35+
log_(function() {
36+
# Retrieve attribute, and use to get post-rehab destination as a string
37+
dest_index <- get_attribute(env, "post_rehab_destination")
38+
dest_names <- names(param[["rehab_routing"]][[patient_type]])
39+
dest <- dest_names[dest_index]
40+
# Create log message
41+
paste0("🎯 Planned rehab -> ", dest_index, " (", dest, ")")
42+
}) |>
43+
44+
set_attribute("rehab_los", function() {
45+
# Retrieve attribute, and use to get post-rehab destination as a string
46+
dest_index <- get_attribute(env, "post_rehab_destination")
47+
dest_names <- names(param[["rehab_routing"]][[patient_type]])
48+
dest <- dest_names[dest_index]
49+
50+
# Determine which LOS distribution to use
51+
if (patient_type == "stroke") {
52+
los_params <- switch(
53+
dest,
54+
esd = param[["rehab_los_lnorm"]][["stroke_esd"]],
55+
other = param[["rehab_los_lnorm"]][["stroke_noesd"]],
56+
stop("Stroke post-rehab destination '", dest, "' invalid",
57+
call. = FALSE)
58+
)
59+
} else {
60+
los_params <- param[["rehab_los_lnorm"]][[patient_type]]
61+
}
62+
63+
# Sample LOS from lognormal
64+
rlnorm(
65+
n = 1L,
66+
meanlog = los_params[["meanlog"]],
67+
sdlog = los_params[["sdlog"]]
68+
)
69+
}) |>
70+
71+
log_(function() {
72+
paste0("⏳ Rehab length of stay: ",
73+
round(get_attribute(env, "rehab_los"), 3L))
74+
}) |>
75+
76+
timeout(function() get_attribute(env, "rehab_los")) |>
77+
78+
log_("🏁 Rehab stay completed")
79+
}

‎R/model.R‎

Lines changed: 86 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,86 @@
1+
#' Run simulation.
2+
#'
3+
#' @param run_number Integer representing index of current simulation run.
4+
#' @param param Named list of model parameters.
5+
#' @param set_seed Whether to set seed within the model function (which we
6+
#' may not wish to do if being set elsewhere - such as done in \code{runner()}).
7+
#' Default is TRUE.
8+
#'
9+
#' @importFrom simmer get_mon_arrivals get_mon_resources simmer wrap
10+
#' @importFrom utils capture.output
11+
#'
12+
#' @return TBC
13+
#' @export
14+
15+
model <- function(run_number, param, set_seed = TRUE) {
16+
17+
# Set random seed based on run number
18+
if (set_seed) {
19+
set.seed(run_number)
20+
}
21+
22+
# Determine whether to get verbose activity logs
23+
verbose <- any(c(param[["log_to_console"]], param[["log_to_file"]]))
24+
25+
# Transform LOS parameters to lognormal scale
26+
param[["asu_los_lnorm"]] <- transform_to_lnorm(param[["asu_los"]])
27+
param[["rehab_los_lnorm"]] <- transform_to_lnorm(param[["rehab_los"]])
28+
29+
# Create simmer environment - set verbose to FALSE as using custom logs
30+
env <- simmer("simulation", verbose = FALSE)
31+
32+
# Add ASU and rehab direct admission patient generators
33+
for (unit in c("asu", "rehab")) {
34+
for (patient_type in names(param[[paste0(unit, "_arrivals")]])) {
35+
36+
# Create patient trajectory
37+
traj <- if (unit == "asu") {
38+
create_asu_trajectory(env, patient_type, param)
39+
} else {
40+
create_rehab_trajectory(env, patient_type, param)
41+
}
42+
43+
# Add patient generator using the created trajectory
44+
sim_log <- capture.output(
45+
env <- add_patient_generator( # nolint
46+
env = env,
47+
trajectory = traj,
48+
unit = unit,
49+
patient_type = patient_type,
50+
param = param
51+
)
52+
)
53+
}
54+
}
55+
56+
# Run the model
57+
sim_log <- capture.output(
58+
env <- env |> # nolint
59+
simmer::run(20L) |>
60+
wrap()
61+
)
62+
63+
# Save and/or display the log
64+
if (isTRUE(verbose)) {
65+
# Create full log message by adding parameters
66+
param_string <- paste(names(param), param, sep = "=", collapse = ";\n ")
67+
full_log <- append(c("Parameters:", param_string, "Log:"), sim_log)
68+
# Print to console
69+
if (isTRUE(param[["log_to_console"]])) {
70+
print(full_log)
71+
}
72+
# Save to file
73+
if (isTRUE(param[["log_to_file"]])) {
74+
writeLines(full_log, param[["file_path"]])
75+
}
76+
}
77+
78+
# Extract the monitored arrivals and resources information from the simmer
79+
# environment object
80+
result <- list(
81+
arrivals = get_mon_arrivals(env, per_resource = TRUE, ongoing = TRUE),
82+
resources = get_mon_resources(env)
83+
)
84+
85+
return(result)
86+
}

0 commit comments

Comments
 (0)