Update NEE card content

NAMESPACE

@@ -14,7 +14,6 @@ export(make_strategy_group_lookup)
 export(md_file_to_html)
 export(md_string_to_html)
 export(plot_age_sex_pyramid)
-export(plot_nee)
 export(plot_rates_box)
 export(plot_rates_funnel)
 export(plot_rates_trend)

R/fct_plots.R

@@ -206,38 +206,3 @@ 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"]]
-      ),
-      linewidth = 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

@@ -8,7 +8,7 @@ mod_plot_age_sex_pyramid_ui <- function(id) {
       "Age-sex pyramid",
       bslib::tooltip(
         bsicons::bs_icon("info-circle"),
-        md_file_to_html("app", "text", "viz-pyramid.md"),
+        md_file_to_html("app", "text", "viz-tooltip-pyramid.md"),
         placement = "right"
       )
     ),

R/mod_plot_nee.R

@@ -1,60 +1,60 @@
-#' 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::tooltip(
-        bsicons::bs_icon("info-circle"),
-        md_file_to_html("app", "text", "viz-nee.md"),
-        placement = "right"
-      )
-    ),
-    bslib::card_body(
-      shinycssloaders::withSpinner(shiny::plotOutput(ns("nee")))
-    ),
-    full_screen = TRUE
-  )
-}
-
-#' Plot National Elicitation Exercise (NEE) Server
-#' @param id Internal parameter for `shiny`.
-#' @param selected_strategy Character. Strategy variable name, e.g.
-#'     `"alcohol_partially_attributable_acute"`.
-#' @noRd
-mod_plot_nee_server <- function(id, selected_strategy) {
-  # load static data items
-  nee_data <- readr::read_csv(
-    app_sys("app", "data", "nee_table.csv"),
-    col_types = "cddd"
-  )
-
-  # return the shiny module
-  shiny::moduleServer(id, function(input, output, session) {
-    selected_nee_data <- shiny::reactive({
-      strat <- shiny::req(selected_strategy())
-
-      nee_data |>
-        dplyr::filter(.data$param_name == strat)
-    })
-
-    output$nee <- shiny::renderPlot({
-      df <- selected_nee_data()
-
-      shiny::validate(
-        shiny::need(
-          nrow(df) > 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(df)
-    })
-  })
-}
+#' 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(
+    fill = FALSE,
+    bslib::card_header("National Elicitation Exercise (NEE) estimate"),
+    bslib::card_body(
+      md_file_to_html("app", "text", "viz-nee.md"),
+      shinycssloaders::withSpinner(shiny::htmlOutput(ns("nee_text")))
+    )
+  )
+}
+
+#' Plot National Elicitation Exercise (NEE) Server
+#' @param id Internal parameter for `shiny`.
+#' @param selected_strategy Character. Strategy variable name, e.g.
+#'     `"alcohol_partially_attributable_acute"`.
+#' @noRd
+mod_plot_nee_server <- function(id, selected_strategy) {
+  # load static data items
+  nee_data <- readr::read_csv(
+    app_sys("app", "data", "nee_table.csv"),
+    col_types = "cddd"
+  )
+
+  # return the shiny module
+  shiny::moduleServer(id, function(input, output, session) {
+    selected_nee_data <- shiny::reactive({
+      strat <- shiny::req(selected_strategy())
+
+      nee_data |>
+        dplyr::filter(.data$param_name == strat)
+    })
+
+    output$nee_text <- shiny::renderText({
+      df <- selected_nee_data()
+
+      nee_aggregate <-
+        "This TPMA was not part of that exercise. No estimate is available."
+
+      has_nee <- nrow(df) > 0
+      if (has_nee) {
+        nee_aggregate <- paste0(
+          "They predicted that a mean of <b>",
+          round(100 - df$mean),
+          "%</b>  of this type of activity could be mitigated, ",
+          "with an 80% prediction interval from <b>",
+          round(100 - df$percentile10),
+          "%</b> to <b>",
+          round(100 - df$percentile90),
+          "%</b>."
+        )
+      }
+
+      nee_aggregate
+    })
+  })
+}

R/mod_plot_rates_box.R

@@ -8,7 +8,7 @@ mod_plot_rates_box_ui <- function(id) {
       "Rates Box",
       bslib::tooltip(
         bsicons::bs_icon("info-circle"),
-        md_file_to_html("app", "text", "viz-box.md"),
+        md_file_to_html("app", "text", "viz-tooltip-box.md"),
         placement = "right"
       )
     ),

R/mod_plot_rates_funnel.R

@@ -8,7 +8,7 @@ mod_plot_rates_funnel_ui <- function(id) {
       "Rates Funnel",
       bslib::tooltip(
         bsicons::bs_icon("info-circle"),
-        md_file_to_html("app", "text", "viz-funnel.md"),
+        md_file_to_html("app", "text", "viz-tooltip-funnel.md"),
         placement = "right"
       )
     ),

R/mod_plot_rates_trend.R

@@ -8,7 +8,7 @@ mod_plot_rates_trend_ui <- function(id) {
       "Rates Trend",
       bslib::tooltip(
         bsicons::bs_icon("info-circle"),
-        md_file_to_html("app", "text", "viz-trend.md"),
+        md_file_to_html("app", "text", "viz-tooltip-trend.md"),
         placement = "right"
       )
     ),

R/mod_select_geography.R

@@ -10,7 +10,7 @@ mod_select_geography_ui <- function(id) {
         "Filter by geography",
         bsicons::bs_icon("info-circle")
       ),
-      md_file_to_html("app", "text", "sidebar-selections.md"),
+      md_file_to_html("app", "text", "sidebar-tooltip-selections.md"),
     ),
     choices = c(
       "NHS provider trusts" = "nhp",

R/mod_select_provider.R

@@ -10,7 +10,7 @@ mod_select_provider_ui <- function(id) {
         "Choose a statistical unit",
         bsicons::bs_icon("info-circle")
       ),
-      md_file_to_html("app", "text", "sidebar-selections.md"),
+      md_file_to_html("app", "text", "sidebar-tooltip-selections.md"),
     ),
     choices = NULL
   )

R/mod_select_strategy.R

@@ -11,7 +11,7 @@ mod_select_strategy_ui <- function(id) {
           "Filter by activity type",
           bsicons::bs_icon("info-circle")
         ),
-        md_file_to_html("app", "text", "sidebar-selections.md"),
+        md_file_to_html("app", "text", "sidebar-tooltip-selections.md"),
       ),
       choices = c(
         "Inpatients" = "ip",
@@ -26,7 +26,7 @@ mod_select_strategy_ui <- function(id) {
           "Choose a TPMA",
           bsicons::bs_icon("info-circle")
         ),
-        md_file_to_html("app", "text", "sidebar-selections.md"),
+        md_file_to_html("app", "text", "sidebar-tooltip-selections.md"),
       ),
       choices = NULL
     )

R/mod_table_diagnoses.R

@@ -8,7 +8,7 @@ mod_table_diagnoses_ui <- function(id) {
       "Diagnoses summary",
       bslib::tooltip(
         bsicons::bs_icon("info-circle"),
-        md_file_to_html("app", "text", "viz-diagnoses.md"),
+        md_file_to_html("app", "text", "viz-tooltip-diagnoses.md"),
         placement = "right"
       )
     ),

R/mod_table_procedures.R

@@ -8,7 +8,7 @@ mod_table_procedures_ui <- function(id) {
       "Procedures summary",
       bslib::tooltip(
         bsicons::bs_icon("info-circle"),
-        md_file_to_html("app", "text", "viz-procedures.md"),
+        md_file_to_html("app", "text", "viz-tooltip-procedures.md"),
         placement = "right"
       )
     ),

inst/app/text/viz-nee.md

@@ -1,4 +1 @@
-Summarised expert predictions from the National Elicitation Exercise (NEE).
-The dot is the mean value and the horizontal bar is the 10% to 90% interval.
-Predictions were for 2039/40.
-Not all TPMAs were part of that exercise.
+Subject-matter experts were invited to provide national forecasts about future hospital activity (2039/40) in [an evidence-based elicitation exercise](https://doi.org/10.1136/bmjopen-2024-084632).

tests/testthat/test-fct_plots.R

@@ -11,7 +11,7 @@ test_that("plot_rates_trend", {
     202021 , 0.07  ,
     202122 , 0.06  ,
     202223 , 0.05  ,
-    202324 , 0.04  
+    202324 , 0.04
   )
   # nolint end
 
@@ -49,7 +49,7 @@ test_that("plot_rates_funnel", {
     0.07  ,         2000 ,           0.08 , NA       , "f"       ,
     0.06  ,         2200 ,           0.08 , NA       , "g"       ,
     0.05  ,         2400 ,           0.08 , NA       , "h"       ,
-    0.04  ,         2600 ,           0.08 , TRUE     , "i"       
+    0.04  ,         2600 ,           0.08 , TRUE     , "i"
   )
   # nolint end
 
@@ -82,7 +82,7 @@ test_that("plot_rates_box", {
     0.07  ,         2000 ,           0.08 , NA       , "f"       ,
     0.06  ,         2200 ,           0.08 , NA       , "g"       ,
     0.05  ,         2400 ,           0.08 , NA       , "h"       ,
-    0.04  ,         2600 ,           0.08 , TRUE     , "i"       
+    0.04  ,         2600 ,           0.08 , TRUE     , "i"
   )
   # nolint end
 
@@ -184,17 +184,3 @@ test_that("plot_age_sex_pyramid", {
   # assert
   vdiffr::expect_doppelganger("plot_age_sex_pyramid", actual)
 })
-
-test_that("plot_nee", {
-  # arrange
-  nee_data <- tibble::tribble(
-    ~strategy, ~percentile10, ~mean, ~percentile90,
-    "Strategy A", 20, 50, 80
-  )
-
-  # act
-  actual <- plot_nee(nee_data)
-
-  # assert
-  vdiffr::expect_doppelganger("plot_nee", actual)
-})