48 mitigator summary

NAMESPACE

@@ -1,5 +1,7 @@
 # Generated by roxygen2: do not edit by hand
 
+export(make_mitigator_uptake_dt)
+export(make_scheme_uptake_dt)
 export(plot_pointrange)
 export(populate_table)
 export(run_app)

R/app_server.R

@@ -266,4 +266,20 @@ app_server <- function(input, output, session) {
     trust_code_lookup |> make_scheme_dt()
   })
 
+  output$mitigator_uptake_dt <- DT::renderDT({
+    make_mitigator_uptake_dt(
+      dat = dat,
+      selected_schemes = input$schemes
+    )
+  })
+
+  output$scheme_uptake_dt <- DT::renderDT({
+    make_scheme_uptake_dt(
+      dat = dat,
+      selected_mitigators = input$mitigators,
+      selected_schemes = input$schemes,
+      focal_scheme = input$focus_scheme
+    )
+  })
+
 }

R/app_ui.R

@@ -210,52 +210,90 @@ app_ui <- function(request) {
       bslib::nav_panel(
         id = "nav_panel_heatmaps",
         title = "Heatmaps",
-        bslib::card(
+
+        bslib::navset_card_underline(
+          id = 'nav_panel_heatmaps_tabs',
           full_screen = TRUE,
-          bslib::layout_sidebar(
-            sidebar = bslib::sidebar(
-              title = "Heatmap settings",
-              open = TRUE,
-              shiny::selectInput(
-                inputId = "heatmap_type",
-                label = bslib::tooltip(
-                  trigger = list(
-                    "Value type",
-                    bsicons::bs_icon("info-circle")
+
+          #### heatmaps ----
+          bslib::nav_panel(
+            title = bslib::tooltip(
+              trigger = list(
+                'Heatmaps',
+                bsicons::bs_icon('info-circle')
+              ),
+              'Customisable heatmaps showing distributions of values by mitigator and scheme'
+            ),
+            bslib::layout_sidebar(
+              sidebar = bslib::sidebar(
+                title = "Heatmap settings",
+                open = TRUE,
+                shiny::selectInput(
+                  inputId = "heatmap_type",
+                  label = bslib::tooltip(
+                    trigger = list(
+                      "Value type",
+                      bsicons::bs_icon("info-circle")
+                    ),
+                    "Schemes' low or high 80% confidence internal selection in the NHP inputs app, or the range or midpoint of these."
                   ),
-                  "Schemes' low or high 80% confidence internal selection in the NHP inputs app, or the range or midpoint of these."
-                ),
-                choices = c(
-                  Binary = "value_binary",
-                  Midpoint = "value_mid",
-                  Range = "value_range",
-                  Low = "value_lo",
-                  High = "value_hi"
+                  choices = c(
+                    Binary = "value_binary",
+                    Midpoint = "value_mid",
+                    Range = "value_range",
+                    Low = "value_lo",
+                    High = "value_hi"
+                  ),
+                  selected = "value_mid",
+                  multiple = FALSE
                 ),
-                selected = "value_mid",
-                multiple = FALSE
-              ),
-              shiny::checkboxInput(
-                inputId = "toggle_horizon_heatmap",
-                label = bslib::tooltip(
-                  trigger = list(
-                    "Standardise by horizon length?",
-                    bsicons::bs_icon("info-circle")
+                shiny::checkboxInput(
+                  inputId = "toggle_horizon_heatmap",
+                  label = bslib::tooltip(
+                    trigger = list(
+                      "Standardise by horizon length?",
+                      bsicons::bs_icon("info-circle")
+                    ),
+                    "Divides the scheme's chosen mitigator values by the number of years between the chosen start and final year."
                   ),
-                  "Divides the scheme's chosen mitigator values by the number of years between the chosen start and final year."
+                  value = FALSE
                 ),
-                value = FALSE
+                shiny::bookmarkButton(
+                  label = "Bookmark",
+                  icon = shiny::icon("bookmark", lib = "glyphicon"),
+                  style = "color: #fff; background-color: #337ab7; border-color: #2e6da4"
+                )
               ),
-              shiny::bookmarkButton(
-                label = "Bookmark",
-                icon = shiny::icon("bookmark", lib = "glyphicon"),
-                style = "color: #fff; background-color: #337ab7; border-color: #2e6da4"
-              )
+              shiny::plotOutput("heatmap"),
+            )
+          ),
+
+          #### mitigator coverage ----
+          bslib::nav_panel(
+            title = bslib::tooltip(
+              trigger = list(
+                'Mitigator coverage',
+                bsicons::bs_icon('info-circle')
+              ),
+              'The proportion of schemes using each mitigator',
             ),
-            shiny::plotOutput("heatmap"),
-          )
-        )
+            DT::DTOutput("mitigator_uptake_dt")
+          ),
+
+          #### scheme coverage ----
+          bslib::nav_panel(
+            title = bslib::tooltip(
+              trigger = list(
+                'Scheme coverage',
+                bsicons::bs_icon('info-circle')
+              ),
+              'The proportion of mitigators in use by each scheme. Selected schemes are shown in bold, the focal scheme is highlighted in red.',
+            ),
+            DT::DTOutput("scheme_uptake_dt")
+          ),
+        ),
       ),
+
       ### data -----
       bslib::nav_panel(
         id = "nav_panel_data",

R/fct_lookups.R

@@ -125,3 +125,166 @@ make_scheme_dt <- function(trust_code_lookup) {
     )
 
 }
+
+
+#' Make the scheme uptake DT object
+#'
+#' Renders a DT object showing the proportion of mitigators in use by each scheme.
+#' Two rates are shown:
+#' 1. covers all available mitigators,
+#' 2. covers the subset of mitigators selected by the user.
+#'
+#' @param dat Tibble - the full prepared dataset for this app
+#' @param selected_schemes Character vector - a list of mitigator_codes selected by the user
+#'
+#' @return DT object listing schemes and the proportions of mitigators in use by them
+#' @export
+make_mitigator_uptake_dt <- function(dat, selected_schemes) {
+
+  dat |>
+    # remove ampersand from mitigator names - causes issues with DT filters
+    dplyr::mutate(
+      mitigator_name = gsub(
+        pattern = 'A&E',
+        x = mitigator_name,
+        replacement = 'ED'
+      )
+    ) |>
+    # count schemes per mitigator
+    dplyr::summarise(
+      n_schemes_using_all = dplyr::n_distinct(
+        scheme_code,
+        na.rm = TRUE
+      ),
+      n_schemes_using_selected = dplyr::n_distinct(
+        scheme_code[scheme_code %in% selected_schemes],
+        na.rm = TRUE
+      ),
+      .by = c(mitigator_activity_type, mitigator_group, mitigator_name)
+    ) |>
+    # convert to rate
+    dplyr::mutate(
+      # get denominators
+      n_schemes_all = dplyr::n_distinct(
+        dat$scheme_code,
+        na.rm = TRUE
+      ),
+      n_schemes_selected = dplyr::n_distinct(
+        dat$scheme_code[dat$scheme_code %in% selected_schemes],
+        na.rm = TRUE
+      ),
+
+      # convert to rates
+      n_schemes_using_all_rate = n_schemes_using_all / n_schemes_all,
+      n_schemes_using_selected_rate = n_schemes_using_selected / n_schemes_selected
+    ) |>
+    # prepare for display
+    dplyr::select(
+      -c(n_schemes_using_all, n_schemes_all,
+         n_schemes_using_selected, n_schemes_selected)
+    ) |>
+    dplyr::mutate(
+      # convert mitigators to factors for drop-down selectors in DT
+      mitigator_activity_type = mitigator_activity_type |> factor(),
+      mitigator_group = mitigator_group |> factor(),
+      mitigator_name = mitigator_name |> factor()
+    ) |>
+    # display as DT
+    DT::datatable(
+      rownames = FALSE,
+      options = list(pageLength = 100, dom = 'Bft'),
+      fillContainer = TRUE,
+      escape = TRUE,
+      filter = 'top',
+      colnames = c(
+        'Activity type', 'Mitigator group', 'Mitigator',
+        'Coverage (all schemes)', 'Coverage (selected schemes)'
+      )
+    ) |>
+    DT::formatPercentage(
+      columns = c('n_schemes_using_all_rate', 'n_schemes_using_selected_rate')
+    )
+}
+
+
+#' Make the mitigator uptake DT object
+#'
+#' Renders a DT object showing the proportion of mitigators used by each scheme.
+#' Two rates are shown:
+#' 1. covers all available mitigators,
+#' 2. covers the subset of mitigators selected by the user.
+#'
+#' @param dat Tibble - the full prepared dataset for this app
+#' @param selected_schemes Character vector - a list of scheme_codes selected by the user
+#' @param focal_scheme Character vector - the focal scheme_code
+#'
+#' @return DT object listing schemes and the proportions of mitigators in use by them
+#' @export
+make_scheme_uptake_dt <- function(dat, selected_mitigators, selected_schemes, focal_scheme) {
+
+  dat |>
+    # count schemes per mitigator
+    dplyr::summarise(
+      n_mitigators_using_all = dplyr::n_distinct(
+        mitigator_code,
+        na.rm = T
+      ),
+      n_mitigators_using_selected = dplyr::n_distinct(
+        mitigator_code[mitigator_code %in% selected_mitigators],
+        na.rm = T
+      ),
+      .by = c(scheme_code, scheme_name)
+    ) |>
+    # convert to rate
+    dplyr::mutate(
+      # get denominators
+      n_mitigators_all = dplyr::n_distinct(
+        dat$mitigator_code,
+        na.rm = T
+      ),
+      n_mitigators_selected = dplyr::n_distinct(
+        dat$mitigator_code[dat$mitigator_code %in% selected_mitigators],
+        na.rm = T
+      ),
+
+      # convert to rates
+      n_mitigators_using_all_rate = n_mitigators_using_all / n_mitigators_all,
+      n_mitigators_using_selected_rate = n_mitigators_using_selected / n_mitigators_selected
+    ) |>
+    # prepare for display
+    dplyr::select(
+      -c(n_mitigators_using_all, n_mitigators_all,
+         n_mitigators_using_selected, n_mitigators_selected)
+    ) |>
+    dplyr::mutate(
+      # convert scheme details to factors for drop-down selectors in DT
+      scheme_code = scheme_code |> factor(),
+      scheme_name = scheme_name |> factor()
+    ) |>
+    dplyr::filter(!is.na(scheme_code)) |>
+    # display as DT
+    DT::datatable(
+      rownames = FALSE,
+      options = list(pageLength = 100, dom = 'Bft'),
+      fillContainer = TRUE,
+      escape = TRUE,
+      style = 'default', # needed to ensure formatStyle works as expected - due to clashes with bslib & bootstrap theme
+      colnames = c(
+        'Scheme code', 'Scheme name', 'Coverage (all mitigators)',
+        'Coverage (selected mitigators)'
+      ),
+      filter = 'top'
+    ) |>
+    DT::formatPercentage(
+      columns = c('n_mitigators_using_all_rate', 'n_mitigators_using_selected_rate')
+    ) |>
+    # style selected schemes in bold
+    DT::formatStyle(
+      columns = 'scheme_code',
+      target = 'row',
+      # highlight all selected schemes in bold
+      fontWeight = DT::styleEqual(levels = c(selected_schemes), 'bold', 'normal'),
+      # highlight focal scheme in red too
+      color = DT::styleEqual(levels = focal_scheme, 'red', 'black')
+    )
+}