Skip to content

Commit f835dbf

Browse files
craig-parylocraig-parylo
authored
Merge pull request #58 from The-Strategy-Unit/48_mitigator_summary
48 mitigator summary
2 parents 9011e0d + 48187f3 commit f835dbf

6 files changed

+303
-38
lines changed

‎NAMESPACE

+2
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,7 @@
11
# Generated by roxygen2: do not edit by hand
22

3+
export(make_mitigator_uptake_dt)
4+
export(make_scheme_uptake_dt)
35
export(plot_pointrange)
46
export(populate_table)
57
export(run_app)

‎R/app_server.R

+16
Original file line numberDiff line numberDiff line change
@@ -266,4 +266,20 @@ app_server <- function(input, output, session) {
266266
trust_code_lookup |> make_scheme_dt()
267267
})
268268

269+
output$mitigator_uptake_dt <- DT::renderDT({
270+
make_mitigator_uptake_dt(
271+
dat = dat,
272+
selected_schemes = input$schemes
273+
)
274+
})
275+
276+
output$scheme_uptake_dt <- DT::renderDT({
277+
make_scheme_uptake_dt(
278+
dat = dat,
279+
selected_mitigators = input$mitigators,
280+
selected_schemes = input$schemes,
281+
focal_scheme = input$focus_scheme
282+
)
283+
})
284+
269285
}

‎R/app_ui.R

+76-38
Original file line numberDiff line numberDiff line change
@@ -210,52 +210,90 @@ app_ui <- function(request) {
210210
bslib::nav_panel(
211211
id = "nav_panel_heatmaps",
212212
title = "Heatmaps",
213-
bslib::card(
213+
214+
bslib::navset_card_underline(
215+
id = 'nav_panel_heatmaps_tabs',
214216
full_screen = TRUE,
215-
bslib::layout_sidebar(
216-
sidebar = bslib::sidebar(
217-
title = "Heatmap settings",
218-
open = TRUE,
219-
shiny::selectInput(
220-
inputId = "heatmap_type",
221-
label = bslib::tooltip(
222-
trigger = list(
223-
"Value type",
224-
bsicons::bs_icon("info-circle")
217+
218+
#### heatmaps ----
219+
bslib::nav_panel(
220+
title = bslib::tooltip(
221+
trigger = list(
222+
'Heatmaps',
223+
bsicons::bs_icon('info-circle')
224+
),
225+
'Customisable heatmaps showing distributions of values by mitigator and scheme'
226+
),
227+
bslib::layout_sidebar(
228+
sidebar = bslib::sidebar(
229+
title = "Heatmap settings",
230+
open = TRUE,
231+
shiny::selectInput(
232+
inputId = "heatmap_type",
233+
label = bslib::tooltip(
234+
trigger = list(
235+
"Value type",
236+
bsicons::bs_icon("info-circle")
237+
),
238+
"Schemes' low or high 80% confidence internal selection in the NHP inputs app, or the range or midpoint of these."
225239
),
226-
"Schemes' low or high 80% confidence internal selection in the NHP inputs app, or the range or midpoint of these."
227-
),
228-
choices = c(
229-
Binary = "value_binary",
230-
Midpoint = "value_mid",
231-
Range = "value_range",
232-
Low = "value_lo",
233-
High = "value_hi"
240+
choices = c(
241+
Binary = "value_binary",
242+
Midpoint = "value_mid",
243+
Range = "value_range",
244+
Low = "value_lo",
245+
High = "value_hi"
246+
),
247+
selected = "value_mid",
248+
multiple = FALSE
234249
),
235-
selected = "value_mid",
236-
multiple = FALSE
237-
),
238-
shiny::checkboxInput(
239-
inputId = "toggle_horizon_heatmap",
240-
label = bslib::tooltip(
241-
trigger = list(
242-
"Standardise by horizon length?",
243-
bsicons::bs_icon("info-circle")
250+
shiny::checkboxInput(
251+
inputId = "toggle_horizon_heatmap",
252+
label = bslib::tooltip(
253+
trigger = list(
254+
"Standardise by horizon length?",
255+
bsicons::bs_icon("info-circle")
256+
),
257+
"Divides the scheme's chosen mitigator values by the number of years between the chosen start and final year."
244258
),
245-
"Divides the scheme's chosen mitigator values by the number of years between the chosen start and final year."
259+
value = FALSE
246260
),
247-
value = FALSE
261+
shiny::bookmarkButton(
262+
label = "Bookmark",
263+
icon = shiny::icon("bookmark", lib = "glyphicon"),
264+
style = "color: #fff; background-color: #337ab7; border-color: #2e6da4"
265+
)
248266
),
249-
shiny::bookmarkButton(
250-
label = "Bookmark",
251-
icon = shiny::icon("bookmark", lib = "glyphicon"),
252-
style = "color: #fff; background-color: #337ab7; border-color: #2e6da4"
253-
)
267+
shiny::plotOutput("heatmap"),
268+
)
269+
),
270+
271+
#### mitigator coverage ----
272+
bslib::nav_panel(
273+
title = bslib::tooltip(
274+
trigger = list(
275+
'Mitigator coverage',
276+
bsicons::bs_icon('info-circle')
277+
),
278+
'The proportion of schemes using each mitigator',
254279
),
255-
shiny::plotOutput("heatmap"),
256-
)
257-
)
280+
DT::DTOutput("mitigator_uptake_dt")
281+
),
282+
283+
#### scheme coverage ----
284+
bslib::nav_panel(
285+
title = bslib::tooltip(
286+
trigger = list(
287+
'Scheme coverage',
288+
bsicons::bs_icon('info-circle')
289+
),
290+
'The proportion of mitigators in use by each scheme. Selected schemes are shown in bold, the focal scheme is highlighted in red.',
291+
),
292+
DT::DTOutput("scheme_uptake_dt")
293+
),
294+
),
258295
),
296+
259297
### data -----
260298
bslib::nav_panel(
261299
id = "nav_panel_data",

‎R/fct_lookups.R

+163
Original file line numberDiff line numberDiff line change
@@ -125,3 +125,166 @@ make_scheme_dt <- function(trust_code_lookup) {
125125
)
126126

127127
}
128+
129+
130+
#' Make the scheme uptake DT object
131+
#'
132+
#' Renders a DT object showing the proportion of mitigators in use by each scheme.
133+
#' Two rates are shown:
134+
#' 1. covers all available mitigators,
135+
#' 2. covers the subset of mitigators selected by the user.
136+
#'
137+
#' @param dat Tibble - the full prepared dataset for this app
138+
#' @param selected_schemes Character vector - a list of mitigator_codes selected by the user
139+
#'
140+
#' @return DT object listing schemes and the proportions of mitigators in use by them
141+
#' @export
142+
make_mitigator_uptake_dt <- function(dat, selected_schemes) {
143+
144+
dat |>
145+
# remove ampersand from mitigator names - causes issues with DT filters
146+
dplyr::mutate(
147+
mitigator_name = gsub(
148+
pattern = 'A&E',
149+
x = mitigator_name,
150+
replacement = 'ED'
151+
)
152+
) |>
153+
# count schemes per mitigator
154+
dplyr::summarise(
155+
n_schemes_using_all = dplyr::n_distinct(
156+
scheme_code,
157+
na.rm = TRUE
158+
),
159+
n_schemes_using_selected = dplyr::n_distinct(
160+
scheme_code[scheme_code %in% selected_schemes],
161+
na.rm = TRUE
162+
),
163+
.by = c(mitigator_activity_type, mitigator_group, mitigator_name)
164+
) |>
165+
# convert to rate
166+
dplyr::mutate(
167+
# get denominators
168+
n_schemes_all = dplyr::n_distinct(
169+
dat$scheme_code,
170+
na.rm = TRUE
171+
),
172+
n_schemes_selected = dplyr::n_distinct(
173+
dat$scheme_code[dat$scheme_code %in% selected_schemes],
174+
na.rm = TRUE
175+
),
176+
177+
# convert to rates
178+
n_schemes_using_all_rate = n_schemes_using_all / n_schemes_all,
179+
n_schemes_using_selected_rate = n_schemes_using_selected / n_schemes_selected
180+
) |>
181+
# prepare for display
182+
dplyr::select(
183+
-c(n_schemes_using_all, n_schemes_all,
184+
n_schemes_using_selected, n_schemes_selected)
185+
) |>
186+
dplyr::mutate(
187+
# convert mitigators to factors for drop-down selectors in DT
188+
mitigator_activity_type = mitigator_activity_type |> factor(),
189+
mitigator_group = mitigator_group |> factor(),
190+
mitigator_name = mitigator_name |> factor()
191+
) |>
192+
# display as DT
193+
DT::datatable(
194+
rownames = FALSE,
195+
options = list(pageLength = 100, dom = 'Bft'),
196+
fillContainer = TRUE,
197+
escape = TRUE,
198+
filter = 'top',
199+
colnames = c(
200+
'Activity type', 'Mitigator group', 'Mitigator',
201+
'Coverage (all schemes)', 'Coverage (selected schemes)'
202+
)
203+
) |>
204+
DT::formatPercentage(
205+
columns = c('n_schemes_using_all_rate', 'n_schemes_using_selected_rate')
206+
)
207+
}
208+
209+
210+
#' Make the mitigator uptake DT object
211+
#'
212+
#' Renders a DT object showing the proportion of mitigators used by each scheme.
213+
#' Two rates are shown:
214+
#' 1. covers all available mitigators,
215+
#' 2. covers the subset of mitigators selected by the user.
216+
#'
217+
#' @param dat Tibble - the full prepared dataset for this app
218+
#' @param selected_schemes Character vector - a list of scheme_codes selected by the user
219+
#' @param focal_scheme Character vector - the focal scheme_code
220+
#'
221+
#' @return DT object listing schemes and the proportions of mitigators in use by them
222+
#' @export
223+
make_scheme_uptake_dt <- function(dat, selected_mitigators, selected_schemes, focal_scheme) {
224+
225+
dat |>
226+
# count schemes per mitigator
227+
dplyr::summarise(
228+
n_mitigators_using_all = dplyr::n_distinct(
229+
mitigator_code,
230+
na.rm = T
231+
),
232+
n_mitigators_using_selected = dplyr::n_distinct(
233+
mitigator_code[mitigator_code %in% selected_mitigators],
234+
na.rm = T
235+
),
236+
.by = c(scheme_code, scheme_name)
237+
) |>
238+
# convert to rate
239+
dplyr::mutate(
240+
# get denominators
241+
n_mitigators_all = dplyr::n_distinct(
242+
dat$mitigator_code,
243+
na.rm = T
244+
),
245+
n_mitigators_selected = dplyr::n_distinct(
246+
dat$mitigator_code[dat$mitigator_code %in% selected_mitigators],
247+
na.rm = T
248+
),
249+
250+
# convert to rates
251+
n_mitigators_using_all_rate = n_mitigators_using_all / n_mitigators_all,
252+
n_mitigators_using_selected_rate = n_mitigators_using_selected / n_mitigators_selected
253+
) |>
254+
# prepare for display
255+
dplyr::select(
256+
-c(n_mitigators_using_all, n_mitigators_all,
257+
n_mitigators_using_selected, n_mitigators_selected)
258+
) |>
259+
dplyr::mutate(
260+
# convert scheme details to factors for drop-down selectors in DT
261+
scheme_code = scheme_code |> factor(),
262+
scheme_name = scheme_name |> factor()
263+
) |>
264+
dplyr::filter(!is.na(scheme_code)) |>
265+
# display as DT
266+
DT::datatable(
267+
rownames = FALSE,
268+
options = list(pageLength = 100, dom = 'Bft'),
269+
fillContainer = TRUE,
270+
escape = TRUE,
271+
style = 'default', # needed to ensure formatStyle works as expected - due to clashes with bslib & bootstrap theme
272+
colnames = c(
273+
'Scheme code', 'Scheme name', 'Coverage (all mitigators)',
274+
'Coverage (selected mitigators)'
275+
),
276+
filter = 'top'
277+
) |>
278+
DT::formatPercentage(
279+
columns = c('n_mitigators_using_all_rate', 'n_mitigators_using_selected_rate')
280+
) |>
281+
# style selected schemes in bold
282+
DT::formatStyle(
283+
columns = 'scheme_code',
284+
target = 'row',
285+
# highlight all selected schemes in bold
286+
fontWeight = DT::styleEqual(levels = c(selected_schemes), 'bold', 'normal'),
287+
# highlight focal scheme in red too
288+
color = DT::styleEqual(levels = focal_scheme, 'red', 'black')
289+
)
290+
}

‎man/make_mitigator_uptake_dt.Rd

+22
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

‎man/make_scheme_uptake_dt.Rd

+24
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

0 commit comments

Comments
 (0)