Merge pull request #41 from The-Strategy-Unit/28-nee

Add NEE plot

Author: matt-dray

NAMESPACE

@@ -7,6 +7,7 @@ export(generate_rates_baseline_data)
 export(generate_rates_funnel_data)
 export(isolate_provider_peers)
 export(plot_age_sex_pyramid)
+export(plot_nee)
 export(plot_rates_box)
 export(plot_rates_funnel)
 export(plot_rates_trend)

R/app_server.R

@@ -30,6 +30,10 @@ app_server <- function(input, output, session) {
     data_version
   ) |>
     prepare_age_sex_data()
+  nee_data <- readr::read_csv(
+    app_sys("app", "data", "nee_table.csv"),
+    col_types = "cddd"
+  )
 
   # Lookups ----
   providers_lookup <- jsonlite::read_json(
@@ -103,4 +107,9 @@ app_server <- function(input, output, session) {
     selected_strategy,
     start_year
   )
+  mod_plot_nee_server(
+    "mod_plot_nee",
+    nee_data,
+    selected_strategy
+  )
 }

R/app_ui.R

@@ -36,7 +36,11 @@ app_ui <- function(request) {
           mod_table_procedures_ui("mod_table_procedures"),
           mod_table_diagnoses_ui("mod_table_diagnoses")
         ),
-        mod_plot_age_sex_pyramid_ui("mod_plot_age_sex_pyramid"),
+        bslib::layout_column_wrap(
+          width = 1 / 2,
+          mod_plot_age_sex_pyramid_ui("mod_plot_age_sex_pyramid"),
+          mod_plot_nee_ui("mod_plot_nee")
+        ),
       )
     )
   )

R/fct_plots.R

@@ -156,3 +156,38 @@ plot_age_sex_pyramid <- function(age_sex_data) {
       panel.background = ggplot2::element_blank()
     )
 }
+
+#' Plot National Elicitation Exercise (NEE) Interval
+#' @param nee_data A data.frame. Mean, p10 and p90 predictions for each of the
+#'     strategies that were part of the National Elicitation Exercise (NEE),
+#'     filtered for the user's selected strategy.
+#' @return A 'ggplot2' object.
+#' @export
+plot_nee <- function(nee_data) {
+  nee_data |>
+    ggplot2::ggplot() +
+    ggplot2::geom_segment(
+      ggplot2::aes(
+        y = 1,
+        yend = 1,
+        x = .data[["percentile10"]],
+        xend = .data[["percentile90"]]
+      ),
+      size = 2
+    ) +
+    ggplot2::geom_point(
+      ggplot2::aes(y = 1, x = mean),
+      size = 5,
+      colour = "#f9bf14"
+    ) +
+    ggplot2::xlim(0, 100) +
+    ggplot2::xlab(
+      "80% prediction interval"
+    ) +
+    ggplot2::theme_minimal() +
+    ggplot2::theme(
+      axis.title.y = ggplot2::element_blank(),
+      axis.text.y = ggplot2::element_blank(),
+      axis.ticks.y = ggplot2::element_blank()
+    )
+}

R/mod_plot_age_sex_pyramid.R

@@ -1,4 +1,4 @@
-#' Plot Age-Sex Pyramid Trend UI
+#' Plot Age-Sex Pyramid UI
 #' @param id,input,output,session Internal parameters for `shiny`.
 #' @noRd
 mod_plot_age_sex_pyramid_ui <- function(id) {
@@ -12,7 +12,9 @@ mod_plot_age_sex_pyramid_ui <- function(id) {
 
 #' Plot Age-Sex Pyramid Server
 #' @param id Internal parameter for `shiny`.
-#' @param age_sex_data A data.frame.
+#' @param age_sex_data A data.frame. Age-sex data read from Azure and processed
+#'     with [prepare_age_sex_data]. Counts for each strategy split by provider,
+#'     year, age group and sex.
 #' @param selected_provider Character. Provider code, e.g. `"RCF"`.
 #' @param selected_strategy Character. Strategy variable name, e.g.
 #'     `"alcohol_partially_attributable_acute"`.

R/mod_plot_nee.R

@@ -0,0 +1,46 @@
+#' Plot National Elicitation Exercise (NEE) UI
+#' @param id,input,output,session Internal parameters for `shiny`.
+#' @noRd
+mod_plot_nee_ui <- function(id) {
+  ns <- shiny::NS(id)
+  bslib::card(
+    bslib::card_header("National Elicitation Exercise (NEE) estimate"),
+    bslib::card_body(
+      shiny::p("2039/40 horizon. Mean represented as a point."),
+      shiny::plotOutput(ns("nee"))
+    ),
+    full_screen = TRUE
+  )
+}
+
+#' Plot National Elicitation Exercise (NEE) Server
+#' @param id Internal parameter for `shiny`.
+#' @param nee_data A data.frame. Mean, p10 and p90 predictions for each of the
+#'     strategies that were part of the National Elicitation Exercise (NEE).
+#' @param selected_strategy Character. Strategy variable name, e.g.
+#'     `"alcohol_partially_attributable_acute"`.
+#' @noRd
+mod_plot_nee_server <- function(id, nee_data, selected_strategy) {
+  shiny::moduleServer(id, function(input, output, session) {
+    output$nee <- shiny::renderPlot({
+      shiny::req(nee_data)
+      shiny::req(selected_strategy())
+
+      nee_filtered <- nee_data |>
+        dplyr::filter(.data$param_name == selected_strategy())
+
+      shiny::validate(
+        shiny::need(
+          nrow(nee_filtered) > 0,
+          paste(
+            "This type of potentially-mitigatable activity (TPMA) was not part",
+            "of the National Elicitation Exercise (NEE), so a",
+            "nationally-determined estimate is not available."
+          )
+        )
+      )
+
+      plot_nee(nee_filtered)
+    })
+  })
+}

inst/app/data/nee_table.csv

@@ -0,0 +1,79 @@
+param_name,mean,percentile10,percentile90
+alcohol_partially_attributable_acute,76.58944231,97.522619072,39.92057311
+alcohol_partially_attributable_chronic,82.59142828,97.901963857,60.15757977
+alcohol_wholly_attributable,85.0659187,98.149701993,59.03811113
+ambulatory_care_conditions_acute,76.24602055,97.072034229,43.62456672
+ambulatory_care_conditions_chronic,75.1070788,97.099716303,40.98916714
+ambulatory_care_conditions_vaccine_preventable,77.79454286,97.33633513,51.67388443
+cancelled_operations,67.50577683,93.232250496,34.67371174
+consultant_to_consultant_reduction_adult_non-surgical,81.31492171,97.607544624,58.15165521
+consultant_to_consultant_reduction_adult_surgical,78.47617512,97.10820316,53.5564793
+consultant_to_consultant_reduction_child_non-surgical,77.30875592,95.797931765,47.26119919
+consultant_to_consultant_reduction_child_surgical,79.96715146,97.746921503,49.384977
+eol_care_2_days,72.08778414,93.711962536,34.55226822
+eol_care_3_to_14_days,79.58371663,95.29097698,50.34811687
+evidence_based_interventions_ent,53.7137119,88.18222051000001,23.343624759999997
+evidence_based_interventions_general_surgery,59.75999705,88.72084248,27.218407420000005
+evidence_based_interventions_gi_surgical,79.80727829,96.77784566,52.78199892
+evidence_based_interventions_msk,54.63154433,89.26653856,21.632259450000006
+evidence_based_interventions_urology,63.28482667,96.286206815,25.842634250000003
+evidence_based_interventions_vascular_varicose_veins,51.72728761,80.17961008,21.427971330000005
+falls_related_admissions,85.91059503,98.714915386,56.9348065
+followup_reduction_adult_non-surgical,65.8700221,95.963139315,37.06084141
+followup_reduction_adult_surgical,74.89754465,97.148738244,42.56895136
+followup_reduction_child_non-surgical,82.4832679,96.43517932,59.98113701
+followup_reduction_child_surgical,83.58469765,97.580519792,59.52655234
+frail_elderly_high,94.286779628,99.566766036,83.60301915
+frail_elderly_intermediate,91.364883775,99.105768203,79.20168105
+frequent_attenders_adult_ambulance,75.3611344,94.799458238,44.16653032
+frequent_attenders_adult_walk-in,81.2851926,96.046881706,60.8844789
+frequent_attenders_child_ambulance,77.38495492,97.226619794,46.82339375
+frequent_attenders_child_walk-in,79.26598771,98.305595653,55.98949325
+intentional_self_harm,81.67292674000001,97.928465846,47.64351967
+left_before_seen_adult_ambulance,75.3004681,95.805192719,48.02266528
+left_before_seen_adult_walk-in,67.58141287000001,97.101765727,34.94430088
+left_before_seen_child_ambulance,69.36482781000001,97.600743381,30.282850120000006
+left_before_seen_child_walk-in,67.09085801,96.878226063,29.537754059999997
+low_cost_discharged_adult_ambulance,69.19920015,93.250010645,40.10873193
+low_cost_discharged_adult_walk-in,74.74368538,94.930529676,46.24473746
+low_cost_discharged_child_ambulance,77.45914761,99.119960209,47.99677245
+low_cost_discharged_child_walk-in,74.84101392,96.647851157,43.82014639
+medically_unexplained_related_admissions,86.66933198,98.833527985,61.18022795
+medicines_related_admissions_explicit,84.25453041,97.64432614,63.04745688
+medicines_related_admissions_implicit_anti-diabetics,70.55096483,95.365109631,37.57622131
+medicines_related_admissions_implicit_benzodiasepines,87.26251081,99.474566688,67.52574745999999
+medicines_related_admissions_implicit_diurectics,83.18944655,98.960862358,59.21627277
+medicines_related_admissions_implicit_nsaids,81.16312970999999,97.633663525,50.31294376
+obesity_related_admissions,84.8284795,98.01943932,55.38353287
+raid_ae,85.22909305,98.071842811,54.76825345
+readmission_within_28_days,83.58979633,95.945934349,63.43411212
+smoking,84.31463664,98.866721497,59.98338837
+zero_los_no_procedure_adult,75.14857705,97.525543798,45.84957177
+zero_los_no_procedure_child,80.38631547,97.527397217,55.13509122
+ambulatory_emergency_care_high,75.01179258,98.689093994,48.04697702
+ambulatory_emergency_care_low,75.12936268,96.049267586,30.65241107
+ambulatory_emergency_care_moderate,72.72610633,95.852054072,46.86872646
+ambulatory_emergency_care_very_high,64.73960328999999,96.588934437,35.099254599999995
+bads_daycase,63.98887742,86.73551731,34.060803910000004
+bads_daycase_occasional,70.46212414,94.797805858,35.836390030000004
+bads_outpatients,55.49104095,85.66413771,19.393883939999995
+bads_outpatients_or_daycase,62.6896898,89.0882033,30.06155769
+emergency_elderly,82.59806635,96.043510115,60.72989743
+enhanced_recovery_bladder,65.80176370000001,91.33441839,34.41313542
+enhanced_recovery_breast,60.18595809,94.287937957,22.834143170000004
+enhanced_recovery_colectomy,76.46814446,94.72628511,50.59516639
+enhanced_recovery_hip,58.96483906,92.930259893,29.274554780000003
+enhanced_recovery_hysterectomy,71.68937628,95.331232806,33.339561520000004
+enhanced_recovery_knee,60.8460233,92.154957577,29.243783300000004
+enhanced_recovery_prostate,69.56661841,92.219803903,39.67523539
+enhanced_recovery_rectum,77.87659980000001,95.403201969,51.79233086
+excess_beddays_elective,76.61621966,97.018275735,44.98583541
+excess_beddays_emergency,72.70341937,96.906496976,44.20408294
+pre-op_los_1-day,54.08834037,82.27572568,27.102307390000007
+pre-op_los_2-day,54.08834037,82.27572568,27.102307390000007
+raid_ip,84.58657373,96.948584232,52.34138682
+stroke_early_supported_discharge,82.03253305999999,96.659841453,55.38388199
+convert_to_tele_adult_surgical,66.81130907,91.339844732,31.50170097
+convert_to_tele_adult_non-surgical,68.98469495,92.89879779500001,34.39320196
+convert_to_tele_child_surgical,72.13793377,90.041605519,46.19841365
+convert_to_tele_child_non-surgical,72.58843795,91.794797295,44.53912826