Introduce LA data and user-selected geography

.Rbuildignore

@@ -4,9 +4,11 @@
 ^\.vscode$
 ^app\.R$
 ^CODEOWNERS$
+^data-raw$
 ^deploy\.R$
 ^dev$
 ^LICENSE\.md$
+^\.lintr$
 ^README\.md$
 ^rsconnect$
 ^tpma-explorer\.Rproj$

.lintr

@@ -0,0 +1,3 @@
+exclusions: list(
+    "data-raw/la-lookups.R"
+  )

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: tpma.explorer
 Title: Explore TPMA Data
-Version: 0.2.0
+Version: 0.2.0.9000
 Authors@R: c(
     person("Matt", "Dray", , "matt.dray@nhs.net", role = c("aut", "cre")),
     person("Tom", "Jemmett", , "thomas.jemmett@nhs.net", role = "aut")
@@ -14,8 +14,11 @@ Depends:
     R (>= 4.1.0)
 Imports:
     azkit,
+    AzureAuth,
+    AzureStor,
     bsicons,
     bslib,
+    config,
     dplyr,
     forcats,
     ggbeeswarm,

NAMESPACE

@@ -5,6 +5,8 @@ export(entable_encounters)
 export(fetch_strategy_text)
 export(generate_rates_baseline_data)
 export(generate_rates_funnel_data)
+export(get_all_geo_data)
+export(get_container)
 export(get_golem_config)
 export(isolate_provider_peers)
 export(make_strategy_group_lookup)

R/app_server.R

@@ -2,71 +2,104 @@
 #' @param input,output,session Internal parameters for 'shiny'.
 #' @noRd
 app_server <- function(input, output, session) {
-  # Env variables ----
-  inputs_container_name <- Sys.getenv("AZ_CONTAINER_INPUTS")
-  data_version <- Sys.getenv("DATA_VERSION")
+  # Variables ----
+  geographies <- c(
+    "New Hospital Programme (NHP)" = "nhp",
+    "Local authority (LA)" = "la"
+  )
+  data_types <- c("age_sex", "diagnoses", "procedures", "rates")
   baseline_year <- Sys.getenv("BASELINE_YEAR") |> as.numeric()
 
   # Data ----
-  inputs_container <- get_container(container_name = inputs_container_name)
-  rates_data <- azkit::read_azure_parquet(
-    inputs_container,
-    "rates",
-    data_version
-  )
-  procedures_data <- azkit::read_azure_parquet(
-    inputs_container,
-    "procedures",
-    data_version
-  )
-  diagnoses_data <- azkit::read_azure_parquet(
-    inputs_container,
-    "diagnoses",
-    data_version
-  )
-  age_sex_data <- azkit::read_azure_parquet(
-    inputs_container,
-    "age_sex",
-    data_version
-  ) |>
-    prepare_age_sex_data()
+  inputs_container <- get_container(
+    container_name = Sys.getenv("AZ_CONTAINER_INPUTS")
+  )
+  inputs_data <- get_all_geo_data(inputs_container, geographies, data_types)
+  age_sex_data <- shiny::reactive({
+    shiny::req(selected_geography())
+    inputs_data[[selected_geography()]][["age_sex"]] |>
+      prepare_age_sex_data()
+  })
+  diagnoses_data <- shiny::reactive({
+    shiny::req(selected_geography())
+    inputs_data[[selected_geography()]][["diagnoses"]]
+  })
+  procedures_data <- shiny::reactive({
+    shiny::req(selected_geography())
+    inputs_data[[selected_geography()]][["procedures"]]
+  })
+  rates_data <- shiny::reactive({
+    shiny::req(selected_geography())
+    inputs_data[[selected_geography()]][["rates"]]
+  })
   nee_data <- readr::read_csv(
     app_sys("app", "data", "nee_table.csv"),
     col_types = "cddd"
   )
 
-  # Lookups ----
-  providers_lookup <- jsonlite::read_json(
-    app_sys("app", "data", "datasets.json"),
-    simplify_vector = TRUE
-  )
-  strategies_lookup <- jsonlite::read_json(
-    app_sys("app", "data", "mitigators.json"),
-    simplify_vector = TRUE
-  )
+  # Lookups (general) ----
   descriptions_lookup <- jsonlite::read_json(
     app_sys("app", "data", "descriptions.json"),
     simplifyVector = TRUE
   )
-  peers_lookup <- readr::read_csv(
-    app_sys("app", "data", "peers.csv"),
+  diagnoses_lookup <- readr::read_csv(
+    app_sys("app", "data", "diagnoses.csv"),
     col_types = "c"
   )
   procedures_lookup <- readr::read_csv(
     app_sys("app", "data", "procedures.csv"),
     col_types = "c"
   )
-  diagnoses_lookup <- readr::read_csv(
-    app_sys("app", "data", "diagnoses.csv"),
-    col_types = "c"
+  strategies_config <- get_golem_config("mitigators_config")
+  strategies_lookup <- jsonlite::read_json(
+    app_sys("app", "data", "mitigators.json"),
+    simplify_vector = TRUE
   )
 
-  # Config ----
-  strategies_config <- get_golem_config("mitigators_config")
+  # Lookups ----
+  # TODO: read lookups into single object, as per providers
+  nhp_providers_lookup <- jsonlite::read_json(
+    app_sys("app", "data", "nhp-datasets.json"),
+    simplify_vector = TRUE
+  )
+  la_providers_lookup <- jsonlite::read_json(
+    app_sys("app", "data", "la-datasets.json"),
+    simplify_vector = TRUE
+  )
+  nhp_peers_lookup <- readr::read_csv(
+    app_sys("app", "data", "nhp-peers.csv"),
+    col_types = "c"
+  )
+  la_peers_lookup <- readr::read_csv(
+    app_sys("app", "data", "la-peers.csv"),
+    col_types = "c"
+  )
+  # TODO: make reactives in similar style to providers
+  providers_lookup <- shiny::reactive({
+    shiny::req(selected_geography())
+    shiny::req(nhp_providers_lookup)
+    shiny::req(la_providers_lookup)
+    if (selected_geography() == "nhp") {
+      nhp_providers_lookup
+    } else {
+      la_providers_lookup
+    }
+  })
+  peers_lookup <- shiny::reactive({
+    shiny::req(selected_geography())
+    shiny::req(nhp_peers_lookup)
+    shiny::req(la_peers_lookup)
+    if (selected_geography() == "nhp") nhp_peers_lookup else la_peers_lookup
+  })
 
   # User inputs ----
+  selected_geography <- mod_select_geography_server(
+    "mod_select_geography",
+    geographies
+  )
   selected_provider <- mod_select_provider_server(
     "mod_select_provider",
+    selected_geography,
     providers_lookup
   )
   selected_strategy <- mod_select_strategy_server(

R/app_ui.R

@@ -7,6 +7,7 @@ app_ui <- function(request) {
     fillable = FALSE, # allow page scroll
 
     sidebar = bslib::sidebar(
+      mod_select_geography_ui("mod_select_geography"),
       mod_select_provider_ui("mod_select_provider"),
       mod_select_strategy_ui("mod_select_strategy"),
     ),

R/fct_azure.R

@@ -1,3 +1,11 @@
+#' Get Azure Container
+#' @param tenant Character. Tenant ID.
+#' @param app_id Character. App ID.
+#' @param ep_uri Character. Endpoint URI.
+#' @param container_name Character. The name of the blob/storage container that
+#'     hosts files you want to read.
+#' @return A blob_container/storage_container list.
+#' @export
 get_container <- function(
   tenant = Sys.getenv("AZ_TENANT_ID"),
   app_id = Sys.getenv("AZ_APP_ID"),

R/mod_plot_age_sex_pyramid.R

@@ -31,12 +31,12 @@ mod_plot_age_sex_pyramid_server <- function(
 ) {
   shiny::moduleServer(id, function(input, output, session) {
     output$age_sex_pyramid <- shiny::renderPlot({
-      shiny::req(age_sex_data)
+      shiny::req(age_sex_data())
       shiny::req(selected_provider())
       shiny::req(selected_strategy())
       shiny::req(baseline_year)
 
-      age_sex_filtered <- age_sex_data |>
+      age_sex_filtered <- age_sex_data() |>
         dplyr::filter(
           .data$provider == selected_provider(),
           .data$strategy == selected_strategy(),

R/mod_plot_rates.R

@@ -40,11 +40,11 @@ mod_plot_rates_server <- function(
     #  Prepare data ----
 
     rates_trend_data <- shiny::reactive({
-      shiny::req(rates)
+      shiny::req(rates())
       shiny::req(selected_provider())
       shiny::req(selected_strategy())
 
-      rates |>
+      rates() |>
         dplyr::filter(
           .data$provider == selected_provider(),
           .data$strategy == selected_strategy()
@@ -53,16 +53,16 @@ mod_plot_rates_server <- function(
     })
 
     rates_baseline_data <- shiny::reactive({
-      shiny::req(rates)
-      shiny::req(peers_lookup)
+      shiny::req(rates())
+      shiny::req(peers_lookup())
       shiny::req(selected_provider())
       shiny::req(selected_strategy())
 
       provider_peers <- isolate_provider_peers(
         selected_provider(),
-        peers_lookup
+        peers_lookup()
       )
-      rates |>
+      rates() |>
         generate_rates_baseline_data(
           selected_provider(),
           provider_peers,
@@ -123,14 +123,12 @@ mod_plot_rates_server <- function(
     mod_plot_rates_funnel_server(
       "mod_plot_rates_funnel",
       rates_funnel_data,
-      peers_lookup,
       y_axis_limits,
       funnel_x_title
     )
     mod_plot_rates_box_server(
       "mod_plot_rates_box",
       rates_baseline_data,
-      peers_lookup,
       y_axis_limits
     )
   })

R/mod_plot_rates_box.R

@@ -14,15 +14,9 @@ mod_plot_rates_box_ui <- function(id) {
 #' @param id Internal parameter for `shiny`.
 #' @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 y_axis_limits Numeric vector. Min and max values for the y axis.
 #' @noRd
-mod_plot_rates_box_server <- function(
-  id,
-  rates,
-  peers_lookup,
-  y_axis_limits
-) {
+mod_plot_rates_box_server <- function(id, rates, y_axis_limits) {
   shiny::moduleServer(id, function(input, output, session) {
     output$rates_box_plot <- shiny::renderPlot({
       rates <- rates()

R/mod_plot_rates_funnel.R

@@ -14,14 +14,12 @@ mod_plot_rates_funnel_ui <- function(id) {
 #' @param id Internal parameter for `shiny`.
 #' @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 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,
   y_axis_limits,
   x_axis_title
 ) {

R/mod_plot_rates_trend.R

@@ -27,16 +27,15 @@ mod_plot_rates_trend_server <- function(
 ) {
   shiny::moduleServer(id, function(input, output, session) {
     output$rates_trend_plot <- shiny::renderPlot({
-      rates <- rates()
-      shiny::validate(shiny::need(
-        nrow(rates) > 0,
-        "No data available for these selections."
-      ))
-      shiny::req(y_axis_limits())
-      shiny::req(y_axis_title())
+      shiny::validate(
+        shiny::need(
+          nrow(rates()) > 0,
+          "No data available for these selections."
+        )
+      )
 
       plot_rates_trend(
-        rates,
+        rates(),
         baseline_year,
         y_axis_limits(),
         y_axis_title = y_axis_title()

R/mod_select_geography.R

@@ -0,0 +1,30 @@
+#' Select Geography UI
+#' @param id,input,output,session Internal parameters for `shiny`.
+#' @noRd
+mod_select_geography_ui <- function(id) {
+  ns <- shiny::NS(id)
+  shiny::selectInput(
+    ns("geography_select"),
+    "Choose a geography:",
+    choices = NULL
+  )
+}
+
+#' Select Geography Server
+#' @param id Internal parameter for `shiny`.
+#' @param geographies Character. The geography level for which the user wants to
+#'     select a provider.
+#' @noRd
+mod_select_geography_server <- function(id, geographies) {
+  shiny::moduleServer(id, function(input, output, session) {
+    shiny::observe({
+      shiny::req(geographies)
+      shiny::updateSelectInput(
+        session,
+        "geography_select",
+        choices = geographies
+      )
+    })
+    shiny::reactive(input$geography_select)
+  })
+}