Merge pull request #73 from The-Strategy-Unit/use-new-rates-data-format

use new rates data format

Author: tomjemmett

.gitignore

@@ -253,3 +253,5 @@ poetry.toml
 pyrightconfig.json
 
 /.quarto/
+
+.cache/

R/app_server.R

@@ -2,6 +2,12 @@
 #' @param input,output,session Internal parameters for 'shiny'.
 #' @noRd
 app_server <- function(input, output, session) {
+  cache <- cachem::cache_disk(".cache")
+  inputs_data_fn <- memoise::memoise(
+    get_all_geo_data,
+    cache = cache
+  )
+
   # Variables ----
   geographies <- c(
     "New Hospital Programme (NHP) schemes" = "nhp",
@@ -11,26 +17,40 @@ app_server <- function(input, output, session) {
   baseline_year <- Sys.getenv("BASELINE_YEAR") |> as.numeric()
 
   # Data ----
-  inputs_container <- get_container(
-    container_name = Sys.getenv("AZ_CONTAINER_INPUTS")
-  )
-  inputs_data <- get_all_geo_data(inputs_container, geographies, data_types)
+  inputs_data <- inputs_data_fn(geographies, data_types)
   age_sex_data <- shiny::reactive({
-    shiny::req(selected_geography())
-    inputs_data[[selected_geography()]][["age_sex"]] |>
+    sg <- shiny::req(selected_geography())
+    inputs_data[[sg]][["age_sex"]] |>
       prepare_age_sex_data()
   })
   diagnoses_data <- shiny::reactive({
-    shiny::req(selected_geography())
-    inputs_data[[selected_geography()]][["diagnoses"]]
+    sg <- shiny::req(selected_geography())
+    inputs_data[[sg]][["diagnoses"]]
   })
   procedures_data <- shiny::reactive({
-    shiny::req(selected_geography())
-    inputs_data[[selected_geography()]][["procedures"]]
+    sg <- shiny::req(selected_geography())
+    inputs_data[[sg]][["procedures"]]
   })
   rates_data <- shiny::reactive({
-    shiny::req(selected_geography())
-    inputs_data[[selected_geography()]][["rates"]]
+    sg <- shiny::req(selected_geography())
+    df <- inputs_data[[sg]][["rates"]]
+
+    national <- df |>
+      dplyr::filter(.data$provider == "national") |>
+      dplyr::select(
+        "strategy",
+        "fyear",
+        national_rate = "std_rate"
+      )
+
+    df |>
+      dplyr::filter(!.data$provider %in% c("national", "unknown")) |>
+      dplyr::inner_join(
+        national,
+        by = c("strategy", "fyear")
+      ) |>
+      dplyr::rename(rate = "std_rate") |>
+      dplyr::select(-"crude_rate")
   })
   nee_data <- readr::read_csv(
     app_sys("app", "data", "nee_table.csv"),
@@ -118,7 +138,8 @@ app_server <- function(input, output, session) {
   mod_show_strategy_text_server(
     "mod_show_strategy_text",
     descriptions_lookup,
-    selected_strategy
+    selected_strategy,
+    cache
   )
   mod_plot_rates_server(
     "mod_plot_rates",

R/fct_azure.R

@@ -7,24 +7,25 @@
 #' @return A blob_container/storage_container list.
 #' @export
 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/")
-  }
+
+  token <- tryCatch(
+    {
+      AzureAuth::get_managed_token("https://storage.azure.com/")
+    },
+    error = function(...) {
+      AzureAuth::get_azure_token(
+        resource = "https://storage.azure.com",
+        tenant = "common",
+        app = "04b07795-8ddb-461a-bbee-02f9e1bf7b46",
+        use_cache = TRUE # avoid browser-authorisation prompt
+      )
+    }
+  )
   ep_uri |>
     AzureStor::blob_endpoint(token = token) |>
     AzureStor::storage_container(container_name)

R/fct_plots.R

@@ -5,14 +5,16 @@
 #' @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_labels A function. Function to format y-axis labels.
 #' @return A 'ggplot2' object.
 #' @export
 plot_rates_trend <- function(
   rates_trend_data,
   baseline_year,
   y_axis_limits,
   x_axis_title = "Financial year",
-  y_axis_title
+  y_axis_title,
+  y_labels
 ) {
   rates_trend_data |>
     ggplot2::ggplot(
@@ -23,8 +25,7 @@ plot_rates_trend <- function(
       data = \(.x) dplyr::filter(.x, .data[["fyear"]] == baseline_year),
       colour = "red"
     ) +
-    # TODO: add labels = number_format to scale_y_continuous
-    ggplot2::scale_y_continuous(name = y_axis_title) +
+    ggplot2::scale_y_continuous(name = y_axis_title, labels = y_labels) +
     ggplot2::coord_cartesian(ylim = y_axis_limits) +
     ggplot2::scale_x_discrete(
       labels = \(.x) stringr::str_replace(.x, "^(\\d{4})(\\d{2})$", "\\1/\\2")

R/mod_plot_rates.R

@@ -107,6 +107,10 @@ mod_plot_rates_server <- function(
       shiny::req(strategy_config())
       strategy_config()[["y_axis_title"]]
     })
+    y_labels <- shiny::reactive({
+      shiny::req(strategy_config())
+      strategy_config()[["number_type"]]
+    })
     funnel_x_title <- shiny::reactive({
       shiny::req(strategy_config())
       strategy_config()[["funnel_x_title"]]
@@ -118,6 +122,7 @@ mod_plot_rates_server <- function(
       rates_trend_data,
       y_axis_limits,
       y_axis_title,
+      y_labels,
       baseline_year
     )
     mod_plot_rates_funnel_server(

R/mod_plot_rates_trend.R

@@ -20,13 +20,15 @@ mod_plot_rates_trend_ui <- function(id) {
 #'     and strategy.
 #' @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 y_labels Function. Function to format y-axis labels.
 #' @param baseline_year Integer. Baseline year in the form `202324`.
 #' @noRd
 mod_plot_rates_trend_server <- function(
   id,
   rates,
   y_axis_limits,
   y_axis_title,
+  y_labels,
   baseline_year
 ) {
   shiny::moduleServer(id, function(input, output, session) {
@@ -42,7 +44,8 @@ mod_plot_rates_trend_server <- function(
         rates(),
         baseline_year,
         y_axis_limits(),
-        y_axis_title = y_axis_title()
+        y_axis_title = y_axis_title(),
+        y_labels = y_labels()
       )
     })
   })

R/mod_show_strategy_text.R

@@ -19,7 +19,8 @@ mod_show_strategy_text_ui <- function(id) {
 mod_show_strategy_text_server <- function(
   id,
   descriptions_lookup,
-  selected_strategy
+  selected_strategy,
+  cache
 ) {
   shiny::moduleServer(id, function(input, output, session) {
     output$strategy_text <- shiny::renderText({
@@ -28,6 +29,7 @@ mod_show_strategy_text_server <- function(
       selected_strategy() |>
         fetch_strategy_text(descriptions_lookup) |>
         convert_md_to_html()
-    })
+    }) |>
+      shiny::bindCache(selected_strategy(), cache = cache)
   })
 }

R/utils_server.R

@@ -1,7 +1,4 @@
 #' Read Inputs Datasets for All Geographies
-#' @param inputs_container A blob_container/storage_container list. The
-#'     object containing the connection to the Azure container hosting the
-#'     datasets named by `data_types`.
 #' @param geographies Character. The geography level for which the user wants to
 #'     select a provider.
 #' @param data_types Character. A vector of filenames (without filetypes) for
@@ -10,19 +7,33 @@
 #' @return A list. One element for each of the `geographies`, with subelements
 #'     that are dataframes of each one of the `data_types`.
 #' @export
-get_all_geo_data <- function(inputs_container, geographies, data_types) {
+get_all_geo_data <- function(geographies, data_types) {
+  inputs_container <- get_container(
+    container_name = Sys.getenv("AZ_CONTAINER_INPUTS")
+  )
+
   purrr::map(
     geographies,
     \(geography) {
       purrr::map(
         data_types,
         \(data_type) {
-          container_dir <- if (geography == "la") {
-            "local_authorities"
-          } else {
-            Sys.getenv("DATA_VERSION")
-          }
-          col_renames <- c(provider = "resladst_ons")
+          geography_folder <- switch(
+            geography,
+            "nhp" = "provider",
+            "la" = "lad23cd"
+          )
+
+          stopifnot(
+            "Unknown geography" = !is.null(geography_folder)
+          )
+
+          container_dir <- file.path(
+            Sys.getenv("DATA_VERSION"),
+            geography_folder
+          )
+
+          col_renames <- c(provider = "lad23cd")
           azkit::read_azure_parquet(
             inputs_container,
             data_type,

inst/app/data/mitigators.json

@@ -5,10 +5,6 @@
   "ambulatory_care_conditions_acute": "Ambulatory Care Sensitive Admissions (Acute Conditions) (IP-AA-004)",
   "ambulatory_care_conditions_chronic": "Ambulatory Care Sensitive Admissions (Chronic Conditions) (IP-AA-005)",
   "ambulatory_care_conditions_vaccine_preventable": "Ambulatory Care Sensitive Admissions (Vaccine Preventable) (IP-AA-006)",
-  "ambulatory_emergency_care_high": "Ambulatory Emergency Care (High Potential) (IP-EF-001)",
-  "ambulatory_emergency_care_low": "Ambulatory Emergency Care (Low Potential) (IP-EF-002)",
-  "ambulatory_emergency_care_moderate": "Ambulatory Emergency Care (Moderate Potential) (IP-EF-003)",
-  "ambulatory_emergency_care_very_high": "Ambulatory Emergency Care (Very High Potential) (IP-EF-004)",
   "cancelled_operations": "Cancelled Operations (IP-AA-007)",
   "consultant_to_consultant_reduction_adult_non-surgical": "Outpatient Consultant to Consultant Referrals (Adult, Non-Surgical) (OP-AA-001)",
   "consultant_to_consultant_reduction_adult_surgical": "Outpatient Consultant to Consultant Referrals (Adult, Surgical) (OP-AA-002)",
@@ -95,4 +91,4 @@
   "virtual_wards_efficiencies_heart_failure": "Virtual Wards LoS Reduction (Heart Failure) (IP-EF-027)",
   "zero_los_no_procedure_adult": "Admission With No Overnight Stay and No Procedure (Adults) (IP-AA-032)",
   "zero_los_no_procedure_child": "Admission With No Overnight Stay and No Procedure (Children) (IP-AA-033)"
-}
+}

inst/golem-config.yml

@@ -29,7 +29,7 @@ default:
       mitigators_type: activity_avoidance
       y_axis_title: "Admissions per 1,000 population"
       x_axis_title: "Financial Year"
-      number_type: !expr scales::comma_format(accuracy = 0.001)
+      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: 1