Merge pull request #45 from The-Strategy-Unit/33-config

Use NHP-inputs config for dynamic axes labelling

Author: matt-dray

.Renviron.example

@@ -1,4 +1,9 @@
+# To run app locally and in deployment
 AZ_CONTAINER_INPUTS=
 AZ_STORAGE_EP=
+AZ_SUPPORT_CONTAINER=
+BASELINE_YEAR=
 DATA_VERSION=
-START_YEAR=
+# To run app locally
+AZ_APP_ID=
+AZ_TENANT_ID=

NAMESPACE

@@ -5,7 +5,9 @@ export(entable_encounters)
 export(fetch_strategy_text)
 export(generate_rates_baseline_data)
 export(generate_rates_funnel_data)
+export(get_golem_config)
 export(isolate_provider_peers)
+export(make_strategy_group_lookup)
 export(plot_age_sex_pyramid)
 export(plot_nee)
 export(plot_rates_box)

R/app_server.R

@@ -5,10 +5,10 @@ app_server <- function(input, output, session) {
   # Env variables ----
   inputs_container_name <- Sys.getenv("AZ_CONTAINER_INPUTS")
   data_version <- Sys.getenv("DATA_VERSION")
-  start_year <- Sys.getenv("START_YEAR") |> as.numeric()
+  baseline_year <- Sys.getenv("BASELINE_YEAR") |> as.numeric()
 
   # Data ----
-  inputs_container <- azkit::get_container(inputs_container_name)
+  inputs_container <- get_container(container_name = inputs_container_name)
   rates_data <- azkit::read_azure_parquet(
     inputs_container,
     "rates",
@@ -61,6 +61,9 @@ app_server <- function(input, output, session) {
     col_types = "c"
   )
 
+  # Config ----
+  strategies_config <- get_golem_config("mitigators_config")
+
   # User inputs ----
   selected_provider <- mod_select_provider_server(
     "mod_select_provider",
@@ -80,32 +83,34 @@ app_server <- function(input, output, session) {
   mod_plot_rates_server(
     "mod_plot_rates",
     rates_data,
+    strategies_config,
     peers_lookup,
     selected_provider,
-    selected_strategy
+    selected_strategy,
+    baseline_year
   )
   mod_table_procedures_server(
     "mod_table_procedures",
     procedures_data,
     procedures_lookup,
     selected_provider,
     selected_strategy,
-    start_year
+    baseline_year
   )
   mod_table_diagnoses_server(
     "mod_table_diagnoses",
     diagnoses_data,
     diagnoses_lookup,
     selected_provider,
     selected_strategy,
-    start_year
+    baseline_year
   )
   mod_plot_age_sex_pyramid_server(
     "mod_plot_age_sex_pyramid",
     age_sex_data,
     selected_provider,
     selected_strategy,
-    start_year
+    baseline_year
   )
   mod_plot_nee_server(
     "mod_plot_nee",

R/fct_azure.R

@@ -0,0 +1,23 @@
+get_container <- function(
+  tenant = Sys.getenv("AZ_TENANT_ID"),
+  app_id = Sys.getenv("AZ_APP_ID"),
+  ep_uri = Sys.getenv("AZ_STORAGE_EP"),
+  container_name = Sys.getenv("AZ_CONTAINER_INPUTS")
+) {
+  # if the app_id variable is empty, we assume that this is running on an Azure
+  # VM, and then we will use Managed Identities for authentication.
+  token <- if (app_id != "") {
+    AzureAuth::get_azure_token(
+      resource = "https://storage.azure.com",
+      tenant = tenant,
+      app = app_id,
+      auth_type = "device_code",
+      use_cache = TRUE # avoid browser-authorisation prompt
+    )
+  } else {
+    AzureAuth::get_managed_token("https://storage.azure.com/")
+  }
+  ep_uri |>
+    AzureStor::blob_endpoint(token = token) |>
+    AzureStor::storage_container(container_name)
+}

R/fct_plots.R

@@ -1,18 +1,18 @@
 #' Plot Rates Trend Over Time
 #' @param rates_trend_data A data.frame. Rates data read in from Azure, filtered
 #'     for a given provider and strategy, and arranged by year.
-#' @param baseline_year Numeric. In the form `202324`.
+#' @param baseline_year Integer. Baseline year in the form `202324`.
+#' @param y_axis_limits Numeric vector. Min and max values for the y axis.
 #' @param x_axis_title Character. Title for the x-axis.
 #' @param y_axis_title Character. Title for the y-axis.
-#' @param y_axis_limits Numeric vector. Min and max values for the y axis.
 #' @return A 'ggplot2' object.
 #' @export
 plot_rates_trend <- function(
   rates_trend_data,
-  baseline_year = 202324,
+  baseline_year,
+  y_axis_limits,
   x_axis_title = "Financial year",
-  y_axis_title = "Rate",
-  y_axis_limits
+  y_axis_title
 ) {
   rates_trend_data |>
     ggplot2::ggplot(

R/mod_plot_age_sex_pyramid.R

@@ -18,6 +18,7 @@ mod_plot_age_sex_pyramid_ui <- function(id) {
 #' @param selected_provider Character. Provider code, e.g. `"RCF"`.
 #' @param selected_strategy Character. Strategy variable name, e.g.
 #'     `"alcohol_partially_attributable_acute"`.
+#' @param baseline_year Integer. Baseline year in the form `202324`.
 #' @noRd
 # nolint start: object_length_linter.
 mod_plot_age_sex_pyramid_server <- function(
@@ -26,20 +27,20 @@ mod_plot_age_sex_pyramid_server <- function(
   age_sex_data,
   selected_provider,
   selected_strategy,
-  start_year
+  baseline_year
 ) {
   shiny::moduleServer(id, function(input, output, session) {
     output$age_sex_pyramid <- shiny::renderPlot({
       shiny::req(age_sex_data)
       shiny::req(selected_provider())
       shiny::req(selected_strategy())
-      shiny::req(start_year)
+      shiny::req(baseline_year)
 
       age_sex_filtered <- age_sex_data |>
         dplyr::filter(
           .data$provider == selected_provider(),
           .data$strategy == selected_strategy(),
-          .data$fyear == .env$start_year
+          .data$fyear == .env$baseline_year
         )
 
       shiny::validate(shiny::need(

R/mod_plot_rates.R

@@ -3,7 +3,7 @@
 #' @noRd
 mod_plot_rates_ui <- function(id) {
   ns <- shiny::NS(id)
-  # these plots share a y axis, so don't use layout_column_wrap()
+  # Rates plots share a y-axis, so don't wrap
   bslib::layout_columns(
     col_widths = c(5, 5, 2),
     fill = FALSE,
@@ -18,19 +18,27 @@ mod_plot_rates_ui <- function(id) {
 #' @param id Internal parameter for `shiny`.
 #' @param rates A data.frame. Annual rate values for combinations of provider
 #'     and strategy.
+#' @param strategies_config List. Configuration for strategies from the
+#'     `"mitigators_config"` element of `golem-config.yml`, read in with
+#'     [get_golem_config].
 #' @param peers_lookup A data.frame. A row per provider-peer pair.
 #' @param selected_provider Character. Provider code, e.g. `"RCF"`.
 #' @param selected_strategy Character. Strategy variable name, e.g.
 #'     `"alcohol_partially_attributable_acute"`.
+#' @param baseline_year Integer. Baseline year in the form `202324`.
 #' @noRd
 mod_plot_rates_server <- function(
   id,
   rates,
+  strategies_config,
   peers_lookup,
   selected_provider,
-  selected_strategy
+  selected_strategy,
+  baseline_year
 ) {
   shiny::moduleServer(id, function(input, output, session) {
+    #  Prepare data ----
+
     rates_trend_data <- shiny::reactive({
       shiny::req(rates)
       shiny::req(selected_provider())
@@ -59,7 +67,7 @@ mod_plot_rates_server <- function(
           selected_provider(),
           provider_peers,
           selected_strategy(),
-          start_year = "202324"
+          baseline_year
         )
     })
 
@@ -68,6 +76,8 @@ mod_plot_rates_server <- function(
       rates_baseline_data() |> generate_rates_funnel_data()
     })
 
+    # Prepare variables ----
+
     y_axis_limits <- shiny::reactive({
       shiny::req(rates_trend_data())
       shiny::req(rates_funnel_data())
@@ -80,27 +90,47 @@ mod_plot_rates_server <- function(
         pmax(0)
     })
 
+    strategy_config <- shiny::reactive({
+      shiny::req(strategies_config)
+      shiny::req(selected_strategy())
+
+      strategy_group_lookup <- strategies_config |> make_strategy_group_lookup()
+
+      strategy_group <- strategy_group_lookup |>
+        dplyr::filter(.data$strategy == selected_strategy()) |>
+        dplyr::pull("group")
+
+      strategies_config[[strategy_group]]
+    })
+
+    y_axis_title <- shiny::reactive({
+      shiny::req(strategy_config())
+      strategy_config()[["y_axis_title"]]
+    })
+    funnel_x_title <- shiny::reactive({
+      shiny::req(strategy_config())
+      strategy_config()[["funnel_x_title"]]
+    })
+
+    # Declare modules ----
     mod_plot_rates_trend_server(
       "mod_plot_rates_trend",
       rates_trend_data,
-      selected_provider,
-      selected_strategy,
-      y_axis_limits
+      y_axis_limits,
+      y_axis_title,
+      baseline_year
     )
     mod_plot_rates_funnel_server(
       "mod_plot_rates_funnel",
       rates_funnel_data,
       peers_lookup,
-      selected_provider,
-      selected_strategy,
-      y_axis_limits
+      y_axis_limits,
+      funnel_x_title
     )
     mod_plot_rates_box_server(
       "mod_plot_rates_box",
       rates_baseline_data,
       peers_lookup,
-      selected_provider,
-      selected_strategy,
       y_axis_limits
     )
   })

R/mod_plot_rates_box.R

@@ -15,17 +15,12 @@ mod_plot_rates_box_ui <- function(id) {
 #' @param rates A data.frame. Annual rate values for combinations of provider
 #'     and strategy.
 #' @param peers_lookup A data.frame. A row per provider-peer pair.
-#' @param selected_provider Character. Provider code, e.g. `"RCF"`.
-#' @param selected_strategy Character. Strategy variable name, e.g.
-#'     `"alcohol_partially_attributable_acute"`.
 #' @param y_axis_limits Numeric vector. Min and max values for the y axis.
 #' @noRd
 mod_plot_rates_box_server <- function(
   id,
   rates,
   peers_lookup,
-  selected_provider,
-  selected_strategy,
   y_axis_limits
 ) {
   shiny::moduleServer(id, function(input, output, session) {

R/mod_plot_rates_funnel.R

@@ -15,18 +15,15 @@ mod_plot_rates_funnel_ui <- function(id) {
 #' @param rates A data.frame. Annual rate values for combinations of provider
 #'     and strategy
 #' @param peers_lookup A data.frame. A row per provider-peer pair.
-#' @param selected_provider Character. Provider code, e.g. `"RCF"`.
-#' @param selected_strategy Character. Strategy variable name, e.g.
-#'     `"alcohol_partially_attributable_acute"`.
 #' @param y_axis_limits Numeric vector. Min and max values for the y axis.
+#' @param x_axis_title Character. Title for the x-axis.
 #' @noRd
 mod_plot_rates_funnel_server <- function(
   id,
   rates,
   peers_lookup,
-  selected_provider,
-  selected_strategy,
-  y_axis_limits
+  y_axis_limits,
+  x_axis_title
 ) {
   shiny::moduleServer(id, function(input, output, session) {
     output$rates_funnel_plot <- shiny::renderPlot({
@@ -35,10 +32,13 @@ mod_plot_rates_funnel_server <- function(
         nrow(rates) > 0,
         "No data available for these selections."
       ))
+      shiny::req(y_axis_limits())
+      shiny::req(x_axis_title())
+
       plot_rates_funnel(
         rates,
         y_axis_limits(),
-        x_axis_title = "Denominator" # TODO: make this dynamic
+        x_axis_title = x_axis_title()
       )
     })
   })

R/mod_plot_rates_trend.R

@@ -14,17 +14,16 @@ mod_plot_rates_trend_ui <- function(id) {
 #' @param id Internal parameter for `shiny`.
 #' @param rates A data.frame. Annual rate values for combinations of provider
 #'     and strategy.
-#' @param selected_provider Character. Provider code, e.g. `"RCF"`.
-#' @param selected_strategy Character. Strategy variable name, e.g.
-#'     `"alcohol_partially_attributable_acute"`.
 #' @param y_axis_limits Numeric vector. Min and max values for the y axis.
+#' @param y_axis_title Character. Title for the y-axis.
+#' @param baseline_year Integer. Baseline year in the form `202324`.
 #' @noRd
 mod_plot_rates_trend_server <- function(
   id,
   rates,
-  selected_provider,
-  selected_strategy,
-  y_axis_limits
+  y_axis_limits,
+  y_axis_title,
+  baseline_year
 ) {
   shiny::moduleServer(id, function(input, output, session) {
     output$rates_trend_plot <- shiny::renderPlot({
@@ -33,7 +32,15 @@ mod_plot_rates_trend_server <- function(
         nrow(rates) > 0,
         "No data available for these selections."
       ))
-      plot_rates_trend(rates, y_axis_limits = y_axis_limits())
+      shiny::req(y_axis_limits())
+      shiny::req(y_axis_title())
+
+      plot_rates_trend(
+        rates,
+        baseline_year,
+        y_axis_limits(),
+        y_axis_title = y_axis_title()
+      )
     })
   })
 }