From c24842e4e3f4881f3a20e5d9b6e8ce55af992f0d Mon Sep 17 00:00:00 2001
From: Matt Dray <18232097+matt-dray@users.noreply.github.com>
Date: Fri, 6 Feb 2026 17:20:32 +0000
Subject: [PATCH 1/4] Adjust NEE card content
---
R/mod_plot_nee.R | 38 ++++++++++++++++++++++----------
inst/app/text/viz-nee.md | 7 +++---
inst/app/text/viz-tooltip-nee.md | 4 ++++
3 files changed, 33 insertions(+), 16 deletions(-)
create mode 100644 inst/app/text/viz-tooltip-nee.md
diff --git a/R/mod_plot_nee.R b/R/mod_plot_nee.R
index a66c5fc..076e835 100644
--- a/R/mod_plot_nee.R
+++ b/R/mod_plot_nee.R
@@ -8,12 +8,16 @@ mod_plot_nee_ui <- function(id) {
"National Elicitation Exercise (NEE) estimate",
bslib::tooltip(
bsicons::bs_icon("info-circle"),
- md_file_to_html("app", "text", "viz-nee.md"),
+ md_file_to_html("app", "text", "viz-tooltip-nee.md"),
placement = "right"
)
),
bslib::card_body(
- shinycssloaders::withSpinner(shiny::plotOutput(ns("nee")))
+ md_file_to_html("app", "text", "viz-nee.md"),
+ shinycssloaders::withSpinner(shiny::textOutput(ns("nee_text"))),
+ shinycssloaders::withSpinner(
+ shiny::plotOutput(ns("nee_plot"), height = "100px")
+ )
),
full_screen = TRUE
)
@@ -40,20 +44,30 @@ mod_plot_nee_server <- function(id, selected_strategy) {
dplyr::filter(.data$param_name == strat)
})
- output$nee <- shiny::renderPlot({
+ output$nee_text <- shiny::renderText({
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."
- )
+ nee_aggregate <- "This TPMA was not part of the NEE. No estimate is available."
+
+ has_nee <- nrow(df) > 0
+ if (has_nee) {
+ nee_aggregate <- paste0(
+ "The mean prediction for this TPMA was ",
+ round(df$mean),
+ "%, with an 80% prediction interval from ",
+ round(df$percentile90),
+ "% to ",
+ round(df$percentile10),
+ "%."
)
- )
+ }
+ nee_aggregate
+ })
+
+ output$nee_plot <- shiny::renderPlot({
+ df <- selected_nee_data()
+ shiny::req(nrow(df) > 0)
plot_nee(df)
})
})
diff --git a/inst/app/text/viz-nee.md b/inst/app/text/viz-nee.md
index 541a952..57b6dca 100644
--- a/inst/app/text/viz-nee.md
+++ b/inst/app/text/viz-nee.md
@@ -1,4 +1,3 @@
-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 forecasts about future hospital activity (2039/40) using an [evidence-based elicitation exercise](https://doi.org/10.1136/bmjopen-2024-084632).
+Experts were asked for the expected level of activity for TPMAs following mitigation, expressed as as an 80% prediction interval.
+The aggregated results can provide a useful 'outside' view but should not be interpreted as an expectation of what can be achieved locally.
diff --git a/inst/app/text/viz-tooltip-nee.md b/inst/app/text/viz-tooltip-nee.md
new file mode 100644
index 0000000..0029509
--- /dev/null
+++ b/inst/app/text/viz-tooltip-nee.md
@@ -0,0 +1,4 @@
+Summarised expert predictions from the National Elicitation Exercise (NEE).
+The dot is the mean value and the horizontal bar is the 80% prediction interval.
+Predictions were for 2039/40.
+Not all TPMAs were part of the exercise.
From 1bebee233c2104287e9649cf94813fbfcf375339 Mon Sep 17 00:00:00 2001
From: Matt Dray <18232097+matt-dray@users.noreply.github.com>
Date: Fri, 6 Feb 2026 17:20:55 +0000
Subject: [PATCH 2/4] Rename Markdown files for clarity
---
R/mod_plot_age_sex_pyramid.R | 2 +-
R/mod_plot_rates_box.R | 2 +-
R/mod_plot_rates_funnel.R | 2 +-
R/mod_plot_rates_trend.R | 2 +-
R/mod_select_geography.R | 2 +-
R/mod_select_provider.R | 2 +-
R/mod_select_strategy.R | 4 ++--
R/mod_table_diagnoses.R | 2 +-
R/mod_table_procedures.R | 2 +-
.../{sidebar-selections.md => sidebar-tooltip-selections.md} | 0
inst/app/text/{viz-box.md => viz-tooltip-box.md} | 0
inst/app/text/{viz-diagnoses.md => viz-tooltip-diagnoses.md} | 0
inst/app/text/{viz-funnel.md => viz-tooltip-funnel.md} | 0
.../app/text/{viz-procedures.md => viz-tooltip-procedures.md} | 0
inst/app/text/{viz-pyramid.md => viz-tooltip-pyramid.md} | 0
inst/app/text/{viz-trend.md => viz-tooltip-trend.md} | 0
16 files changed, 10 insertions(+), 10 deletions(-)
rename inst/app/text/{sidebar-selections.md => sidebar-tooltip-selections.md} (100%)
rename inst/app/text/{viz-box.md => viz-tooltip-box.md} (100%)
rename inst/app/text/{viz-diagnoses.md => viz-tooltip-diagnoses.md} (100%)
rename inst/app/text/{viz-funnel.md => viz-tooltip-funnel.md} (100%)
rename inst/app/text/{viz-procedures.md => viz-tooltip-procedures.md} (100%)
rename inst/app/text/{viz-pyramid.md => viz-tooltip-pyramid.md} (100%)
rename inst/app/text/{viz-trend.md => viz-tooltip-trend.md} (100%)
diff --git a/R/mod_plot_age_sex_pyramid.R b/R/mod_plot_age_sex_pyramid.R
index db2402d..5826330 100644
--- a/R/mod_plot_age_sex_pyramid.R
+++ b/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"
)
),
diff --git a/R/mod_plot_rates_box.R b/R/mod_plot_rates_box.R
index e3fca0a..a8d8243 100644
--- a/R/mod_plot_rates_box.R
+++ b/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"
)
),
diff --git a/R/mod_plot_rates_funnel.R b/R/mod_plot_rates_funnel.R
index 488a587..bf234cf 100644
--- a/R/mod_plot_rates_funnel.R
+++ b/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"
)
),
diff --git a/R/mod_plot_rates_trend.R b/R/mod_plot_rates_trend.R
index aa55a22..2d076cb 100644
--- a/R/mod_plot_rates_trend.R
+++ b/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"
)
),
diff --git a/R/mod_select_geography.R b/R/mod_select_geography.R
index 084cc5e..bc23233 100644
--- a/R/mod_select_geography.R
+++ b/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",
diff --git a/R/mod_select_provider.R b/R/mod_select_provider.R
index 367e74f..0138c29 100644
--- a/R/mod_select_provider.R
+++ b/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
)
diff --git a/R/mod_select_strategy.R b/R/mod_select_strategy.R
index f0e5c12..2b044c6 100644
--- a/R/mod_select_strategy.R
+++ b/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
)
diff --git a/R/mod_table_diagnoses.R b/R/mod_table_diagnoses.R
index 9570d16..d83e009 100644
--- a/R/mod_table_diagnoses.R
+++ b/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"
)
),
diff --git a/R/mod_table_procedures.R b/R/mod_table_procedures.R
index 90a9952..b31c93f 100644
--- a/R/mod_table_procedures.R
+++ b/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"
)
),
diff --git a/inst/app/text/sidebar-selections.md b/inst/app/text/sidebar-tooltip-selections.md
similarity index 100%
rename from inst/app/text/sidebar-selections.md
rename to inst/app/text/sidebar-tooltip-selections.md
diff --git a/inst/app/text/viz-box.md b/inst/app/text/viz-tooltip-box.md
similarity index 100%
rename from inst/app/text/viz-box.md
rename to inst/app/text/viz-tooltip-box.md
diff --git a/inst/app/text/viz-diagnoses.md b/inst/app/text/viz-tooltip-diagnoses.md
similarity index 100%
rename from inst/app/text/viz-diagnoses.md
rename to inst/app/text/viz-tooltip-diagnoses.md
diff --git a/inst/app/text/viz-funnel.md b/inst/app/text/viz-tooltip-funnel.md
similarity index 100%
rename from inst/app/text/viz-funnel.md
rename to inst/app/text/viz-tooltip-funnel.md
diff --git a/inst/app/text/viz-procedures.md b/inst/app/text/viz-tooltip-procedures.md
similarity index 100%
rename from inst/app/text/viz-procedures.md
rename to inst/app/text/viz-tooltip-procedures.md
diff --git a/inst/app/text/viz-pyramid.md b/inst/app/text/viz-tooltip-pyramid.md
similarity index 100%
rename from inst/app/text/viz-pyramid.md
rename to inst/app/text/viz-tooltip-pyramid.md
diff --git a/inst/app/text/viz-trend.md b/inst/app/text/viz-tooltip-trend.md
similarity index 100%
rename from inst/app/text/viz-trend.md
rename to inst/app/text/viz-tooltip-trend.md
From b05b3c7cebf9f98716f547b1e070989c527831b0 Mon Sep 17 00:00:00 2001
From: Matt Dray <18232097+matt-dray@users.noreply.github.com>
Date: Mon, 9 Feb 2026 11:42:04 +0000
Subject: [PATCH 3/4] Adjust NEE card, tests, remove plot
---
NAMESPACE | 1 -
R/fct_plots.R | 35 --------------------------------
R/mod_plot_nee.R | 35 +++++++++-----------------------
inst/app/text/viz-nee.md | 4 +---
inst/app/text/viz-tooltip-nee.md | 4 ----
man/plot_nee.Rd | 19 -----------------
tests/testthat/test-fct_plots.R | 20 +++---------------
7 files changed, 14 insertions(+), 104 deletions(-)
delete mode 100644 inst/app/text/viz-tooltip-nee.md
delete mode 100644 man/plot_nee.Rd
diff --git a/NAMESPACE b/NAMESPACE
index 3e4a64c..e287b3b 100644
--- a/NAMESPACE
+++ b/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)
diff --git a/R/fct_plots.R b/R/fct_plots.R
index 2af46eb..3b0ebcb 100644
--- a/R/fct_plots.R
+++ b/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()
- )
-}
diff --git a/R/mod_plot_nee.R b/R/mod_plot_nee.R
index 076e835..d99c116 100644
--- a/R/mod_plot_nee.R
+++ b/R/mod_plot_nee.R
@@ -4,22 +4,12 @@
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-tooltip-nee.md"),
- placement = "right"
- )
- ),
+ 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::textOutput(ns("nee_text"))),
- shinycssloaders::withSpinner(
- shiny::plotOutput(ns("nee_plot"), height = "100px")
- )
- ),
- full_screen = TRUE
+ shinycssloaders::withSpinner(shiny::htmlOutput(ns("nee_text")))
+ )
)
}
@@ -47,28 +37,23 @@ mod_plot_nee_server <- function(id, selected_strategy) {
output$nee_text <- shiny::renderText({
df <- selected_nee_data()
- nee_aggregate <- "This TPMA was not part of the NEE. No estimate is available."
+ 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(
- "The mean prediction for this TPMA was ",
+ "They predicted that a mean of ",
round(df$mean),
- "%, with an 80% prediction interval from ",
+ "% (with an 80% prediction interval from ",
round(df$percentile90),
- "% to ",
+ "% to ",
round(df$percentile10),
- "%."
+ "%) of this type of activity could be mitigated."
)
}
nee_aggregate
})
-
- output$nee_plot <- shiny::renderPlot({
- df <- selected_nee_data()
- shiny::req(nrow(df) > 0)
- plot_nee(df)
- })
})
}
diff --git a/inst/app/text/viz-nee.md b/inst/app/text/viz-nee.md
index 57b6dca..c5b089a 100644
--- a/inst/app/text/viz-nee.md
+++ b/inst/app/text/viz-nee.md
@@ -1,3 +1 @@
-Subject matter experts were invited to provide forecasts about future hospital activity (2039/40) using an [evidence-based elicitation exercise](https://doi.org/10.1136/bmjopen-2024-084632).
-Experts were asked for the expected level of activity for TPMAs following mitigation, expressed as as an 80% prediction interval.
-The aggregated results can provide a useful 'outside' view but should not be interpreted as an expectation of what can be achieved locally.
+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).
diff --git a/inst/app/text/viz-tooltip-nee.md b/inst/app/text/viz-tooltip-nee.md
deleted file mode 100644
index 0029509..0000000
--- a/inst/app/text/viz-tooltip-nee.md
+++ /dev/null
@@ -1,4 +0,0 @@
-Summarised expert predictions from the National Elicitation Exercise (NEE).
-The dot is the mean value and the horizontal bar is the 80% prediction interval.
-Predictions were for 2039/40.
-Not all TPMAs were part of the exercise.
diff --git a/man/plot_nee.Rd b/man/plot_nee.Rd
deleted file mode 100644
index cff9760..0000000
--- a/man/plot_nee.Rd
+++ /dev/null
@@ -1,19 +0,0 @@
-% 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
-}
diff --git a/tests/testthat/test-fct_plots.R b/tests/testthat/test-fct_plots.R
index 06f60b7..01eeb2d 100644
--- a/tests/testthat/test-fct_plots.R
+++ b/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)
-})
From 97d8c88ecb6ae44b7c700f17ec5ae0f654823f5d Mon Sep 17 00:00:00 2001
From: Matt Dray <18232097+matt-dray@users.noreply.github.com>
Date: Mon, 9 Feb 2026 12:26:50 +0000
Subject: [PATCH 4/4] Invert NEE value
---
R/mod_plot_nee.R | 119 ++++++++++++++++++++++++-----------------------
1 file changed, 60 insertions(+), 59 deletions(-)
diff --git a/R/mod_plot_nee.R b/R/mod_plot_nee.R
index d99c116..bdaaac7 100644
--- a/R/mod_plot_nee.R
+++ b/R/mod_plot_nee.R
@@ -1,59 +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(
- 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 ",
- round(df$mean),
- "% (with an 80% prediction interval from ",
- round(df$percentile90),
- "% to ",
- round(df$percentile10),
- "%) of this type of activity could be mitigated."
- )
- }
-
- nee_aggregate
- })
- })
-}
+#' 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 ",
+ round(100 - df$mean),
+ "% of this type of activity could be mitigated, ",
+ "with an 80% prediction interval from ",
+ round(100 - df$percentile10),
+ "% to ",
+ round(100 - df$percentile90),
+ "%."
+ )
+ }
+
+ nee_aggregate
+ })
+ })
+}