diff --git a/R/app_config.R b/R/app_config.R
index 948a99a..c0d9820 100644
--- a/R/app_config.R
+++ b/R/app_config.R
@@ -23,18 +23,17 @@ app_sys <- function(...) {
#'
#' @noRd
get_golem_config <- function(
- value,
- config = Sys.getenv(
- "GOLEM_CONFIG_ACTIVE",
- Sys.getenv(
- "R_CONFIG_ACTIVE",
- "default"
- )
- ),
- use_parent = TRUE,
- # Modify this if your config file is somewhere else
- file = app_sys("golem-config.yml")
-) {
+ value,
+ config = Sys.getenv(
+ "GOLEM_CONFIG_ACTIVE",
+ Sys.getenv(
+ "R_CONFIG_ACTIVE",
+ "default"
+ )
+ ),
+ use_parent = TRUE,
+ # Modify this if your config file is somewhere else
+ file = app_sys("golem-config.yml")) {
config::get(
value = value,
config = config,
diff --git a/R/mod_assumptions.R b/R/mod_assumptions.R
index 2d117d0..576678e 100644
--- a/R/mod_assumptions.R
+++ b/R/mod_assumptions.R
@@ -4,10 +4,10 @@
#'
#' @param id,input,output,session Internal parameters for {shiny}.
#'
-#' @noRd
+#' @noRd
#'
-#' @importFrom shiny NS tagList
-mod_assumptions_ui <- function(id){
+#' @importFrom shiny NS tagList
+mod_assumptions_ui <- function(id) {
ns <- NS(id)
tagList(
HTML("
The code for this project is open-source, and is on GitHub.
"),
@@ -16,7 +16,7 @@ mod_assumptions_ui <- function(id){
width = 12,
p("This model is in development. It is not yet ready to be used for planning. Some of the issues to be resolved are detailed below."),
HTML(
- "
+ "
- Is the main queue appearing in the right place? Is the typical real waiting list post referral and pre OP appointment, or is it post OP appt and pre-admission.
- How to model the queue between OP appt and hospital admission?
- Appointment non-attendance is not yet modelled. Attendance is assumed to be 100%.
@@ -29,19 +29,18 @@ mod_assumptions_ui <- function(id){
),
)
}
-
+
#' assumptions Server Functions
#'
-#' @noRd
-mod_assumptions_server <- function(id){
- moduleServer( id, function(input, output, session){
+#' @noRd
+mod_assumptions_server <- function(id) {
+ moduleServer(id, function(input, output, session) {
ns <- session$ns
-
})
}
-
+
## To be copied in the UI
# mod_assumptions_ui("assumptions_1")
-
+
## To be copied in the server
# mod_assumptions_server("assumptions_1")
diff --git a/R/mod_simulation.R b/R/mod_simulation.R
index 02855de..51284f0 100644
--- a/R/mod_simulation.R
+++ b/R/mod_simulation.R
@@ -7,7 +7,7 @@
#' @noRd
#'
#' @importFrom shiny NS tagList
-mod_simulation_ui <- function(id){
+mod_simulation_ui <- function(id) {
ns <- NS(id)
tagList(
shinyjs::useShinyjs(),
@@ -47,7 +47,7 @@ mod_simulation_ui <- function(id){
sliderInput(NS(id, "numPatBacklogSize"), "Number of existing patients in the OP clinic backlog", value = 500, min = 0, max = 5000),
sliderInput(NS(id, "numPatReferralRate"), "Number of new patient referrals (monthly)", value = 100, min = 0, max = 1000),
sliderInput(NS(id, "numOPOutcomeFup"), "OP outcome: Book followup (%)", value = 25, min = 0, max = 100),
- sliderInput(NS(id, "numOPOutcomeAdmit"), "OP outcome: Admit (%)", value = 10 , min = 0, max = 100),
+ sliderInput(NS(id, "numOPOutcomeAdmit"), "OP outcome: Admit (%)", value = 10, min = 0, max = 100),
uiOutput(NS(id, "OPOutcomeDischarge")), # a shinyjs output
sliderInput(NS(id, "numPreOpLos"), "Average pre-operative length of stay (hours)", value = 6, min = 0, max = 36),
sliderInput(NS(id, "numPostOpLos"), "Average post-operative length of stay (days)", value = 3, min = 0, max = 42, step = 0.1),
@@ -64,7 +64,8 @@ mod_simulation_ui <- function(id){
),
column(1)
),
- column(12,
+ column(
+ 12,
hr(),
plotOutput(NS(id, "queuePlot")),
hr(),
@@ -82,25 +83,27 @@ mod_simulation_ui <- function(id){
#' simulation Server Functions
#'
#' @noRd
-mod_simulation_server <- function(id){
- moduleServer( id, function(input, output, session){
+mod_simulation_server <- function(id) {
+ moduleServer(id, function(input, output, session) {
ns <- session$ns
#### REACTIVITY ####
# display a disabled input for the discharge rate (which depends on followup and admit rates)
- output$OPOutcomeDischarge = renderUI({
- shinyjs::disabled(sliderInput(inputId = "OPOutcomeDischarge", label = "OP outcome: Discharge (%)",
- min = 0, max = 100, value = max(0, (100 - input$numOPOutcomeFup - input$numOPOutcomeAdmit))))
+ output$OPOutcomeDischarge <- renderUI({
+ shinyjs::disabled(sliderInput(
+ inputId = "OPOutcomeDischarge", label = "OP outcome: Discharge (%)",
+ min = 0, max = 100, value = max(0, (100 - input$numOPOutcomeFup - input$numOPOutcomeAdmit))
+ ))
})
# handle the cases where discharge rate is already zero
- observeEvent(input$numOPOutcomeFup, {
- if(input$numOPOutcomeFup + input$numOPOutcomeAdmit > 100){
+ observeEvent(input$numOPOutcomeFup, {
+ if (input$numOPOutcomeFup + input$numOPOutcomeAdmit > 100) {
updateSliderInput(session = session, inputId = "numOPOutcomeAdmit", value = 100 - input$numOPOutcomeFup)
}
})
- observeEvent(input$numOPOutcomeAdmit, {
- if(input$numOPOutcomeFup + input$numOPOutcomeAdmit > 100){
+ observeEvent(input$numOPOutcomeAdmit, {
+ if (input$numOPOutcomeFup + input$numOPOutcomeAdmit > 100) {
updateSliderInput(session = session, inputId = "numOPOutcomeFup", value = 100 - input$numOPOutcomeAdmit)
}
})
@@ -165,11 +168,10 @@ mod_simulation_server <- function(id){
B->F;
}
- ")
- )
+ "
+ ))
observeEvent(input$updateButton, {
-
# it's most convenient to use library calls while prototyping
# may remove later
library(simmer)
@@ -193,7 +195,7 @@ mod_simulation_server <- function(id){
# make a plot
output$queuePlot <- renderPlot(
plot(sim_resources, metric = "usage", items = "queue", steps = TRUE) +
- scale_x_continuous(name = "Days", labels = scales::number_format(scale = 1/60/24)) + # format labels to represent days
+ scale_x_continuous(name = "Days", labels = scales::number_format(scale = 1 / 60 / 24)) + # format labels to represent days
labs(
title = "Queue size",
y = "Number of patients"
@@ -203,9 +205,9 @@ mod_simulation_server <- function(id){
)
output$serverPlot <- renderPlot(
plot(sim_resources, metric = "usage", items = "server", steps = TRUE) +
- scale_x_continuous(name = "Days", labels = scales::number_format(scale = 1/60/24)) + # format labels to represent days
- scale_color_manual(values = "lightgreen") +
- labs(
+ scale_x_continuous(name = "Days", labels = scales::number_format(scale = 1 / 60 / 24)) + # format labels to represent days
+ scale_color_manual(values = "lightgreen") +
+ labs(
subtitle = "Dotted line = max capacity, Solid line = actual usage",
y = "Used"
) +
@@ -224,10 +226,7 @@ mod_simulation_server <- function(id){
output$trajectoryPlot <- DiagrammeR::renderGrViz(
plot(patient, verbose = TRUE)
)
-
-
})
-
})
}
diff --git a/R/run_app.R b/R/run_app.R
index 34d886f..3fa4f2a 100644
--- a/R/run_app.R
+++ b/R/run_app.R
@@ -8,12 +8,11 @@
#' @importFrom shiny shinyApp
#' @importFrom golem with_golem_options
run_app <- function(
- onStart = NULL,
- options = list(),
- enableBookmarking = "url",
- uiPattern = "/",
- ...
-) {
+ onStart = NULL,
+ options = list(),
+ enableBookmarking = "url",
+ uiPattern = "/",
+ ...) {
with_golem_options(
app = shinyApp(
ui = app_ui,
diff --git a/R/run_sim.R b/R/run_sim.R
index d928f3c..c5cf782 100644
--- a/R/run_sim.R
+++ b/R/run_sim.R
@@ -6,8 +6,7 @@
#' @export
#' @noRd
#'
-run_sim <- function(model_config){
-
+run_sim <- function(model_config) {
# read the model config to a short variable name
mc <- model_config()
@@ -18,37 +17,37 @@ run_sim <- function(model_config){
# patient arrivals
rate <- mc$pat_referral_rate * 12 / 365 / 24 / 60 # monthly -> annual, then calculate patients per minute
dist_patient_arrival <- function() rexp(1, rate)
- #dist_patient_arrival()
+ # dist_patient_arrival()
# initial backlog of patients
dist_starting_backlog <- at(rep(0, mc$pat_backlog_size))
- #dist_starting_backlog()
+ # dist_starting_backlog()
dist_pre_op_ward_los <- function() rexp(1, 1 / (60 * mc$pre_op_los)) # x60 = hours
- #dist_pre_op_ward_los()
+ # dist_pre_op_ward_los()
dist_operating_time <- function() rexp(1, 1 / mc$theatre_proc_length) # minutes
- #dist_operating_time()
+ # dist_operating_time()
dist_post_op_ward_los <- function() rexp(1, 1 / (60 * 24 * mc$post_op_los)) # 60x24 = days
- #dist_post_op_ward_los()
+ # dist_post_op_ward_los()
# OP outcoming result. 1 = admit to wl, 2 = OP followup, 3 = discharged
op_disch_rate <- (100 - mc$op_admit_rate - mc$op_fup_rate)
dist_op_outcome <- function() sample(1:3, 1, FALSE, c(mc$op_admit_rate, mc$op_fup_rate, op_disch_rate))
- #dist_op_outcome()
+ # dist_op_outcome()
# create some schedules to close resources overnight
op_clinic_schedule <- schedule(
- c(60*8, 60*16),
+ c(60 * 8, 60 * 16),
c(1, 0),
- period = 60*24
+ period = 60 * 24
)
theatre_schedule <- schedule(
- c(60*8, 60*16),
+ c(60 * 8, 60 * 16),
c(1, 0),
- period = 60*24
+ period = 60 * 24
)
# create the patient pathway branches
@@ -63,20 +62,17 @@ run_sim <- function(model_config){
branch_admit <- trajectory("admit for treatment") |>
set_attribute("admitted_for_treatment", 1) |>
-
# take a pre-op bed
set_attribute("moved_to_pre_op_bed", 1) |>
seize("Bed") |>
timeout(dist_pre_op_ward_los) |>
release("Bed") |>
-
# operate
set_attribute("moved_to_theatre", 1) |>
seize("Theatre") |>
timeout(dist_operating_time) |>
release("Theatre") |>
log_("Im recovering") |>
-
# take a recovery ward bed
set_attribute("moved_to_post_op_bed", 1) |>
seize("Bed") |>
@@ -93,12 +89,13 @@ run_sim <- function(model_config){
seize("OP Clinic", 1, tag = "op_clinic") |>
timeout(function() rnorm(1, mean = mc$op_clinic_length, sd = 6)) |>
release("OP Clinic", 1) |>
-
# branch into admission and discharge
- branch(dist_op_outcome, FALSE,
- branch_admit,
- branch_followup_later,
- branch_discharge_from_op)
+ branch(
+ dist_op_outcome, FALSE,
+ branch_admit,
+ branch_followup_later,
+ branch_discharge_from_op
+ )
sim <- env |>
@@ -108,7 +105,7 @@ run_sim <- function(model_config){
add_generator("backlog patient", patient, dist_starting_backlog, mon = 2) |>
add_generator("new patient", patient, dist_patient_arrival, mon = 2)
- env |> run(60*24*7 * mc$forecast_length) # 60 * 24 * 7 = 1 week
+ env |> run(60 * 24 * 7 * mc$forecast_length) # 60 * 24 * 7 = 1 week
res <- list(
sim = sim,