From e7fd1866818e2e959196a86b595254b06775f73b Mon Sep 17 00:00:00 2001 From: Tom Jemmett Date: Wed, 11 Feb 2026 11:46:50 +0000 Subject: [PATCH 01/28] simplifies init observer removes code that is no longer needed. the config$params_items is now all just values and no longer functions that need to be evaluated switches from a function to get the default interval to hardcoded values - the function ignored the argument and always returned c(0.95, 1.0) --- R/mod_mitigators_server.R | 45 ++++++++++++--------------------------- 1 file changed, 14 insertions(+), 31 deletions(-) diff --git a/R/mod_mitigators_server.R b/R/mod_mitigators_server.R index ab8077c..9f0ee59 100644 --- a/R/mod_mitigators_server.R +++ b/R/mod_mitigators_server.R @@ -55,9 +55,7 @@ mod_mitigators_server <- function( ) }) - get_default <- function(rate) { - c(0.95, 1) - } + default_interval <- c(0.95, 1) init <- shiny::observe( { @@ -74,36 +72,21 @@ mod_mitigators_server <- function( _[strategies] |> purrr::map("interval") - strategies |> - # remove the friendly name for the strategy, replace with itself - purrr::set_names() |> - purrr::walk(\(i) { - # get the rates data for this strategy (for the provider in the baseline year) - r <- rates_data |> - dplyr::filter( - .data$strategy == strategies[i], - .data$provider == params$dataset, - .data$fyear == params$start_year - ) - - slider_values[[mitigators_type]][[i]] <- c( - # add the additional param items if they exist. - config$params_items |> - # if the additional item is a list, chose the value for the current strategy - purrr::map_if(is.list, ~ .x[[i]]) |> - # if the additional item is a function, evaluate it with the rates data - purrr::map_if(is.function, rlang::exec, r), - list( - interval = loaded_values[[i]] %||% get_default(r$rate) - ) + purrr::walk(strategies, \(i) { + slider_values[[mitigators_type]][[i]] <- c( + # add the additional param items if they exist. + config$params_items, + list( + interval = loaded_values[[i]] %||% default_interval ) + ) - params[[mitigators_type]][[activity_type]][[i]] <- if ( - !is.null(loaded_values[[i]]) - ) { - slider_values[[mitigators_type]][[i]] - } - }) + params[[mitigators_type]][[activity_type]][[i]] <- if ( + !is.null(loaded_values[[i]]) + ) { + slider_values[[mitigators_type]][[i]] + } + }) init$destroy() }, From c9acda91db365b02276d9cf7e2dfcd02b8edf8ce Mon Sep 17 00:00:00 2001 From: Tom Jemmett Date: Wed, 11 Feb 2026 11:57:24 +0000 Subject: [PATCH 02/28] renamed provider_max_value to provider_baseline_value, removes truncating of number which is no longer needed --- R/mod_mitigators_server.R | 8 +++----- inst/golem-config.yml | 28 ---------------------------- 2 files changed, 3 insertions(+), 33 deletions(-) diff --git a/R/mod_mitigators_server.R b/R/mod_mitigators_server.R index 9f0ee59..e6f70af 100644 --- a/R/mod_mitigators_server.R +++ b/R/mod_mitigators_server.R @@ -137,10 +137,8 @@ mod_mitigators_server <- function( # params controls ---- - provider_max_value <- shiny::reactive({ - r <- dplyr::filter(rates_baseline_data(), !.data$is_peer)$rate - m <- config$slider_scale / config$slider_step - floor(r * m) / m + provider_baseline_value <- shiny::reactive({ + dplyr::filter(rates_baseline_data(), !.data$is_peer)$rate }) shiny::observe({ @@ -540,7 +538,7 @@ mod_mitigators_server <- function( output$slider_absolute <- shiny::renderUI({ strategy <- shiny::req(input$strategy) - baseline_value <- provider_max_value() + baseline_value <- provider_baseline_value() number_format <- config$interval_text_number_type %||% config$number_type diff --git a/inst/golem-config.yml b/inst/golem-config.yml index a87720e..d440884 100644 --- a/inst/golem-config.yml +++ b/inst/golem-config.yml @@ -32,8 +32,6 @@ default: number_type: !expr scales::comma_format(accuracy = 0.001, scale = 1000) funnel_x_title: "Catchment Population of Trust" funnel_number_type: !expr scales::comma_format() - slider_scale: 1000 - slider_step: 0.1 strategy_subset: alcohol_partially_attributable_acute: "Alcohol Related Admissions (Acute Conditions - Partially Attributable)" alcohol_partially_attributable_chronic: "Alcohol Related Admissions (Chronic Conditions - Partially Attributable)" @@ -75,8 +73,6 @@ default: x_axis_title: "Financial Year" number_type: !expr scales::comma_format(accuracy = 0.1) funnel_x_title: "Number of Admissions" - slider_scale: 1 - slider_step: 0.1 strategy_subset: emergency_elderly: "Emergency Admission of Older People" enhanced_recovery_bladder: "Enhanced Recovery (Bladder)" @@ -105,8 +101,6 @@ default: number_type: !expr scales::comma_format(accuracy = 0.001, scale = 1000) funnel_x_title: "Catchment Population of Trust" funnel_number_type: !expr scales::comma_format() - slider_scale: 1000 - slider_step: 0.1 strategy_subset: same_day_emergency_care_low: "Same Day Emergency Care (Low Potential)" same_day_emergency_care_moderate: "Same Day Emergency Care (Moderate Potential)" @@ -121,8 +115,6 @@ default: x_axis_title: "Financial Year" number_type: !expr scales::comma_format(accuracy = 0.1, scale = 1000) funnel_x_title: "Number of Procedures Performed" - slider_scale: 1000 - slider_step: 0.1 strategy_subset: pre-op_los_1-day: "Pre-op Length of Stay of 1 day" pre-op_los_2-day: "Pre-op Length of Stay of 2 days" @@ -139,8 +131,6 @@ default: number_type: !expr scales::percent_format() interval_text_number_type: !expr scales::percent_format(accuracy = 0.01) funnel_x_title: "Number of Procedures Performed" - slider_scale: 100 - slider_step: 0.1 strategy_subset: day_procedures_occasionally_dc: "Day Procedures: Occasionally performed as a Daycase" day_procedures_usually_dc: "Day Procedures: Usually performed as a Daycase" @@ -154,8 +144,6 @@ default: number_type: !expr scales::percent_format() interval_text_number_type: !expr scales::percent_format(accuracy = 0.01) funnel_x_title: "Number of Procedures Performed" - slider_scale: 100 - slider_step: 0.1 strategy_subset: day_procedures_occasionally_op: "Day Procedures: Occasionally performed in Outpatients" day_procedures_usually_op: "Day Procedures: Usually performed in Outpatients" @@ -169,8 +157,6 @@ default: number_type: !expr scales::percent_format() interval_text_number_type: !expr scales::percent_format(accuracy = 0.01) funnel_x_title: "Number of Appointments" - slider_scale: 100 - slider_step: 0.1 strategy_subset: consultant_to_consultant_reduction_adult_non-surgical: "Outpatient Consultant to Consultant Referrals (Adult, Non-Surgical)" consultant_to_consultant_reduction_adult_surgical: "Outpatient Consultant to Consultant Referrals (Adult, Surgical)" @@ -184,8 +170,6 @@ default: number_type: !expr scales::percent_format() interval_text_number_type: !expr scales::percent_format(accuracy = 0.01) funnel_x_title: "Number of Appointments" - slider_scale: 100 - slider_step: 0.1 strategy_subset: convert_to_tele_adult_non-surgical: "Outpatient Convert to Tele-Attendance (Adult, Non-Surgical)" convert_to_tele_adult_surgical: "Outpatient Convert to Tele-Attendance (Adult, Surgical)" @@ -198,8 +182,6 @@ default: x_axis_title: "Financial Year" number_type: !expr scales::comma_format() funnel_x_title: "Number of Appointments" - slider_scale: 1 - slider_step: 0.1 strategy_subset: followup_reduction_adult_non-surgical: "Outpatient Followup Appointment Reduction (Adult, Non-Surgical)" followup_reduction_adult_surgical: "Outpatient Followup Appointment Reduction (Adult, Surgical)" @@ -213,8 +195,6 @@ default: number_type: !expr scales::percent_format() interval_text_number_type: !expr scales::percent_format(accuracy = 0.01) funnel_x_title: "Number of Appointments" - slider_scale: 100 - slider_step: 0.1 strategy_subset: gp_referred_first_attendance_reduction_adult_non-surgical: "Outpatient GP Referred First Attendance Reduction (Adult, Non-Surgical)" gp_referred_first_attendance_reduction_adult_surgical: "Outpatient GP Referred First Attendance Reduction (Adult, Surgical)" @@ -228,8 +208,6 @@ default: number_type: !expr scales::percent_format() interval_text_number_type: !expr scales::percent_format(accuracy = 0.01) funnel_x_title: "Number of Attendances" - slider_scale: 100 - slider_step: 0.1 strategy_subset: frequent_attenders_adult_ambulance: "A&E Frequent Attenders (Adult, Ambulance Conveyed)" frequent_attenders_adult_walk-in: "A&E Frequent Attenders (Adult, Walk-in)" @@ -243,8 +221,6 @@ default: number_type: !expr scales::percent_format() interval_text_number_type: !expr scales::percent_format(accuracy = 0.01) funnel_x_title: "Number of Attendances" - slider_scale: 100 - slider_step: 0.1 strategy_subset: left_before_seen_adult_ambulance: "A&E Patients Left Before Being Treated (Adult, Ambulance Conveyed)" left_before_seen_adult_walk-in: "A&E Patients Left Before Being Treated (Adult, Walk-in)" @@ -258,8 +234,6 @@ default: number_type: !expr scales::percent_format() interval_text_number_type: !expr scales::percent_format(accuracy = 0.01) funnel_x_title: "Number of Attendances" - slider_scale: 100 - slider_step: 0.1 strategy_subset: discharged_no_treatment_adult_ambulance: "A&E Discharged No Investigation or Treatment (Adult, Ambulance Conveyed)" discharged_no_treatment_adult_walk-in: "A&E Discharged No Investigation or Treatment (Adult, Walk-in)" @@ -273,8 +247,6 @@ default: number_type: !expr scales::percent_format() interval_text_number_type: !expr scales::percent_format(accuracy = 0.01) funnel_x_title: "Number of Attendances" - slider_scale: 100 - slider_step: 0.1 strategy_subset: low_cost_discharged_adult_ambulance: "A&E Low Cost Discharged Attendances (Adult, Ambulance Conveyed)" low_cost_discharged_adult_walk-in: "A&E Low Cost Discharged Attendances (Adult, Walk-in)" From 46275601f223ef08653d3ff0880b79364dab05ee Mon Sep 17 00:00:00 2001 From: Tom Jemmett Date: Wed, 11 Feb 2026 12:57:48 +0000 Subject: [PATCH 03/28] moved observer from inside a reactive to the module server --- R/mod_mitigators_server.R | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/R/mod_mitigators_server.R b/R/mod_mitigators_server.R index e6f70af..63d1889 100644 --- a/R/mod_mitigators_server.R +++ b/R/mod_mitigators_server.R @@ -35,13 +35,6 @@ mod_mitigators_server <- function( # make sure a provider is selected shiny::req(params$dataset) - shiny::observe( - input$strategy |> - shiny::req() |> - reasons_key() - ) |> - shiny::bindEvent(input$strategy) - # need to invert this list (flip names -> values) strats_subset <- config$strategy_subset available_subset <- intersect( @@ -55,6 +48,14 @@ mod_mitigators_server <- function( ) }) + shiny::observe( + # update the reasons module with the selected strategy + input$strategy |> + shiny::req() |> + reasons_key() + ) |> + shiny::bindEvent(input$strategy) + default_interval <- c(0.95, 1) init <- shiny::observe( From 74bcd5c5a70742e7f5f309c374544677f9c2c318 Mon Sep 17 00:00:00 2001 From: Tom Jemmett Date: Wed, 11 Feb 2026 13:14:24 +0000 Subject: [PATCH 04/28] refactor "init" observer use once=TRUE instead of init$destroy --- R/mod_mitigators_server.R | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/R/mod_mitigators_server.R b/R/mod_mitigators_server.R index 63d1889..ccca6aa 100644 --- a/R/mod_mitigators_server.R +++ b/R/mod_mitigators_server.R @@ -58,7 +58,7 @@ mod_mitigators_server <- function( default_interval <- c(0.95, 1) - init <- shiny::observe( + shiny::observe( { strategies <- shiny::req(strategies()) @@ -88,11 +88,10 @@ mod_mitigators_server <- function( slider_values[[mitigators_type]][[i]] } }) - - init$destroy() }, priority = 100 - ) + ) |> + shiny::bindEvent(strategies(), once = TRUE) # set the strategy text by loading the contents of the file for that strategy output$strategy_text <- shiny::renderUI({ From 823b918d4b3db8f08945e8089e114e05de1d6ee1 Mon Sep 17 00:00:00 2001 From: Tom Jemmett Date: Wed, 11 Feb 2026 16:34:02 +0000 Subject: [PATCH 05/28] adds namespace to observer call --- R/app_server.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/app_server.R b/R/app_server.R index d8b4d10..a297805 100644 --- a/R/app_server.R +++ b/R/app_server.R @@ -169,7 +169,7 @@ app_server <- function(input, output, session) { mod_health_status_adjustment_server("health_status_adjustment", params) - observe({ + shiny::observe({ can_set_inequalities <- any( c("nhp_devs", "nhp_power_users", "nhp_test_inequalities") %in% session$groups From 4cacfdbebbc1065ad871ffbaac12c3b58840c485 Mon Sep 17 00:00:00 2001 From: Tom Jemmett Date: Wed, 11 Feb 2026 13:34:31 +0000 Subject: [PATCH 06/28] adds comments for the observers/reactives --- R/mod_mitigators_server.R | 199 ++++++++++++++++++++++++-------------- 1 file changed, 129 insertions(+), 70 deletions(-) diff --git a/R/mod_mitigators_server.R b/R/mod_mitigators_server.R index ccca6aa..166c44b 100644 --- a/R/mod_mitigators_server.R +++ b/R/mod_mitigators_server.R @@ -14,6 +14,8 @@ mod_mitigators_server <- function( mitigator_codes_lkup, peers ) { + default_interval <- c(0.95, 1) + config <- get_golem_config("mitigators_config")[[id]] activity_type <- config$activity_type @@ -29,8 +31,21 @@ mod_mitigators_server <- function( ) shiny::moduleServer(id, function(input, output, session) { + # -------------------------------------------------------------------------- + # module initialization + # -------------------------------------------------------------------------- + + # this will contain the slider values for each strategy. this is separate + # from the params reactiveValues, because we want to keep track of the + # values a user has set whether they have clicked "include" or not. + # if a value is in the params, it will be equal to the value in + # slider_values slider_values <- shiny::reactiveValues() + # get the available strategies for this module + # + # uses the config values to filter all of the strategies to just those that + # are relevant to this module, and are available for the selected provider strategies <- shiny::reactive({ # make sure a provider is selected shiny::req(params$dataset) @@ -48,16 +63,9 @@ mod_mitigators_server <- function( ) }) - shiny::observe( - # update the reasons module with the selected strategy - input$strategy |> - shiny::req() |> - reasons_key() - ) |> - shiny::bindEvent(input$strategy) - - default_interval <- c(0.95, 1) - + # initialize the module with the values from the loaded parameters file + # + # runs when strategies() has loaded, and only runs once shiny::observe( { strategies <- shiny::req(strategies()) @@ -93,6 +101,18 @@ mod_mitigators_server <- function( ) |> shiny::bindEvent(strategies(), once = TRUE) + # -------------------------------------------------------------------------- + # input$strategy observers + # -------------------------------------------------------------------------- + + # update the reasons module with the selected strategy + shiny::observe( + input$strategy |> + shiny::req() |> + reasons_key() + ) |> + shiny::bindEvent(input$strategy) + # set the strategy text by loading the contents of the file for that strategy output$strategy_text <- shiny::renderUI({ strategy <- shiny::req(input$strategy) @@ -105,10 +125,47 @@ mod_mitigators_server <- function( "strategy_text", paste0(files[stringr::str_detect(strategy, files)], ".md") ) - }) + }) |> + shiny::bindEvent(input$strategy) - # rates data baseline year ---- + # update the state of the "include?" checkbox when the strategy is changed + # + # runs when the strategy dropdown is changed and sets the checkbox to + # TRUE/FALSE depending on whether the value is currently in params or not + # + # ensures that the module is initialized by checking that slider_values is + # not null for the selected strategy + shiny::observe({ + # ensure include checkbox is on or off given param value + strategy <- shiny::req(input$strategy) + # Wait for slider to be initialized before updating checkbox + shiny::req(slider_values[[mitigators_type]][[strategy]]) + include <- !is.null(params[[mitigators_type]][[activity_type]][[ + strategy + ]]) + shiny::updateCheckboxInput(session, "include", value = include) + }) |> + shiny::bindEvent(input$strategy) + + # update the slider values when the strategy is changed + # + # runs when the strategy dropdown is changed and loads the currently + # saved values for the selected strategy + shiny::observe({ + # update slider + strategy <- shiny::req(input$strategy) + scale <- 100 + values <- slider_values[[mitigators_type]][[strategy]]$interval * scale + shiny::updateSliderInput( + session, + "slider", + value = values + ) + }) |> + shiny::bindEvent(input$strategy) + + # rates data for the baseline year rates_baseline_data <- shiny::reactive({ strategy <- shiny::req(input$strategy) @@ -133,40 +190,18 @@ mod_mitigators_server <- function( ) ) |> dplyr::arrange(dplyr::desc(.data$is_peer)) # to plot focal scheme last - }) - - # params controls ---- - - provider_baseline_value <- shiny::reactive({ - dplyr::filter(rates_baseline_data(), !.data$is_peer)$rate - }) - - shiny::observe({ - # ensure include checkbox is on or off given param value - strategy <- shiny::req(input$strategy) - # Wait for slider to be initialized before updating checkbox - shiny::req(slider_values[[mitigators_type]][[strategy]]) - include <- !is.null(params[[mitigators_type]][[activity_type]][[ - strategy - ]]) - shiny::updateCheckboxInput(session, "include", value = include) }) |> shiny::bindEvent(input$strategy) - shiny::observe({ - # update slider - strategy <- shiny::req(input$strategy) - scale <- 100 - - values <- slider_values[[mitigators_type]][[strategy]]$interval * scale - shiny::updateSliderInput( - session, - "slider", - value = values - ) - }) |> - shiny::bindEvent(input$strategy) + # -------------------------------------------------------------------------- + # params controls + # -------------------------------------------------------------------------- + # update the params when the slider or include checkbox is changed + # + # runs when the slider or include checkbox is changed and saves the values + # for the selected strategy to the params reactiveValues (or, removes it + # from params if include is FALSE) shiny::observe({ values <- input$slider strategy <- shiny::req(input$strategy) @@ -189,8 +224,14 @@ mod_mitigators_server <- function( }) |> shiny::bindEvent(input$include) - # plot ribbon to show selected params ---- + # -------------------------------------------------------------------------- + # output reactives + # -------------------------------------------------------------------------- + # plot ribbon to show selected params + # + # draws a yellow ribbon on the trend, funnel, and boxplot charts to show the + # interval selected by the slider. plot_ribbon <- shiny::reactive({ baseline_value <- dplyr::filter( rates_baseline_data(), @@ -217,9 +258,9 @@ mod_mitigators_server <- function( } }) - # trend plot ---- + # trend plot + # # use the rates data, filtered to the provider that has been selected - trend_data <- shiny::reactive({ strategy <- shiny::req(input$strategy) rates_data |> @@ -229,25 +270,19 @@ mod_mitigators_server <- function( ) }) - output$trend_plot <- shiny::renderPlot({ - rates_trend_plot( - trend_data(), - params$start_year, - plot_range(), - config$y_axis_title, - config$x_axis_title, - config$number_type, - plot_ribbon() - ) - }) - - # funnel plot ---- + # funnel plot + # + # use the rates data for the baseline year to generate the funnel plot data, + # showing all providers, highlighting the selected provider and its peers funnel_data <- shiny::reactive({ rates_baseline_data() |> generate_rates_funnel_data() }) # calculate the range across our plots + # + # used to ensure that the y-axis is the same across the trend, funnel, and + # boxplot plot_range <- shiny::reactive({ td_rate <- shiny::req(trend_data())$rate @@ -264,6 +299,35 @@ mod_mitigators_server <- function( c(0, max(c(td_rate, fd_rate))) }) + # get the value in the baseline year for the selected provider + # + # runs when the rates_baseline_data changes (which happens when the strategy + # dropdown is changed) + provider_baseline_value <- shiny::reactive({ + rates_baseline_data() |> + dplyr::filter(.data$provider == params$dataset) |> + purrr::pluck("rate") + }) |> + shiny::bindEvent(rates_baseline_data()) + + # -------------------------------------------------------------------------- + # output renderers + # -------------------------------------------------------------------------- + + # render the trend plot + output$trend_plot <- shiny::renderPlot({ + rates_trend_plot( + trend_data(), + params$start_year, + plot_range(), + config$y_axis_title, + config$x_axis_title, + config$number_type, + plot_ribbon() + ) + }) + + # render the funnel plot output$funnel_plot <- shiny::renderPlot({ plot( funnel_data(), @@ -273,15 +337,13 @@ mod_mitigators_server <- function( ) }) - # boxplot ---- - + # render the boxplot output$boxplot <- shiny::renderPlot({ rates_baseline_data() |> rates_boxplot(plot_range(), plot_ribbon()) }) - # diagnoses ---- - + # render the diagnoses table output$diagnoses_table <- gt::render_gt({ shiny::validate( shiny::need( @@ -370,8 +432,7 @@ mod_mitigators_server <- function( ) }) - # procedures ---- - + # render the procedures table output$procedures_table <- gt::render_gt({ shiny::validate( shiny::need( @@ -469,8 +530,7 @@ mod_mitigators_server <- function( ) }) - # age group ---- - + # render the age group pyramid plot output$age_grp_plot <- shiny::renderPlot({ strategy <- shiny::req(input$strategy) age_data <- age_sex_data |> @@ -484,8 +544,7 @@ mod_mitigators_server <- function( age_pyramid(age_data) }) - # NEE result ---- - + # render the NEE result output$nee_result <- shiny::renderPlot( { nee_params <- app_sys("app", "data", "nee_table.csv") |> @@ -534,8 +593,7 @@ mod_mitigators_server <- function( height = 60 ) - # rate values ---- - + # render the slider absolute values text output$slider_absolute <- shiny::renderUI({ strategy <- shiny::req(input$strategy) baseline_value <- provider_baseline_value() @@ -562,6 +620,7 @@ mod_mitigators_server <- function( shiny::tags$p(shiny::HTML(text), style = style) }) + # render the slider interval explanation text output$slider_interval_text <- shiny::renderUI({ text <- glue::glue( "Click a slider handle and use your arrow keys for finer control.", From 1e7a1a2b7f114c6c202f21d8217a0a25a774efa2 Mon Sep 17 00:00:00 2001 From: Tom Jemmett Date: Fri, 13 Feb 2026 12:35:44 +0000 Subject: [PATCH 07/28] moves lookups out of server, uses a new get_lookups function prevents lookups having to be loaded multiple times for each different connection to the server --- R/ZZZ.R | 5 -- R/app_server.R | 38 +------- R/mod_baseline_adjustment_server.R | 5 +- R/mod_baseline_adjustment_ui.R | 3 +- R/mod_expat_repat_server.R | 20 ++--- R/mod_home_server.R | 2 +- R/mod_mitigators_server.R | 30 +++---- R/mod_mitigators_summary_server.R | 24 ++--- R/mod_non_demographic_adjustment_server.R | 6 +- R/mod_waiting_list_imbalances_server.R | 22 +---- R/mod_waiting_list_imbalances_utils.R | 4 +- R/utils_lookups.R | 105 ++++++++++++++++++++++ 12 files changed, 147 insertions(+), 117 deletions(-) create mode 100644 R/utils_lookups.R diff --git a/R/ZZZ.R b/R/ZZZ.R index 5803c24..12ee332 100644 --- a/R/ZZZ.R +++ b/R/ZZZ.R @@ -9,11 +9,6 @@ utils::globalVariables(c( ".env" )) -rtt_specialties <- function() { - app_sys("app", "data", "rtt_specialties.csv") |> - readr::read_csv(col_types = "cc") -} - sanitize_input_name <- function(.x) { .x |> stringr::str_to_lower() |> diff --git a/R/app_server.R b/R/app_server.R index a297805..240fed1 100644 --- a/R/app_server.R +++ b/R/app_server.R @@ -12,37 +12,8 @@ app_server <- function(input, output, session) { Sys.getenv("CACHE_VERSION", 0) }) - diagnoses_lkup <- shiny::reactive({ - readr::read_csv(app_sys("app", "data", "diagnoses.csv"), col_types = "ccc") - }) - - procedures_lkup <- shiny::reactive({ - readr::read_csv(app_sys("app", "data", "procedures.csv"), col_types = "ccc") - }) - - mitigator_codes_lkup <- shiny::reactive({ - lkup <- app_sys("app", "data", "mitigator-codes.csv") |> - readr::read_csv(col_types = "c") - - purrr::set_names( - paste0(lkup[["strategy_name"]], " (", lkup[["mitigator_code"]], ")"), - lkup[["strategy"]] - ) - }) - - providers <- shiny::reactive({ - app_sys("app", "data", "providers.csv") |> - readr::read_csv(col_types = "cc") |> - tibble::deframe() # convert tibble to named vector - }) - - peers <- shiny::reactive({ - readr::read_csv(app_sys("app", "data", "peers.csv"), col_types = "cc") - }) - params <- mod_home_server( "home", - providers(), shiny::reactive(input$params_file) ) @@ -194,8 +165,7 @@ app_server <- function(input, output, session) { expat_data(), repat_local_data(), repat_nonlocal_data(), - params, - providers() + params ) mod_non_demographic_adjustment_server("non_demographic_adjustment", params) @@ -225,11 +195,7 @@ app_server <- function(input, output, session) { age_sex_data(), diagnoses_data(), procedures_data(), - available_strategies, - diagnoses_lkup(), - procedures_lkup(), - mitigator_codes_lkup(), - peers() + available_strategies ) # enable the run_model page for certain users/running locally diff --git a/R/mod_baseline_adjustment_server.R b/R/mod_baseline_adjustment_server.R index 7497ac0..cdf6e71 100644 --- a/R/mod_baseline_adjustment_server.R +++ b/R/mod_baseline_adjustment_server.R @@ -4,13 +4,14 @@ mod_baseline_adjustment_server <- function(id, baseline_data, params) { mod_reasons_server(shiny::NS(id, "reasons"), params, "baseline_adjustment") + rtt_specialties <- get_lookups()[["rtt_specialties"]] + shiny::moduleServer(id, function(input, output, session) { # static data ---- # creates a table containing all of the options shown in the baseline adjustment page, including the input id # for each slider - specs <- rtt_specialties() |> - dplyr::mutate(sanitized_code = sanitize_input_name(.data[["code"]])) |> + specs <- rtt_specialties |> dplyr::cross_join( dplyr::bind_rows( ip = tibble::tibble(g = c("elective", "non-elective", "maternity")), diff --git a/R/mod_baseline_adjustment_ui.R b/R/mod_baseline_adjustment_ui.R index 67d2043..66da856 100644 --- a/R/mod_baseline_adjustment_ui.R +++ b/R/mod_baseline_adjustment_ui.R @@ -10,8 +10,7 @@ mod_baseline_adjustment_ui <- function(id) { ns <- shiny::NS(id) - specs <- rtt_specialties() |> - dplyr::mutate(sanitized_code = sanitize_input_name(.data[["code"]])) + specs <- get_lookups()[["rtt_specialties"]] create_table <- function(at, g, df = specs) { df |> diff --git a/R/mod_expat_repat_server.R b/R/mod_expat_repat_server.R index 31b8938..230cd66 100644 --- a/R/mod_expat_repat_server.R +++ b/R/mod_expat_repat_server.R @@ -6,21 +6,19 @@ mod_expat_repat_server <- function( expat_data, repat_local_data, repat_nonlocal_data, - params, - providers + params ) { + providers <- get_lookups()[["providers"]] + + rtt_specialties <- get_lookups()[["rtt_specialties"]] |> + dplyr::select("specialty", "code") |> + tibble::deframe() + + icb_boundaries <- get_lookups()[["icb_boundaries"]] + mod_reasons_server(shiny::NS(id, "reasons"), params, "expat_repat") shiny::moduleServer(id, function(input, output, session) { - # static data ---- - rtt_specialties <- rtt_specialties() |> - tibble::deframe() - icb_boundaries <- sf::read_sf(app_sys( - "app", - "data", - "icb_boundaries.geojson" - )) - # helpers ---- extract_expat_repat_data <- function(dat) { diff --git a/R/mod_home_server.R b/R/mod_home_server.R index 411b609..dc5317b 100644 --- a/R/mod_home_server.R +++ b/R/mod_home_server.R @@ -1,7 +1,7 @@ #' home Server Functions #' #' @noRd -mod_home_server <- function(id, providers, filename) { +mod_home_server <- function(id, filename) { shiny::moduleServer(id, function(input, output, session) { # reactives ---- diff --git a/R/mod_mitigators_server.R b/R/mod_mitigators_server.R index 166c44b..2b0d890 100644 --- a/R/mod_mitigators_server.R +++ b/R/mod_mitigators_server.R @@ -8,13 +8,11 @@ mod_mitigators_server <- function( age_sex_data, diagnoses_data, procedures_data, - available_strategies, - diagnoses_lkup, - procedures_lkup, - mitigator_codes_lkup, - peers + available_strategies ) { - default_interval <- c(0.95, 1) + lookups <- get_lookups() + + default_interval <- c(0.95, 1.0) config <- get_golem_config("mitigators_config")[[id]] @@ -57,10 +55,10 @@ mod_mitigators_server <- function( available_strategies() ) - purrr::set_names( - available_subset, - mitigator_codes_lkup[available_subset] # e.g. 'IP-EF-017: Enhanced Recovery (Hip)' - ) + lookups[["mitigators"]] |> + dplyr::select("strategy_name_full", "strategy") |> + dplyr::filter(.data$strategy %in% available_subset) |> + tibble::deframe() }) # initialize the module with the values from the loaded parameters file @@ -170,7 +168,7 @@ mod_mitigators_server <- function( strategy <- shiny::req(input$strategy) # nolint start: object_usage_linter - scheme_peers <- peers |> + scheme_peers <- lookups[["peers"]] |> dplyr::filter( .data$procode == params$dataset & .data$peer != params$dataset ) |> @@ -361,7 +359,7 @@ mod_mitigators_server <- function( .data$fyear == params$start_year ) |> dplyr::inner_join( - diagnoses_lkup, + lookups[["diagnoses"]], by = c("diagnosis" = "diagnosis_code") ) |> dplyr::select("diagnosis_description", "n", "pcnt") @@ -458,7 +456,10 @@ mod_mitigators_server <- function( .data$strategy == .env$strategy, .data$fyear == params$start_year ) |> - dplyr::left_join(procedures_lkup, by = c("procedure_code" = "code")) |> + dplyr::left_join( + lookups[["procedures"]], + by = c("procedure_code" = "code") + ) |> tidyr::replace_na(list( description = "Unknown/Invalid Procedure Code" )) |> @@ -547,8 +548,7 @@ mod_mitigators_server <- function( # render the NEE result output$nee_result <- shiny::renderPlot( { - nee_params <- app_sys("app", "data", "nee_table.csv") |> - readr::read_csv(col_types = "cddd") |> + nee_params <- lookups[["nee_table"]] |> dplyr::filter(.data[["param_name"]] == input$strategy) shiny::validate( diff --git a/R/mod_mitigators_summary_server.R b/R/mod_mitigators_summary_server.R index 79fe816..a688a96 100644 --- a/R/mod_mitigators_summary_server.R +++ b/R/mod_mitigators_summary_server.R @@ -6,26 +6,12 @@ mod_mitigators_summary_server <- function(id, age_sex_data, params) { mitigators_summary <- shiny::reactive({ year <- as.character(shiny::req(params$start_year)) - strategy_codes <- readr::read_csv( - app_sys("app", "data", "mitigator-codes.csv"), - col_select = c("strategy", "strategy_name", "mitigator_code"), - col_types = "c" + strategy_codes <- dplyr::select( + get_lookups()[["mitigators"]], + "strategy_name" = "strategy_name_full", + "strategy" ) - strategy_names <- get_golem_config("mitigators_config") |> - purrr::map("strategy_subset") |> - purrr::flatten() |> - tibble::enframe("strategy", "strategy_name") |> - tidyr::unnest("strategy_name") |> - dplyr::left_join( - strategy_codes, - by = dplyr::join_by("strategy", "strategy_name") - ) |> - dplyr::mutate( - strategy_name = glue::glue("{strategy_name} ({mitigator_code})") - ) |> - dplyr::select(-"mitigator_code") - age_sex_data |> dplyr::filter( .data[["fyear"]] == year, @@ -38,7 +24,7 @@ mod_mitigators_summary_server <- function(id, age_sex_data, params) { sort = TRUE ) |> dplyr::slice(1:20) |> - dplyr::inner_join(strategy_names, by = dplyr::join_by("strategy")) |> + dplyr::inner_join(strategy_codes, by = dplyr::join_by("strategy")) |> dplyr::select(-"strategy") }) diff --git a/R/mod_non_demographic_adjustment_server.R b/R/mod_non_demographic_adjustment_server.R index 2e273ad..33db9de 100644 --- a/R/mod_non_demographic_adjustment_server.R +++ b/R/mod_non_demographic_adjustment_server.R @@ -8,11 +8,9 @@ mod_non_demographic_adjustment_server <- function(id, params) { "non-demographic_adjustment" ) - shiny::moduleServer(id, function(input, output, session) { - ndg_variants <- app_sys("app", "data", "ndg_variants.json") |> - jsonlite::read_json(simplifyVector = TRUE) |> - purrr::keep_at(c("variant_2", "variant_3")) + ndg_variants <- get_lookups()[["ndg_variants"]] + shiny::moduleServer(id, function(input, output, session) { # reactives ---- non_demographic_adjustment <- shiny::reactive({ diff --git a/R/mod_waiting_list_imbalances_server.R b/R/mod_waiting_list_imbalances_server.R index d29b465..010627a 100644 --- a/R/mod_waiting_list_imbalances_server.R +++ b/R/mod_waiting_list_imbalances_server.R @@ -2,6 +2,8 @@ #' #' @noRd mod_waiting_list_imbalances_server <- function(id, wli_data, params) { + multipliers <- get_lookups()[["waiting_list_multipliers"]] + mod_reasons_server( shiny::NS(id, "reasons"), params, @@ -9,26 +11,6 @@ mod_waiting_list_imbalances_server <- function(id, wli_data, params) { ) shiny::moduleServer(id, function(input, output, session) { - # static values ---- - multipliers <- readr::read_csv( - "inst/app/data/waiting_list_params.csv", - col_types = "cddddd" - ) |> - dplyr::transmute( - .data[["tretspef"]], - ip = .data[["mixed_split"]] * - .data[["avg_ip_activity_per_pathway_mixed"]], - op = .data[["op_only_split"]] * - .data[["avg_op_first_activity_per_pathway_op_only"]] + - .data[["mixed_split"]] * - .data[["avg_op_first_activity_per_pathway_mixed"]] - ) |> - tidyr::pivot_longer( - c("ip", "op"), - names_to = "activity_type", - values_to = "multiplier" - ) - # reactives ---- # load the waiting list data from azure diff --git a/R/mod_waiting_list_imbalances_utils.R b/R/mod_waiting_list_imbalances_utils.R index 4b36218..bdff17f 100644 --- a/R/mod_waiting_list_imbalances_utils.R +++ b/R/mod_waiting_list_imbalances_utils.R @@ -1,7 +1,7 @@ mod_waiting_list_imbalances_table <- function(df) { - rtt_specialties() |> + get_lookups()[["rtt_specialties"]] |> dplyr::inner_join(df, c(code = "tretspef")) |> - dplyr::select(-"code") |> + dplyr::select(-"code", -"sanitized_code") |> tidyr::pivot_wider( names_from = "activity_type", values_from = c("count", "param") diff --git a/R/utils_lookups.R b/R/utils_lookups.R new file mode 100644 index 0000000..758d372 --- /dev/null +++ b/R/utils_lookups.R @@ -0,0 +1,105 @@ +get_diagnoses_lookup <- function() { + readr::read_csv( + app_sys("app", "data", "diagnoses.csv"), + col_types = "ccc", + progress = FALSE + ) +} + +get_procedures_lookup <- function() { + readr::read_csv( + app_sys("app", "data", "procedures.csv"), + col_types = "ccc", + progress = FALSE + ) +} + +get_mitigators_lookup <- function() { + app_sys("app", "data", "mitigator-codes.csv") |> + readr::read_csv(col_types = "c", progress = FALSE) |> + dplyr::mutate( + strategy_name_full = glue::glue("{strategy_name} ({mitigator_code})") + ) +} + +get_peers_lookup <- function() { + readr::read_csv( + app_sys("app", "data", "peers.csv"), + col_types = "cc", + progress = FALSE + ) +} + +get_providers_lookup <- function() { + app_sys("app", "data", "providers.csv") |> + readr::read_csv(col_types = "cc", progress = FALSE) |> + tibble::deframe() +} + +get_ndg_variants_lookup <- function() { + app_sys("app", "data", "ndg_variants.json") |> + jsonlite::read_json(simplifyVector = TRUE) |> + purrr::keep_at(c("variant_2", "variant_3")) +} + +get_nee_lookup <- function() { + readr::read_csv( + app_sys("app", "data", "nee_table.csv"), + col_types = "cddd", + progress = FALSE + ) +} + +get_rtt_specialties_lookup <- function() { + app_sys("app", "data", "rtt_specialties.csv") |> + readr::read_csv(col_types = "cc", progress = FALSE) |> + dplyr::mutate(sanitized_code = sanitize_input_name(.data[["code"]])) +} + +get_waiting_list_multipliers <- function() { + app_sys("app", "data", "waiting_list_params.csv") |> + readr::read_csv(col_types = "cddddd", progress = FALSE) |> + dplyr::transmute( + .data[["tretspef"]], + ip = .data[["mixed_split"]] * + .data[["avg_ip_activity_per_pathway_mixed"]], + op = .data[["op_only_split"]] * + .data[["avg_op_first_activity_per_pathway_op_only"]] + + .data[["mixed_split"]] * + .data[["avg_op_first_activity_per_pathway_mixed"]] + ) |> + tidyr::pivot_longer( + c("ip", "op"), + names_to = "activity_type", + values_to = "multiplier" + ) +} + +get_icb_boundaries <- function() { + sf::read_sf(app_sys("app", "data", "icb_boundaries.geojson")) +} + +# use a singleton pattern to cache lookups in memory, but prevent the files from +# being read immediately when the package is attached +.lookups_cache <- new.env() + +get_lookups <- function() { + if (length(ls(envir = .lookups_cache)) == 0) { + list2env( + list( + "diagnoses" = get_diagnoses_lookup(), + "procedures" = get_procedures_lookup(), + "mitigators" = get_mitigators_lookup(), + "peers" = get_peers_lookup(), + "providers" = get_providers_lookup(), + "ndg_variants" = get_ndg_variants_lookup(), + "nee_table" = get_nee_lookup(), + "rtt_specialties" = get_rtt_specialties_lookup(), + "waiting_list_multipliers" = get_waiting_list_multipliers(), + "icb_boundaries" = get_icb_boundaries() + ), + envir = .lookups_cache + ) + } + .lookups_cache +} From 8e0c138424b94884d7a68624b36ab46f48212a78 Mon Sep 17 00:00:00 2001 From: Tom Jemmett Date: Fri, 13 Feb 2026 21:38:43 +0000 Subject: [PATCH 08/28] adds loading spinners to outputs in the expat/repat module --- R/mod_expat_repat_ui.R | 30 ++++++++++++++++++++---------- 1 file changed, 20 insertions(+), 10 deletions(-) diff --git a/R/mod_expat_repat_ui.R b/R/mod_expat_repat_ui.R index b252634..ff854b5 100644 --- a/R/mod_expat_repat_ui.R +++ b/R/mod_expat_repat_ui.R @@ -84,13 +84,17 @@ mod_expat_repat_ui <- function(id) { generate_param_controls("repat_local", 100, 500, c(100, 105)), shiny::fluidRow( col_6( - shiny::plotOutput( - ns("repat_local_plot"), + shinycssloaders::withSpinner( + shiny::plotOutput( + ns("repat_local_plot"), + ) ) ), col_6( - shiny::plotOutput( - ns("repat_local_split_plot") + shinycssloaders::withSpinner( + shiny::plotOutput( + ns("repat_local_split_plot") + ) ) ) ) @@ -101,18 +105,24 @@ mod_expat_repat_ui <- function(id) { generate_param_controls("repat_nonlocal", 100, 500, c(100, 105)), shiny::fluidRow( col_4( - shiny::plotOutput( - ns("repat_nonlocal_pcnt_plot") + shinycssloaders::withSpinner( + shiny::plotOutput( + ns("repat_nonlocal_pcnt_plot") + ) ) ), col_4( - shiny::plotOutput( - ns("repat_nonlocal_n") + shinycssloaders::withSpinner( + shiny::plotOutput( + ns("repat_nonlocal_n") + ) ) ), col_4( - leaflet::leafletOutput( - ns("repat_nonlocal_icb_map") + shinycssloaders::withSpinner( + leaflet::leafletOutput( + ns("repat_nonlocal_icb_map") + ) ) ) ) From 6388b39847a1aa6fb8e476c0ddd993524766d1c4 Mon Sep 17 00:00:00 2001 From: Tom Jemmett Date: Mon, 16 Feb 2026 09:15:43 +0000 Subject: [PATCH 09/28] renames inst/app/data to inst/app/reference --- .gitignore | 2 ++ R/utils_lookups.R | 24 +++++++++++-------- inst/app/{data => reference}/diagnoses.csv | 0 .../icb_boundaries.geojson | 0 .../{data => reference}/mitigator-codes.csv | 0 .../app/{data => reference}/ndg_variants.json | 0 inst/app/{data => reference}/nee_table.csv | 0 inst/app/{data => reference}/peers.csv | 0 inst/app/{data => reference}/procedures.csv | 0 inst/app/{data => reference}/providers.csv | 0 .../{data => reference}/rtt_specialties.csv | 0 .../waiting_list_params.csv | 0 12 files changed, 16 insertions(+), 10 deletions(-) rename inst/app/{data => reference}/diagnoses.csv (100%) rename inst/app/{data => reference}/icb_boundaries.geojson (100%) rename inst/app/{data => reference}/mitigator-codes.csv (100%) rename inst/app/{data => reference}/ndg_variants.json (100%) rename inst/app/{data => reference}/nee_table.csv (100%) rename inst/app/{data => reference}/peers.csv (100%) rename inst/app/{data => reference}/procedures.csv (100%) rename inst/app/{data => reference}/providers.csv (100%) rename inst/app/{data => reference}/rtt_specialties.csv (100%) rename inst/app/{data => reference}/waiting_list_params.csv (100%) diff --git a/.gitignore b/.gitignore index e00a527..1d4945f 100644 --- a/.gitignore +++ b/.gitignore @@ -18,3 +18,5 @@ inputs_selection_app/ .cache/ tmp/ + +inst/app/data/ \ No newline at end of file diff --git a/R/utils_lookups.R b/R/utils_lookups.R index 758d372..9efcf96 100644 --- a/R/utils_lookups.R +++ b/R/utils_lookups.R @@ -1,6 +1,10 @@ +lookup_file_path <- function(file) { + app_sys("app", "reference", file) +} + get_diagnoses_lookup <- function() { readr::read_csv( - app_sys("app", "data", "diagnoses.csv"), + lookup_file_path("diagnoses.csv"), col_types = "ccc", progress = FALSE ) @@ -8,14 +12,14 @@ get_diagnoses_lookup <- function() { get_procedures_lookup <- function() { readr::read_csv( - app_sys("app", "data", "procedures.csv"), + lookup_file_path("procedures.csv"), col_types = "ccc", progress = FALSE ) } get_mitigators_lookup <- function() { - app_sys("app", "data", "mitigator-codes.csv") |> + lookup_file_path("mitigator-codes.csv") |> readr::read_csv(col_types = "c", progress = FALSE) |> dplyr::mutate( strategy_name_full = glue::glue("{strategy_name} ({mitigator_code})") @@ -24,40 +28,40 @@ get_mitigators_lookup <- function() { get_peers_lookup <- function() { readr::read_csv( - app_sys("app", "data", "peers.csv"), + lookup_file_path("peers.csv"), col_types = "cc", progress = FALSE ) } get_providers_lookup <- function() { - app_sys("app", "data", "providers.csv") |> + lookup_file_path("providers.csv") |> readr::read_csv(col_types = "cc", progress = FALSE) |> tibble::deframe() } get_ndg_variants_lookup <- function() { - app_sys("app", "data", "ndg_variants.json") |> + lookup_file_path("ndg_variants.json") |> jsonlite::read_json(simplifyVector = TRUE) |> purrr::keep_at(c("variant_2", "variant_3")) } get_nee_lookup <- function() { readr::read_csv( - app_sys("app", "data", "nee_table.csv"), + lookup_file_path("nee_table.csv"), col_types = "cddd", progress = FALSE ) } get_rtt_specialties_lookup <- function() { - app_sys("app", "data", "rtt_specialties.csv") |> + lookup_file_path("rtt_specialties.csv") |> readr::read_csv(col_types = "cc", progress = FALSE) |> dplyr::mutate(sanitized_code = sanitize_input_name(.data[["code"]])) } get_waiting_list_multipliers <- function() { - app_sys("app", "data", "waiting_list_params.csv") |> + lookup_file_path("waiting_list_params.csv") |> readr::read_csv(col_types = "cddddd", progress = FALSE) |> dplyr::transmute( .data[["tretspef"]], @@ -76,7 +80,7 @@ get_waiting_list_multipliers <- function() { } get_icb_boundaries <- function() { - sf::read_sf(app_sys("app", "data", "icb_boundaries.geojson")) + sf::read_sf(lookup_file_path("icb_boundaries.geojson")) } # use a singleton pattern to cache lookups in memory, but prevent the files from diff --git a/inst/app/data/diagnoses.csv b/inst/app/reference/diagnoses.csv similarity index 100% rename from inst/app/data/diagnoses.csv rename to inst/app/reference/diagnoses.csv diff --git a/inst/app/data/icb_boundaries.geojson b/inst/app/reference/icb_boundaries.geojson similarity index 100% rename from inst/app/data/icb_boundaries.geojson rename to inst/app/reference/icb_boundaries.geojson diff --git a/inst/app/data/mitigator-codes.csv b/inst/app/reference/mitigator-codes.csv similarity index 100% rename from inst/app/data/mitigator-codes.csv rename to inst/app/reference/mitigator-codes.csv diff --git a/inst/app/data/ndg_variants.json b/inst/app/reference/ndg_variants.json similarity index 100% rename from inst/app/data/ndg_variants.json rename to inst/app/reference/ndg_variants.json diff --git a/inst/app/data/nee_table.csv b/inst/app/reference/nee_table.csv similarity index 100% rename from inst/app/data/nee_table.csv rename to inst/app/reference/nee_table.csv diff --git a/inst/app/data/peers.csv b/inst/app/reference/peers.csv similarity index 100% rename from inst/app/data/peers.csv rename to inst/app/reference/peers.csv diff --git a/inst/app/data/procedures.csv b/inst/app/reference/procedures.csv similarity index 100% rename from inst/app/data/procedures.csv rename to inst/app/reference/procedures.csv diff --git a/inst/app/data/providers.csv b/inst/app/reference/providers.csv similarity index 100% rename from inst/app/data/providers.csv rename to inst/app/reference/providers.csv diff --git a/inst/app/data/rtt_specialties.csv b/inst/app/reference/rtt_specialties.csv similarity index 100% rename from inst/app/data/rtt_specialties.csv rename to inst/app/reference/rtt_specialties.csv diff --git a/inst/app/data/waiting_list_params.csv b/inst/app/reference/waiting_list_params.csv similarity index 100% rename from inst/app/data/waiting_list_params.csv rename to inst/app/reference/waiting_list_params.csv From f5685a857c40fe8d11ce2760be1793dc6f834204 Mon Sep 17 00:00:00 2001 From: Tom Jemmett Date: Mon, 16 Feb 2026 11:40:13 +0000 Subject: [PATCH 10/28] switches how we load data * no longer tries to download files in the shiny app * adds dev/get_data_files.R to download the files to inst/app/data * removes caching as no longer needed * moves logic for reshaping the required data from the app_server function to their own functions in fct_load_provider_data.R --- R/ZZZ.R | 35 ++++++++++------ R/app_server.R | 86 ++++++++++---------------------------- R/fct_azure_storage.R | 74 ++++++++++++++++++++++++++------ R/fct_create_data_cache.R | 33 --------------- R/fct_load_provider_data.R | 77 ++++++++++++++++++++++++++++++++++ R/fct_reduce_values.R | 36 ---------------- R/run_app.R | 11 +++-- dev/download_data.R | 37 ++++++++++++++++ 8 files changed, 226 insertions(+), 163 deletions(-) delete mode 100644 R/fct_create_data_cache.R create mode 100644 R/fct_load_provider_data.R delete mode 100644 R/fct_reduce_values.R create mode 100644 dev/download_data.R diff --git a/R/ZZZ.R b/R/ZZZ.R index 12ee332..63e9c2b 100644 --- a/R/ZZZ.R +++ b/R/ZZZ.R @@ -86,22 +86,33 @@ encrypt_filename <- function( openssl::base64_encode(c(hm, ct)) } -get_params_schema_text <- function( +download_params_schema <- function( + data_path = app_sys("app", "data"), app_version = Sys.getenv("INPUTS_DATA_VERSION", "dev") ) { - tf <- tempfile() - - utils::download.file( - glue::glue( - "https://the-strategy-unit.github.io/nhp_model/{app_version}/params-schema.json" - ), - tf + file_path <- file.path( + data_path, + glue::glue("params-schema.json") ) - # append a newline to the end of the params-schema file, otherwise you get a warning - # "incomplete final line found" - cat("\n", file = tf, append = TRUE) - paste(readLines(tf), collapse = "\n") + params_schema <- httr2::request( + "https://the-strategy-unit.github.io" + ) |> + httr2::req_url_path("nhp_model", app_version, "params-schema.json") |> + httr2::req_perform() |> + httr2::resp_body_string() + + readr::write_lines(params_schema, file_path) + + invisible(file_path) +} + +get_params_schema_text <- function( + app_version = Sys.getenv("INPUTS_DATA_VERSION", "dev") +) { + file_path <- app_sys("app", "data", glue::glue("params-schema.json")) + + readr::read_file(file_path) } create_params_schema <- function(schema_text) { diff --git a/R/app_server.R b/R/app_server.R index 240fed1..2e12520 100644 --- a/R/app_server.R +++ b/R/app_server.R @@ -5,13 +5,6 @@ #' @import shiny #' @noRd app_server <- function(input, output, session) { - # in fct_create_data_cache, we utilise this env var to invalidate the cache - # we can use it's value to allow us to cache all of the reactive data without - # having to bind to some other input which might change - cache_version <- shiny::reactive({ - Sys.getenv("CACHE_VERSION", 0) - }) - params <- mod_home_server( "home", shiny::reactive(input$params_file) @@ -27,85 +20,48 @@ app_server <- function(input, output, session) { # load all data rates_data <- shiny::reactive({ - rates <- load_provider_data("rates") |> - dplyr::select(-"crude_rate") |> - dplyr::rename(rate = "std_rate") - - national_rate <- rates |> - dplyr::filter( - .data$provider == "national" - ) |> - dplyr::summarise( - .by = c("fyear", "strategy"), - national_rate = dplyr::first(.data$rate) - ) - - rates |> - dplyr::filter(.data$provider != "national") |> - dplyr::inner_join(national_rate, by = c("fyear", "strategy")) - }) |> - shiny::bindCache(cache_version()) + get_rates_data() + }) age_sex_data <- shiny::reactive({ - age_sex <- load_provider_data("age_sex") - # nolint start: object_usage_linter - age_fct <- age_sex |> _[["age_group"]] |> unique() |> sort() - # nolint end - age_sex |> - dplyr::mutate( - dplyr::across("sex", as.character), - age_group = factor( - .data[["age_group"]], - levels = .env[["age_fct"]] - ) - ) - }) |> - shiny::bindCache(cache_version()) + get_age_sex_data() + }) diagnoses_data <- shiny::reactive({ - load_provider_data("diagnoses") - }) |> - shiny::bindCache(cache_version()) + get_diagnoses_data() + }) procedures_data <- shiny::reactive({ - load_provider_data("procedures") - }) |> - shiny::bindCache(cache_version()) + get_procedures_data() + }) baseline_data <- shiny::reactive({ - load_provider_data("baseline") - }) |> - shiny::bindCache(cache_version()) + get_baseline_data() + }) wli_data <- shiny::reactive({ - load_provider_data("wli") - }) |> - shiny::bindCache(cache_version()) + get_wli_data() + }) inequalities_data <- shiny::reactive({ - load_provider_data("inequalities") - }) |> - shiny::bindCache(cache_version()) + get_inequalities_data() + }) expat_data <- shiny::reactive({ - load_provider_data("expat") - }) |> - shiny::bindCache(cache_version()) + get_expat_data() + }) repat_local_data <- shiny::reactive({ - load_provider_data("repat_local") - }) |> - shiny::bindCache(cache_version()) + get_repat_local_data() + }) repat_nonlocal_data <- shiny::reactive({ - load_provider_data("repat_nonlocal") - }) |> - shiny::bindCache(cache_version()) + get_repat_nonlocal_data() + }) params_schema_text <- shiny::reactive({ get_params_schema_text() - }) |> - shiny::bindCache(cache_version()) + }) # load all other modules once the home module has finished loading init <- shiny::observe({ diff --git a/R/fct_azure_storage.R b/R/fct_azure_storage.R index 59fa200..e5a461c 100644 --- a/R/fct_azure_storage.R +++ b/R/fct_azure_storage.R @@ -1,22 +1,27 @@ -#' Get Provider Data +#' Download Provider Data #' -#' Read the parquet file containing a selected type of provider data. +#' Download a selected type of provider data from ADLS and save it as a parquet +#' file in the app's data directory. #' -#' @param file The name of the file to read. +#' @param file The name of the file to download. +#' @param data_path The path to the app's data directory. #' @param inputs_data_version The version of the inputs data to use. -#' @return A tibble. -load_provider_data <- function( +#' @param ... Additional arguments to pass to `AzureStor::download_adls_file()`. +#' +#' @return The path to the downloaded file. +download_provider_data <- function( file, - inputs_data_version = Sys.getenv("NHP_INPUTS_DATA_VERSION", "dev") + data_path = app_sys("app", "data"), + inputs_data_version = Sys.getenv("NHP_INPUTS_DATA_VERSION", "dev"), + ... ) { fs <- get_adls_fs() - fs |> - AzureStor::download_adls_file( - glue::glue("{inputs_data_version}/provider/{file}.parquet"), - dest = NULL - ) |> - arrow::read_parquet() |> - tibble::as_tibble() + src <- glue::glue("{inputs_data_version}/provider/{file}.parquet") + dest <- file.path(data_path, glue::glue("{file}.parquet")) + + AzureStor::download_adls_file(fs, src = src, dest = dest, ...) + + invisible(dest) } #' Get ADLS Filesystem @@ -32,3 +37,46 @@ get_adls_fs <- function() { AzureStor::adls_endpoint(token = token) |> AzureStor::adls_filesystem(Sys.getenv("AZ_STORAGE_CONTAINER")) } + +#' Get All Data Files +#' +#' Download all provider data files from ADLS and save them as parquet files in +#' the app's data directory. +#' +#' @param inputs_data_version The version of the inputs data to use. +#' @return NULL +get_all_data_files <- function( + inputs_data_version = Sys.getenv("NHP_INPUTS_DATA_VERSION", "dev") +) { + data_path <- file.path("inst", "app", "data") + if (!dir.exists(data_path)) { + dir.create(data_path, recursive = TRUE) + } + + files <- c( + "rates", + "age_sex", + "diagnoses", + "procedures", + "baseline", + "inequalities", + "expat", + "repat_local", + "repat_nonlocal" + ) + + purrr::walk( + purrr::set_names(files), + download_provider_data, + inputs_data_version = inputs_data_version, + data_path = data_path, + overwrite = TRUE + ) + + download_params_schema( + data_path = data_path, + app_version = inputs_data_version + ) + + invisible(NULL) +} diff --git a/R/fct_create_data_cache.R b/R/fct_create_data_cache.R deleted file mode 100644 index f9b9c82..0000000 --- a/R/fct_create_data_cache.R +++ /dev/null @@ -1,33 +0,0 @@ -#' create_data_cache -#' -#' @description A fct function -#' -#' @return The return value, if any, from executing the function. -#' -#' @noRd - -create_data_cache <- function() { - if (!dir.exists(".cache")) { - dir.create(".cache") - } - - dc <- cachem::cache_disk(".cache/data_cache", 200 * 1024^2) # 200MB - - # in case we need to invalidate the cache on rsconnect quickly, we can increment the "CACHE_VERSION" env var - cache_version <- ifelse( - file.exists(".cache/cache_version.txt"), - as.numeric(readLines(".cache/cache_version.txt")), - -1 - ) - - if (Sys.getenv("CACHE_VERSION", 0) > cache_version) { - cat("Invalidating cache\n") - dc$reset() - cache_version <- Sys.getenv("CACHE_VERSION", 0) - writeLines(as.character(cache_version), ".cache/cache_version.txt") - } - - shiny::shinyOptions(cache = dc) - - invisible(NULL) -} diff --git a/R/fct_load_provider_data.R b/R/fct_load_provider_data.R new file mode 100644 index 0000000..daf339b --- /dev/null +++ b/R/fct_load_provider_data.R @@ -0,0 +1,77 @@ +#' Get Provider Data +#' +#' Read the parquet file containing a selected type of provider data. +#' +#' @param file The name of the file to read. +#' @param inputs_data_version The version of the inputs data to use. +#' @return A tibble. +load_provider_data <- function(file, data_path = app_sys("app", "data")) { + file.path(data_path, glue::glue("{file}.parquet")) |> + arrow::read_parquet() |> + tibble::as_tibble() +} + +get_rates_data <- function() { + rates <- load_provider_data("rates") |> + dplyr::select(-"crude_rate") |> + dplyr::rename(rate = "std_rate") + + national_rate <- rates |> + dplyr::filter( + .data$provider == "national" + ) |> + dplyr::summarise( + .by = c("fyear", "strategy"), + national_rate = dplyr::first(.data$rate) + ) + + rates |> + dplyr::filter(.data$provider != "national") |> + dplyr::inner_join(national_rate, by = c("fyear", "strategy")) +} + +get_age_sex_data <- function() { + age_sex <- load_provider_data("age_sex") + + age_fct <- sort(unique(age_sex[["age_group"]])) + + age_sex |> + dplyr::mutate( + age_group = factor( + .data[["age_group"]], + levels = .env[["age_fct"]] + ) + ) +} + +get_diagnoses_data <- function() { + load_provider_data("diagnoses") +} + +get_procedures_data <- function() { + load_provider_data("procedures") +} + +get_baseline_data <- function() { + load_provider_data("baseline") +} + +get_wli_data <- function() { + load_provider_data("wli") +} + +get_inequalities_data <- function() { + load_provider_data("inequalities") +} + +get_expat_data <- function() { + load_provider_data("expat") +} + +get_repat_local_data <- function() { + load_provider_data("repat_local") +} + +get_repat_nonlocal_data <- function() { + load_provider_data("repat_nonlocal") +} diff --git a/R/fct_reduce_values.R b/R/fct_reduce_values.R deleted file mode 100644 index e3c9846..0000000 --- a/R/fct_reduce_values.R +++ /dev/null @@ -1,36 +0,0 @@ -reduce_values <- function(values, target) { - # ensure values are valid - stopifnot( - "values must be between 0 and 1" = all(values >= 0, values <= 1) - ) - - # start of including all of the non-target items which are greater than 0 - include <- values[values > 0] |> - names() |> - stringr::str_subset(stringr::fixed(target), TRUE) - - # create a recursive function to reduce the values until sum(values) <= 1 - fn <- function(values, include) { - # get the sum of the values - s <- sum(values) - # if the sum is less than or equal to 1 we are ok - if (s <= 1) { - return(values) - } - # work out the amount over - over <- s - 1 - # how many values can we reduce - n <- length(include) - # figure out how much to reduce the values by - # - use either the smallest value in the list, - # - or equally reduce all of the values - r <- pmin(min(values[include]), over / n) - # update the values - values[include] <- values[include] - r - # recurse: remove items that are now 0 - fn(values, include[values[include] > 0]) - } - - # run the function - fn(values, include) -} diff --git a/R/run_app.R b/R/run_app.R index c52c5d0..fa3fe16 100644 --- a/R/run_app.R +++ b/R/run_app.R @@ -17,15 +17,18 @@ run_app <- function( uiPattern = "/", # nolint ... ) { - if (getOption("golem.app.prod", FALSE)) { - create_data_cache() - } - # required for async promise calls if (!is_local()) { future::plan(future::multicore, workers = 2) } + # check files exist before starting app + # TODO: consider more rigorous checks, e.g. specific files exist, or number of files + if (!dir.exists(file.path(app_sys("app"), "data"))) { + cat("Initialising data directory...\n") + get_all_data_files() + } + golem::with_golem_options( app = shiny::shinyApp( ui = app_ui, diff --git a/dev/download_data.R b/dev/download_data.R new file mode 100644 index 0000000..68b6dc4 --- /dev/null +++ b/dev/download_data.R @@ -0,0 +1,37 @@ +get_data_files <- function( + inputs_data_version = Sys.getenv("NHP_INPUTS_DATA_VERSION", "dev") +) { + data_path <- file.path("inst", "app", "data") + if (!dir.exists(data_path)) { + dir.create(data_path, recursive = TRUE) + } + + files <- c( + "rates", + "age_sex", + "diagnoses", + "procedures", + "baseline", + "inequalities", + "expat", + "repat_local", + "repat_nonlocal" + ) + + purrr::walk( + purrr::set_names(files), + download_provider_data, + inputs_data_version = inputs_data_version, + data_path = data_path, + overwrite = TRUE + ) + + download_params_schema( + data_path = data_path, + app_version = inputs_data_version + ) + + invisible(NULL) +} + +get_data_files() From 1cb175f5dace489d7dd98e5c650f09e088310618 Mon Sep 17 00:00:00 2001 From: Tom Jemmett Date: Mon, 16 Feb 2026 13:29:55 +0000 Subject: [PATCH 11/28] renames file --- R/{utils_lookups.R => fct_utils_lookups.R} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename R/{utils_lookups.R => fct_utils_lookups.R} (100%) diff --git a/R/utils_lookups.R b/R/fct_utils_lookups.R similarity index 100% rename from R/utils_lookups.R rename to R/fct_utils_lookups.R From 3d802fc5ecba1bf9aaf8e69fb6c8af1181a3146a Mon Sep 17 00:00:00 2001 From: Tom Jemmett Date: Mon, 16 Feb 2026 13:42:09 +0000 Subject: [PATCH 12/28] cache data so it's only loaded once into memory, rather than per session --- R/fct_load_provider_data.R | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/R/fct_load_provider_data.R b/R/fct_load_provider_data.R index daf339b..849f8d4 100644 --- a/R/fct_load_provider_data.R +++ b/R/fct_load_provider_data.R @@ -1,3 +1,5 @@ +.data_cache <- new.env() + #' Get Provider Data #' #' Read the parquet file containing a selected type of provider data. @@ -6,9 +8,12 @@ #' @param inputs_data_version The version of the inputs data to use. #' @return A tibble. load_provider_data <- function(file, data_path = app_sys("app", "data")) { - file.path(data_path, glue::glue("{file}.parquet")) |> - arrow::read_parquet() |> - tibble::as_tibble() + if (!exists(file, envir = .data_cache)) { + .data_cache[[file]] <- file.path(data_path, glue::glue("{file}.parquet")) |> + arrow::read_parquet() |> + tibble::as_tibble() + } + .data_cache[[file]] } get_rates_data <- function() { From d3dbeca1a66a709c6440c9f4094dec09904009ca Mon Sep 17 00:00:00 2001 From: Tom Jemmett Date: Mon, 16 Feb 2026 14:35:20 +0000 Subject: [PATCH 13/28] caches the json schema to only load once per session --- R/ZZZ.R | 12 +++++++----- R/app_server.R | 8 ++------ R/mod_run_model_fix_params.R | 4 ++-- R/mod_run_model_remove_invalid_mitigators.R | 4 ++-- R/mod_run_model_server.R | 6 +++--- 5 files changed, 16 insertions(+), 18 deletions(-) diff --git a/R/ZZZ.R b/R/ZZZ.R index 63e9c2b..42f4728 100644 --- a/R/ZZZ.R +++ b/R/ZZZ.R @@ -107,14 +107,16 @@ download_params_schema <- function( invisible(file_path) } -get_params_schema_text <- function( +.schema_cache <- new.env() +get_params_schema <- function( app_version = Sys.getenv("INPUTS_DATA_VERSION", "dev") ) { file_path <- app_sys("app", "data", glue::glue("params-schema.json")) - readr::read_file(file_path) -} + schema_text <- readr::read_file(file_path) -create_params_schema <- function(schema_text) { - jsonvalidate::json_schema$new(schema_text) + if (!exists("schema", envir = .schema_cache)) { + .schema_cache[["schema"]] <- jsonvalidate::json_schema$new(schema_text) + } + .schema_cache[["schema"]] } diff --git a/R/app_server.R b/R/app_server.R index 2e12520..14c1a6d 100644 --- a/R/app_server.R +++ b/R/app_server.R @@ -59,10 +59,6 @@ app_server <- function(input, output, session) { get_repat_nonlocal_data() }) - params_schema_text <- shiny::reactive({ - get_params_schema_text() - }) - # load all other modules once the home module has finished loading init <- shiny::observe({ shiny::req(start() > 0) @@ -161,7 +157,7 @@ app_server <- function(input, output, session) { ) if (is_local() || can_run_model) { shinyjs::show("run-model-container") - mod_run_model_server("run_model", params, params_schema_text()) + mod_run_model_server("run_model", params) } init$destroy() @@ -182,7 +178,7 @@ app_server <- function(input, output, session) { params |> shiny::reactiveValuesToList() |> - mod_run_model_fix_params(params_schema_text()) |> + mod_run_model_fix_params() |> jsonlite::write_json(file, pretty = TRUE, auto_unbox = TRUE) }) diff --git a/R/mod_run_model_fix_params.R b/R/mod_run_model_fix_params.R index 4de82a2..0d0e7c5 100644 --- a/R/mod_run_model_fix_params.R +++ b/R/mod_run_model_fix_params.R @@ -1,5 +1,5 @@ -mod_run_model_fix_params <- function(p, schema_text) { - p <- mod_run_model_remove_invalid_mitigators(p, schema_text) +mod_run_model_fix_params <- function(p) { + p <- mod_run_model_remove_invalid_mitigators(p) # nolint start: commented_code_linter # some of the items in our params will be lists of length 0. diff --git a/R/mod_run_model_remove_invalid_mitigators.R b/R/mod_run_model_remove_invalid_mitigators.R index 6e6d171..676abee 100644 --- a/R/mod_run_model_remove_invalid_mitigators.R +++ b/R/mod_run_model_remove_invalid_mitigators.R @@ -1,5 +1,5 @@ -mod_run_model_remove_invalid_mitigators <- function(p, schema_text) { - schema <- create_params_schema(schema_text) +mod_run_model_remove_invalid_mitigators <- function(p) { + schema <- get_params_schema() json_p <- jsonlite::toJSON(p, auto_unbox = TRUE) diff --git a/R/mod_run_model_server.R b/R/mod_run_model_server.R index 05067f1..816d3e7 100644 --- a/R/mod_run_model_server.R +++ b/R/mod_run_model_server.R @@ -1,7 +1,7 @@ #' run_model Server Functions #' #' @noRd -mod_run_model_server <- function(id, params, schema_text) { +mod_run_model_server <- function(id, params) { mod_reasons_server(shiny::NS(id, "reasons"), params, "model_run") shiny::moduleServer(id, function(input, output, session) { @@ -23,7 +23,7 @@ mod_run_model_server <- function(id, params, schema_text) { params |> shiny::reactiveValuesToList() |> - mod_run_model_fix_params(schema_text) + mod_run_model_fix_params() }) # output the status of the model run after submit is pressed @@ -78,7 +78,7 @@ mod_run_model_server <- function(id, params, schema_text) { }) params_json_validation <- shiny::reactive({ - schema <- create_params_schema(schema_text) + schema <- get_params_schema() v <- schema$validate(params_json(), verbose = TRUE) From ba8fd098884398b63a288f8916044e0566544c58 Mon Sep 17 00:00:00 2001 From: Tom Jemmett Date: Mon, 16 Feb 2026 15:37:38 +0000 Subject: [PATCH 14/28] function is moved into the package --- dev/download_data.R | 37 ------------------------------------- 1 file changed, 37 deletions(-) delete mode 100644 dev/download_data.R diff --git a/dev/download_data.R b/dev/download_data.R deleted file mode 100644 index 68b6dc4..0000000 --- a/dev/download_data.R +++ /dev/null @@ -1,37 +0,0 @@ -get_data_files <- function( - inputs_data_version = Sys.getenv("NHP_INPUTS_DATA_VERSION", "dev") -) { - data_path <- file.path("inst", "app", "data") - if (!dir.exists(data_path)) { - dir.create(data_path, recursive = TRUE) - } - - files <- c( - "rates", - "age_sex", - "diagnoses", - "procedures", - "baseline", - "inequalities", - "expat", - "repat_local", - "repat_nonlocal" - ) - - purrr::walk( - purrr::set_names(files), - download_provider_data, - inputs_data_version = inputs_data_version, - data_path = data_path, - overwrite = TRUE - ) - - download_params_schema( - data_path = data_path, - app_version = inputs_data_version - ) - - invisible(NULL) -} - -get_data_files() From 3844d3663d84f2d26e49572816bdfb8f4c72895c Mon Sep 17 00:00:00 2001 From: Tom Jemmett Date: Mon, 16 Feb 2026 15:57:24 +0000 Subject: [PATCH 15/28] removes wli modulde code as the data is not currently available --- R/app_server.R | 10 ---------- R/app_ui.R | 4 ---- R/fct_load_provider_data.R | 4 ---- 3 files changed, 18 deletions(-) diff --git a/R/app_server.R b/R/app_server.R index 14c1a6d..524b233 100644 --- a/R/app_server.R +++ b/R/app_server.R @@ -39,10 +39,6 @@ app_server <- function(input, output, session) { get_baseline_data() }) - wli_data <- shiny::reactive({ - get_wli_data() - }) - inequalities_data <- shiny::reactive({ get_inequalities_data() }) @@ -106,12 +102,6 @@ app_server <- function(input, output, session) { mod_inequalities_server("inequalities", inequalities_data(), params) - mod_waiting_list_imbalances_server( - "waiting_list_imbalances", - wli_data(), - params - ) - mod_expat_repat_server( "expat_repat", expat_data(), diff --git a/R/app_ui.R b/R/app_ui.R index c68d186..9e75979 100644 --- a/R/app_ui.R +++ b/R/app_ui.R @@ -201,10 +201,6 @@ app_ui <- function(request) { tabName = "tab_nda", mod_non_demographic_adjustment_ui("non_demographic_adjustment") ), - bs4Dash::tabItem( - tabName = "tab_wli", - mod_waiting_list_imbalances_ui("waiting_list_imbalances") - ), bs4Dash::tabItem( tabName = "tab_er", mod_expat_repat_ui("expat_repat") diff --git a/R/fct_load_provider_data.R b/R/fct_load_provider_data.R index 849f8d4..e9b5df8 100644 --- a/R/fct_load_provider_data.R +++ b/R/fct_load_provider_data.R @@ -61,10 +61,6 @@ get_baseline_data <- function() { load_provider_data("baseline") } -get_wli_data <- function() { - load_provider_data("wli") -} - get_inequalities_data <- function() { load_provider_data("inequalities") } From f075c86e21e13955d431a5b4a311d9b8eead97b4 Mon Sep 17 00:00:00 2001 From: Tom Jemmett Date: Mon, 16 Feb 2026 16:54:47 +0000 Subject: [PATCH 16/28] more eagerly filter data, and move single-use reactives to their respective modules --- R/app_server.R | 57 ++++++++++-------------------- R/fct_load_provider_data.R | 45 +++++++++++++++++------ R/mod_baseline_adjustment_server.R | 8 +++-- R/mod_expat_repat_server.R | 29 ++++++++------- R/mod_inequalities_server.R | 11 ++++-- R/mod_mitigators_server.R | 40 ++++++++------------- 6 files changed, 98 insertions(+), 92 deletions(-) diff --git a/R/app_server.R b/R/app_server.R index 524b233..97c41d5 100644 --- a/R/app_server.R +++ b/R/app_server.R @@ -24,35 +24,24 @@ app_server <- function(input, output, session) { }) age_sex_data <- shiny::reactive({ - get_age_sex_data() - }) - - diagnoses_data <- shiny::reactive({ - get_diagnoses_data() - }) - - procedures_data <- shiny::reactive({ - get_procedures_data() - }) + provider <- params$dataset + fyear <- params$start_year - baseline_data <- shiny::reactive({ - get_baseline_data() + get_age_sex_data(provider, fyear) }) - inequalities_data <- shiny::reactive({ - get_inequalities_data() - }) + diagnoses_data <- shiny::reactive({ + provider <- params$dataset + fyear <- params$start_year - expat_data <- shiny::reactive({ - get_expat_data() + get_diagnoses_data(provider, fyear) }) - repat_local_data <- shiny::reactive({ - get_repat_local_data() - }) + procedures_data <- shiny::reactive({ + provider <- params$dataset + fyear <- params$start_year - repat_nonlocal_data <- shiny::reactive({ - get_repat_nonlocal_data() + get_procedures_data(provider, fyear) }) # load all other modules once the home module has finished loading @@ -78,11 +67,7 @@ app_server <- function(input, output, session) { unique() }) - mod_baseline_adjustment_server( - "baseline_adjustment", - baseline_data(), - params - ) + mod_baseline_adjustment_server("baseline_adjustment", params) mod_population_growth_server("population_growth", params) @@ -100,15 +85,9 @@ app_server <- function(input, output, session) { ) }) - mod_inequalities_server("inequalities", inequalities_data(), params) + mod_inequalities_server("inequalities", params) - mod_expat_repat_server( - "expat_repat", - expat_data(), - repat_local_data(), - repat_nonlocal_data(), - params - ) + mod_expat_repat_server("expat_repat", params) mod_non_demographic_adjustment_server("non_demographic_adjustment", params) @@ -133,10 +112,10 @@ app_server <- function(input, output, session) { ), mod_mitigators_server, params, - rates_data(), - age_sex_data(), - diagnoses_data(), - procedures_data(), + rates_data, + age_sex_data, + diagnoses_data, + procedures_data, available_strategies ) diff --git a/R/fct_load_provider_data.R b/R/fct_load_provider_data.R index e9b5df8..b4ff9c2 100644 --- a/R/fct_load_provider_data.R +++ b/R/fct_load_provider_data.R @@ -35,12 +35,16 @@ get_rates_data <- function() { dplyr::inner_join(national_rate, by = c("fyear", "strategy")) } -get_age_sex_data <- function() { +get_age_sex_data <- function(provider, fyear) { age_sex <- load_provider_data("age_sex") age_fct <- sort(unique(age_sex[["age_group"]])) age_sex |> + dplyr::filter( + .data$provider == .env$provider, + .data$fyear == .env$fyear + ) |> dplyr::mutate( age_group = factor( .data[["age_group"]], @@ -49,24 +53,43 @@ get_age_sex_data <- function() { ) } -get_diagnoses_data <- function() { - load_provider_data("diagnoses") +get_diagnoses_data <- function(provider, fyear) { + load_provider_data("diagnoses") |> + dplyr::filter( + .data$provider == .env$provider, + .data$fyear == .env$fyear + ) } -get_procedures_data <- function() { - load_provider_data("procedures") +get_procedures_data <- function(provider, fyear) { + load_provider_data("procedures") |> + dplyr::filter( + .data$provider == .env$provider, + .data$fyear == .env$fyear + ) } -get_baseline_data <- function() { - load_provider_data("baseline") +get_baseline_data <- function(provider, fyear) { + load_provider_data("baseline") |> + dplyr::filter( + .data$provider == .env$provider, + .data$fyear == .env$fyear + ) } -get_inequalities_data <- function() { - load_provider_data("inequalities") +get_inequalities_data <- function(provider, fyear) { + load_provider_data("inequalities") |> + dplyr::filter( + .data$provider == .env$provider, + .data$fyear == .env$fyear + ) } -get_expat_data <- function() { - load_provider_data("expat") +get_expat_data <- function(provider) { + load_provider_data("expat") |> + dplyr::filter( + .data$provider == .env$provider + ) } get_repat_local_data <- function() { diff --git a/R/mod_baseline_adjustment_server.R b/R/mod_baseline_adjustment_server.R index cdf6e71..150a3bf 100644 --- a/R/mod_baseline_adjustment_server.R +++ b/R/mod_baseline_adjustment_server.R @@ -1,12 +1,16 @@ #' baseline_adjustment Server Functions #' #' @noRd -mod_baseline_adjustment_server <- function(id, baseline_data, params) { +mod_baseline_adjustment_server <- function(id, params) { mod_reasons_server(shiny::NS(id, "reasons"), params, "baseline_adjustment") rtt_specialties <- get_lookups()[["rtt_specialties"]] shiny::moduleServer(id, function(input, output, session) { + baseline_data <- shiny::reactive({ + get_baseline_data(params$dataset, params$start_year) + }) + # static data ---- # creates a table containing all of the options shown in the baseline adjustment page, including the input id @@ -48,7 +52,7 @@ mod_baseline_adjustment_server <- function(id, baseline_data, params) { year <- as.character(shiny::req(params$start_year)) # nolint end - baseline_data |> + baseline_data() |> dplyr::filter( .data[["fyear"]] == .env[["year"]], .data[["provider"]] == .env[["dataset"]] diff --git a/R/mod_expat_repat_server.R b/R/mod_expat_repat_server.R index 230cd66..16498ee 100644 --- a/R/mod_expat_repat_server.R +++ b/R/mod_expat_repat_server.R @@ -1,13 +1,7 @@ #' expat_repat Server Functions #' #' @noRd -mod_expat_repat_server <- function( - id, - expat_data, - repat_local_data, - repat_nonlocal_data, - params -) { +mod_expat_repat_server <- function(id, params) { providers <- get_lookups()[["providers"]] rtt_specialties <- get_lookups()[["rtt_specialties"]] |> @@ -19,6 +13,18 @@ mod_expat_repat_server <- function( mod_reasons_server(shiny::NS(id, "reasons"), params, "expat_repat") shiny::moduleServer(id, function(input, output, session) { + expat_data <- shiny::reactive({ + get_expat_data(params$dataset) + }) + + repat_local_data <- shiny::reactive({ + get_repat_local_data() + }) + + repat_nonlocal_data <- shiny::reactive({ + get_repat_nonlocal_data() + }) + # helpers ---- extract_expat_repat_data <- function(dat) { @@ -49,24 +55,21 @@ mod_expat_repat_server <- function( # extract the expat data for the current selection expat <- shiny::reactive({ - ds <- shiny::req(params$dataset) - - expat_data |> - dplyr::filter(.data$provider == ds) |> + expat_data() |> extract_expat_repat_data() |> dplyr::select("fyear", "count") }) # extract the repat local data for the current selection repat_local <- shiny::reactive({ - repat_local_data |> + repat_local_data() |> extract_expat_repat_data() |> dplyr::select("fyear", "icb", "provider", "count", "pcnt") }) # extract the repat nonlocal data for the current selection repat_nonlocal <- shiny::reactive({ - repat_nonlocal_data |> + repat_nonlocal_data() |> extract_expat_repat_data() |> dplyr::select( "fyear", diff --git a/R/mod_inequalities_server.R b/R/mod_inequalities_server.R index 484fe87..03f25a9 100644 --- a/R/mod_inequalities_server.R +++ b/R/mod_inequalities_server.R @@ -1,10 +1,17 @@ #' inequalities Server Functions #' #' @noRd -mod_inequalities_server <- function(id, inequalities_data, params) { +mod_inequalities_server <- function(id, params) { shiny::moduleServer(id, function(input, output, session) { ns <- session$ns + inequalities_data <- shiny::reactive({ + provider <- params$dataset + fyear <- params$start_year + + get_inequalities_data(provider, fyear) + }) + mod_reasons_server(shiny::NS(id, "reasons"), params, "inequalities") # This is the data for each HRG split by IMD for the selector provider @@ -12,7 +19,7 @@ mod_inequalities_server <- function(id, inequalities_data, params) { provider_inequalities <- shiny::reactive({ dataset <- shiny::req(params$dataset) # nolint: object_usage_linter - inequalities_data |> + inequalities_data() |> dplyr::filter( .data[["provider"]] == .env[["dataset"]] ) diff --git a/R/mod_mitigators_server.R b/R/mod_mitigators_server.R index 2b0d890..c3ba851 100644 --- a/R/mod_mitigators_server.R +++ b/R/mod_mitigators_server.R @@ -175,7 +175,7 @@ mod_mitigators_server <- function( dplyr::pull(.data$peer) # nolint end - rates_data |> + rates_data() |> dplyr::filter( .data$strategy == .env$strategy, .data$fyear == params$start_year @@ -261,7 +261,7 @@ mod_mitigators_server <- function( # use the rates data, filtered to the provider that has been selected trend_data <- shiny::reactive({ strategy <- shiny::req(input$strategy) - rates_data |> + rates_data() |> dplyr::filter( .data$strategy == .env$strategy, .data$provider == params$dataset @@ -343,21 +343,19 @@ mod_mitigators_server <- function( # render the diagnoses table output$diagnoses_table <- gt::render_gt({ + data <- diagnoses_data() + shiny::validate( shiny::need( - diagnoses_data, + data, message = "Insufficient or suppressed data." ) ) strategy <- shiny::req(input$strategy) - data <- diagnoses_data |> - dplyr::filter( - .data$provider == params$dataset, - .data$strategy == .env$strategy, - .data$fyear == params$start_year - ) |> + data <- data |> + dplyr::filter(.data$strategy == .env$strategy) |> dplyr::inner_join( lookups[["diagnoses"]], by = c("diagnosis" = "diagnosis_code") @@ -432,30 +430,26 @@ mod_mitigators_server <- function( # render the procedures table output$procedures_table <- gt::render_gt({ + data <- procedures_data() + shiny::validate( shiny::need( - procedures_data, + data, message = "Insufficient or suppressed data." ) ) - pd <- procedures_data - shiny::validate( shiny::need( - !is.null(pd) && nrow(pd) > 0, + !is.null(data) && nrow(data) > 0, "No procedures to display" ) ) strategy <- shiny::req(input$strategy) - data <- pd |> - dplyr::filter( - .data$provider == params$dataset, - .data$strategy == .env$strategy, - .data$fyear == params$start_year - ) |> + data <- data |> + dplyr::filter(.data$strategy == .env$strategy) |> dplyr::left_join( lookups[["procedures"]], by = c("procedure_code" = "code") @@ -534,12 +528,8 @@ mod_mitigators_server <- function( # render the age group pyramid plot output$age_grp_plot <- shiny::renderPlot({ strategy <- shiny::req(input$strategy) - age_data <- age_sex_data |> - dplyr::filter( - .data$provider == params$dataset, - .data$strategy == .env$strategy, - .data$fyear == params$start_year - ) + age_data <- age_sex_data() |> + dplyr::filter(.data$strategy == .env$strategy) shiny::req(nrow(age_data) > 0) age_pyramid(age_data) From f1162883b9f52133ea75a20b85aa2cc5fdf53d68 Mon Sep 17 00:00:00 2001 From: Tom Jemmett Date: Mon, 16 Feb 2026 16:56:34 +0000 Subject: [PATCH 17/28] removes need for start reactive --- R/app_server.R | 14 ++------------ 1 file changed, 2 insertions(+), 12 deletions(-) diff --git a/R/app_server.R b/R/app_server.R index 97c41d5..a605e07 100644 --- a/R/app_server.R +++ b/R/app_server.R @@ -10,14 +10,6 @@ app_server <- function(input, output, session) { shiny::reactive(input$params_file) ) - # we could probably drop the need for start now, kept for historical reasons - start <- shiny::reactive({ - shiny::req(length(params) > 0) - shiny::req(params$dataset) - shiny::req(params$scenario) - 1 - }) - # load all data rates_data <- shiny::reactive({ get_rates_data() @@ -46,7 +38,7 @@ app_server <- function(input, output, session) { # load all other modules once the home module has finished loading init <- shiny::observe({ - shiny::req(start() > 0) + shiny::req(params$dataset) available_strategies <- shiny::reactive({ # nolint start: object_usage_linter @@ -130,11 +122,9 @@ app_server <- function(input, output, session) { } init$destroy() - }) |> - shiny::bindEvent(start()) + }) shiny::observe({ - shiny::req(start() > 0) shiny::req(params$dataset) shiny::req(params$scenario) From e15f65efe9019a4d572a78dbb775655265200d42 Mon Sep 17 00:00:00 2001 From: Tom Jemmett Date: Mon, 16 Feb 2026 21:16:43 +0000 Subject: [PATCH 18/28] removes code relating to caching, no longer using caching --- R/app_server.R | 13 ------------- 1 file changed, 13 deletions(-) diff --git a/R/app_server.R b/R/app_server.R index a605e07..69a6413 100644 --- a/R/app_server.R +++ b/R/app_server.R @@ -146,19 +146,6 @@ app_server <- function(input, output, session) { session$allowReconnect("force") } - shiny::observe({ - shiny::req("nhp_devs" %in% session$groups) - - u <- shiny::parseQueryString(session$clientData$url_search) - - shiny::req(!is.null(u$reset_cache)) - cat("reset cache\n") - - dc <- shiny::shinyOptions()$cache - - dc$reset() - }) - # return NULL } From 55ee12abb1f8d3a3bf7092cda708ce2976f5159c Mon Sep 17 00:00:00 2001 From: Tom Jemmett Date: Mon, 16 Feb 2026 21:18:06 +0000 Subject: [PATCH 19/28] removes other unused code --- R/app_server.R | 5 ----- 1 file changed, 5 deletions(-) diff --git a/R/app_server.R b/R/app_server.R index 69a6413..390cf03 100644 --- a/R/app_server.R +++ b/R/app_server.R @@ -141,11 +141,6 @@ app_server <- function(input, output, session) { jsonlite::write_json(file, pretty = TRUE, auto_unbox = TRUE) }) - if (as.logical(Sys.getenv("ENABLE_AUTO_RECONNECT", FALSE))) { - cat("auto reconnect enabled\n") - session$allowReconnect("force") - } - # return NULL } From aca66b183ee2cff581721ac1afd5817140e02720 Mon Sep 17 00:00:00 2001 From: Tom Jemmett Date: Mon, 16 Feb 2026 21:49:58 +0000 Subject: [PATCH 20/28] passes reactive, not evaluated value --- R/app_server.R | 2 +- R/mod_mitigators_summary_server.R | 8 +------- 2 files changed, 2 insertions(+), 8 deletions(-) diff --git a/R/app_server.R b/R/app_server.R index 390cf03..29f118c 100644 --- a/R/app_server.R +++ b/R/app_server.R @@ -83,7 +83,7 @@ app_server <- function(input, output, session) { mod_non_demographic_adjustment_server("non_demographic_adjustment", params) - mod_mitigators_summary_server("mitigators_summary", age_sex_data(), params) + mod_mitigators_summary_server("mitigators_summary", age_sex_data, params) purrr::walk( c( diff --git a/R/mod_mitigators_summary_server.R b/R/mod_mitigators_summary_server.R index a688a96..6d43a2e 100644 --- a/R/mod_mitigators_summary_server.R +++ b/R/mod_mitigators_summary_server.R @@ -4,19 +4,13 @@ mod_mitigators_summary_server <- function(id, age_sex_data, params) { shiny::moduleServer(id, function(input, output, session) { mitigators_summary <- shiny::reactive({ - year <- as.character(shiny::req(params$start_year)) - strategy_codes <- dplyr::select( get_lookups()[["mitigators"]], "strategy_name" = "strategy_name_full", "strategy" ) - age_sex_data |> - dplyr::filter( - .data[["fyear"]] == year, - .data[["provider"]] == params$dataset - ) |> + age_sex_data() |> dplyr::count( .data[["strategy"]], wt = .data[["n"]], From cc1fffb18899bb91df4a15e6eb47287af0cfeafe Mon Sep 17 00:00:00 2001 From: Tom Jemmett Date: Mon, 16 Feb 2026 21:50:44 +0000 Subject: [PATCH 21/28] fixes some potential schema validation bugs --- R/ZZZ.R | 13 ++++--------- R/mod_run_model_remove_invalid_mitigators.R | 8 +++++++- 2 files changed, 11 insertions(+), 10 deletions(-) diff --git a/R/ZZZ.R b/R/ZZZ.R index 42f4728..c41bd5b 100644 --- a/R/ZZZ.R +++ b/R/ZZZ.R @@ -90,10 +90,7 @@ download_params_schema <- function( data_path = app_sys("app", "data"), app_version = Sys.getenv("INPUTS_DATA_VERSION", "dev") ) { - file_path <- file.path( - data_path, - glue::glue("params-schema.json") - ) + file_path <- file.path(data_path, "params-schema.json") params_schema <- httr2::request( "https://the-strategy-unit.github.io" @@ -111,12 +108,10 @@ download_params_schema <- function( get_params_schema <- function( app_version = Sys.getenv("INPUTS_DATA_VERSION", "dev") ) { - file_path <- app_sys("app", "data", glue::glue("params-schema.json")) - - schema_text <- readr::read_file(file_path) - if (!exists("schema", envir = .schema_cache)) { - .schema_cache[["schema"]] <- jsonvalidate::json_schema$new(schema_text) + .schema_cache[["schema"]] <- app_sys("app", "data", "params-schema.json") |> + readr::read_file() |> + jsonvalidate::json_schema$new() } .schema_cache[["schema"]] } diff --git a/R/mod_run_model_remove_invalid_mitigators.R b/R/mod_run_model_remove_invalid_mitigators.R index 676abee..e44deed 100644 --- a/R/mod_run_model_remove_invalid_mitigators.R +++ b/R/mod_run_model_remove_invalid_mitigators.R @@ -3,7 +3,13 @@ mod_run_model_remove_invalid_mitigators <- function(p) { json_p <- jsonlite::toJSON(p, auto_unbox = TRUE) - paths <- schema$validate(json_p, verbose = TRUE) |> + validate <- schema$validate(json_p, verbose = TRUE) + + if (validate) { + return(p) + } + + paths <- validate |> attr("errors") |> dplyr::filter( .data[["keyword"]] == "additionalProperties", From de3b1a637c2307fd05310a0f1078c7964cf6e454 Mon Sep 17 00:00:00 2001 From: Tom Jemmett Date: Mon, 16 Feb 2026 22:17:26 +0000 Subject: [PATCH 22/28] runs devtools::document --- man/download_provider_data.Rd | 29 +++++++++++++++++++++++++++++ man/get_all_data_files.Rd | 17 +++++++++++++++++ man/load_provider_data.Rd | 7 ++----- 3 files changed, 48 insertions(+), 5 deletions(-) create mode 100644 man/download_provider_data.Rd create mode 100644 man/get_all_data_files.Rd diff --git a/man/download_provider_data.Rd b/man/download_provider_data.Rd new file mode 100644 index 0000000..4e7b157 --- /dev/null +++ b/man/download_provider_data.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/fct_azure_storage.R +\name{download_provider_data} +\alias{download_provider_data} +\title{Download Provider Data} +\usage{ +download_provider_data( + file, + data_path = app_sys("app", "data"), + inputs_data_version = Sys.getenv("NHP_INPUTS_DATA_VERSION", "dev"), + ... +) +} +\arguments{ +\item{file}{The name of the file to download.} + +\item{data_path}{The path to the app's data directory.} + +\item{inputs_data_version}{The version of the inputs data to use.} + +\item{...}{Additional arguments to pass to `AzureStor::download_adls_file()`.} +} +\value{ +The path to the downloaded file. +} +\description{ +Download a selected type of provider data from ADLS and save it as a parquet +file in the app's data directory. +} diff --git a/man/get_all_data_files.Rd b/man/get_all_data_files.Rd new file mode 100644 index 0000000..60f7323 --- /dev/null +++ b/man/get_all_data_files.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/fct_azure_storage.R +\name{get_all_data_files} +\alias{get_all_data_files} +\title{Get All Data Files} +\usage{ +get_all_data_files( + inputs_data_version = Sys.getenv("NHP_INPUTS_DATA_VERSION", "dev") +) +} +\arguments{ +\item{inputs_data_version}{The version of the inputs data to use.} +} +\description{ +Download all provider data files from ADLS and save them as parquet files in +the app's data directory. +} diff --git a/man/load_provider_data.Rd b/man/load_provider_data.Rd index 6f07199..46c96cf 100644 --- a/man/load_provider_data.Rd +++ b/man/load_provider_data.Rd @@ -1,13 +1,10 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/fct_azure_storage.R +% Please edit documentation in R/fct_load_provider_data.R \name{load_provider_data} \alias{load_provider_data} \title{Get Provider Data} \usage{ -load_provider_data( - file, - inputs_data_version = Sys.getenv("NHP_INPUTS_DATA_VERSION", "dev") -) +load_provider_data(file, data_path = app_sys("app", "data")) } \arguments{ \item{file}{The name of the file to read.} From 35fb520d759d32685593a157b0885e12372c40bd Mon Sep 17 00:00:00 2001 From: Tom Jemmett Date: Thu, 21 May 2026 09:23:05 +0100 Subject: [PATCH 23/28] ensures sex column is a character --- R/fct_load_provider_data.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/fct_load_provider_data.R b/R/fct_load_provider_data.R index b4ff9c2..3651b13 100644 --- a/R/fct_load_provider_data.R +++ b/R/fct_load_provider_data.R @@ -46,6 +46,7 @@ get_age_sex_data <- function(provider, fyear) { .data$fyear == .env$fyear ) |> dplyr::mutate( + dplyr::across("sex", as.character), age_group = factor( .data[["age_group"]], levels = .env[["age_fct"]] From 335bea4044649224d8a10bed511653d43d2815eb Mon Sep 17 00:00:00 2001 From: Tom Jemmett Date: Thu, 21 May 2026 09:40:26 +0100 Subject: [PATCH 24/28] moves data to app_data folder from inst --- .gitignore | 2 +- R/ZZZ.R | 4 ++-- R/fct_azure_storage.R | 4 ++-- R/fct_load_provider_data.R | 2 +- R/run_app.R | 2 +- man/download_provider_data.Rd | 2 +- man/load_provider_data.Rd | 2 +- 7 files changed, 9 insertions(+), 9 deletions(-) diff --git a/.gitignore b/.gitignore index 1d4945f..35240a6 100644 --- a/.gitignore +++ b/.gitignore @@ -19,4 +19,4 @@ inputs_selection_app/ .cache/ tmp/ -inst/app/data/ \ No newline at end of file +app_data/ \ No newline at end of file diff --git a/R/ZZZ.R b/R/ZZZ.R index c41bd5b..40c9dbb 100644 --- a/R/ZZZ.R +++ b/R/ZZZ.R @@ -87,7 +87,7 @@ encrypt_filename <- function( } download_params_schema <- function( - data_path = app_sys("app", "data"), + data_path = "app_data", app_version = Sys.getenv("INPUTS_DATA_VERSION", "dev") ) { file_path <- file.path(data_path, "params-schema.json") @@ -109,7 +109,7 @@ get_params_schema <- function( app_version = Sys.getenv("INPUTS_DATA_VERSION", "dev") ) { if (!exists("schema", envir = .schema_cache)) { - .schema_cache[["schema"]] <- app_sys("app", "data", "params-schema.json") |> + .schema_cache[["schema"]] <- file.path("app_data", "params-schema.json") |> readr::read_file() |> jsonvalidate::json_schema$new() } diff --git a/R/fct_azure_storage.R b/R/fct_azure_storage.R index e5a461c..d4c28d2 100644 --- a/R/fct_azure_storage.R +++ b/R/fct_azure_storage.R @@ -11,7 +11,7 @@ #' @return The path to the downloaded file. download_provider_data <- function( file, - data_path = app_sys("app", "data"), + data_path = file.path("app_data"), inputs_data_version = Sys.getenv("NHP_INPUTS_DATA_VERSION", "dev"), ... ) { @@ -48,7 +48,7 @@ get_adls_fs <- function() { get_all_data_files <- function( inputs_data_version = Sys.getenv("NHP_INPUTS_DATA_VERSION", "dev") ) { - data_path <- file.path("inst", "app", "data") + data_path <- file.path("app_data") if (!dir.exists(data_path)) { dir.create(data_path, recursive = TRUE) } diff --git a/R/fct_load_provider_data.R b/R/fct_load_provider_data.R index 3651b13..5ec1aed 100644 --- a/R/fct_load_provider_data.R +++ b/R/fct_load_provider_data.R @@ -7,7 +7,7 @@ #' @param file The name of the file to read. #' @param inputs_data_version The version of the inputs data to use. #' @return A tibble. -load_provider_data <- function(file, data_path = app_sys("app", "data")) { +load_provider_data <- function(file, data_path = file.path("app_data")) { if (!exists(file, envir = .data_cache)) { .data_cache[[file]] <- file.path(data_path, glue::glue("{file}.parquet")) |> arrow::read_parquet() |> diff --git a/R/run_app.R b/R/run_app.R index fa3fe16..582e681 100644 --- a/R/run_app.R +++ b/R/run_app.R @@ -24,7 +24,7 @@ run_app <- function( # check files exist before starting app # TODO: consider more rigorous checks, e.g. specific files exist, or number of files - if (!dir.exists(file.path(app_sys("app"), "data"))) { + if (!dir.exists(file.path("app_data"))) { cat("Initialising data directory...\n") get_all_data_files() } diff --git a/man/download_provider_data.Rd b/man/download_provider_data.Rd index 4e7b157..c168d0c 100644 --- a/man/download_provider_data.Rd +++ b/man/download_provider_data.Rd @@ -6,7 +6,7 @@ \usage{ download_provider_data( file, - data_path = app_sys("app", "data"), + data_path = file.path("app_data"), inputs_data_version = Sys.getenv("NHP_INPUTS_DATA_VERSION", "dev"), ... ) diff --git a/man/load_provider_data.Rd b/man/load_provider_data.Rd index 46c96cf..4499879 100644 --- a/man/load_provider_data.Rd +++ b/man/load_provider_data.Rd @@ -4,7 +4,7 @@ \alias{load_provider_data} \title{Get Provider Data} \usage{ -load_provider_data(file, data_path = app_sys("app", "data")) +load_provider_data(file, data_path = file.path("app_data")) } \arguments{ \item{file}{The name of the file to read.} From 1ac10c3a452bf81d76e3783b66a59e4c27deff9e Mon Sep 17 00:00:00 2001 From: Tom Jemmett Date: Thu, 21 May 2026 09:50:41 +0100 Subject: [PATCH 25/28] fix some copilot comments --- R/ZZZ.R | 4 +--- R/fct_load_provider_data.R | 2 +- man/load_provider_data.Rd | 2 +- 3 files changed, 3 insertions(+), 5 deletions(-) diff --git a/R/ZZZ.R b/R/ZZZ.R index 40c9dbb..ccc71e0 100644 --- a/R/ZZZ.R +++ b/R/ZZZ.R @@ -105,9 +105,7 @@ download_params_schema <- function( } .schema_cache <- new.env() -get_params_schema <- function( - app_version = Sys.getenv("INPUTS_DATA_VERSION", "dev") -) { +get_params_schema <- function() { if (!exists("schema", envir = .schema_cache)) { .schema_cache[["schema"]] <- file.path("app_data", "params-schema.json") |> readr::read_file() |> diff --git a/R/fct_load_provider_data.R b/R/fct_load_provider_data.R index 5ec1aed..03eac7b 100644 --- a/R/fct_load_provider_data.R +++ b/R/fct_load_provider_data.R @@ -5,7 +5,7 @@ #' Read the parquet file containing a selected type of provider data. #' #' @param file The name of the file to read. -#' @param inputs_data_version The version of the inputs data to use. +#' @param data_path The path to the directory containing the parquet files. #' @return A tibble. load_provider_data <- function(file, data_path = file.path("app_data")) { if (!exists(file, envir = .data_cache)) { diff --git a/man/load_provider_data.Rd b/man/load_provider_data.Rd index 4499879..b0cd536 100644 --- a/man/load_provider_data.Rd +++ b/man/load_provider_data.Rd @@ -9,7 +9,7 @@ load_provider_data(file, data_path = file.path("app_data")) \arguments{ \item{file}{The name of the file to read.} -\item{inputs_data_version}{The version of the inputs data to use.} +\item{data_path}{The path to the directory containing the parquet files.} } \value{ A tibble. From 13fa4a6dbfbec16da07ef5dabf5ee10249bb7c82 Mon Sep 17 00:00:00 2001 From: Tom Jemmett Date: Thu, 21 May 2026 11:04:20 +0100 Subject: [PATCH 26/28] fixes issue with using the config$param_items reverted to what we had before, except without the handling of function calls --- R/mod_mitigators_server.R | 29 ++++++++++++++++------------- 1 file changed, 16 insertions(+), 13 deletions(-) diff --git a/R/mod_mitigators_server.R b/R/mod_mitigators_server.R index c3ba851..c033128 100644 --- a/R/mod_mitigators_server.R +++ b/R/mod_mitigators_server.R @@ -79,21 +79,24 @@ mod_mitigators_server <- function( _[strategies] |> purrr::map("interval") - purrr::walk(strategies, \(i) { - slider_values[[mitigators_type]][[i]] <- c( - # add the additional param items if they exist. - config$params_items, - list( - interval = loaded_values[[i]] %||% default_interval + strategies |> + purrr::walk(\(i) { + slider_values[[mitigators_type]][[i]] <- c( + # add the additional param items if they exist. + + # if the additional item is a list, chose the value for the current strategy + purrr::map_if(config$params_items, is.list, ~ .x[[i]]), + list( + interval = loaded_values[[i]] %||% default_interval + ) ) - ) - params[[mitigators_type]][[activity_type]][[i]] <- if ( - !is.null(loaded_values[[i]]) - ) { - slider_values[[mitigators_type]][[i]] - } - }) + params[[mitigators_type]][[activity_type]][[i]] <- if ( + !is.null(loaded_values[[i]]) + ) { + slider_values[[mitigators_type]][[i]] + } + }) }, priority = 100 ) |> From a46c849ccd6d0859f09f2ca809ade22919e28f85 Mon Sep 17 00:00:00 2001 From: Tom Jemmett Date: Thu, 21 May 2026 11:07:19 +0100 Subject: [PATCH 27/28] removes unused function/code --- R/ZZZ.R | 20 -------------------- 1 file changed, 20 deletions(-) diff --git a/R/ZZZ.R b/R/ZZZ.R index ccc71e0..5cf6b37 100644 --- a/R/ZZZ.R +++ b/R/ZZZ.R @@ -16,12 +16,6 @@ sanitize_input_name <- function(.x) { stringr::str_remove_all("[^a-z0-9-]+") } -# suppress vs code / languageserver "no visible binding" warnings -if (FALSE) { - .data <- NULL - .env <- NULL -} - md_file_to_html <- function(...) { file <- app_sys(...) @@ -72,20 +66,6 @@ is_local <- function() { Sys.getenv("SHINY_PORT") == "" || !getOption("golem.app.prod", TRUE) } -encrypt_filename <- function( - filename, - key_b64 = Sys.getenv("NHP_ENCRYPT_KEY") -) { - key <- openssl::base64_decode(key_b64) - - f <- charToRaw(filename) - - ct <- openssl::aes_cbc_encrypt(f, key, NULL) - hm <- as.raw(openssl::sha256(ct, key)) - - openssl::base64_encode(c(hm, ct)) -} - download_params_schema <- function( data_path = "app_data", app_version = Sys.getenv("INPUTS_DATA_VERSION", "dev") From cd3cfe5fa9413533857a03481e12509e624f88e5 Mon Sep 17 00:00:00 2001 From: Tom Jemmett Date: Wed, 10 Jun 2026 14:36:37 +0100 Subject: [PATCH 28/28] adds in a missing comment after rebasing --- R/mod_mitigators_server.R | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/R/mod_mitigators_server.R b/R/mod_mitigators_server.R index c033128..977297f 100644 --- a/R/mod_mitigators_server.R +++ b/R/mod_mitigators_server.R @@ -220,6 +220,10 @@ mod_mitigators_server <- function( }) |> shiny::bindEvent(input$slider, input$include) + # enable/disable the slider depending on whether the "include?" checkbox is + # checked + # + # runs when the include checkbox is changed shiny::observe({ shinyjs::toggleState("slider", condition = input$include) }) |>