diff --git a/NAMESPACE b/NAMESPACE index 940f5ce..6f3a9b8 100644 --- a/NAMESPACE +++ b/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) diff --git a/R/app_server.R b/R/app_server.R index be9b91f..0b3badd 100644 --- a/R/app_server.R +++ b/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 + ) + }) + } diff --git a/R/app_ui.R b/R/app_ui.R index d32fed0..062e0fb 100644 --- a/R/app_ui.R +++ b/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", diff --git a/R/fct_lookups.R b/R/fct_lookups.R index 4a219aa..86a9e64 100644 --- a/R/fct_lookups.R +++ b/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') + ) +} diff --git a/man/make_mitigator_uptake_dt.Rd b/man/make_mitigator_uptake_dt.Rd new file mode 100644 index 0000000..5c9fc2c --- /dev/null +++ b/man/make_mitigator_uptake_dt.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/fct_lookups.R +\name{make_mitigator_uptake_dt} +\alias{make_mitigator_uptake_dt} +\title{Make the scheme uptake DT object} +\usage{ +make_mitigator_uptake_dt(dat, selected_schemes) +} +\arguments{ +\item{dat}{Tibble - the full prepared dataset for this app} + +\item{selected_schemes}{Character vector - a list of mitigator_codes selected by the user} +} +\value{ +DT object listing schemes and the proportions of mitigators in use by them +} +\description{ +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. +} diff --git a/man/make_scheme_uptake_dt.Rd b/man/make_scheme_uptake_dt.Rd new file mode 100644 index 0000000..eb9ff86 --- /dev/null +++ b/man/make_scheme_uptake_dt.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/fct_lookups.R +\name{make_scheme_uptake_dt} +\alias{make_scheme_uptake_dt} +\title{Make the mitigator uptake DT object} +\usage{ +make_scheme_uptake_dt(dat, selected_mitigators, selected_schemes, focal_scheme) +} +\arguments{ +\item{dat}{Tibble - the full prepared dataset for this app} + +\item{selected_schemes}{Character vector - a list of scheme_codes selected by the user} + +\item{focal_scheme}{Character vector - the focal scheme_code} +} +\value{ +DT object listing schemes and the proportions of mitigators in use by them +} +\description{ +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. +}