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_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_nee.R b/R/mod_plot_nee.R
index a66c5fc..bdaaac7 100644
--- a/R/mod_plot_nee.R
+++ b/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 ",
+ 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
+ })
+ })
+}
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-nee.md b/inst/app/text/viz-nee.md
index 541a952..c5b089a 100644
--- a/inst/app/text/viz-nee.md
+++ b/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).
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
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)
-})