diff --git a/NAMESPACE b/NAMESPACE index 6f91e05..e6cf3ab 100644 --- a/NAMESPACE +++ b/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) diff --git a/R/app_server.R b/R/app_server.R index 208add1..107d71f 100644 --- a/R/app_server.R +++ b/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 + ) } diff --git a/R/app_ui.R b/R/app_ui.R index 1f8f96c..e511ea7 100644 --- a/R/app_ui.R +++ b/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") + ), ) ) ) diff --git a/R/fct_plots.R b/R/fct_plots.R index 870385d..3db3257 100644 --- a/R/fct_plots.R +++ b/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() + ) +} diff --git a/R/mod_plot_age_sex_pyramid.R b/R/mod_plot_age_sex_pyramid.R index b86acbe..1da3a2d 100644 --- a/R/mod_plot_age_sex_pyramid.R +++ b/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"`. diff --git a/R/mod_plot_nee.R b/R/mod_plot_nee.R new file mode 100644 index 0000000..ebd0d21 --- /dev/null +++ b/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) + }) + }) +} diff --git a/inst/app/data/nee_table.csv b/inst/app/data/nee_table.csv new file mode 100644 index 0000000..59ebaeb --- /dev/null +++ b/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 diff --git a/man/plot_nee.Rd b/man/plot_nee.Rd new file mode 100644 index 0000000..cff9760 --- /dev/null +++ b/man/plot_nee.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/fct_plots.R +\name{plot_nee} +\alias{plot_nee} +\title{Plot National Elicitation Exercise (NEE) Interval} +\usage{ +plot_nee(nee_data) +} +\arguments{ +\item{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.} +} +\value{ +A 'ggplot2' object. +} +\description{ +Plot National Elicitation Exercise (NEE) Interval +}