feat(model): set up rehab sampling destination + LOS (like ASU) + linting

Author: amyheather

R/create_asu_trajectory.R

@@ -25,8 +25,7 @@ create_asu_trajectory <- function(env, patient_type, param) {
   # Set up simmer trajectory object...
   trajectory(paste0("ASU_", patient_type, "_path")) |>
 
-    # Sample destination after ASU (we do this immediately on arrival in the
-    # ASU, as the destination influences the length of stay)
+    # 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]])
     }) |>
@@ -42,9 +41,11 @@ create_asu_trajectory <- function(env, patient_type, param) {
       if (patient_type == "stroke") {
         los_params <- switch(
           dest,
-          "esd" = param[["asu_los_lnorm"]][["stroke_esd"]],
-          "rehab" = param[["asu_los_lnorm"]][["stroke_noesd"]],
-          param[["asu_los_lnorm"]][["stroke_mortality"]]  # Default case
+          esd = param[["asu_los_lnorm"]][["stroke_esd"]],
+          rehab = param[["asu_los_lnorm"]][["stroke_noesd"]],
+          other = param[["asu_los_lnorm"]][["stroke_mortality"]],
+          stop("Stroke post-asu destination '", dest, "' invalid",
+               call. = FALSE)
         )
       } else {
         los_params <- param[["asu_los_lnorm"]][[patient_type]]

R/create_rehab_trajectory.R

@@ -1,5 +1,10 @@
 #' Create rehab patient trajectory.
 #'
+#'  Represents patient stay on the rehabilitation unit - samples their (1)
+#'  destination after rehab, and (2) length of stay (LOS) on the unit.
+#'
+#' @param env Simmer environment object. The simulation environment where
+#' generators will be added.
 #' @param patient_type Character string specifying patient category. Must be
 #' one of: "stroke", "tia", "neuro", or "other". Determines which arrival rate
 #' parameter is used.
@@ -9,12 +14,47 @@
 #' \code{param$rehab_routing$stroke$esd = 0.40}).
 #'
 #' @importFrom simmer trajectory
+#' @importFrom stats rlnorm
 #'
 #' @return Simmer trajectory object. Defines patient journey logic through the
 #' healthcare system.
 #' @export
 
-create_rehab_trajectory <- function(patient_type, param) {
+create_rehab_trajectory <- function(env, patient_type, param) {
+
+  # Set up simmer trajectory object...
   trajectory(paste0("rehab_", patient_type, "_path")) |>
-    timeout(1L)
+
+    # 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]])
+    }) |>
+
+    timeout(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
+      if (patient_type == "stroke") {
+        los_params <- switch(
+          dest,
+          esd = param[["rehab_los_lnorm"]][["stroke_esd"]],
+          other = param[["rehab_los_lnorm"]][["stroke_noesd"]],
+          stop("Stroke post-rehab destination '", dest, "' invalid",
+               call. = FALSE)
+        )
+      } else {
+        los_params <- param[["rehab_los_lnorm"]][[patient_type]]
+      }
+
+      # Sample LOS from lognormal
+      rlnorm(
+        n = 1L,
+        meanlog = los_params[["meanlog"]],
+        sdlog = los_params[["sdlog"]]
+      )
+    })
 }

R/model.R

@@ -32,11 +32,9 @@ model <- function(run_number, param, set_seed = TRUE) {
 
       # Create patient trajectory
       traj <- if (unit == "asu") {
-        create_asu_trajectory(
-          env = env, patient_type = patient_type, param = param
-        )
+        create_asu_trajectory(env, patient_type, param)
       } else {
-        create_rehab_trajectory(patient_type, param)
+        create_rehab_trajectory(env, patient_type, param)
       }
 
       # Add patient generator using the created trajectory

R/transform_to_lnorm.R

@@ -16,10 +16,10 @@
 
 transform_to_lnorm <- function(los_list) {
   lapply(los_list, function(x) {
-    variance <- x$sd^2
-    sigma_sq <- log(variance / (x$mean^2) + 1)
+    variance <- x$sd^2L
+    sigma_sq <- log(variance / (x$mean^2L) + 1L)
     sdlog <- sqrt(sigma_sq)
-    meanlog <- log(x$mean) - sigma_sq / 2
+    meanlog <- log(x$mean) - sigma_sq / 2L
     list(meanlog = meanlog, sdlog = sdlog)
   })
 }