Merge pull request #19 from The-Strategy-Unit/14-md

Add TPMA descriptions

Author: matt-dray

DESCRIPTION

@@ -16,10 +16,14 @@ Imports:
     bslib,
     dplyr,
     ggplot2,
+    glue,
     jsonlite,
+    markdown,
     purrr,
     rlang,
-    shiny
+    shiny,
+    stringr,
+    withr
 Remotes:
     The-Strategy-Unit/azkit
 Encoding: UTF-8

NAMESPACE

@@ -1,5 +1,7 @@
 # Generated by roxygen2: do not edit by hand
 
+export(convert_md_to_html)
+export(fetch_strategy_description)
 export(plot_rates)
 export(run_app)
 importFrom(rlang,.data)

R/ZZZ.R

@@ -1,2 +1,4 @@
 #' @importFrom rlang .data .env
 NULL
+
+utils::globalVariables("temp")

R/app_server.R

@@ -9,11 +9,14 @@ app_server <- function(input, output, session) {
     app_sys("app", "data", "datasets.json"),
     simplify_vector = TRUE
   )
-
   strategies_lookup <- jsonlite::read_json(
     app_sys("app", "data", "mitigators.json"),
     simplify_vector = TRUE
   )
+  descriptions_lookup <- jsonlite::read_json(
+    "inst/app/data/descriptions.json",
+    simplifyVector = TRUE
+  )
 
   selected_provider <- mod_select_provider_server(
     "mod_select_provider",
@@ -24,6 +27,11 @@ app_server <- function(input, output, session) {
     strategies_lookup
   )
 
+  mod_show_description_server(
+    "mod_show_description",
+    descriptions_lookup,
+    selected_strategy
+  )
   mod_plot_trend_server(
     "mod_plot_trend",
     rates_data,

R/app_ui.R

@@ -20,10 +20,16 @@ app_ui <- function(request) {
       The information presented here should not be relied on as fact."
     ),
 
-    bslib::card(
-      bslib::card_header("Trend in rates"),
-      bslib::card_body(mod_plot_trend_ui("mod_plot_trend")),
-      full_screen = TRUE
+    bslib::layout_columns(
+      bslib::card(
+        bslib::card_header("Description"),
+        bslib::card_body(mod_show_description_ui("mod_show_description"))
+      ),
+      bslib::card(
+        bslib::card_header("Trend in rates"),
+        bslib::card_body(mod_plot_trend_ui("mod_plot_trend")),
+        full_screen = TRUE
+      )
     )
   )
 }

R/mod_show_description.R

@@ -0,0 +1,25 @@
+#' Show Descriptions UI
+#' @param id,input,output,session Internal parameters for `shiny`.
+#' @noRd
+mod_show_description_ui <- function(id) {
+  ns <- shiny::NS(id)
+  shiny::htmlOutput(ns("strategy_description"))
+}
+
+#' Show Descriptions Server
+#' @param id Internal parameter for `shiny`.
+#' @noRd
+mod_show_description_server <- function(
+  id,
+  descriptions_lookup,
+  selected_strategy
+) {
+  shiny::moduleServer(id, function(input, output, session) {
+    output$strategy_description <- shiny::renderText({
+      shiny::req(selected_strategy())
+      selected_strategy() |>
+        fetch_strategy_description(descriptions_lookup) |>
+        convert_md_to_html()
+    })
+  })
+}

R/utils_description.R

@@ -0,0 +1,36 @@
+#' Fetch Strategy Text from NHP Inputs
+#' @param strategy Character. The variable name for a strategy, e.g.
+#'     `"discharged_no_treatment_adult_ambulance"`.
+#' @param descriptions_lookup Character. The names of the available Markdown
+#'     description files.
+#' @details Markdown files containing strategy descriptions are read from
+#'     [NHP Inputs](https://github.com/The-Strategy-Unit/nhp_inputs/).
+#' @return Character.
+#' @export
+fetch_strategy_description <- function(strategy, descriptions_lookup) {
+  is_stub <- stringr::str_detect(strategy, descriptions_lookup)
+  strategy_stub <- descriptions_lookup[is_stub]
+
+  withr::with_tempfile("temp", {
+    # nolint start object_usage_linter.
+    utils::download.file(
+      glue::glue(
+        "https://raw.githubusercontent.com/The-Strategy-Unit/nhp_inputs/",
+        "refs/heads/main/inst/app/strategy_text/{strategy_stub}.md"
+      ),
+      temp
+    )
+    cat("\n", file = temp, append = TRUE) # stop 'incomplete final line' warning
+    paste(readLines(temp), collapse = "\n")
+    # nolint end
+  })
+}
+
+#' Convert Strategy Text from Markdown to HTML
+#' @param text Character. The Markdown text description for a strategy, as read
+#'     by [fetch_strategy_description].
+#' @return HTML/character.
+#' @export
+convert_md_to_html <- function(text) {
+  shiny::HTML(markdown::mark_html(text, output = FALSE, template = FALSE))
+}

inst/app/data/descriptions.json

@@ -0,0 +1,40 @@
+[
+    "alcohol_partially_attributable",
+    "alcohol_wholly_attributable",
+    "ambulatory_care_conditions",
+    "ambulatory_emergency_care",
+    "cancelled_operations",
+    "consultant_to_consultant_reduction",
+    "convert_to_tele",
+    "day_procedures",
+    "discharged_no_treatment",
+    "emergency_elderly",
+    "enhanced_recovery",
+    "eol_care",
+    "evidence_based_interventions",
+    "excess_beddays",
+    "falls_related_admissions",
+    "followup_reduction",
+    "frail_elderly",
+    "frequent_attenders",
+    "general_los_reduction",
+    "gp_referred_first_attendance_reduction",
+    "intentional_self_harm",
+    "left_before_seen",
+    "low_cost_discharged",
+    "medically_unexplained_related_admissions",
+    "medicines_related_admissions",
+    "obesity_related_admissions",
+    "pre-op_los",
+    "raid_ae",
+    "raid_ip",
+    "readmission_within_28_days",
+    "same_day_emergency_care",
+    "smoking",
+    "stroke_early_supported_discharge",
+    "virtual_wards_activity_avoidance_ari",
+    "virtual_wards_activity_avoidance_heart_failure",
+    "virtual_wards_efficiencies_ari",
+    "virtual_wards_efficiencies_heart_failure",
+    "zero_los_no_procedure"
+]