feat/refactor/fix(distributionregistry): amend model + add_generator + add_trajectory (#11)

Author: amyheather

R/add_patient_generator.R

@@ -29,7 +29,7 @@ add_patient_generator <- function(env, trajectory, unit, patient_type, param) {
     name_prefix = paste0(unit, "_", patient_type),
     trajectory = trajectory,
     distribution = function() {
-      rexp(1L, 1L / param[[paste0(unit, "_arrivals")]][[patient_type]])
+      param[["dist"]][["arrivals"]][[unit]][[patient_type]]()
     }
   )
 }

R/create_asu_trajectory.R

@@ -32,44 +32,30 @@ create_asu_trajectory <- function(env, patient_type, param) {
 
     # Sample destination after ASU (as destination influences length of stay)
     set_attribute("post_asu_destination", function() {
-      sample_routing(prob_list = param[["asu_routing"]][[patient_type]])
+      param[["dist"]][["routing"]][["asu"]][[patient_type]]()
     }) |>
 
     log_(function() {
-      # Retrieve attribute, and use to get post-ASU destination as a string
-      dest_index <- get_attribute(env, "post_asu_destination")
-      dest_names <- names(param[["asu_routing"]][[patient_type]])
-      dest <- dest_names[dest_index]
-      # Create log message
-      paste0("\U0001F3AF Planned ASU -> ", dest_index, " (", dest, ")")
+      dest <- get_attribute(env, "post_asu_destination")
+      paste0("\U0001F3AF Planned ASU -> ", dest)
     }, level = 1L) |>
 
+    # Sample ASU LOS. For stroke patients, LOS distribution is based on
+    # the planned destination after the ASU.
     set_attribute("asu_los", function() {
-      # Retrieve attribute, and use to get post-ASU destination as a string
-      dest_index <- get_attribute(env, "post_asu_destination")
-      dest_names <- names(param[["asu_routing"]][[patient_type]])
-      dest <- dest_names[dest_index]
-
-      # Determine which LOS distribution to use
+      dest <- get_attribute(env, "post_asu_destination")
       if (patient_type == "stroke") {
-        los_params <- switch(
+        switch(
           dest,
-          esd = param[["asu_los_lnorm"]][["stroke_esd"]],
-          rehab = param[["asu_los_lnorm"]][["stroke_no_esd"]],
-          other = param[["asu_los_lnorm"]][["stroke_mortality"]],
+          esd = param[["dest"]][["los"]][["asu"]][["stroke_esd"]],
+          rehab = param[["dest"]][["los"]][["asu"]][["stroke_no_esd"]],
+          other = param[["dest"]][["los"]][["asu"]][["stroke_mortality"]],
           stop("Stroke post-asu destination '", dest, "' invalid",
                call. = FALSE)
         )
       } else {
-        los_params <- param[["asu_los_lnorm"]][[patient_type]]
+        param[["dest"]][["los"]][["asu"]][[patient_type]]()
       }
-
-      # Sample LOS from lognormal
-      rlnorm(
-        n = 1L,
-        meanlog = los_params[["meanlog"]],
-        sdlog = los_params[["sdlog"]]
-      )
     }) |>
 
     log_(function() {
@@ -86,12 +72,7 @@ create_asu_trajectory <- function(env, patient_type, param) {
     # If that patient's destination is rehab, then start on that trajectory
     branch(
       option = function() {
-        # Retrieve attribute, and use to get post-ASU destination as a string
-        dest_index <- get_attribute(env, "post_asu_destination")
-        dest_names <- names(param[["asu_routing"]][[patient_type]])
-        dest <- dest_names[dest_index]
-        # Return 1 for rehab and 0 otherwise
-        if (dest == "rehab") 1L else 0L
+        if (get_attribute(env, "post_asu_destination") == "rehab") 1L else 0L
       },
       continue = FALSE,  # Do not continue main trajectory after branch
       create_rehab_trajectory(env, patient_type, param)

R/create_rehab_trajectory.R

@@ -32,43 +32,29 @@ create_rehab_trajectory <- function(env, patient_type, param) {
 
     # Sample destination after rehab (as destination influences length of stay)
     set_attribute("post_rehab_destination", function() {
-      sample_routing(prob_list = param[["rehab_routing"]][[patient_type]])
+      param[["dist"]][["routing"]][["rehab"]][[patient_type]]()
     }) |>
 
     log_(function() {
-      # Retrieve attribute, and use to get post-rehab destination as a string
-      dest_index <- get_attribute(env, "post_rehab_destination")
-      dest_names <- names(param[["rehab_routing"]][[patient_type]])
-      dest <- dest_names[dest_index]
-      # Create log message
+      dest <- get_attribute(env, "post_rehab_destination")
       paste0("\U0001F3AF Planned rehab -> ", dest_index, " (", dest, ")")
     }, level = 1L) |>
 
+    # Sample rehab LOS. For stroke patients, LOS distribution is based on
+    # the planned destination after the rehab
     set_attribute("rehab_los", function() {
-      # Retrieve attribute, and use to get post-rehab destination as a string
-      dest_index <- get_attribute(env, "post_rehab_destination")
-      dest_names <- names(param[["rehab_routing"]][[patient_type]])
-      dest <- dest_names[dest_index]
-
-      # Determine which LOS distribution to use
+      dest <- get_attribute(env, "post_rehab_destination")
       if (patient_type == "stroke") {
-        los_params <- switch(
+        switch(
           dest,
-          esd = param[["rehab_los_lnorm"]][["stroke_esd"]],
-          other = param[["rehab_los_lnorm"]][["stroke_no_esd"]],
+          esd = param[["los"]][["rehab"]][["stroke_esd"]](),
+          other = param[["los"]][["rehab"]][["stroke_no_esd"]](),
           stop("Stroke post-rehab destination '", dest, "' invalid",
                call. = FALSE)
         )
       } else {
-        los_params <- param[["rehab_los_lnorm"]][[patient_type]]
+        param[["los"]][["rehab"]][[patient_type]]()
       }
-
-      # Sample LOS from lognormal
-      rlnorm(
-        n = 1L,
-        meanlog = los_params[["meanlog"]],
-        sdlog = los_params[["sdlog"]]
-      )
     }) |>
 
     log_(function() {

R/model.R

@@ -32,9 +32,20 @@ model <- function(run_number, param, set_seed = TRUE) {
   param[["verbose"]] <- any(c(param[["log_to_console"]],
                               param[["log_to_file"]]))
 
-  # Transform LOS parameters to lognormal scale
-  param[["asu_los_lnorm"]] <- transform_to_lnorm(param[["asu_los"]])
-  param[["rehab_los_lnorm"]] <- transform_to_lnorm(param[["rehab_los"]])
+  # Set up sampling distributions
+  registry <- simulation::DistributionRegistry$new()
+  param[["dist"]] <- registry$create_batch(as.list(param[["dist_config"]]))
+
+  # Restructure as dist[type][unit][patient]
+  dist <- list()
+  for (key in names(param[["dist"]])) {
+    parts <- strsplit(key, "_")[[1]]
+    dist_type <- parts[2]
+    unit <- parts[1]
+    patient <- paste(parts[-(1:2)], collapse = "_")
+    dist[[dist_type]][[unit]][[patient]] <- param[["dist"]][[key]]
+  }
+  param[["dist"]] <- dist
 
   # Create simmer environment - set verbose to FALSE as using custom logs
   # (but can change to TRUE if want to see default simmer logs as well)