From e820902eb3de5b01db7e1693b63303460df45403 Mon Sep 17 00:00:00 2001
From: Jake Tufts <137207796+JT-39@users.noreply.github.com>
Date: Thu, 12 Dec 2024 12:37:43 +0000
Subject: [PATCH] Eesp review fixes (#49)
* Chore: Removing compact table setting from info page
* Feat: New navigation style - same as apprenticeship, cookies not quite working
* Chore: Added gov link colour
* Feat: Updated dfeshiny to use the new header() fn
* Chore: Deleted unused example_tab file
* Chore: Removing overflow site
* Chore: Standardising site title useage, improving custom_disconnect_message
* Fix: Cookies still not working properly possibly
* Chore: Moving footer and left navigation fns to helper
* Chore: Storing the main panels in their own scripts in ui_panels
* Chore: Removing useShinydashboard() from ui
* Chore: Tidying footer code
* Chore: Changed .csv to CSV
* Fix: Adding generic_ggiraph_options() to error plots
* Fix: Using dfereactable on error tables
* Fix: Replacing window_title logic to suit new navigation method
* Fix: Corrected the cookies issue where the id was too strict so banner link not working
* Feat: Adding pages id to bookmark so footer pages included too
* Chore: Improving clarity of Create Your Own downlaod data from github msg
* Chore: Changing text spinners to black and adding color option to with_gov_spinners()
* Chore: Moving navigation fns to ui_layout fn script
* Feat: Improving column names for LA and Regions also removing unecessary card headers
* Chore: Standardising all tabs, also made tab text not bold
* Chore: More consistent font sizes on Create Your Own inputs
* Chore: Adding more header and intro info to Create Your Own page
* Chore: Adding tooltip and rank colname for All LA regions table
* Feat: Adding alt-text options for charts
* Feat: Hiding copy to clipboard button and plot from screen readers
* Feat: Download UI calculates actual size of the download, both table and image
* Feat: Removing image filesize calc due to time taken
* Feat: Dataset file size now calculating based on size of csv or xlsx dataset (not id name)
* Chore: Adding spinning gear icon on developer updates to hidden for screen readers
* Chore: Updating email contacts for team email
* Feat: Ammending the support panel so it shows relevant info - still some test text in there
* Feat: Adding return to the top button
* Chore: Making contents title break words
* Fix: Change id for download file text logic as was same as the button id
* Fix: Screenshot of charts now working as added shinyWidgets::useShinydashboard() back in
* Fix: Removing screenshot tests and shinyWidgets::useShinydashboard()
* Chore: Increase chart download modal size so fits the text (file size info)
* Chore: Seperating out the calculate_file_size fn from the file_type_input_btn fn
---
.github/CONTRIBUTING.md | 52 +-
02_dev/info_pages/dev_user_guide.R | 11 +-
02_dev/la_level_page/la_dev_app.R | 1289 +++++++------
02_dev/la_level_page/la_dev_app_mod.R | 2 +-
R/fn_analysis.R | 8 +-
R/fn_helper_functions.R | 4 +-
R/fn_load_data.R | 680 +++----
R/fn_table_helpers.R | 4 +-
R/fn_ui_layout.R | 205 +-
R/lait_modules/mod_all_la_table.R | 64 +-
R/lait_modules/mod_app_helpers.R | 5 +-
R/lait_modules/mod_app_inputs.R | 364 ++--
R/lait_modules/mod_create_own_charts.R | 18 +-
R/lait_modules/mod_create_own_inputs.R | 11 +-
R/lait_modules/mod_create_own_table.R | 1715 +++++++++--------
R/lait_modules/mod_info_page.R | 729 +++----
R/lait_modules/mod_la_lvl_charts.R | 736 +++----
R/lait_modules/mod_la_lvl_metadata.R | 2 +-
R/lait_modules/mod_la_lvl_table.R | 14 +-
R/lait_modules/mod_region_table.R | 81 +-
R/lait_modules/mod_stat_n_table.R | 51 +-
R/ui_panels/accessibility_statement.R | 318 ++-
R/ui_panels/all_la_level_panel.R | 9 +
R/ui_panels/create_your_own_panel.R | 43 +
R/ui_panels/example_tab_1.R | 130 --
R/ui_panels/la_level_panel.R | 22 +
R/ui_panels/region_level_panel.R | 21 +
R/ui_panels/stat_n_level_panel.R | 27 +
R/ui_panels/support_panel.R | 49 +
README.md | 4 +-
global.R | 8 +-
renv.lock | 63 +-
server.R | 117 +-
.../la-charts-la_bar_chart.png | Bin 23455 -> 23129 bytes
.../la-charts-la_line_chart.png | Bin 25789 -> 25497 bytes
tests/testthat/test-UI-mod_la_lvl_table.R | 20 +-
ui.R | 317 +--
www/cookie-consent.js | 50 +-
www/dfe_shiny_gov_style.css | 73 +-
39 files changed, 3733 insertions(+), 3583 deletions(-)
create mode 100644 R/ui_panels/all_la_level_panel.R
create mode 100644 R/ui_panels/create_your_own_panel.R
delete mode 100644 R/ui_panels/example_tab_1.R
create mode 100644 R/ui_panels/la_level_panel.R
create mode 100644 R/ui_panels/region_level_panel.R
create mode 100644 R/ui_panels/stat_n_level_panel.R
create mode 100644 R/ui_panels/support_panel.R
diff --git a/.github/CONTRIBUTING.md b/.github/CONTRIBUTING.md
index 8246a6e3..4d8d0b15 100644
--- a/.github/CONTRIBUTING.md
+++ b/.github/CONTRIBUTING.md
@@ -1,26 +1,26 @@
-# How to contribute
-
-Thank you for looking to contribute to our project! The following document outlines our contributors guidance.
-
-## Reporting bugs or features
-
-If you spot a bug or feature you want to report, please check first that it has not been reported as an [issue](https://github.com/dfe-analytical-services/shiny-template/issues) already.
-
-If no issue is open for your bug or feature, please [open a new one](https://github.com/dfe-analytical-services/shiny-template/issues/new)
-
-Please use the templates provided to ensure that there is sufficient detail in your reported issue.
-
-## Pull requests
-
-If you have written some code that fixes a bug or feature, please push this up in a new branch under the format "bug/issue" and open this as a new PR when it is ready to review.
-
-- Ensure the PR description clearly describes the problem and solution.
-- Include the relevant issue number if applicable.
-
-### Code styling
-
-All code is styled using the styleR package. Running the `styler::style_dir()` function before pushing up to branch ensures that your code is in line with our style, and passes the pre-commit hooks.
-
-## Any other questions
-
-If you have any other questions, please do not hesitate to contact us at jake.tufts@education.gov.uk or explore.statistics@education.gov.uk
+# How to contribute
+
+Thank you for looking to contribute to our project! The following document outlines our contributors guidance.
+
+## Reporting bugs or features
+
+If you spot a bug or feature you want to report, please check first that it has not been reported as an [issue](https://github.com/dfe-analytical-services/shiny-template/issues) already.
+
+If no issue is open for your bug or feature, please [open a new one](https://github.com/dfe-analytical-services/shiny-template/issues/new)
+
+Please use the templates provided to ensure that there is sufficient detail in your reported issue.
+
+## Pull requests
+
+If you have written some code that fixes a bug or feature, please push this up in a new branch under the format "bug/issue" and open this as a new PR when it is ready to review.
+
+- Ensure the PR description clearly describes the problem and solution.
+- Include the relevant issue number if applicable.
+
+### Code styling
+
+All code is styled using the styleR package. Running the `styler::style_dir()` function before pushing up to branch ensures that your code is in line with our style, and passes the pre-commit hooks.
+
+## Any other questions
+
+If you have any other questions, please do not hesitate to contact us at Darlington.BRIDGE@education.gov.uk or explore.statistics@education.gov.uk
diff --git a/02_dev/info_pages/dev_user_guide.R b/02_dev/info_pages/dev_user_guide.R
index a432749e..a6f9cc08 100644
--- a/02_dev/info_pages/dev_user_guide.R
+++ b/02_dev/info_pages/dev_user_guide.R
@@ -77,15 +77,8 @@ ui_dev <- function(input, output, session) {
shinyGovstyle::banner(
"beta banner",
"beta",
- paste0(
- "This Dashboard is in beta phase and we are still reviewing performance
- and reliability. ",
- "In case of slowdown or connection issues due to high demand, we have
- produced two instances of this site which can be accessed at the
- following links: ",
- "Site 1 and ",
- "Site 2."
- )
+ "This Dashboard is in beta phase and we are still reviewing performance
+ and reliability. "
),
# Start of app ============================================================
diff --git a/02_dev/la_level_page/la_dev_app.R b/02_dev/la_level_page/la_dev_app.R
index 7bc32945..ce50a270 100644
--- a/02_dev/la_level_page/la_dev_app.R
+++ b/02_dev/la_level_page/la_dev_app.R
@@ -1,645 +1,644 @@
-# Load global
-source(here::here("global.R"))
-
-# Load functions
-list.files("R/", full.names = TRUE) |>
- (\(x) {
- x[grepl("fn_", x)]
- })() |>
- purrr::walk(source)
-
-
-# UI
-ui_dev <- bslib::page_fillable(
-
- ## Custom CSS =============================================================
- shiny::includeCSS(here::here("www/dfe_shiny_gov_style.css")),
-
- # Tab header ==============================================================
- h1("Local Authority View"),
- div(
- class = "well",
- style = "overflow-y: visible;",
- bslib::layout_column_wrap(
- width = "15rem", # Minimum width for each input box before wrapping
- shiny::selectizeInput(
- inputId = "la_input",
- label = "LA:",
- choices = la_names_bds
- ),
- shiny::selectizeInput(
- inputId = "topic_input",
- label = "Topic:",
- choices = c("All topics", metric_topics),
- multiple = TRUE,
- options = list(
- maxItems = 1,
- placeholder = "No topic selected, showing all indicators.",
- plugins = list("clear_button"),
- dropdownParent = "body"
- )
- ),
- shiny::selectizeInput(
- inputId = "indicator",
- label = "Indicator:",
- choices = metric_names
- )
- ),
- # Conditional State-funded school banner
- shiny::uiOutput("state_funded_banner")
- ),
- div(
- class = "well",
- style = "overflow-y: visible;",
- bslib::card(
- bslib::card_header("Local Authority, Region and England"),
- bslib::card_body(
- shinycssloaders::withSpinner(
- reactable::reactableOutput("la_table"),
- type = 6,
- color = "#1d70b8"
- )
- )
- )
- ),
- div(
- class = "well",
- style = "overflow-y: visible;",
- bslib::card(
- bslib::card_body(
- shinycssloaders::withSpinner(
- reactable::reactableOutput("la_stats_table"),
- type = 6,
- color = "#1d70b8",
- size = 0.5,
- proxy.height = "100px"
- )
- )
- )
- ),
- div(
- class = "well",
- style = "overflow-y: visible;",
- bslib::navset_card_underline(
- id = "la_charts",
- bslib::nav_panel(
- title = "Line chart",
- bslib::card(
- bslib::card_body(
- shinycssloaders::withSpinner(
- ggiraph::girafeOutput("la_line_chart"),
- type = 6,
- color = "#1d70b8"
- )
- ),
- full_screen = TRUE
- ),
- ),
- bslib::nav_panel(
- title = "Bar chart",
- bslib::card(
- id = "la_bar_body",
- bslib::card_body(
- shinycssloaders::withSpinner(
- ggiraph::girafeOutput("la_bar_chart"),
- type = 6,
- color = "#1d70b8"
- )
- ),
- full_screen = TRUE
- )
- )
- )
- ),
- div(
- class = "well",
- style = "overflow-y: visible;",
- bslib::card(
- bslib::card_body(
- h3("Description:"),
- shinycssloaders::withSpinner(
- textOutput("description"),
- type = 6,
- color = "#1d70b8"
- ),
- h3("Methodology:"),
- shinycssloaders::withSpinner(
- uiOutput("methodology"),
- type = 6,
- color = "#1d70b8"
- ),
- div(
- # Creates a flex container where the items are centered vertically
- style = "display: flex; align-items: baseline;",
- h3("Last Updated:",
- style = "margin-right: 1rem; margin-bottom: 0.3rem;"
- ),
- shinycssloaders::withSpinner(
- textOutput("last_update"),
- type = 6,
- color = "#1d70b8"
- )
- ),
- div(
- style = "display: flex; align-items: baseline;",
- h3("Next Updated:",
- style = "margin-right: 1rem; margin-bottom: 0.3rem;"
- ),
- shinycssloaders::withSpinner(
- uiOutput("next_update"),
- type = 6,
- color = "#1d70b8"
- )
- ),
- div(
- style = "display: flex; align-items: baseline;",
- h3("Source:",
- style = "margin-right: 1rem; margin-bottom: 0.3rem;"
- ),
- shinycssloaders::withSpinner(
- uiOutput("source"),
- type = 6,
- color = "#1d70b8"
- )
- )
- )
- )
- )
-)
-
-
-# Server
-server_dev <- function(input, output, session) {
- # Input ----------------------------------
- # Using the server to power to the provider dropdown for increased speed
- shiny::observeEvent(input$topic_input,
- {
- # Save the currently selected indicator
- current_indicator <- input$indicator
-
- # Get indicator choices for selected topic
- # Include all rows if no topic is selected or "All topics" is selected
- filtered_topic_bds <- bds_metrics |>
- dplyr::filter(
- if (is.null(input$topic_input) || "All topics" %in% input$topic_input) {
- TRUE
- } else {
- .data$Topic %in% input$topic_input # Filter by selected topic(s)
- }
- ) |>
- pull_uniques("Measure")
-
- # Ensure the current indicator stays selected if it's in the new list of available indicators
- # Default to the first available indicator if the current one is no longer valid
- selected_indicator <- if (current_indicator %in% filtered_topic_bds) {
- current_indicator
- } else {
- filtered_topic_bds[1]
- }
-
- shiny::updateSelectizeInput(
- session = session,
- inputId = "indicator",
- label = "Indicator:",
- choices = filtered_topic_bds,
- selected = selected_indicator
- )
- },
- ignoreNULL = FALSE
- )
-
-
- # Main LA Level table ----------------------------------
- # Filter for selectedindicator
- # Define filtered_bds outside of observeEvent
- filtered_bds <- reactiveValues(data = NULL)
-
- observeEvent(input$indicator, {
- # Don't change the currently selected indicator if no indicator is selected
- if (is.null(input$indicator) || input$indicator == "") {
- return()
- }
-
- # Main LA Level table ----------------------------------
- # Filter for selected indicator
- filtered_bds$data <- bds_metrics |>
- dplyr::filter(
- Measure == input$indicator
- )
- })
-
- # Get decimal places for indicator selected
- indicator_dps <- reactive({
- filtered_bds$data |>
- get_indicator_dps()
- })
-
- # Long format LA data
- la_long <- reactive({
- # Filter stat neighbour for selected LA
- filtered_sn <- stat_n_la |>
- dplyr::filter(`LA Name` == input$la_input)
-
- # Statistical Neighbours
- la_sns <- filtered_sn |>
- pull_uniques("LA Name_sn")
-
- # LA region
- la_region <- filtered_sn |>
- pull_uniques("GOReg")
-
- # Determine London region to use
- la_region_ldn_clean <- clean_ldn_region(
- la_region,
- filtered_bds$data
- )
-
- # Then filter for selected LA, region, stat neighbours and relevant national
- la_filtered_bds <- filtered_bds$data |>
- dplyr::filter(
- `LA and Regions` %in% c(input$la_input, la_region_ldn_clean, la_sns, "England")
- )
-
- # SN average
- sn_avg <- la_filtered_bds |>
- dplyr::filter(`LA and Regions` %in% la_sns) |>
- dplyr::summarise(
- values_num = dplyr::na_if(mean(values_num, na.rm = TRUE), NaN),
- .by = c("Years", "Years_num")
- ) |>
- dplyr::mutate(
- "LA Number" = "-",
- "LA and Regions" = "Statistical Neighbours",
- .before = "Years"
- )
-
- # LA levels long
- la_filtered_bds |>
- dplyr::filter(`LA and Regions` %notin% c(la_sns)) |>
- dplyr::select(`LA Number`, `LA and Regions`, Years, Years_num, values_num) |>
- dplyr::bind_rows(sn_avg) |>
- dplyr::mutate(
- `LA and Regions` = factor(
- `LA and Regions`,
- levels = c(
- input$la_input, la_region_ldn_clean,
- "Statistical Neighbours", "England"
- )
- )
- )
- })
-
- # Difference between last two years
- la_diff <- reactive({
- la_long() |>
- dplyr::group_by(`LA and Regions`) |>
- dplyr::arrange(`LA and Regions`, desc(Years)) |>
- dplyr::mutate(
- values_num = dplyr::lag(values_num) - values_num,
- Years = "Change from previous year"
- ) |>
- dplyr::filter(dplyr::row_number() == 2)
- })
-
- # Build Main LA Level table
- la_table <- shiny::reactive({
- # Join difference and pivot wider to recreate LAIT table
- la_long() |>
- dplyr::bind_rows(la_diff()) |>
- tidyr::pivot_wider(
- id_cols = c("LA Number", "LA and Regions"),
- names_from = Years,
- values_from = values_num
- ) |>
- dplyr::arrange(`LA and Regions`)
- })
-
-
- # Stet funded school banner (appears for certain indicators)
- output$state_funded_banner <- renderUI({
- # Get whether state-funded idnicator
- state_funded <- filtered_bds$data |>
- pull_uniques("state_funded_flag") |>
- (\(x) !is.na(x))()
-
- # Render banner if state-funded
- if (state_funded) {
- tagList(
- br(),
- shinyGovstyle::noti_banner(
- inputId = "notId",
- title_txt = "Note",
- body_txt = "Data includes only State-funded Schools."
- )
- )
- }
- })
-
- output$la_table <- reactable::renderReactable({
- dfe_reactable(
- la_table(),
- columns = utils::modifyList(
- format_num_reactable_cols(
- la_table(),
- get_indicator_dps(filtered_bds$data),
- num_exclude = "LA Number"
- ),
- set_custom_default_col_widths()
- ),
- rowStyle = function(index) {
- highlight_selected_row(index, la_table(), input$la_input)
- }
- )
- })
-
-
- # Stats LA Level table ----------------------------------
- la_stats_table <- shiny::reactive({
- # Extract change from prev year (from LA table)
- la_change_prev <- la_diff() |>
- filter_la_regions(input$la_input, pull_col = "values_num")
-
- # Set the trend value
- la_trend <- as.numeric(la_change_prev)
-
- # Get polarity of indicator
- la_indicator_polarity <- filtered_bds$data |>
- pull_uniques("Polarity")
-
- # Get latest rank, ties are set to min & NA vals to NA rank
- la_rank <- filtered_bds$data |>
- filter_la_regions(la_names_bds, latest = TRUE) |>
- calculate_rank(la_indicator_polarity) |>
- filter_la_regions(input$la_input, pull_col = "rank")
-
- # Calculate quartile bands for indicator
- la_quartile_bands <- filtered_bds$data |>
- filter_la_regions(la_names_bds, latest = TRUE, pull_col = "values_num") |>
- quantile(na.rm = TRUE)
-
- # Extracting LA latest value
- la_indicator_val <- filtered_bds$data |>
- filter_la_regions(input$la_input, latest = TRUE, pull_col = "values_num")
-
- # Boolean as to whether to include Quartile Banding
- no_show_qb <- input$indicator %in% no_qb_indicators
-
- # Calculating which quartile this value sits in
- la_quartile <- calculate_quartile_band(
- la_indicator_val,
- la_quartile_bands,
- la_indicator_polarity
- )
-
- # Build stats LA Level table
- la_stats_table <- build_la_stats_table(
- la_diff(),
- input$la_input,
- la_trend,
- la_change_prev,
- la_rank,
- la_quartile,
- la_quartile_bands,
- get_indicator_dps(filtered_bds$data),
- la_indicator_polarity,
- no_show_qb
- )
-
- la_stats_table
- })
-
- output$la_stats_table <- reactable::renderReactable({
- dfe_reactable(
- la_stats_table(),
- columns = modifyList(
- # Create the reactable with specific column alignments
- format_num_reactable_cols(
- la_stats_table(),
- get_indicator_dps(filtered_bds$data),
- num_exclude = "LA Number",
- categorical = c(
- "Trend", "Quartile Banding", "Latest National Rank",
- "A", "B",
- "C", "D"
- )
- ),
- # Style Quartile Banding column with colour
- list(
- set_custom_default_col_widths(),
- Trend = reactable::colDef(
- header = add_tooltip_to_reactcol(
- "Trend",
- "Based on change from previous year"
- ),
- cell = trend_icon_renderer,
- style = function(value) {
- get_trend_colour(value, la_stats_table()$Polarity[1])
- }
- ),
- `Quartile Banding` = reactable::colDef(
- style = function(value, index) {
- quartile_banding_col_def(la_stats_table()[index, ])
- }
- ),
- `Latest National Rank` = reactable::colDef(
- header = add_tooltip_to_reactcol(
- "Latest National Rank",
- "Rank 1 is always best/top"
- )
- ),
- Polarity = reactable::colDef(show = FALSE)
- )
- )
- )
- })
-
-
- # LA Level line chart plot ----------------------------------
- la_line_chart <- reactive({
- # Generate the covid plot data if add_covid_plot is TRUE
- covid_plot <- calculate_covid_plot(
- la_long(),
- covid_affected_data,
- input$indicator,
- "line"
- )
-
- # Build plot
- la_line_chart <- la_long() |>
- # Set geog orders so selected LA is on top of plot
- reorder_la_regions(reverse = TRUE) |>
- ggplot2::ggplot() +
- ggiraph::geom_line_interactive(
- ggplot2::aes(
- x = Years_num,
- y = values_num,
- color = `LA and Regions`,
- data_id = `LA and Regions`
- ),
- na.rm = TRUE,
- linewidth = 1
- ) +
- # Only show point data where line won't appear (NAs)
- ggplot2::geom_point(
- data = subset(create_show_point(
- la_long(),
- covid_affected_data,
- input$indicator
- ), show_point),
- ggplot2::aes(
- x = Years_num,
- y = values_num,
- color = `LA and Regions`
- ),
- shape = 15,
- size = 1,
- na.rm = TRUE
- ) +
- # Add COVID plot if indicator affected
- add_covid_elements(covid_plot) +
- format_axes(la_long()) +
- set_plot_colours(la_long(), focus_group = input$la_input) +
- set_plot_labs(filtered_bds$data) +
- custom_theme() +
- # Revert order of the legend so goes from right to left
- ggplot2::guides(color = ggplot2::guide_legend(reverse = TRUE))
-
- # Creating vertical geoms to make vertical hover tooltip
- vertical_hover <- lapply(
- get_years(la_long()),
- tooltip_vlines,
- la_long(),
- indicator_dps(),
- input$la_input
- )
-
- # Plotting interactive graph
- ggiraph::girafe(
- ggobj = (la_line_chart + vertical_hover),
- width_svg = 8.5,
- options = generic_ggiraph_options(
- opts_hover(
- css = "stroke-dasharray:5,5;stroke:black;stroke-width:2px;"
- )
- ),
- fonts = list(sans = "Arial")
- )
- })
-
- output$la_line_chart <- ggiraph::renderGirafe({
- la_line_chart()
- })
-
-
- # LA Level bar plot ----------------------------------
- la_bar_chart <- reactive({
- # Generate the covid plot data if add_covid_plot is TRUE
- covid_plot <- calculate_covid_plot(
- la_long(),
- covid_affected_data,
- input$indicator,
- "bar"
- )
-
- # Build plot
- la_bar_chart <- la_long() |>
- ggplot2::ggplot() +
- ggiraph::geom_col_interactive(
- ggplot2::aes(
- x = Years_num,
- y = values_num,
- fill = `LA and Regions`,
- tooltip = tooltip_bar(la_long(), indicator_dps(), input$la_input),
- data_id = `LA and Regions`
- ),
- position = "dodge",
- width = 0.6,
- na.rm = TRUE,
- colour = "black"
- ) +
- # Add COVID plot if indicator affected
- add_covid_elements(covid_plot) +
- format_axes(la_long()) +
- set_plot_colours(la_long(), "fill", input$la_input) +
- set_plot_labs(filtered_bds$data) +
- custom_theme()
-
- # Plotting interactive graph
- ggiraph::girafe(
- ggobj = la_bar_chart,
- width_svg = 8.5,
- options = generic_ggiraph_options(
- opts_hover(
- css = "stroke-dasharray:5,5;stroke:black;stroke-width:2px;"
- )
- ),
- fonts = list(sans = "Arial")
- )
- })
-
-
- output$la_bar_chart <- ggiraph::renderGirafe({
- la_bar_chart()
- })
-
-
- # LA Metadata ----------------------------------
- # Reactive values to store previous data
- previous_metadata <- reactiveValues(
- description = NULL,
- methodology = NULL,
- last_update = NULL,
- next_update = NULL,
- source = NULL
- )
-
- # Outputs using the helper function
- output$description <- renderText({
- update_and_fetch_metadata(
- input$indicator,
- "Description",
- previous_metadata,
- "description"
- )
- })
-
- output$methodology <- renderUI({
- update_and_fetch_metadata(
- input$indicator,
- "Methodology",
- previous_metadata,
- "methodology"
- )
- })
-
- output$last_update <- renderText({
- update_and_fetch_metadata(
- input$indicator,
- "Last Update",
- previous_metadata,
- "last_update"
- )
- })
-
- output$next_update <- renderUI({
- update_and_fetch_metadata(
- input$indicator,
- "Next Update",
- previous_metadata,
- "next_update"
- )
- })
-
- output$source <- renderUI({
- hyperlink <- update_and_fetch_metadata(
- input$indicator,
- "Hyperlink(s)",
- previous_metadata,
- "source"
- )
- dfeshiny::external_link(href = hyperlink, link_text = input$indicator)
- })
-}
-
-# App
-shinyApp(ui_dev, server_dev)
+# Load global
+source(here::here("global.R"))
+
+# Load functions
+list.files("R/", full.names = TRUE) |>
+ (\(x) {
+ x[grepl("fn_", x)]
+ })() |>
+ purrr::walk(source)
+
+
+# UI
+ui_dev <- bslib::page_fillable(
+
+ ## Custom CSS =============================================================
+ shiny::includeCSS(here::here("www/dfe_shiny_gov_style.css")),
+
+ # Tab header ==============================================================
+ h1("Local Authority View"),
+ div(
+ class = "well",
+ style = "overflow-y: visible;",
+ bslib::layout_column_wrap(
+ width = "15rem", # Minimum width for each input box before wrapping
+ shiny::selectizeInput(
+ inputId = "la_input",
+ label = "LA:",
+ choices = la_names_bds
+ ),
+ shiny::selectizeInput(
+ inputId = "topic_input",
+ label = "Topic:",
+ choices = c("All topics", metric_topics),
+ multiple = TRUE,
+ options = list(
+ maxItems = 1,
+ placeholder = "No topic selected, showing all indicators.",
+ plugins = list("clear_button"),
+ dropdownParent = "body"
+ )
+ ),
+ shiny::selectizeInput(
+ inputId = "indicator",
+ label = "Indicator:",
+ choices = metric_names
+ )
+ ),
+ # Conditional State-funded school banner
+ shiny::uiOutput("state_funded_banner")
+ ),
+ div(
+ class = "well",
+ style = "overflow-y: visible;",
+ bslib::card(
+ bslib::card_body(
+ shinycssloaders::withSpinner(
+ reactable::reactableOutput("la_table"),
+ type = 6,
+ color = "#1d70b8"
+ )
+ )
+ )
+ ),
+ div(
+ class = "well",
+ style = "overflow-y: visible;",
+ bslib::card(
+ bslib::card_body(
+ shinycssloaders::withSpinner(
+ reactable::reactableOutput("la_stats_table"),
+ type = 6,
+ color = "#1d70b8",
+ size = 0.5,
+ proxy.height = "100px"
+ )
+ )
+ )
+ ),
+ div(
+ class = "well",
+ style = "overflow-y: visible;",
+ bslib::navset_card_underline(
+ id = "la_charts",
+ bslib::nav_panel(
+ title = "Line chart",
+ bslib::card(
+ bslib::card_body(
+ shinycssloaders::withSpinner(
+ ggiraph::girafeOutput("la_line_chart"),
+ type = 6,
+ color = "#1d70b8"
+ )
+ ),
+ full_screen = TRUE
+ ),
+ ),
+ bslib::nav_panel(
+ title = "Bar chart",
+ bslib::card(
+ id = "la_bar_body",
+ bslib::card_body(
+ shinycssloaders::withSpinner(
+ ggiraph::girafeOutput("la_bar_chart"),
+ type = 6,
+ color = "#1d70b8"
+ )
+ ),
+ full_screen = TRUE
+ )
+ )
+ )
+ ),
+ div(
+ class = "well",
+ style = "overflow-y: visible;",
+ bslib::card(
+ bslib::card_body(
+ h3("Description:"),
+ shinycssloaders::withSpinner(
+ textOutput("description"),
+ type = 6,
+ color = "#1d70b8"
+ ),
+ h3("Methodology:"),
+ shinycssloaders::withSpinner(
+ uiOutput("methodology"),
+ type = 6,
+ color = "#1d70b8"
+ ),
+ div(
+ # Creates a flex container where the items are centered vertically
+ style = "display: flex; align-items: baseline;",
+ h3("Last Updated:",
+ style = "margin-right: 1rem; margin-bottom: 0.3rem;"
+ ),
+ shinycssloaders::withSpinner(
+ textOutput("last_update"),
+ type = 6,
+ color = "#1d70b8"
+ )
+ ),
+ div(
+ style = "display: flex; align-items: baseline;",
+ h3("Next Updated:",
+ style = "margin-right: 1rem; margin-bottom: 0.3rem;"
+ ),
+ shinycssloaders::withSpinner(
+ uiOutput("next_update"),
+ type = 6,
+ color = "#1d70b8"
+ )
+ ),
+ div(
+ style = "display: flex; align-items: baseline;",
+ h3("Source:",
+ style = "margin-right: 1rem; margin-bottom: 0.3rem;"
+ ),
+ shinycssloaders::withSpinner(
+ uiOutput("source"),
+ type = 6,
+ color = "#1d70b8"
+ )
+ )
+ )
+ )
+ )
+)
+
+
+# Server
+server_dev <- function(input, output, session) {
+ # Input ----------------------------------
+ # Using the server to power to the provider dropdown for increased speed
+ shiny::observeEvent(input$topic_input,
+ {
+ # Save the currently selected indicator
+ current_indicator <- input$indicator
+
+ # Get indicator choices for selected topic
+ # Include all rows if no topic is selected or "All topics" is selected
+ filtered_topic_bds <- bds_metrics |>
+ dplyr::filter(
+ if (is.null(input$topic_input) || "All topics" %in% input$topic_input) {
+ TRUE
+ } else {
+ .data$Topic %in% input$topic_input # Filter by selected topic(s)
+ }
+ ) |>
+ pull_uniques("Measure")
+
+ # Ensure the current indicator stays selected if it's in the new list of available indicators
+ # Default to the first available indicator if the current one is no longer valid
+ selected_indicator <- if (current_indicator %in% filtered_topic_bds) {
+ current_indicator
+ } else {
+ filtered_topic_bds[1]
+ }
+
+ shiny::updateSelectizeInput(
+ session = session,
+ inputId = "indicator",
+ label = "Indicator:",
+ choices = filtered_topic_bds,
+ selected = selected_indicator
+ )
+ },
+ ignoreNULL = FALSE
+ )
+
+
+ # Main LA Level table ----------------------------------
+ # Filter for selectedindicator
+ # Define filtered_bds outside of observeEvent
+ filtered_bds <- reactiveValues(data = NULL)
+
+ observeEvent(input$indicator, {
+ # Don't change the currently selected indicator if no indicator is selected
+ if (is.null(input$indicator) || input$indicator == "") {
+ return()
+ }
+
+ # Main LA Level table ----------------------------------
+ # Filter for selected indicator
+ filtered_bds$data <- bds_metrics |>
+ dplyr::filter(
+ Measure == input$indicator
+ )
+ })
+
+ # Get decimal places for indicator selected
+ indicator_dps <- reactive({
+ filtered_bds$data |>
+ get_indicator_dps()
+ })
+
+ # Long format LA data
+ la_long <- reactive({
+ # Filter stat neighbour for selected LA
+ filtered_sn <- stat_n_la |>
+ dplyr::filter(`LA Name` == input$la_input)
+
+ # Statistical Neighbours
+ la_sns <- filtered_sn |>
+ pull_uniques("LA Name_sn")
+
+ # LA region
+ la_region <- filtered_sn |>
+ pull_uniques("GOReg")
+
+ # Determine London region to use
+ la_region_ldn_clean <- clean_ldn_region(
+ la_region,
+ filtered_bds$data
+ )
+
+ # Then filter for selected LA, region, stat neighbours and relevant national
+ la_filtered_bds <- filtered_bds$data |>
+ dplyr::filter(
+ `LA and Regions` %in% c(input$la_input, la_region_ldn_clean, la_sns, "England")
+ )
+
+ # SN average
+ sn_avg <- la_filtered_bds |>
+ dplyr::filter(`LA and Regions` %in% la_sns) |>
+ dplyr::summarise(
+ values_num = dplyr::na_if(mean(values_num, na.rm = TRUE), NaN),
+ .by = c("Years", "Years_num")
+ ) |>
+ dplyr::mutate(
+ "LA Number" = "-",
+ "LA and Regions" = "Statistical Neighbours",
+ .before = "Years"
+ )
+
+ # LA levels long
+ la_filtered_bds |>
+ dplyr::filter(`LA and Regions` %notin% c(la_sns)) |>
+ dplyr::select(`LA Number`, `LA and Regions`, Years, Years_num, values_num) |>
+ dplyr::bind_rows(sn_avg) |>
+ dplyr::mutate(
+ `LA and Regions` = factor(
+ `LA and Regions`,
+ levels = c(
+ input$la_input, la_region_ldn_clean,
+ "Statistical Neighbours", "England"
+ )
+ )
+ )
+ })
+
+ # Difference between last two years
+ la_diff <- reactive({
+ la_long() |>
+ dplyr::group_by(`LA and Regions`) |>
+ dplyr::arrange(`LA and Regions`, desc(Years)) |>
+ dplyr::mutate(
+ values_num = dplyr::lag(values_num) - values_num,
+ Years = "Change from previous year"
+ ) |>
+ dplyr::filter(dplyr::row_number() == 2)
+ })
+
+ # Build Main LA Level table
+ la_table <- shiny::reactive({
+ # Join difference and pivot wider to recreate LAIT table
+ la_long() |>
+ dplyr::bind_rows(la_diff()) |>
+ tidyr::pivot_wider(
+ id_cols = c("LA Number", "LA and Regions"),
+ names_from = Years,
+ values_from = values_num
+ ) |>
+ dplyr::arrange(`LA and Regions`)
+ })
+
+
+ # Stet funded school banner (appears for certain indicators)
+ output$state_funded_banner <- renderUI({
+ # Get whether state-funded idnicator
+ state_funded <- filtered_bds$data |>
+ pull_uniques("state_funded_flag") |>
+ (\(x) !is.na(x))()
+
+ # Render banner if state-funded
+ if (state_funded) {
+ tagList(
+ br(),
+ shinyGovstyle::noti_banner(
+ inputId = "notId",
+ title_txt = "Note",
+ body_txt = "Data includes only State-funded Schools."
+ )
+ )
+ }
+ })
+
+ output$la_table <- reactable::renderReactable({
+ dfe_reactable(
+ la_table(),
+ columns = utils::modifyList(
+ format_num_reactable_cols(
+ la_table(),
+ get_indicator_dps(filtered_bds$data),
+ num_exclude = "LA Number"
+ ),
+ set_custom_default_col_widths()
+ ),
+ rowStyle = function(index) {
+ highlight_selected_row(index, la_table(), input$la_input)
+ }
+ )
+ })
+
+
+ # Stats LA Level table ----------------------------------
+ la_stats_table <- shiny::reactive({
+ # Extract change from prev year (from LA table)
+ la_change_prev <- la_diff() |>
+ filter_la_regions(input$la_input, pull_col = "values_num")
+
+ # Set the trend value
+ la_trend <- as.numeric(la_change_prev)
+
+ # Get polarity of indicator
+ la_indicator_polarity <- filtered_bds$data |>
+ pull_uniques("Polarity")
+
+ # Get latest rank, ties are set to min & NA vals to NA rank
+ la_rank <- filtered_bds$data |>
+ filter_la_regions(la_names_bds, latest = TRUE) |>
+ calculate_rank(la_indicator_polarity) |>
+ filter_la_regions(input$la_input, pull_col = "rank")
+
+ # Calculate quartile bands for indicator
+ la_quartile_bands <- filtered_bds$data |>
+ filter_la_regions(la_names_bds, latest = TRUE, pull_col = "values_num") |>
+ quantile(na.rm = TRUE)
+
+ # Extracting LA latest value
+ la_indicator_val <- filtered_bds$data |>
+ filter_la_regions(input$la_input, latest = TRUE, pull_col = "values_num")
+
+ # Boolean as to whether to include Quartile Banding
+ no_show_qb <- input$indicator %in% no_qb_indicators
+
+ # Calculating which quartile this value sits in
+ la_quartile <- calculate_quartile_band(
+ la_indicator_val,
+ la_quartile_bands,
+ la_indicator_polarity
+ )
+
+ # Build stats LA Level table
+ la_stats_table <- build_la_stats_table(
+ la_diff(),
+ input$la_input,
+ la_trend,
+ la_change_prev,
+ la_rank,
+ la_quartile,
+ la_quartile_bands,
+ get_indicator_dps(filtered_bds$data),
+ la_indicator_polarity,
+ no_show_qb
+ )
+
+ la_stats_table
+ })
+
+ output$la_stats_table <- reactable::renderReactable({
+ dfe_reactable(
+ la_stats_table(),
+ columns = modifyList(
+ # Create the reactable with specific column alignments
+ format_num_reactable_cols(
+ la_stats_table(),
+ get_indicator_dps(filtered_bds$data),
+ num_exclude = "LA Number",
+ categorical = c(
+ "Trend", "Quartile Banding", "Latest National Rank",
+ "A", "B",
+ "C", "D"
+ )
+ ),
+ # Style Quartile Banding column with colour
+ list(
+ set_custom_default_col_widths(),
+ Trend = reactable::colDef(
+ header = add_tooltip_to_reactcol(
+ "Trend",
+ "Based on change from previous year"
+ ),
+ cell = trend_icon_renderer,
+ style = function(value) {
+ get_trend_colour(value, la_stats_table()$Polarity[1])
+ }
+ ),
+ `Quartile Banding` = reactable::colDef(
+ style = function(value, index) {
+ quartile_banding_col_def(la_stats_table()[index, ])
+ }
+ ),
+ `Latest National Rank` = reactable::colDef(
+ header = add_tooltip_to_reactcol(
+ "Latest National Rank",
+ "Rank 1 is always best/top"
+ )
+ ),
+ Polarity = reactable::colDef(show = FALSE)
+ )
+ )
+ )
+ })
+
+
+ # LA Level line chart plot ----------------------------------
+ la_line_chart <- reactive({
+ # Generate the covid plot data if add_covid_plot is TRUE
+ covid_plot <- calculate_covid_plot(
+ la_long(),
+ covid_affected_data,
+ input$indicator,
+ "line"
+ )
+
+ # Build plot
+ la_line_chart <- la_long() |>
+ # Set geog orders so selected LA is on top of plot
+ reorder_la_regions(reverse = TRUE) |>
+ ggplot2::ggplot() +
+ ggiraph::geom_line_interactive(
+ ggplot2::aes(
+ x = Years_num,
+ y = values_num,
+ color = `LA and Regions`,
+ data_id = `LA and Regions`
+ ),
+ na.rm = TRUE,
+ linewidth = 1
+ ) +
+ # Only show point data where line won't appear (NAs)
+ ggplot2::geom_point(
+ data = subset(create_show_point(
+ la_long(),
+ covid_affected_data,
+ input$indicator
+ ), show_point),
+ ggplot2::aes(
+ x = Years_num,
+ y = values_num,
+ color = `LA and Regions`
+ ),
+ shape = 15,
+ size = 1,
+ na.rm = TRUE
+ ) +
+ # Add COVID plot if indicator affected
+ add_covid_elements(covid_plot) +
+ format_axes(la_long()) +
+ set_plot_colours(la_long(), focus_group = input$la_input) +
+ set_plot_labs(filtered_bds$data) +
+ custom_theme() +
+ # Revert order of the legend so goes from right to left
+ ggplot2::guides(color = ggplot2::guide_legend(reverse = TRUE))
+
+ # Creating vertical geoms to make vertical hover tooltip
+ vertical_hover <- lapply(
+ get_years(la_long()),
+ tooltip_vlines,
+ la_long(),
+ indicator_dps(),
+ input$la_input
+ )
+
+ # Plotting interactive graph
+ ggiraph::girafe(
+ ggobj = (la_line_chart + vertical_hover),
+ width_svg = 8.5,
+ options = generic_ggiraph_options(
+ opts_hover(
+ css = "stroke-dasharray:5,5;stroke:black;stroke-width:2px;"
+ )
+ ),
+ fonts = list(sans = "Arial")
+ )
+ })
+
+ output$la_line_chart <- ggiraph::renderGirafe({
+ la_line_chart()
+ })
+
+
+ # LA Level bar plot ----------------------------------
+ la_bar_chart <- reactive({
+ # Generate the covid plot data if add_covid_plot is TRUE
+ covid_plot <- calculate_covid_plot(
+ la_long(),
+ covid_affected_data,
+ input$indicator,
+ "bar"
+ )
+
+ # Build plot
+ la_bar_chart <- la_long() |>
+ ggplot2::ggplot() +
+ ggiraph::geom_col_interactive(
+ ggplot2::aes(
+ x = Years_num,
+ y = values_num,
+ fill = `LA and Regions`,
+ tooltip = tooltip_bar(la_long(), indicator_dps(), input$la_input),
+ data_id = `LA and Regions`
+ ),
+ position = "dodge",
+ width = 0.6,
+ na.rm = TRUE,
+ colour = "black"
+ ) +
+ # Add COVID plot if indicator affected
+ add_covid_elements(covid_plot) +
+ format_axes(la_long()) +
+ set_plot_colours(la_long(), "fill", input$la_input) +
+ set_plot_labs(filtered_bds$data) +
+ custom_theme()
+
+ # Plotting interactive graph
+ ggiraph::girafe(
+ ggobj = la_bar_chart,
+ width_svg = 8.5,
+ options = generic_ggiraph_options(
+ opts_hover(
+ css = "stroke-dasharray:5,5;stroke:black;stroke-width:2px;"
+ )
+ ),
+ fonts = list(sans = "Arial")
+ )
+ })
+
+
+ output$la_bar_chart <- ggiraph::renderGirafe({
+ la_bar_chart()
+ })
+
+
+ # LA Metadata ----------------------------------
+ # Reactive values to store previous data
+ previous_metadata <- reactiveValues(
+ description = NULL,
+ methodology = NULL,
+ last_update = NULL,
+ next_update = NULL,
+ source = NULL
+ )
+
+ # Outputs using the helper function
+ output$description <- renderText({
+ update_and_fetch_metadata(
+ input$indicator,
+ "Description",
+ previous_metadata,
+ "description"
+ )
+ })
+
+ output$methodology <- renderUI({
+ update_and_fetch_metadata(
+ input$indicator,
+ "Methodology",
+ previous_metadata,
+ "methodology"
+ )
+ })
+
+ output$last_update <- renderText({
+ update_and_fetch_metadata(
+ input$indicator,
+ "Last Update",
+ previous_metadata,
+ "last_update"
+ )
+ })
+
+ output$next_update <- renderUI({
+ update_and_fetch_metadata(
+ input$indicator,
+ "Next Update",
+ previous_metadata,
+ "next_update"
+ )
+ })
+
+ output$source <- renderUI({
+ hyperlink <- update_and_fetch_metadata(
+ input$indicator,
+ "Hyperlink(s)",
+ previous_metadata,
+ "source"
+ )
+ dfeshiny::external_link(href = hyperlink, link_text = input$indicator)
+ })
+}
+
+# App
+shinyApp(ui_dev, server_dev)
diff --git a/02_dev/la_level_page/la_dev_app_mod.R b/02_dev/la_level_page/la_dev_app_mod.R
index c5bbb4f6..014fe2d7 100644
--- a/02_dev/la_level_page/la_dev_app_mod.R
+++ b/02_dev/la_level_page/la_dev_app_mod.R
@@ -38,7 +38,7 @@ ui_mod <- bslib::page_fillable(
div(
class = "well",
style = "overflow-y: visible;",
- bslib::navset_card_underline(
+ bslib::navset_card_tab(
id = "la_charts",
LA_LineChartUI("la_line_chart"),
LA_BarChartUI("la_bar_chart")
diff --git a/R/fn_analysis.R b/R/fn_analysis.R
index 6a3d3f48..cfb6b0d1 100644
--- a/R/fn_analysis.R
+++ b/R/fn_analysis.R
@@ -269,10 +269,11 @@ calculate_rank <- function(filtered_data, indicator_polarity) {
#' # Assuming `df` is your data frame and `la_names_vec` is a vector of LA names
#' filtered_data <- filter_la_data_all_la(df, la_names_vec)
#'
-filter_la_data_all_la <- function(data, la_names) {
+filter_la_data_all_la <- function(data, la_names, geog_colname) {
data |>
dplyr::filter(`LA and Regions` %in% la_names) |>
- dplyr::arrange(`LA and Regions`)
+ dplyr::arrange(`LA and Regions`) |>
+ dplyr::rename("LA" = `LA and Regions`)
}
@@ -310,7 +311,8 @@ filter_region_data_all_la <- function(data, la_names) {
))) == 0)
) |>
dplyr::mutate(Rank = "") |>
- dplyr::arrange(`LA Number`)
+ dplyr::arrange(`LA Number`) |>
+ dplyr::rename("Region" = `LA and Regions`)
}
diff --git a/R/fn_helper_functions.R b/R/fn_helper_functions.R
index 0fd87b01..8c7a5917 100644
--- a/R/fn_helper_functions.R
+++ b/R/fn_helper_functions.R
@@ -684,11 +684,11 @@ add_line_breaks <- function(text, max_length = 20) {
#' # Wrap a plot with a larger spinner
#' with_gov_spinner(plotOutput("la_plot"), size = 2)
#'
-with_gov_spinner <- function(ui_element, spinner_type = 6, size = 1) {
+with_gov_spinner <- function(ui_element, spinner_type = 6, size = 1, color = "#1d70b8") {
shinycssloaders::withSpinner(
ui_element,
type = spinner_type,
- color = "#1d70b8",
+ color = color,
size = size,
proxy.height = paste0(250 * size, "px")
)
diff --git a/R/fn_load_data.R b/R/fn_load_data.R
index b3c23e27..e06b0e07 100644
--- a/R/fn_load_data.R
+++ b/R/fn_load_data.R
@@ -1,322 +1,358 @@
-#' Shared Folder Path
-#'
-#' This variable holds the path to the 'LAIT - modernisation' teams channel folder.
-#' The folder is synchronised and located in the user's local system.
-#'
-shared_folder <- paste0(
- r"(C:\Users\jtufts\Department for Education\LAIT modernisation - General)",
- r"(\LAIT Modernisation 2024\Information for App Development)"
-)
-
-
-#' Clean SNP Column Names
-#'
-#' This function cleans the column names of a given data frame. Specifically, it adds numbers to 'SNP' columns
-#' based on the numbers extracted from 'SN' columns.
-#'
-#' @param data A data frame that contains columns with names starting with 'SN' and 'SNP'.
-#'
-#' @return A data frame with cleaned column names.
-#'
-#' @examples
-#' \dontrun{
-#' data <- data.frame(SN1 = c(1, 2), SNP = c(3, 4), SN2 = c(5, 6), SNP = c(7, 8))
-#' clean_snp_colnames(data)
-#' }
-#'
-#' @export
-clean_snp_colnames <- function(data) {
- col_names <- colnames(data)
-
- # Logical vectors to identify "SN" and "SNP" columns
- sn_cols <- which(grepl("^SN\\d+$", col_names))
- snp_cols <- which(grepl("^SNP", col_names))
-
- if (length(sn_cols) < 1) {
- stop(
- paste0(
- "SN columns do not seem to be in the right format e.g., SNx",
- "where x is a number"
- )
- )
- }
-
- if (length(snp_cols) < 1) {
- stop(
- paste0(
- "SNP columns do not seem to be in the right format e.g., SNPx",
- "where x can be anything"
- )
- )
- }
-
- # Extract the numbers from "SN" columns
- sn_numbers <- gsub("^SN", "", col_names[sn_cols])
-
- # Clean column names vector
- clean_col_names <- col_names
-
- # Assign new names to "SNP" columns using extracted "SN" column numbers
- clean_col_names[snp_cols] <- paste0("SNP", sn_numbers)
-
- # Assign the new column names to the dataframe
- colnames(data) <- clean_col_names
-
- data
-}
-
-
-#' Create Measure Key
-#'
-#' This function creates a new column 'measure_key' in the given data frame. The 'measure_key' is created by
-#' concatenating the 'Topic' and 'Measure_short' columns, replacing spaces with underscores, and converting
-#' the resulting string to lowercase.
-#'
-#' @param data A data frame that contains the columns 'Topic' and 'Measure_short'.
-#'
-#' @return A data frame with an additional 'measure_key' column.
-#'
-#' @examples
-#' \dontrun{
-#' data <- data.frame(Topic = c("Topic1", "Topic2"), Measure_short = c("Measure1", "Measure2"))
-#' create_measure_key(data)
-#' }
-#'
-#' @export
-create_measure_key <- function(data) {
- data |>
- dplyr::mutate(
- measure_key = tolower(gsub(" ", "_", paste(Topic, Measure_short))),
- .after = Measure_short
- )
-}
-
-
-#' Generate Downloadable File Based on Data and File Type
-#'
-#' This function generates a temporary file for download based on the provided
-#' data and file type. Supported file types include CSV, XLSX, PNG, and HTML.
-#' The function writes the data to the corresponding file format, and returns
-#' the file path for download.
-#'
-#' @param data A dataset or object to be saved, which can be a data frame or
-#' a reactive list containing specific data for charts or widgets.
-#' @param file_type A string specifying the desired file type for download.
-#' Supported types are: "csv", "xlsx", "png", and "html". This string
-#' is matched case-insensitively.
-#'
-#' @return A character string representing the path to the generated file.
-#' The file will be saved temporarily with the appropriate extension
-#' based on the provided `file_type`.
-#'
-#' @details
-#' The function handles multiple file types as follows:
-#' - For `"csv"`, it writes the data to a CSV file without row names.
-#' - For `"xlsx"`, it saves the data as an Excel file with auto column widths.
-#' - For `"png"`, it saves a ggplot object to a PNG file with specified size.
-#' - For `"html"`, it saves an HTML widget to an HTML file.
-#' If an unsupported file type is provided, the function returns an error.
-#'
-#' @examples
-#' \dontrun{
-#' # Save a data frame as a CSV file
-#' generate_download_file(mtcars, "csv")
-#'
-#' # Save a ggplot chart as PNG
-#' plot_data <- list(png = ggplot(mtcars, aes(mpg, wt)) +
-#' geom_point())
-#' generate_download_file(plot_data, "png")
-#' }
-#'
-generate_download_file <- function(data, file_type, svg_width = 8.5) {
- out <- tempfile(fileext = dplyr::case_when(
- grepl("csv", file_type, ignore.case = TRUE) ~ ".csv",
- grepl("xlsx", file_type, ignore.case = TRUE) ~ ".xlsx",
- grepl("svg", file_type, ignore.case = TRUE) ~ ".svg",
- grepl("html", file_type, ignore.case = TRUE) ~ ".html",
- TRUE ~ "Error"
- ))
-
- if (grepl("csv", file_type, ignore.case = TRUE)) {
- write.csv(data, file = out, row.names = FALSE)
- } else if (grepl("xlsx", file_type, ignore.case = TRUE)) {
- openxlsx::write.xlsx(data, file = out, colWidths = "Auto")
- } else if (grepl("svg", file_type, ignore.case = TRUE)) {
- ggplot2::ggsave(filename = out, plot = data, width = svg_width, height = 6)
- } else if (grepl("html", file_type, ignore.case = TRUE)) {
- htmlwidgets::saveWidget(widget = data, file = out)
- }
-
- out
-}
-
-
-#' Create Download Handler for Shiny Application
-#'
-#' This function creates a `downloadHandler` for use in a Shiny app, allowing
-#' users to download a file in the specified format. The file name is generated
-#' dynamically based on the provided extension input and table name prefix.
-#'
-#' @param export_file A string representing the file path of the file to be
-#' downloaded. This should be a pre-generated file ready for download.
-#' @param ext_input A reactive expression that returns the file type selected
-#' by the user. Supported types are: "xlsx", "csv", "png", and "html".
-#' The file extension is matched case-insensitively.
-#' @param table_name_prefix A reactive expression returning a vector of strings
-#' that represent parts of the file name. These are concatenated with
-#' hyphens (`-`) to form the base of the download file name.
-#'
-#' @return A `downloadHandler` object for use in the server function of a
-#' Shiny app. This handler will allow the user to download a file
-#' with the desired format and name.
-#'
-#' @details
-#' The filename is generated based on the table name prefix and current date,
-#' with the appropriate file extension determined by the user's selection.
-#' Supported extensions are: `.xlsx`, `.csv`, `.png`, and `.html`. The content
-#' of the file is copied from `export_file`, and a notification is shown to
-#' indicate that the file is being generated.
-#'
-#' @examples
-#' \dontrun{
-#' # Create a download handler for a CSV file
-#' create_download_handler("path/to/file.csv", reactive("csv"), reactive("data-table"))
-#' }
-#'
-create_download_handler <- function(local) {
- downloadHandler(
- filename = function() {
- file_ext <- dplyr::case_when(
- grepl("xlsx", local$file_type, ignore.case = TRUE) ~ ".xlsx",
- grepl("csv", local$file_type, ignore.case = TRUE) ~ ".csv",
- grepl("svg", local$file_type, ignore.case = TRUE) ~ ".svg",
- grepl("html", local$file_type, ignore.case = TRUE) ~ ".html",
- TRUE ~ "Error"
- )
- paste0(paste(local$file_name, collapse = "-"), "-", Sys.Date(), file_ext)
- },
- content = function(file) {
- pop_up <- shiny::showNotification("Generating download file", duration = NULL)
- file.copy(local$export_file, file)
- on.exit(shiny::removeNotification(pop_up), add = TRUE)
- }
- )
-}
-
-
-#' Generate a Radio Button Input for File Type Selection
-#'
-#' This function creates a radio button input for selecting the download file
-#' format in a Shiny application. The label, hint, and choices for the radio
-#' button are dynamically generated based on the type of file being downloaded
-#' (either a data table or plot).
-#'
-#' @param input_id A string representing the input ID for the radio button,
-#' which will be used to access the selected file type in the Shiny
-#' server logic.
-#' @param file_type A string that specifies the type of file being downloaded.
-#' It can either be "table" (for downloading data tables) or any other
-#' string (for downloading plots). Defaults to "table".
-#'
-#' @return A `shinyGovstyle::radio_button_Input` object to be included in the
-#' Shiny UI, allowing the user to choose between available file formats
-#' for the download.
-#'
-#' @details
-#' When the `file_type` is "table", the user will have the option to select
-#' between "CSV" and "XLSX" file formats. For other file types, the user can
-#' select between "PNG" and "HTML". The default selected option is "CSV" for
-#' tables and "PNG" for plots. The hint label displayed below the input will
-#' provide guidance based on the type of download.
-#'
-#' @examples
-#' \dontrun{
-#' # Generate file type selection for a table
-#' file_type_input_btn("file_type", file_type = "table")
-#'
-#' # Generate file type selection for a plot
-#' file_type_input_btn("file_type", file_type = "plot")
-#' }
-#'
-file_type_input_btn <- function(input_id, file_type = "table") {
- shinyGovstyle::radio_button_Input(
- inputId = input_id,
- label = h2("Choose download file format"),
- hint_label = if (file_type == "table") {
- paste0(
- "This will download all data related to the providers and options selected.",
- " The XLSX format is designed for use in Microsoft Excel."
- )
- } else {
- paste0(
- "This will download the plots related to the options selected.",
- " The HTML format contains the interactive element."
- )
- },
- choices = if (file_type == "table") {
- c("CSV", "XLSX")
- } else {
- c("SVG", "HTML")
- },
- selected = if (file_type == "table") "CSV" else "SVG"
- )
-}
-
-
-#' Update and fetch metadata for a given indicator
-#'
-#' This function retrieves the metadata for a specified indicator and updates
-#' the associated reactive storage. If the indicator is empty, the previously
-#' stored value is returned.
-#'
-#' @param input_indicator A string representing the selected indicator. If
-#' empty, the function returns the previously stored value.
-#' @param metadata_type A string specifying the type of metadata to fetch (e.g.,
-#' "Description", "Methodology").
-#' @param reactive_storage A `reactiveValues` object where the metadata is
-#' stored and updated.
-#' @param key A string representing the key in `reactive_storage` corresponding
-#' to the metadata type.
-#'
-#' @return The metadata associated with the specified indicator and metadata
-#' type. If the indicator is empty, the previously stored value is returned.
-#'
-#' @examples
-#' \dontrun{
-#' previous_metadata <- reactiveValues(description = NULL)
-#' update_and_fetch_metadata(
-#' input_indicator = "Indicator A",
-#' metadata_type = "Description",
-#' reactive_storage = previous_metadata,
-#' key = "description"
-#' )
-#' }
-#'
-update_and_fetch_metadata <- function(input_indicator,
- metadata_type,
- reactive_storage,
- key) {
- if (input_indicator == "") {
- return(reactive_storage[[key]])
- }
-
- # Fetch the metadata for the selected indicator
- metadata <- metrics_clean |>
- get_metadata(input_indicator, metadata_type)
-
- # Update the previous value in the reactive storage
- reactive_storage[[key]] <- metadata
-
- return(metadata)
-}
-
-
-
-read_data_dict_shared_folder <- function(shared_folder, sheet_name) {
- readxl::read_xlsx(
- path = paste0(shared_folder, "/../Information for App Development/LAIT Data Dictionary (To QA!).xlsx"),
- sheet = sheet_name,
- # Replace multi-space with single-space
- .name_repair = clean_spaces
- )
-}
+#' Shared Folder Path
+#'
+#' This variable holds the path to the 'LAIT - modernisation' teams channel folder.
+#' The folder is synchronised and located in the user's local system.
+#'
+shared_folder <- paste0(
+ r"(C:\Users\jtufts\Department for Education\LAIT modernisation - General)",
+ r"(\LAIT Modernisation 2024\Information for App Development)"
+)
+
+
+#' Clean SNP Column Names
+#'
+#' This function cleans the column names of a given data frame. Specifically, it adds numbers to 'SNP' columns
+#' based on the numbers extracted from 'SN' columns.
+#'
+#' @param data A data frame that contains columns with names starting with 'SN' and 'SNP'.
+#'
+#' @return A data frame with cleaned column names.
+#'
+#' @examples
+#' \dontrun{
+#' data <- data.frame(SN1 = c(1, 2), SNP = c(3, 4), SN2 = c(5, 6), SNP = c(7, 8))
+#' clean_snp_colnames(data)
+#' }
+#'
+#' @export
+clean_snp_colnames <- function(data) {
+ col_names <- colnames(data)
+
+ # Logical vectors to identify "SN" and "SNP" columns
+ sn_cols <- which(grepl("^SN\\d+$", col_names))
+ snp_cols <- which(grepl("^SNP", col_names))
+
+ if (length(sn_cols) < 1) {
+ stop(
+ paste0(
+ "SN columns do not seem to be in the right format e.g., SNx",
+ "where x is a number"
+ )
+ )
+ }
+
+ if (length(snp_cols) < 1) {
+ stop(
+ paste0(
+ "SNP columns do not seem to be in the right format e.g., SNPx",
+ "where x can be anything"
+ )
+ )
+ }
+
+ # Extract the numbers from "SN" columns
+ sn_numbers <- gsub("^SN", "", col_names[sn_cols])
+
+ # Clean column names vector
+ clean_col_names <- col_names
+
+ # Assign new names to "SNP" columns using extracted "SN" column numbers
+ clean_col_names[snp_cols] <- paste0("SNP", sn_numbers)
+
+ # Assign the new column names to the dataframe
+ colnames(data) <- clean_col_names
+
+ data
+}
+
+
+#' Create Measure Key
+#'
+#' This function creates a new column 'measure_key' in the given data frame. The 'measure_key' is created by
+#' concatenating the 'Topic' and 'Measure_short' columns, replacing spaces with underscores, and converting
+#' the resulting string to lowercase.
+#'
+#' @param data A data frame that contains the columns 'Topic' and 'Measure_short'.
+#'
+#' @return A data frame with an additional 'measure_key' column.
+#'
+#' @examples
+#' \dontrun{
+#' data <- data.frame(Topic = c("Topic1", "Topic2"), Measure_short = c("Measure1", "Measure2"))
+#' create_measure_key(data)
+#' }
+#'
+#' @export
+create_measure_key <- function(data) {
+ data |>
+ dplyr::mutate(
+ measure_key = tolower(gsub(" ", "_", paste(Topic, Measure_short))),
+ .after = Measure_short
+ )
+}
+
+
+#' Generate Downloadable File Based on Data and File Type
+#'
+#' This function generates a temporary file for download based on the provided
+#' data and file type. Supported file types include CSV, XLSX, PNG, and HTML.
+#' The function writes the data to the corresponding file format, and returns
+#' the file path for download.
+#'
+#' @param data A dataset or object to be saved, which can be a data frame or
+#' a reactive list containing specific data for charts or widgets.
+#' @param file_type A string specifying the desired file type for download.
+#' Supported types are: "csv", "xlsx", "png", and "html". This string
+#' is matched case-insensitively.
+#'
+#' @return A character string representing the path to the generated file.
+#' The file will be saved temporarily with the appropriate extension
+#' based on the provided `file_type`.
+#'
+#' @details
+#' The function handles multiple file types as follows:
+#' - For `"csv"`, it writes the data to a CSV file without row names.
+#' - For `"xlsx"`, it saves the data as an Excel file with auto column widths.
+#' - For `"png"`, it saves a ggplot object to a PNG file with specified size.
+#' - For `"html"`, it saves an HTML widget to an HTML file.
+#' If an unsupported file type is provided, the function returns an error.
+#'
+#' @examples
+#' \dontrun{
+#' # Save a data frame as a CSV file
+#' generate_download_file(mtcars, "csv")
+#'
+#' # Save a ggplot chart as PNG
+#' plot_data <- list(png = ggplot(mtcars, aes(mpg, wt)) +
+#' geom_point())
+#' generate_download_file(plot_data, "png")
+#' }
+#'
+generate_download_file <- function(data, file_type, svg_width = 8.5) {
+ out <- tempfile(fileext = dplyr::case_when(
+ grepl("csv", file_type, ignore.case = TRUE) ~ ".csv",
+ grepl("xlsx", file_type, ignore.case = TRUE) ~ ".xlsx",
+ grepl("svg", file_type, ignore.case = TRUE) ~ ".svg",
+ grepl("html", file_type, ignore.case = TRUE) ~ ".html",
+ TRUE ~ "Error"
+ ))
+
+ if (grepl("csv", file_type, ignore.case = TRUE)) {
+ write.csv(data, file = out, row.names = FALSE)
+ } else if (grepl("xlsx", file_type, ignore.case = TRUE)) {
+ openxlsx::write.xlsx(data, file = out, colWidths = "Auto")
+ } else if (grepl("svg", file_type, ignore.case = TRUE)) {
+ ggplot2::ggsave(filename = out, plot = data, width = svg_width, height = 6)
+ } else if (grepl("html", file_type, ignore.case = TRUE)) {
+ htmlwidgets::saveWidget(widget = data, file = out)
+ }
+
+ out
+}
+
+
+#' Create Download Handler for Shiny Application
+#'
+#' This function creates a `downloadHandler` for use in a Shiny app, allowing
+#' users to download a file in the specified format. The file name is generated
+#' dynamically based on the provided extension input and table name prefix.
+#'
+#' @param export_file A string representing the file path of the file to be
+#' downloaded. This should be a pre-generated file ready for download.
+#' @param ext_input A reactive expression that returns the file type selected
+#' by the user. Supported types are: "xlsx", "csv", "png", and "html".
+#' The file extension is matched case-insensitively.
+#' @param table_name_prefix A reactive expression returning a vector of strings
+#' that represent parts of the file name. These are concatenated with
+#' hyphens (`-`) to form the base of the download file name.
+#'
+#' @return A `downloadHandler` object for use in the server function of a
+#' Shiny app. This handler will allow the user to download a file
+#' with the desired format and name.
+#'
+#' @details
+#' The filename is generated based on the table name prefix and current date,
+#' with the appropriate file extension determined by the user's selection.
+#' Supported extensions are: `.xlsx`, `.csv`, `.png`, and `.html`. The content
+#' of the file is copied from `export_file`, and a notification is shown to
+#' indicate that the file is being generated.
+#'
+#' @examples
+#' \dontrun{
+#' # Create a download handler for a CSV file
+#' create_download_handler("path/to/file.csv", reactive("csv"), reactive("data-table"))
+#' }
+#'
+create_download_handler <- function(local) {
+ downloadHandler(
+ filename = function() {
+ file_ext <- dplyr::case_when(
+ grepl("xlsx", local$file_type, ignore.case = TRUE) ~ ".xlsx",
+ grepl("csv", local$file_type, ignore.case = TRUE) ~ ".csv",
+ grepl("svg", local$file_type, ignore.case = TRUE) ~ ".svg",
+ grepl("html", local$file_type, ignore.case = TRUE) ~ ".html",
+ TRUE ~ "Error"
+ )
+ paste0(paste(local$file_name, collapse = "-"), "-", Sys.Date(), file_ext)
+ },
+ content = function(file) {
+ pop_up <- shiny::showNotification("Generating download file", duration = NULL)
+ file.copy(local$export_file, file)
+ on.exit(shiny::removeNotification(pop_up), add = TRUE)
+ }
+ )
+}
+
+
+# Helper function to calculate actual file size
+calculate_file_size <- function(file_type, data) {
+ # Create a temporary file
+ temp_file <- tempfile(fileext = paste0(".", tolower(file_type)))
+
+ # Create file or return estimated size
+ if (file_type == "CSV") {
+ write.csv(data, temp_file, row.names = FALSE)
+ } else if (file_type == "XLSX") {
+ openxlsx::write.xlsx(data, temp_file, colWidths = "auto")
+ } else if (file_type == "SVG") {
+ return("usually 20 KB and no larger than 200 KB")
+ } else if (file_type == "HTML") {
+ return("usually 275 KB and no larger than 500 KB")
+ }
+
+ # Get the file size in KB
+ file_size_kb <- ceiling((file.size(temp_file) / 1024) / 5) * 5
+
+ # Round file size to nearest 10, while handling small sizes correctly
+ rounded_file_size <- round(file_size_kb, 2)
+
+ unlink(temp_file) # Remove the temporary file
+ return(paste0(rounded_file_size, " KB"))
+}
+
+
+#' Generate a Radio Button Input for File Type Selection
+#'
+#' This function creates a radio button input for selecting the download file
+#' format in a Shiny application. The label, hint, and choices for the radio
+#' button are dynamically generated based on the type of file being downloaded
+#' (either a data table or plot).
+#'
+#' @param input_id A string representing the input ID for the radio button,
+#' which will be used to access the selected file type in the Shiny
+#' server logic.
+#' @param file_type A string that specifies the type of file being downloaded.
+#' It can either be "table" (for downloading data tables) or any other
+#' string (for downloading plots). Defaults to "table".
+#'
+#' @return A `shinyGovstyle::radio_button_Input` object to be included in the
+#' Shiny UI, allowing the user to choose between available file formats
+#' for the download.
+#'
+#' @details
+#' When the `file_type` is "table", the user will have the option to select
+#' between "CSV" and "XLSX" file formats. For other file types, the user can
+#' select between "PNG" and "HTML". The default selected option is "CSV" for
+#' tables and "PNG" for plots. The hint label displayed below the input will
+#' provide guidance based on the type of download.
+#'
+#' @examples
+#' \dontrun{
+#' # Generate file type selection for a table
+#' file_type_input_btn("file_type", file_type = "table")
+#'
+#' # Generate file type selection for a plot
+#' file_type_input_btn("file_type", file_type = "plot")
+#' }
+#'
+file_type_input_btn <- function(input_id, data = NULL, file_type = "table") {
+ # Generate choices with actual file size
+ choices_with_size <- if (file_type == "table") {
+ c(
+ paste0("CSV (less than ", calculate_file_size("CSV", data), ")"),
+ paste0("XLSX (less than ", calculate_file_size("XLSX", data), ")")
+ )
+ } else {
+ c(
+ paste0("SVG (", calculate_file_size("SVG", data), ")"),
+ paste0("HTML (", calculate_file_size("HTML", data), ")")
+ )
+ }
+
+ shinyGovstyle::radio_button_Input(
+ inputId = input_id,
+ label = h2("Choose download file format"),
+ hint_label = if (file_type == "table") {
+ paste0(
+ "This will download all data related to the providers and options selected.",
+ " The XLSX format is designed for use in Microsoft Excel."
+ )
+ } else {
+ paste0(
+ "This will download the plots related to the options selected.",
+ " The HTML format contains the interactive element."
+ )
+ },
+ choices = choices_with_size,
+ selected = choices_with_size[1]
+ )
+}
+
+
+#' Update and fetch metadata for a given indicator
+#'
+#' This function retrieves the metadata for a specified indicator and updates
+#' the associated reactive storage. If the indicator is empty, the previously
+#' stored value is returned.
+#'
+#' @param input_indicator A string representing the selected indicator. If
+#' empty, the function returns the previously stored value.
+#' @param metadata_type A string specifying the type of metadata to fetch (e.g.,
+#' "Description", "Methodology").
+#' @param reactive_storage A `reactiveValues` object where the metadata is
+#' stored and updated.
+#' @param key A string representing the key in `reactive_storage` corresponding
+#' to the metadata type.
+#'
+#' @return The metadata associated with the specified indicator and metadata
+#' type. If the indicator is empty, the previously stored value is returned.
+#'
+#' @examples
+#' \dontrun{
+#' previous_metadata <- reactiveValues(description = NULL)
+#' update_and_fetch_metadata(
+#' input_indicator = "Indicator A",
+#' metadata_type = "Description",
+#' reactive_storage = previous_metadata,
+#' key = "description"
+#' )
+#' }
+#'
+update_and_fetch_metadata <- function(input_indicator,
+ metadata_type,
+ reactive_storage,
+ key) {
+ if (input_indicator == "") {
+ return(reactive_storage[[key]])
+ }
+
+ # Fetch the metadata for the selected indicator
+ metadata <- metrics_clean |>
+ get_metadata(input_indicator, metadata_type)
+
+ # Update the previous value in the reactive storage
+ reactive_storage[[key]] <- metadata
+
+ return(metadata)
+}
+
+
+
+read_data_dict_shared_folder <- function(shared_folder, sheet_name) {
+ readxl::read_xlsx(
+ path = paste0(shared_folder, "/../Information for App Development/LAIT Data Dictionary (To QA!).xlsx"),
+ sheet = sheet_name,
+ # Replace multi-space with single-space
+ .name_repair = clean_spaces
+ )
+}
diff --git a/R/fn_table_helpers.R b/R/fn_table_helpers.R
index 9c0aa3a8..c0056e8d 100644
--- a/R/fn_table_helpers.R
+++ b/R/fn_table_helpers.R
@@ -645,8 +645,8 @@ build_sn_stats_table <- function(
#' }
#' )
#' }
-highlight_selected_row <- function(index, data, selected_area = NULL) {
- la_region <- data[index, "LA and Regions"]
+highlight_selected_row <- function(index, data, selected_area = NULL, geog_col = "LA and Regions") {
+ la_region <- data[index, geog_col]
# Handle missing values first
if (is.na(la_region)) {
diff --git a/R/fn_ui_layout.R b/R/fn_ui_layout.R
index aab35679..edcddcd3 100644
--- a/R/fn_ui_layout.R
+++ b/R/fn_ui_layout.R
@@ -37,7 +37,7 @@ create_download_options_ui <- function(download_id, copy_clipboard_id) {
actionButton(
copy_clipboard_id,
"Copy Chart to Clipboard",
- icon = icon("copy"),
+ icon = icon("copy", `aria-hidden` = "true"),
class = "gov-uk-button"
),
style = "max-width: none;"
@@ -66,7 +66,8 @@ create_hidden_clipboard_plot <- function(clipboard_plot_id) {
# Hidden static plot for copy-to-clipboard
div(
shiny::plotOutput(clipboard_plot_id),
- style = "content-visibility: hidden;"
+ style = "content-visibility: hidden;",
+ `aria-hidden` = "true"
)
}
@@ -157,8 +158,8 @@ full_data_on_github_noti <- function() {
input_id = "full_data_on_github",
title_txt = "Information",
body_txt = shiny::HTML(paste0(
- "The full dataset is available to download as a .csv on GitHub. ",
- "The file is ",
+ "The full dataset is available for download as a CSV on GitHub. ",
+ "You can access the file ",
dfeshiny::external_link(
href = paste0(
"https://github.com/dfe-analytical-services/",
@@ -168,9 +169,201 @@ full_data_on_github_noti <- function() {
),
".
",
"",
- "This should be the preferred method for large data downloads ",
- "especially for use with code."
+ "We recommend this method for downloading large datasets, ",
+ "especially if you plan to use the data in your code."
)),
type = "standard"
)
}
+
+
+dfe_footer <- function(links_list) {
+ # Add the HTML around the link and make an id by snake casing
+ create_footer_link <- function(link_text) {
+ shiny::tags$li(
+ class = "govuk-footer__inline-list-item",
+ actionLink(
+ class = "govuk-link govuk-footer__link",
+ inputId = tolower(gsub(" ", "_", link_text)),
+ label = link_text
+ )
+ )
+ }
+
+ # The HTML div to be returned
+ shiny::tags$footer(
+ class = "govuk-footer ",
+ role = "contentinfo",
+ shiny::div(class = "govuk-width-container ", shiny::div(
+ # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ # Add custom links in
+ shiny::div(
+ class = "govuk-footer__meta-item govuk-footer__meta-item--grow",
+
+ # Set a visually hidden title for accessibility
+ shiny::h2(class = "govuk-visually-hidden", "Support links"),
+ # Generate as many links as needed
+ shiny::tags$ul(
+ class = "govuk-footer__inline-list",
+ lapply(links_list, create_footer_link)
+ )
+ ),
+
+ # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ # Back to copied code from shinyGovstyle
+ shiny::div(class = "govuk-footer__meta", shiny::tagList(
+ shiny::div(
+ class = "govuk-footer__meta-item govuk-footer__meta-item--grow",
+ shiny::tag(
+ "svg",
+ list(
+ role = "presentation",
+ focusable = "false",
+ class = "govuk-footer__licence-logo",
+ xmlns = "http://www.w3.org/2000/svg",
+ viewbox = "0 0 483.2 195.7",
+ height = "17",
+ width = "41",
+ shiny::tag("path", list(
+ fill = "currentColor",
+ d = paste0(
+ "M421.5 142.8V.1l-50.7 32.3v161.1h112.4v-50.7",
+ "zm-122.3-9.6A47.12 47.12 0 0 1 221 97.8c0-26 21",
+ ".1-47.1 47.1-47.1 16.7 0 31.4 8.7 39.7 21.8l42.7",
+ "-27.2A97.63 97.63 0 0 0 268.1 0c-36.5 0-68.3 20.1",
+ "-85.1 49.7A98 98 0 0 0 97.8 0C43.9 0 0 43.9 0 97",
+ ".8s43.9 97.8 97.8 97.8c36.5 0 68.3-20.1 85.1-49.",
+ "7a97.76 97.76 0 0 0 149.6 25.4l19.4 22.2h3v-87.8",
+ "h-80l24.3 27.5zM97.8 145c-26 0-47.1-21.1-47.1-47",
+ ".1s21.1-47.1 47.1-47.1 47.2 21 47.2 47S123.8 145",
+ " 97.8 145"
+ )
+ ))
+ )
+ ),
+ shiny::tags$span(
+ class = "govuk-footer__licence-description",
+ "All content is available under the",
+ shiny::tags$a(
+ class = "govuk-footer__link",
+ href = "https://www.nationalarchives.gov.uk/doc/open-government-licence/version/3/",
+ rel = "license",
+ "Open Government Licence v3.0",
+ .noWS = "after"
+ ),
+ ", except where otherwise stated"
+ )
+ ),
+ shiny::tags$div(
+ class = "govuk-footer__meta-item",
+ shiny::tags$a(
+ class = "govuk-footer__link govuk-footer__copyright-logo",
+ href =
+ paste0(
+ "https://www.nationalarchives.gov.uk/information-management/",
+ "re-using-public-sector-information/uk-government-licensing-framework/crown-copyright/"
+ ),
+ "\u00A9 Crown copyright"
+ )
+ )
+ ))
+ ))
+ )
+}
+
+
+# left nav ====================================================================
+dfe_contents_links <- function(links_list) {
+ # Add the HTML around the link and make an id by snake casing
+ create_sidelink <- function(link_text) {
+ tags$li(
+ "—",
+ actionLink(tolower(gsub(
+ " ", "_", link_text
+ )), link_text, class = "contents_link")
+ )
+ }
+
+ # The HTML div to be returned
+ tags$div(
+ style = "position: sticky; top: 0.5rem; padding: 0.25rem; word-break: break-word;",
+ # Make it stick!
+ h2("Contents"),
+ # remove the circle bullets
+ tags$ol(
+ style = "list-style-type: none; padding-left: 0; font-size: 1rem;",
+ lapply(links_list, create_sidelink)
+ )
+ )
+}
+
+
+cookies_banner_server_jt <- function(id = "cookies_banner",
+ input_cookies,
+ parent_session,
+ google_analytics_key = NULL,
+ cookies_link_panel = "cookies_panel_ui") {
+ shiny::moduleServer(id, function(input, output, session) {
+ if (is.null(google_analytics_key)) {
+ warning("Please provide a valid Google Analytics key")
+ }
+ shiny::observeEvent(input_cookies(), {
+ if (!is.null(input_cookies())) {
+ if (!("dfe_analytics" %in% names(input_cookies()))) {
+ shinyjs::show(id = "cookies_main")
+ } else {
+ shinyjs::hide(id = "cookies_main")
+ msg <- list(
+ name = "dfe_analytics",
+ value = input_cookies()$dfe_analytics
+ )
+ session$sendCustomMessage("analytics-consent", msg)
+ if ("cookies" %in% names(input)) {
+ if ("dfe_analytics" %in% names(input_cookies())) {
+ if (input_cookies()$dfe_analytics == "denied") {
+ ga_msg <- list(name = paste0("_ga_", google_analytics_key))
+ session$sendCustomMessage("cookie-clear", ga_msg)
+ }
+ }
+ }
+ }
+ } else {
+ shinyjs::hide(id = "cookies_main", asis = TRUE)
+ shinyjs::toggle(id = "cookies_div", asis = TRUE)
+ }
+ })
+ shiny::observeEvent(input$cookies_accept, {
+ msg <- list(name = "dfe_analytics", value = "granted")
+ session$sendCustomMessage("cookie-set", msg)
+ session$sendCustomMessage("analytics-consent", msg)
+ shinyjs::hide(id = "cookies_main", asis = TRUE)
+ })
+ shiny::observeEvent(input$cookies_reject, {
+ msg <- list(name = "dfe_analytics", value = "denied")
+ session$sendCustomMessage("cookie-set", msg)
+ session$sendCustomMessage("analytics-consent", msg)
+ shinyjs::hide(id = "cookies_main", asis = TRUE)
+ })
+ shiny::observeEvent(input$cookies_link, {
+ shiny::updateTabsetPanel(
+ session = parent_session, "pages",
+ selected = cookies_link_panel
+ )
+ })
+ return(shiny::renderText({
+ cookies_text_stem <- "You have chosen to"
+ cookies_text_tail <- "the use of cookies on this website."
+ if (!is.null(input_cookies())) {
+ if ("dfe_analytics" %in% names(input_cookies())) {
+ if (input_cookies()$dfe_analytics == "granted") {
+ paste(cookies_text_stem, "accept", cookies_text_tail)
+ } else {
+ paste(cookies_text_stem, "reject", cookies_text_tail)
+ }
+ }
+ } else {
+ "Cookies consent has not been confirmed."
+ }
+ }))
+ })
+}
diff --git a/R/lait_modules/mod_all_la_table.R b/R/lait_modules/mod_all_la_table.R
index 5925ddc2..e4406e2f 100644
--- a/R/lait_modules/mod_all_la_table.R
+++ b/R/lait_modules/mod_all_la_table.R
@@ -152,34 +152,32 @@ AllLA_TableUI <- function(id) {
div(
class = "well",
style = "overflow-y: visible;",
- bslib::navset_tab(
+ bslib::navset_card_tab(
id = "all_la_table_tabs",
bslib::nav_panel(
"Tables",
- bslib::card(
- bslib::card_header(
- Get_AllLATableNameUI(ns("table_name")),
- style = "text-align: center;"
- ),
- bslib::card_header("Local Authorities"),
+ bslib::card_header(
+ Get_AllLATableNameUI(ns("table_name")),
+ style = "text-align: center;"
+ ),
+ bslib::card_header("Local Authorities"),
+ with_gov_spinner(
+ reactable::reactableOutput(ns("la_table")),
+ size = 3
+ ),
+ div(
+ # Add black border between the tables
+ style = "border-top: 2px solid black; padding-top: 2.5rem;",
+ bslib::card_header("Regions"),
with_gov_spinner(
- reactable::reactableOutput(ns("la_table")),
- size = 3
- ),
- div(
- # Add black border between the tables
- style = "border-top: 2px solid black; padding-top: 2.5rem;",
- bslib::card_header("Regions"),
- with_gov_spinner(
- reactable::reactableOutput(ns("region_table")),
- size = 1.6
- )
+ reactable::reactableOutput(ns("region_table")),
+ size = 1.6
)
)
),
bslib::nav_panel(
"Download data",
- file_type_input_btn(ns("file_type")),
+ shiny::uiOutput(ns("download_file_txt")),
Download_DataUI(ns("all_download"), "All Geographies Table"),
Download_DataUI(ns("la_download"), "LA Table"),
Download_DataUI(ns("region_download"), "Region Table")
@@ -235,6 +233,13 @@ AllLA_TableServer <- function(id, app_inputs, bds_metrics, la_names_bds) {
)
# All geographies table download ------------------------------------------
+ # File download text - calculates file size
+ ns <- NS(id)
+ output$download_file_txt <- shiny::renderUI({
+ file_type_input_btn(ns("file_type"), all_la_table())
+ })
+
+ # Download dataset
Download_DataServer(
"all_download",
reactive(input$file_type),
@@ -262,7 +267,7 @@ AllLA_TableServer <- function(id, app_inputs, bds_metrics, la_names_bds) {
set_custom_default_col_widths()
),
rowStyle = function(index) {
- highlight_selected_row(index, all_la_la_table, app_inputs$la())
+ highlight_selected_row(index, all_la_la_table, app_inputs$la(), "LA")
},
pagination = FALSE
)
@@ -287,10 +292,10 @@ AllLA_TableServer <- function(id, app_inputs, bds_metrics, la_names_bds) {
# Sums number of non-NA cols (left of LA and Regions) and checks if = 0
rowSums(!is.na(dplyr::select(all_la_table(), -c(`LA Number`, `LA and Regions`)))) == 0)
) |>
- # Replace Rank with a blank col
+ # Replace Rank
dplyr::mutate(Rank = "") |>
- dplyr::rename(` ` = "Rank") |>
- dplyr::arrange(`LA Number`)
+ dplyr::arrange(`LA Number`) |>
+ dplyr::rename("Region" = `LA and Regions`)
# Get region of LA
all_la_region <- stat_n_la |>
@@ -309,10 +314,19 @@ AllLA_TableServer <- function(id, app_inputs, bds_metrics, la_names_bds) {
num_exclude = "LA Number",
categorical = "Rank"
),
- set_custom_default_col_widths()
+ list(
+ set_custom_default_col_widths(),
+ Rank = reactable::colDef(
+ header = add_tooltip_to_reactcol(
+ "Rank",
+ "Regions are not currently ranked",
+ placement = "top"
+ )
+ )
+ )
),
rowStyle = function(index) {
- highlight_selected_row(index, all_la_region_table, all_la_region)
+ highlight_selected_row(index, all_la_region_table, all_la_region, "Region")
},
pagination = FALSE
# class = "hidden-column-headers"
diff --git a/R/lait_modules/mod_app_helpers.R b/R/lait_modules/mod_app_helpers.R
index 43f898d4..e412f62d 100644
--- a/R/lait_modules/mod_app_helpers.R
+++ b/R/lait_modules/mod_app_helpers.R
@@ -19,7 +19,7 @@ PageHeaderUI <- function(id) {
shinycssloaders::withSpinner(
shiny::uiOutput(ns("page_header")),
type = 7,
- color = "#1d70b8",
+ color = "#0b0c0c",
size = 1,
proxy.height = paste0(250 * 0.25, "px")
)
@@ -238,7 +238,8 @@ DownloadChartModalUI <- function(id, chart_type) {
footer = shiny::tagAppendAttributes(
shiny::modalButton("Close"),
class = "govuk-button--secondary"
- )
+ ),
+ size = "l"
)
}
diff --git a/R/lait_modules/mod_app_inputs.R b/R/lait_modules/mod_app_inputs.R
index 1fd03c96..edc9a718 100644
--- a/R/lait_modules/mod_app_inputs.R
+++ b/R/lait_modules/mod_app_inputs.R
@@ -1,182 +1,182 @@
-# nolint start: object_name
-#
-#' Shiny Module UI for Displaying the App Inputs
-#'
-#' This function creates a Shiny UI module for displaying the app inputs.
-#' The inputs include a select input for the local authority (LA) name,
-#' the topic name, and the indicator name.
-#' Each input is wrapped in a div with a well and a layout column for styling.
-#'
-#' @param id A unique ID that identifies the UI element
-#' @return A div object that contains the UI elements for the module
-#'
-appInputsUI <- function(id) {
- ns <- NS(id)
-
- div(
- class = "well",
- style = "overflow-y: visible; position: relative;",
- bslib::layout_column_wrap(
- width = "15rem", # Minimum width for each input box before wrapping
- shiny::selectizeInput(
- inputId = ns("la_name"),
- label = tags$label(
- "Local Authority:",
- create_tooltip_icon("Change selection by scrolling or typing")
- ),
- choices = la_names_bds,
- options = list(
- placeholder = "Start typing or scroll to find a Local Authority...",
- plugins = list("clear_button")
- )
- ),
- shiny::selectizeInput(
- inputId = ns("topic_name"),
- label = tags$label(
- id = ns("topic_label"),
- "Topic:"
- ),
- choices = c("All Topics", metric_topics),
- selected = "All Topics",
- options = list(
- placeholder = "No topic selected, showing all indicators...",
- plugins = list("clear_button")
- )
- ),
- shiny::selectizeInput(
- inputId = ns("indicator_name"),
- label = "Indicator:",
- choices = metric_names,
- options = list(
- placeholder = "Start typing or scroll to find an indicator...",
- plugins = list("clear_button")
- )
- )
- )
- )
-}
-
-
-#' Shiny Server Function for Handling the App Inputs with Synchronisation
-#'
-#' This function creates a Shiny server module for handling the app inputs
-#' and synchronising them across multiple pages.
-#' It observes the selected topic name and updates the choices for the
-#' indicator name based on the selected topic, and also updates the shared
-#' reactive values to keep the inputs in sync between pages.
-#'
-#' @param id A unique ID that identifies the server function.
-#' @param shared_values A `reactiveValues` object to store shared input values
-#' that can be accessed and modified across different modules.
-#' @return A list of reactive expressions for the app inputs, including
-#' the selected LA name, topic name, and indicator name.
-#'
-appInputsServer <- function(id,
- shared_values,
- topic_indicator_full) {
- moduleServer(id, function(input, output, session) {
- # Reactive value to store the previous LA name
- previous_la_name <- reactiveVal(NULL)
-
- # Debounce input values to prevent looping when inputs change quickly
- debounced_la_name <- shiny::debounce(reactive(input$la_name), 150)
- debounced_topic_name <- shiny::debounce(reactive(input$topic_name), 150)
- debounced_indicator_name <- shiny::debounce(reactive(input$indicator_name), 150)
-
- # Update Indicator dropdown for selected Topic
- shiny::observeEvent(debounced_topic_name(),
- {
- # Save the currently selected indicator
- current_indicator <- debounced_indicator_name()
-
- # Determine the filter condition for Topic
- topic_filter <- debounced_topic_name()
-
- # Get indicator choices for selected topic
- # Include all rows if no topic is selected or "All Topics" is selected
- filtered_topic_bds <- topic_indicator_full |>
- filter_by_topic("Topic", topic_filter) |>
- pull_uniques("Measure")
-
- # Ensure the current indicator stays selected
- # Default to the first topic indicator if the current is not valid
- selected_indicator <- if (current_indicator %in% filtered_topic_bds) {
- current_indicator
- } else {
- filtered_topic_bds[1]
- }
-
- # Update the Indicator dropdown based on selected Topic
- shiny::updateSelectizeInput(
- session = session,
- inputId = "indicator_name",
- choices = filtered_topic_bds,
- selected = selected_indicator
- )
-
- # Update the shared reactive value for the topic
- shared_values$topic <- debounced_topic_name()
- },
- ignoreNULL = FALSE
- )
-
- # Prevent LA input from being empty by storing its previous value
- shiny::observeEvent(debounced_la_name(), {
- # Check if the LA name is NULL or empty
- la_name <- debounced_la_name()
-
- if ("" %notin% la_name && !is.null(la_name)) {
- # Update the reactive value with the current valid input
- previous_la_name(la_name)
-
- # Synchronise the shared reactive value
- shared_values$la <- la_name
- }
- })
-
- # Set dynamic topic label
- # (to display topic when not selected or all topics selected)
- update_topic_label(
- indicator_input = debounced_indicator_name,
- topic_input = debounced_topic_name,
- topic_indicator_data = topic_indicator_full,
- topic_label_id = "topic_label"
- )
-
- # Observe and synchronise Indicator input changes
- observeEvent(debounced_indicator_name(), {
- shared_values$indicator <- debounced_indicator_name()
- })
-
- # Synchronise inputs across pages:
- # LA
- observe({
- shiny::updateSelectizeInput(session, "la_name", selected = shared_values$la)
- })
- # Topic
- observe({
- shiny::updateSelectizeInput(session, "topic_name", selected = shared_values$topic)
- })
- # Indicator
- observe({
- shiny::updateSelectizeInput(session, "indicator_name", selected = shared_values$indicator)
- })
-
- # Return reactive settings
- app_settings <- list(
- la = reactive({
- previous_la_name()
- }),
- topic = reactive({
- debounced_topic_name()
- }),
- indicator = reactive({
- debounced_indicator_name()
- })
- )
-
- return(app_settings)
- })
-}
-
-# nolint end
+# nolint start: object_name
+#
+#' Shiny Module UI for Displaying the App Inputs
+#'
+#' This function creates a Shiny UI module for displaying the app inputs.
+#' The inputs include a select input for the local authority (LA) name,
+#' the topic name, and the indicator name.
+#' Each input is wrapped in a div with a well and a layout column for styling.
+#'
+#' @param id A unique ID that identifies the UI element
+#' @return A div object that contains the UI elements for the module
+#'
+appInputsUI <- function(id) {
+ ns <- NS(id)
+
+ div(
+ class = "well",
+ style = "overflow-y: visible; position: relative;",
+ bslib::layout_column_wrap(
+ width = "15rem", # Minimum width for each input box before wrapping
+ shiny::selectizeInput(
+ inputId = ns("la_name"),
+ label = tags$label(
+ "Local Authority:",
+ create_tooltip_icon("Change selection by scrolling or typing")
+ ),
+ choices = la_names_bds,
+ options = list(
+ placeholder = "Start typing or scroll to find a Local Authority...",
+ plugins = list("clear_button")
+ )
+ ),
+ shiny::selectizeInput(
+ inputId = ns("topic_name"),
+ label = tags$label(
+ id = ns("topic_label"),
+ "Topic:"
+ ),
+ choices = c("All Topics", metric_topics),
+ selected = "All Topics",
+ options = list(
+ placeholder = "No topic selected, showing all indicators...",
+ plugins = list("clear_button")
+ )
+ ),
+ shiny::selectizeInput(
+ inputId = ns("indicator_name"),
+ label = "Indicator:",
+ choices = metric_names,
+ options = list(
+ placeholder = "Start typing or scroll to find an indicator...",
+ plugins = list("clear_button")
+ ),
+ )
+ )
+ )
+}
+
+
+#' Shiny Server Function for Handling the App Inputs with Synchronisation
+#'
+#' This function creates a Shiny server module for handling the app inputs
+#' and synchronising them across multiple pages.
+#' It observes the selected topic name and updates the choices for the
+#' indicator name based on the selected topic, and also updates the shared
+#' reactive values to keep the inputs in sync between pages.
+#'
+#' @param id A unique ID that identifies the server function.
+#' @param shared_values A `reactiveValues` object to store shared input values
+#' that can be accessed and modified across different modules.
+#' @return A list of reactive expressions for the app inputs, including
+#' the selected LA name, topic name, and indicator name.
+#'
+appInputsServer <- function(id,
+ shared_values,
+ topic_indicator_full) {
+ moduleServer(id, function(input, output, session) {
+ # Reactive value to store the previous LA name
+ previous_la_name <- reactiveVal(NULL)
+
+ # Debounce input values to prevent looping when inputs change quickly
+ debounced_la_name <- shiny::debounce(reactive(input$la_name), 150)
+ debounced_topic_name <- shiny::debounce(reactive(input$topic_name), 75)
+ debounced_indicator_name <- shiny::debounce(reactive(input$indicator_name), 150)
+
+ # Update Indicator dropdown for selected Topic
+ shiny::observeEvent(debounced_topic_name(),
+ {
+ # Save the currently selected indicator
+ current_indicator <- debounced_indicator_name()
+
+ # Determine the filter condition for Topic
+ topic_filter <- debounced_topic_name()
+
+ # Get indicator choices for selected topic
+ # Include all rows if no topic is selected or "All Topics" is selected
+ filtered_topic_bds <- topic_indicator_full |>
+ filter_by_topic("Topic", topic_filter) |>
+ pull_uniques("Measure")
+
+ # Ensure the current indicator stays selected
+ # Default to the first topic indicator if the current is not valid
+ selected_indicator <- if (current_indicator %in% filtered_topic_bds) {
+ current_indicator
+ } else {
+ filtered_topic_bds[1]
+ }
+
+ # Update the Indicator dropdown based on selected Topic
+ shiny::updateSelectizeInput(
+ session = session,
+ inputId = "indicator_name",
+ choices = filtered_topic_bds,
+ selected = selected_indicator
+ )
+
+ # Update the shared reactive value for the topic
+ shared_values$topic <- debounced_topic_name()
+ },
+ ignoreNULL = FALSE
+ )
+
+ # Prevent LA input from being empty by storing its previous value
+ shiny::observeEvent(debounced_la_name(), {
+ # Check if the LA name is NULL or empty
+ la_name <- debounced_la_name()
+
+ if ("" %notin% la_name && !is.null(la_name)) {
+ # Update the reactive value with the current valid input
+ previous_la_name(la_name)
+
+ # Synchronise the shared reactive value
+ shared_values$la <- la_name
+ }
+ })
+
+ # Set dynamic topic label
+ # (to display topic when not selected or all topics selected)
+ update_topic_label(
+ indicator_input = debounced_indicator_name,
+ topic_input = debounced_topic_name,
+ topic_indicator_data = topic_indicator_full,
+ topic_label_id = "topic_label"
+ )
+
+ # Observe and synchronise Indicator input changes
+ observeEvent(debounced_indicator_name(), {
+ shared_values$indicator <- debounced_indicator_name()
+ })
+
+ # Synchronise inputs across pages:
+ # LA
+ observe({
+ shiny::updateSelectizeInput(session, "la_name", selected = shared_values$la)
+ })
+ # Topic
+ observe({
+ shiny::updateSelectizeInput(session, "topic_name", selected = shared_values$topic)
+ })
+ # Indicator
+ observe({
+ shiny::updateSelectizeInput(session, "indicator_name", selected = shared_values$indicator)
+ })
+
+ # Return reactive settings
+ app_settings <- list(
+ la = reactive({
+ previous_la_name()
+ }),
+ topic = reactive({
+ debounced_topic_name()
+ }),
+ indicator = reactive({
+ debounced_indicator_name()
+ })
+ )
+
+ return(app_settings)
+ })
+}
+
+# nolint end
diff --git a/R/lait_modules/mod_create_own_charts.R b/R/lait_modules/mod_create_own_charts.R
index c4649a02..a92aee73 100644
--- a/R/lait_modules/mod_create_own_charts.R
+++ b/R/lait_modules/mod_create_own_charts.R
@@ -270,21 +270,24 @@ CreateOwnLineChartServer <- function(id, query, bds_metrics, covid_affected_data
if ("Message from tool" %in% colnames(create_own_data())) {
ggiraph::girafe(
ggobj = display_no_data_plot("No plot as not enough selections made."),
- width_svg = 8.5
+ width_svg = 8.5,
+ options = generic_ggiraph_options()
)
} else if (
chart_info$no_geogs() > 4
) {
ggiraph::girafe(
ggobj = display_no_data_plot(label = "No plot as too many Geographies selected."),
- width_svg = 8.5
+ width_svg = 8.5,
+ options = generic_ggiraph_options()
)
} else if (
chart_info$no_indicators() > 3
) {
ggiraph::girafe(
ggobj = display_no_data_plot(label = "No plot as too many Indicators selected."),
- width_svg = 8.5
+ width_svg = 8.5,
+ options = generic_ggiraph_options()
)
# Plot line chart
@@ -527,21 +530,24 @@ CreateOwnBarChartServer <- function(id, query, bds_metrics, covid_affected_data)
if ("Message from tool" %in% colnames(create_own_data())) {
ggiraph::girafe(
ggobj = display_no_data_plot("No plot as not enough selections made."),
- width_svg = 8.5
+ width_svg = 8.5,
+ options = generic_ggiraph_options()
)
} else if (
chart_info$no_geogs() > 4
) {
ggiraph::girafe(
ggobj = display_no_data_plot(label = "No plot as too many Geographies selected."),
- width_svg = 8.5
+ width_svg = 8.5,
+ options = generic_ggiraph_options()
)
} else if (
chart_info$no_indicators() > 3
) {
ggiraph::girafe(
ggobj = display_no_data_plot(label = "No plot as too many Indicators selected."),
- width_svg = 8.5
+ width_svg = 8.5,
+ options = generic_ggiraph_options()
)
# Plot chart
diff --git a/R/lait_modules/mod_create_own_inputs.R b/R/lait_modules/mod_create_own_inputs.R
index 18cefca9..49d04605 100644
--- a/R/lait_modules/mod_create_own_inputs.R
+++ b/R/lait_modules/mod_create_own_inputs.R
@@ -96,7 +96,12 @@ Create_MainInputsUI <- function(id) {
),
# Add selection (query) button
"Add selection" = div(
- style = "height: 100%; display: flex; justify-content: center; align-items: flex-end;",
+ style = "
+ height: 100%;
+ display: flex;
+ justify-content: center;
+ align-items: flex-end;
+ ",
shinyGovstyle::button_Input(
inputId = ns("add_query"),
label = "Add selections",
@@ -324,9 +329,9 @@ YearRangeServer <- function(id, bds_metrics, indicator_input, clear_selections)
shinyWidgets::updatePickerInput(
session = session,
inputId = "year_range",
- choices = "Please select an indicator first",
+ choices = "Select an indicator to see year range",
options = shinyWidgets::pickerOptions(
- noneSelectedText = "Select an indicator to see year range",
+ noneSelectedText = "Select an indicator...",
maxOptions = 2,
maxOptionsText = "Select and indicator",
size = "auto"
diff --git a/R/lait_modules/mod_create_own_table.R b/R/lait_modules/mod_create_own_table.R
index bc184d69..4cc91a53 100644
--- a/R/lait_modules/mod_create_own_table.R
+++ b/R/lait_modules/mod_create_own_table.R
@@ -1,854 +1,861 @@
-# nolint start: object_name
-#
-# Staging table ================================================================
-# Staging BDS ------------------------------------------------------------------
-# Filter the BDS for current user input selections
-# (used to create the staging table)
-#
-#' Staging BDS Server
-#'
-#' This function filters the BDS (Business Data Service) metrics based on
-#' user input selections to create a staging table. It filters for selected
-#' topic-indicator pairs, geographic groupings, and a specified year range.
-#'
-#' @param id A unique identifier for the Shiny module.
-#' @param create_inputs A list of reactive inputs generated by the main
-#' input module, including selected topic-indicator pairs.
-#' @param geog_groups A reactive expression providing the selected geographic
-#' groups based on user input.
-#' @param year_input A list containing reactive expressions for selected
-#' year range and available years choices.
-#' @param bds_metrics A data frame containing the business data service metrics
-#' used for filtering based on user selections.
-#' @return A reactive data frame that contains the filtered BDS metrics
-#' suitable for display in the staging table.
-#'
-StagingBDSServer <- function(id,
- create_inputs,
- geog_groups,
- year_input,
- bds_metrics) {
- moduleServer(id, function(input, output, session) {
- # Forcing module to react to change in year input (not best practice)
- observeEvent(year_input$range(), {
- year_input$range()
- })
-
- # Filter BDS for topic-indicator pairs in the selected_values reactive
- topic_indicator_bds <- reactive({
- req(length(create_inputs$indicator()) > 0)
- bds_metrics |>
- dplyr::filter(Measure %in% create_inputs$indicator())
- })
-
- # Now filter BDS for geographies and year range
- # Split from above so if indicator doesn't change then don't recompute
- staging_bds <- reactive({
- req(geog_groups(), topic_indicator_bds())
- # Filter by full geography inputs
- filtered_bds <- topic_indicator_bds() |>
- dplyr::filter(
- `LA and Regions` %in% geog_groups()
- )
-
- # Cleaning Years
- # Check if all years have consistent suffix
- consistent_str_years <- check_year_suffix_consistency(filtered_bds)
-
- # If not consistent suffix use the cleaned year cols (numeric years)
- if (!consistent_str_years) {
- filtered_bds <- filtered_bds |>
- dplyr::mutate(
- Years = Years_num
- )
- }
-
- # Apply the year range filter
- # If only one year selected then show just that year
- if (length(year_input$range()) == 1) {
- filtered_bds <- filtered_bds |>
- dplyr::filter(
- Years == year_input$range()[1]
- )
- } else if (length(year_input$range()) == 2) {
- filtered_bds <- filtered_bds |>
- dplyr::filter(
- Years >= year_input$range()[1],
- Years <= year_input$range()[2]
- )
- }
-
- # Return the user selection filtered data for staging table
- filtered_bds
- })
-
-
- # Return staging BDS
- staging_bds
- })
-}
-
-
-# Staging data -----------------------------------------------------------------
-#
-#' Staging Data Server
-#'
-#' This function builds a staging table for displaying filtered BDS metrics
-#' in a Shiny application. It incorporates statistical neighbour associations
-#' if selected and formats the data into a wide format for easier analysis.
-#'
-#' @param id A unique identifier for the Shiny module.
-#' @param create_inputs A list of reactive inputs generated by the main
-#' input module, including selected topic-indicator pairs.
-#' @param staging_bds A reactive expression providing the filtered BDS metrics
-#' based on user selections.
-#' @param region_names_bds A vector of names representing regions in the BDS.
-#' @param la_names_bds A vector of names representing local authorities in the BDS.
-#' @param stat_n_la A data frame containing statistical neighbour data for LAs.
-#' @return A reactive data frame that contains the formatted staging table
-#' ready for display in the Shiny app.
-#'
-StagingDataServer <- function(
- id, create_inputs, staging_bds, region_names_bds, la_names_bds, stat_n_la) {
- moduleServer(id, function(input, output, session) {
- # Make statistical neighbour association table available
- stat_n_association <- StatN_AssociationServer(
- "stat_n_association",
- create_inputs,
- la_names_bds,
- stat_n_la
- )
-
- # Build the staging table
- staging_table <- reactive({
- # Selected relevant cols
- # Coerce to wide format
- # (any new values created set to NaN so can be picked up as user created NAs)
- # Set regions and England as themselves for Region
- wide_table <- staging_bds() |>
- dplyr::select(
- `LA Number`, `LA and Regions`, Region, Topic,
- Measure, Years, Years_num, values_num, Values
- ) |>
- tidyr::pivot_wider(
- id_cols = c("LA Number", "LA and Regions", "Region", "Topic", "Measure"),
- names_from = Years,
- values_from = values_num,
- values_fill = NaN
- ) |>
- dplyr::mutate(Region = dplyr::case_when(
- `LA and Regions` %in% c("England", region_names_bds) ~ `LA and Regions`,
- TRUE ~ Region
- ))
-
- # Order columns (and sort year cols order)
- wide_table_ordered <- wide_table |>
- dplyr::select(
- `LA Number`, `LA and Regions`, Region,
- Topic, Measure,
- dplyr::all_of(sort_year_columns(wide_table))
- )
-
- # If SNs included, add SN LA association column
- # Multi-join as want to include an association for every row (even duplicates)
- if (isTRUE(create_inputs$la_group() == "la_stat_ns")) {
- wide_table_ordered <- wide_table_ordered |>
- dplyr::left_join(
- stat_n_association(),
- by = "LA and Regions",
- relationship = "many-to-many"
- ) |>
- dplyr::relocate(sn_parent, .after = "Measure") |>
- dplyr::rename("Statistical Neighbour Group" = "sn_parent")
- }
-
- # Staging table formatted and ready for output
- wide_table_ordered
- })
-
- # Return staging table
- staging_table
- })
-}
-
-
-# Staging table UI -------------------------------------------------------------
-# Simple reactable table inside a well div
-#
-#' Staging Table UI
-#'
-#' This function creates the user interface for the staging table, which
-#' displays the current selections in a well-styled format. The UI includes
-#' a header and a reactable output for rendering the staging data.
-#'
-#' @param id A unique identifier for the Shiny module.
-#' @return A div containing the UI elements for the staging table, including
-#' a header and a reactable output.
-#'
-StagingTableUI <- function(id) {
- ns <- NS(id)
-
- div(
- class = "well",
- style = "overflow-y: visible;",
- bslib::layout_column_wrap(
- h3(
- "Staging Table",
- create_tooltip_icon("Showing data from current selections")
- ),
- # Include empty divs so matches inputs above and add selections aligns
- div(),
- div(),
- # Add selections button
- Create_MainInputsUI("create_inputs")["Add selection"]
- ),
- bslib::card(
- with_gov_spinner(
- reactable::reactableOutput(ns("staging_table")),
- size = 0.5
- )
- )
- )
-}
-
-
-# Staging table Server ---------------------------------------------------------
-# Output a formatted reactable table of the staging data
-# Few error message table outputs for incorrect/ missing selections
-#
-#' Staging Table Server
-#'
-#' This function generates the server-side logic for the staging table, which
-#' renders a reactable table of the current selections. It handles error
-#' messages for incorrect or missing selections and formats the staging data
-#' for better readability. It filters the BDS data based on user inputs and
-#' prepares it for display.
-#'
-#' @param id A unique identifier for the Shiny module.
-#' @param create_inputs A list of reactive inputs generated by the main input
-#' module, including selected indicators and geography.
-#' @param region_names_bds A vector of names representing regions in the BDS.
-#' @param la_names_bds A vector of names representing local authorities in the BDS.
-#' @param stat_n_la A data frame containing statistical neighbour data for LAs.
-#' @param geog_groups A reactive expression that provides the selected geography
-#' groups based on user input.
-#' @param year_input A reactive expression providing the selected year range.
-#' @param bds_metrics A data frame containing the BDS metrics used for filtering.
-#' @return A reactable output for the staging table, displaying filtered BDS data
-#' or error messages based on user selections.
-StagingTableServer <- function(id,
- create_inputs,
- region_names_bds,
- la_names_bds,
- stat_n_la,
- geog_groups,
- year_input,
- bds_metrics) {
- moduleServer(id, function(input, output, session) {
- # Staging table reactable ouput
- output$staging_table <- reactable::renderReactable({
- # Display messages if there are incorrect selections
- if (length(create_inputs$indicator()) == 0 && is.null(geog_groups())) {
- return(reactable::reactable(
- data.frame(
- `Message from tool` = "Please add selections (above).",
- check.names = FALSE
- )
- ))
- } else if (length(create_inputs$indicator()) == 0) {
- return(reactable::reactable(
- data.frame(
- `Message from tool` = "Please add an indicator selection (above).",
- check.names = FALSE
- )
- ))
- } else if (is.null(geog_groups())) {
- return(reactable::reactable(
- data.frame(
- `Message from tool` = "Please add a geography selection (above).",
- check.names = FALSE
- )
- ))
- }
-
- # Filtering BDS for staging data
- staging_bds <- StagingBDSServer(
- "staging_bds",
- create_inputs,
- geog_groups,
- year_input,
- bds_metrics
- )
-
- # Build staging data
- staging_data <- StagingDataServer(
- "staging_data",
- create_inputs,
- staging_bds,
- region_names_bds,
- la_names_bds,
- stat_n_la
- )
-
- # Output table - formatting numbers, long text and page settings
- dfe_reactable(
- staging_data(),
- columns = utils::modifyList(
- format_num_reactable_cols(
- staging_data(),
- get_indicator_dps(staging_bds()),
- num_exclude = c("LA Number", "Topic", "Measure")
- ),
- list(
- set_custom_default_col_widths(
- Measure = set_min_col_width(90)
- ),
- # Truncates long cell values and displays hover with full value
- Measure = reactable::colDef(
- html = TRUE,
- cell = function(value, index, name) {
- truncate_cell_with_hover(text = value, tooltip = value)
- }
- )
- )
- ),
- defaultPageSize = 3,
- showPageSizeOptions = TRUE,
- pageSizeOptions = c(3, 5, 10, 25),
- compact = TRUE
- )
- })
- })
-}
-
-
-# Query table ==================================================================
-# Query data -------------------------------------------------------------------
-#
-#' Query Data Server
-#'
-#' This function manages the server-side logic for storing and displaying
-#' queries based on user selections. It allows users to add queries to a
-#' saved list and formats the data for display. The function maintains
-#' a reactive data structure that includes the selected topics, indicators,
-#' geography, and year range.
-#'
-#' @param id A unique identifier for the Shiny module.
-#' @param create_inputs A list of reactive inputs generated by the main input
-#' module, including selected indicators and geography.
-#' @param geog_groups A reactive expression that provides the selected geography
-#' groups based on user input.
-#' @param year_input A reactive expression providing the selected year range.
-#' @param staging_data A reactive expression that contains the staging data
-#' filtered based on user selections.
-#' @return A reactive value list containing the current queries and output data
-#' for display, including options for removing queries.
-#'
-QueryDataServer <- function(id,
- create_inputs,
- geog_groups,
- year_input,
- staging_data) {
- moduleServer(id, function(input, output, session) {
- # Reactive value "query" used to store query data
- # Uses lists to store multiple inputs (Geographies & Indicators)
- query <- reactiveValues(
- data = data.frame(
- Topic = I(list()),
- Indicator = I(list()),
- `LA and Regions` = I(list()),
- `Year range` = I(list()),
- `Click to remove query` = character(),
- `.query_id` = numeric(),
- check.names = FALSE
- ),
- output = data.frame(
- `LA Number` = character(),
- `LA and Regions` = character(),
- Region = character(),
- Topic = character(),
- Measure = character(),
- check.names = FALSE
- )
- )
-
- # When "Add table" button clicked - add query to saved queries
- observeEvent(create_inputs$add_query(),
- {
- # Check if anything selected
- req(length(geog_groups()) > 0 && length(create_inputs$indicator()) > 0)
-
- # Create a unique identifier for the new query (current no of queries + 1)
- new_q_id <- max(c(0, query$data$.query_id), na.rm = TRUE) + 1
-
- # Creating year range info
- # Get the range of available years
- available_years <- range(year_input$choices())
-
- # Define the year range info logic
- # None selected - all years - "All years (x to y)"
- # Range selected - "x to y"
- # One year selected - "x"
- year_range_display <- dplyr::case_when(
- length(year_input$range()) == 0 ~ paste0("All years (", available_years[1], " to ", available_years[2], ")"),
- length(year_input$range()) == 2 ~ paste(year_input$range()[1], "to", year_input$range()[2]),
- length(year_input$range()) == 1 ~ paste0("", year_input$range()[1])
- )
-
- # Evaluate user inputs for get_geog_selection()
- evaluated_inputs <- list(
- geog = create_inputs$geog(),
- la_group = create_inputs$la_group(),
- inc_regions = create_inputs$inc_regions(),
- inc_england = create_inputs$inc_england()
- )
-
- # Get selected Indicator Topics
- selected_topics <- staging_data() |>
- pull_uniques("Topic")
-
- # Create query information
- # Split multiple input choices with commas and line breaks
- # (indicator x, indicator y)
- # Assign the new query ID, selected topic-indicator pairs,
- # create the geog selections (special formatting for groupings),
- # year range (with logic from above) and the remove col
- new_query <- data.frame(
- .query_id = new_q_id,
- Topic = paste(selected_topics, collapse = ",
"),
- Indicator = paste(create_inputs$indicator(), collapse = ",
"),
- `LA and Regions` = paste(
- get_geog_selection(evaluated_inputs, la_names_bds, region_names_bds, stat_n_geog),
- collapse = ",
"
- ),
- `Year range` = year_range_display,
- `Click to remove query` = "Remove",
- check.names = FALSE
- )
-
- # Append new query to the existing queries
- query$data <- query$data |>
- rbind(new_query)
-
- # Appending the data of the new query to the output table
- # Adding new query ID to staging data
- # (so remove button also removes relevant data from output table)
- query_output <- query$output
- staging_to_append <- staging_data()
- staging_to_append$.query_id <- new_q_id
- consistent_staging_final_yrs <- data.frame(
- Years = c(
- colnames(query_output)[grepl("^\\d{4}", colnames(query_output))],
- colnames(staging_to_append)[grepl("^\\d{4}", colnames(staging_to_append))]
- )
- ) |> check_year_suffix_consistency()
-
- # If not consistent suffixes then clean both dfs year cols
- if (!consistent_staging_final_yrs && nrow(query_output) > 0) {
- query_output <- rename_columns_with_year(query_output)
- staging_to_append <- rename_columns_with_year(staging_to_append)
- }
-
- # Get all years across both dfs
- all_year_columns <- union(
- grep("^\\d{4}", names(query_output), value = TRUE),
- grep("^\\d{4}", names(staging_to_append), value = TRUE)
- )
-
- # Add the new (missing) years onto the existing dfs with values as NaN
- # This is so that they can be coded as "-" in the table
- # Saved queries
- if (nrow(query_output) > 0) {
- for (col in setdiff(all_year_columns, names(query_output))) {
- query_output[[col]] <- NaN
- }
- }
-
- # New query
- if (nrow(staging_to_append) > 0) {
- for (col in setdiff(all_year_columns, names(staging_to_append))) {
- staging_to_append[[col]] <- NaN
- }
- }
-
- # Combine query tables for final table output
- query$output <- rbind(query_output, staging_to_append)
- },
- ignoreInit = TRUE
- )
-
- query
- })
-}
-
-
-# Query Table UI ---------------------------------------------------------------
-#
-#' Query Table UI
-#'
-#' This function creates the user interface for displaying a summary of
-#' saved queries in a well-styled format. It includes a reactable table
-#' output to present the user's selections.
-#'
-#' @param id A unique identifier for the Shiny module.
-#' @return A UI element that displays a summary of selections in a
-#' reactable table format.
-#'
-QueryTableUI <- function(id) {
- ns <- NS(id)
-
- div(
- class = "well",
- style = "overflow-y: visible;",
- h3("Summary of Selections"),
- bslib::card(
- with_gov_spinner(
- reactable::reactableOutput(ns("query_table")),
- size = 0.5
- )
- )
- )
-}
-
-# Query Table Server -----------------------------------------------------------
-# Renders the query table and manages removal actions
-#
-#' Query Table Server
-#'
-#' This function handles the server-side logic for rendering the query
-#' table and managing the removal of saved queries. It displays the
-#' current queries and allows users to remove specific entries.
-#'
-#' @param id A unique identifier for the Shiny module.
-#' @param query A reactive list containing the current query data, including
-#' saved queries and output for display.
-#' @return A reactive value list that updates when queries are added or
-#' removed, reflecting the current state of the query data.
-#'
-QueryTableServer <- function(id, query) {
- moduleServer(id, function(input, output, session) {
- # Display message if there are no saved selections
- output$query_table <- reactable::renderReactable({
- req(nrow(query$data))
- if (nrow(query$data) == 0) {
- return(reactable::reactable(
- data.frame(`Message from tool` = "No saved selections.", check.names = FALSE)
- ))
- }
-
- # Output table - Allow html (for
),
- # add the JS from reactable.extras::button_extra() for remove button
- # Show only unique topics and remove the query ID col
- dfe_reactable(
- query$data,
- columns = list(
- Indicator = html_col_def(),
- `LA and Regions` = html_col_def(),
- `Click to remove query` = reactable::colDef(
- cell = reactable::JS(
- "function(cellInfo) {
- const buttonId = 'query_table-remove-' + cellInfo.row['.query_id'];
- console.log('Generated button ID:', buttonId); // Confirm buttonId in console
- return React.createElement(ButtonExtras, {
- id: buttonId,
- label: 'Remove',
- uuid: cellInfo.row['.query_id'],
- column: cellInfo.column.id,
- class: 'govuk-button--warning',
- className: 'govuk-button--warning'
- }, cellInfo.index);
- }"
- )
- ),
- Topic = html_col_def(),
- .query_id = reactable::colDef(show = FALSE)
- ),
- defaultPageSize = 5,
- showPageSizeOptions = TRUE,
- pageSizeOptions = c(5, 10, 25),
- compact = TRUE
- )
- })
-
- # Remove query button logic
- observe({
- req(nrow(query$data))
-
- # Create button observers for each row using the query ID
- lapply(query$data$.query_id, function(q_id) {
- # Create matching query ID for each remove button
- remove_button_id <- paste0("remove-", q_id)
-
- # Observe the button click
- observeEvent(input[[remove_button_id]],
- {
- # Remove the corresponding row (query) from query$data using the query ID
- query$data <- query$data[query$data$.query_id != q_id, , drop = FALSE]
-
- # Also remove the corresponding rows from query$output
- query$output <- query$output[query$output$.query_id != q_id, , drop = FALSE]
-
- # If no rows (queries) left then also remove the years cols
- # This is so that if a user wants a range of years next
- # the legacy years aren't still there
- if (nrow(query$output) == 0) {
- query$output <- query$output |>
- dplyr::select(
- `LA Number`,
- `LA and Regions`,
- Region,
- Topic,
- Measure,
- .query_id
- )
- }
- },
- ignoreInit = TRUE
- )
- })
- })
-
- # Output updated query (which is up-to-date with any removed rows)
- query
- })
-}
-
-
-# Create Own Table =============================================================
-# Create Own Data --------------------------------------------------------------
-#
-#' Create Own Data Server
-#'
-#' This function processes saved queries and generates a cleaned final
-#' table output for display. It checks for year suffix consistency and
-#' adjusts the column names accordingly. If there are no saved queries,
-#' it returns a message indicating this.
-#'
-#' @param id A unique identifier for the Shiny module.
-#' @param query A reactive list containing the current query data, including
-#' saved queries and output for display.
-#' @param bds_metrics A data frame containing metrics related to the BDS,
-#' which is used to verify year suffix consistency.
-#' @return A reactive data frame containing the cleaned final output table
-#' with correctly formatted year columns and relevant information.
-#'
-CreateOwnDataServer <- function(id, query, bds_metrics) {
- moduleServer(id, function(input, output, session) {
- # Building data for the output of all saved queries
- clean_final_table <- reactive({
- req(query$data)
-
- # Check if there are any saved queries
- if (nrow(query$data) == 0) {
- return(
- data.frame(
- `Message from tool` = "No saved selections.",
- check.names = FALSE
- )
- )
- }
-
- # Remove columns that contain only NaN values
- # (aka user removed query that was including these years so no need to display them now)
- query_output_clean <- query$output[, !sapply(query$output, function(x) all(is.nan(x)))]
-
- # Logic to reset the year cols to have year suffixes if they match
- # (As they may have been cleaned from the code logic at end of the new query chunk)
- # Determine if output indicators share year suffix consistency
- output_indicators <- query_output_clean |> pull_uniques("Measure")
- share_year_suffix <- bds_metrics |>
- dplyr::filter(Measure %in% output_indicators) |>
- check_year_suffix_consistency()
-
- # Reapply year suffixes to columns if needed
- if (share_year_suffix) {
- years_dict <- bds_metrics |>
- dplyr::filter(Measure %in% output_indicators) |>
- dplyr::distinct(Years, Years_num)
-
- # Replace numeric year columns with the corresponding suffix
- new_col_names <- colnames(query_output_clean) |>
- vapply(function(col) {
- if (col %in% years_dict$Years_num) {
- return(years_dict$Years[match(col, years_dict$Years_num)])
- } else {
- return(col)
- }
- }, character(1))
-
- colnames(query_output_clean) <- new_col_names
- }
-
- # Final query output table with ordered columns (SN parent if selected)
- # and sorted year columns
- query_output_clean |>
- dplyr::select(
- `LA Number`, `LA and Regions`,
- Region, Topic, Measure,
- tidyselect::any_of("Statistical Neighbour Group"),
- dplyr::all_of(sort_year_columns(query_output_clean))
- )
- })
-
- # Return data ready to render as output of Create Own Table
- clean_final_table
- })
-}
-
-
-# Create Own BDS ---------------------------------------------------------------
-#
-#' Create Own BDS Server
-#'
-#' This function filters the BDS metrics based on the topic-indicator pairs
-#' present in the final output table. It returns a reactive data frame
-#' containing only the relevant entries from the BDS that match the specified
-#' selections.
-#'
-#' @param id A unique identifier for the Shiny module.
-#' @param create_own_table A reactive expression that returns the final output
-#' table containing selected topic-indicator pairs.
-#' @param bds_metrics A data frame containing the full BDS metrics to be
-#' filtered based on the selections.
-#' @return A reactive data frame containing the filtered BDS metrics based
-#' on the selected topic-indicator pairs from the final output table.
-#'
-CreateOwnBDSServer <- function(id, create_own_table, bds_metrics) {
- moduleServer(id, function(input, output, session) {
- # Filtering BDS for all topic-indicator pairs in the final output table
- # (The filtered_bds only has the staging topic-indicator pairs)
- final_filtered_bds <- reactive({
- output_table_filters <- create_own_table() |>
- dplyr::distinct(`LA and Regions`, Topic, Measure)
-
- bds_metrics |>
- dplyr::semi_join(
- output_table_filters,
- by = c("LA and Regions", "Topic", "Measure")
- )
- })
-
- final_filtered_bds
- })
-}
-
-
-# Create Own Table UI ----------------------------------------------------------
-#
-#' Create Own Table UI
-#'
-#' This function generates the user interface for displaying the output table
-#' that shows all saved selections, along with a download section for exporting
-#' the table in various file formats.
-#'
-#' @param id A unique identifier for the Shiny module, used for namespacing.
-#' @return A UI component consisting of a well containing the output table and
-#' download options.
-#'
-CreateOwnTableUI <- function(id) {
- ns <- NS(id)
-
- div(
- class = "well",
- style = "overflow-y: visible;",
- h3(
- "Output Table",
- create_tooltip_icon(
- '
W_XGX;aCy)u1KwFR8-X23={U%)qU=ywe4jdpI025oP#%N zU(L1l;v#+1M3&2w&(=lI^^uFKZz$6W3pc{B%VA(5E3JlbhfFvYZ#nkJb233~8*y=Q zL71_{ckkX6>cX<@R^W#%xOMbNS6TKB3$d8{!(5xtxDF$?z1Q6?>PzpABSxhi%gclB z@j)DteXN2FLK)U-j^{BF%Sh{FZ&B4Ux*2w7S=&mL`_KTWjmpJMe%2!S{tTsc$`T6;Q-7px@kpi8z_Ua5F#%<8gIeT3Eh8?^rYxAEb6Yib_drf3VE6XCs z!B{1DyQXv_;PiBM zq*v`rx!UP~5~Y*+${uX9_VwD^Adh~N{ndp7b~7Pl{g=X?F4Uos_xw^MysC4OTwSdq z!+z_rlFTaI4aU!aVKWmpJ!KVvxf9!=Sf4hfGYiLBTUp)P-RFMH2=k-}GjUM}!7WQm z9QTF!WQaHo gXl*v z!(FeZ3pD`u9%W{g))676saG&BbDX(rhiXg=JRehEQzN9^EaLyrMt{W|rh(mUzr})E zNShdjn@zGLb#!#h!%ibu{E3OM{5qyJ9^^Ip55w9A2i0~UBH7t|M~xOsdrmtLo@4aS zS&wt(X6Aw%sm*h3Va5y =;<1^UIT>YPJv;oPL$I6S+)JD=AdYslPW5;?8^=D}T)f z5PL9Q^+Pp0-nG*b8=m(Zexj>z?>RbZ{0Ag2UApwSSjZO jL<)GZhh4 Uh=4aBD;tH(I@X%md+Y-g$@eKWTl!I@i~&KLrOk z0+!*xJ6cJZv7$ejEG{G@1VUBM*RU~&+^w+@?mgDYw9G}AOtoaDm^E-L46s8W=9m$g z=ZIiF2xP&fE@qm9$mq3jqNAhZ+HkR^e!J|I6GK&nhm$M=3t*in!|fg_bRiU~>_tI? z>RR7f(fC*T{XM5%c@NPfxfpIKvg11ViAY#`wuAE~St(*_A8UF$@>RqWo>^DDy4i-5 z?h@~q3cVYGIy!W8qiQDz)TuOBGRhUHzcAxq%9E#@^4ymD-g4jG-ri29Nf?s^BNG#Q z m? zSiAL*Q!m@wV+*SU1W}8v=pMmrgHv-Hr^8RM9p)YC6rj%B`H7frAJKfl$OYR`hNGFh z%G?@Jyb FDq z|9PJ@lRn&@&%Db{lFUJ@2DXp6K`F&5)un&d4ad1gB%|u~mJWn{a?+UbzO6SEBULuz zWuCBpP}x;FLw^*DcYPXyUP7Y#+}&oHf2zkaDl1c{e3JLG-aCQg0QOG?^ADQvdM|Jo zc34Y&yYyuy+b5&hp+LKk3A^Plf!z*sCO%s?m+0Ek<%kvm&Xv9+T))Q>Ch;9ZBJqYq ztfM#<#T3~=aFbEuWVAOf9yL{^xU_;GXEPV2d%$wenzKNwTs4dbi$d#SPkh4|_DsA^ z@7hfEA>cQJmQTVwcvWr?6kMSnp2r@emi3k~b-pg+9s&zW@dh33CR#NQ75J=m&vbiN zE+2Oo)|y)=6BBUWGT|*SxsW_sv%z8b>D24g4x8QG?2%6UW?n&FzFMy+gkB(z`}VoW z$Veca09vY||7RHmHQ#was=d5UXP&kw9m)?zvMU))5d4urxnZJ3#3<@^Wh1HraPYGI zm3IVJ#+#d)=jTl-Qu8$mb;`)G?TRM6oP?fTowlgJ9Z5+A-Q8TSSnfXwqA!PygKc7q zY6K56j>5V?q0owpFxycFH1_PFrav& K}%o)8D=?o&wk)D zC*ZW{b)BNGB5z;V?hh<3OQL3Jv1}~!qrBh3%qYSgevr_k4#Tkn(udSl2eRLZW<;{Y z@mjJHcEdlJV}wFzIccp!Z05w#@)o{k_+jyoyUvxvX1r=+B|8}~>mL J7%`Bjnv! P)6rGm%A3T+o4*>NQ7S5{;Y8Lg_YoB?Y^ScBf zkRiz)5Q0E5!58vMN<4K3k6-<&1^>mb`Af%=vb8N*y?Qk|K3@05i *TUxnklX!ZV`Jx`NsfrjoP_G`o*p*C-Su@nB7t)7duH0===G>; zF+!S`te%+(CMtGJ!xG!(6tN>; jQ z^H333h6#>;^0}O>tcpR;>JY8 4_& z!E%;sTqWsHiD>1#{d1-+@^W(;oal;+wwKVHlYlT7Grqg_c%z`(*u{d =LOFke%z3g^KjI zef}UIQ2Fo=Id` P4jM8f=hO+e0GI;Xx*pk;=yvw7VjjAXkJ2(III5;vdk=>zZf|Fl65 z;}J9sus8e`*UU;uxtU~6MX*xR-9tt2&7qXRP^IEklONDker?xAIRI7v#weZ9vb?;U zDB_AoIM0Jk@4Y_h-wO{9(f>`s{&zdvAR)HfHW&F&VW5Hy+MbQf+CoLX0-o6+s=A&l z(8#Ll7EX^Jnax%TuSqqUbqKXCB0=@Ko)ido*% 7SaG8~S%szA!9WX7(?Tc9u|zOwsOZTK8PaLM}l*nk3j4Su|jk2fek zvD<7dC-1I65KXW`|EuyqfoyH7o*|k6gIfdy-#TF xp6R{U4$ 7WCfQ`1;u@rLbOo%Fw&WBSDjBorug<5kK<`M6D9EEQqEH znkQ_ z as6c2~ z!?~=(h}u};X?ntXB~fdCut_Z+%%EVyVttouO3SgRP}Xigol8?vp42 ^d}(Q%llo4J^#)D!~)(5Xi<9Q5;dERy^jp;rkAdzq5<`P^%d%;p3R2 zcsuJVvImrF7!M6f>b9Kkw&k+YHp(S@6**N+0_|#yf0`<@#P)P=@Iy!1T8$dA;51$P znPs7o>>@v|X*XMoSXV9c1(iOh;$&`gCV10bKEBblDJJELp1Q%vsG)zMOzp>T QyYA|%2dzd;%@)Rb1 z`$2kz0trDtWZRs5-6Vb?%07&2akPQEHcv(Nk1TB;{5bj?d@%d4;ZIn}>}=k0M;m=7 zXLMHNR0>T@__z#feS38b6vj}rkz=(+Vvx27@vTyCY3Vb+-o_RvZ1a13s+)PWmn+ZS zlHdv(*wgpwFF5#B-W@>+pg*53_XZ{QdXA1XZt319gvYLq 2JX5XvEp4!t~^vBF7!8ntDdYja*z1colX zIkHopG)cS a_Qye>WEU 8` z*Ymj if293q$89_(&CLyccI2EBJ?=)$~5HtJxJN=^moz>DuQA zsXBj5&v!bI!@(r3qwp#5JOOPvz{hv*&V%-x8Gw+Qni~A%b#A(b>&E|JQmo^N$nPT{ zC@s*1+5Sq!GTlIE0orQ;U@y7rJtkRx6zKQE^ ?fr5=laTH18iF~D0Gw?rz({cz!YI`baR3_$Mbf;Du>R=0=JlJeEfWG83yuDWG z^bm8w0BK^i480s;3wGm5`8&Q?fL@{B2wy=INE(SJ@%!to3>&|$f5HScgZ{WHF9zhJ z2S6#n_w?|ZKS(r5KF5}LEH9ikZymF~@g3&gYkbe{i+2N(C~_|e;L?L5X1zmQ#5scJ zT6HdkfDLNAcu}%G)fY% J?2w1-npD6$z@ zZS4hCDeW3kQz7{*0fc=fyC}&^@q6)7T2@Y>(w)7)!(@zssmLM #OCXxcL7~cnNNr0?F2FdOcTHx^d5F`k-$n^>gAlFdG3C z6Xi(whg1CTCjvdSv&%{6SRN)`qp+yIFH;#^#o0he4#J~u!uIKhc#C0>{l+=|w zhNF`2QwQIJ2lgkJjoVAS0wNqWck?W6F>cE%DgrXw-7Oz jO!PpiiN As^a& z@3UZk&nP|YTD*=sKKHa;+Ha%oIu&pTT#^={bpp(vmX0p3*n0cSCr_ov$;a})Sp*E> zaz-G&yT$C_SlIof2*6^JuU9m3UQc7mEH6r4^0yo}oDdVke(i4FU9zL2qmJQvHi`7& zV1sfqg&oM!(vrk;WwGt{t}Z!z%*Xp{rZcTyzVvAn%3?=Gs_oNF{$i&9h44Z5itfsb zZkPaV@IHfE{_dNDHZZf<^LU+{Vw9CjlQ=XwS{MX Lxew2>9{#OAn8+1&2cY_>QjY=a_hDjX1={MrjXOGtMp(P;G6^ zG_9 bQH+j>3D<2do?d&!grx}B6#n+zJiR$`0-50KB#(OwcKb3gF5Rl@ zR8)VpkH8m0`7x;E-%Y$@ZV=@Edeu)R7!U?_CElaP{pS19kg9S?Mg8KhWv>)pwKd z5ycm$zbneW=@^1e+}oCa)tS~b{;@YKORa`>)`EUDGN-5i?lr@kTuGwtJBQoG_(b90 zumkS>Ux9%BDcEglpaBT}$N@bi_K)lS@8?Rs~DiIop|rW{~ptuT&- }+g60s5~hnvIPudh&!Dd>pMG+8l&8CH&pl z4;6GPtzyrj`W|wzvrFS~<98>N=>22oix)kQSF+tf=Fv98eFsUPK<3}53ctpFb5a#N zG6)Af)sX*B1k1|G0-@l`2rzU1Q7HL;B~1YPdQ)GYGMJe~FfC;MPydOAK#@>VP{5-O zD2tVnM3n)_yWacbO(TA@)HX=O^*S+fQBqJy4+r9{Oktqqd+( !k8Oh)EX7`4X{*#_7NJfu zvaq ic?c>DGX3Cgn&%IpwGUl>yo%4`f{r>q-8GFJn6anEg>OV>z_jv z`)kAOaH?3Z{W7*Oz>@$D3kWzC8zBE`I7pNu?jJ#sw+$U1KmI %^G1e<;L$2*$2Eb@QV-!p zFEWA%uwCzqiRr7UWz>fM@hKz(2)|y(13>ZwO7Aa)5M(THD1%L9W@eVq(>?j-@&~*# z@?VSoLtxrq=HcOKBBz$0ii1EWY+?VD21m+FgYgK0SB~QOe`!zux$FnZ#BUkx_Tu;V z#2^{sE1~Ondm$C*uK;?1XLewXmU%K=|7ErK7kJ%f@FjSpbN%}D0)vKbY$y2TxAvxG zW==xzvPLVE=k8buAlan!cqvrs?;Rb#f%2Dsq$g42FaHQ=-Ld=wNiAnw>h!r|fT}j< zQn$3Y`0HB#8{(3Fr5hmkEG#VGw>{_=B04&LZTnwO)V0kj1zJWxFKEDz*m50^Z~o0I z<&ShmHZZ0KNojSiXfks0U#=9;+;|iA&l2x%rsfy6w}58_9X31!f(-$J{jYq7mjk(P zy#itB=}%FVP#YOt5Go zmBjHYbrS{0ZMQM~9v;6x{^FGy8c8=^=mX~^2XL*}(+ldN%GTt~&CS;$bhCjBt2Rss zh}9Fer}ckp{cPehrYQaw8W}{xEM4b|^Xa7CaPbuPy6=d!YhxyMm(;s Vt5!4f9-$z`D59nWHC%Cwm;j+9qfF3*9F+5)u;? z8W%@LYa-YkYavQ?qP9!m-Ak9cMMlxV$)0j@##%Ak$vCE(tfZtwIVnUr%e7;O5~603 zHy56$?+C8r3{9%> Km+N(iAX=&*fhS=DLKw*FIAT`en2 TwrkJezYjQ_%yr&i0eI zN--HH5qo3TO=U|Hu$BIe?Pa8wxsjqI-0WZvU|;c(CafL;jpMibxiLyS1^*QB9&{nD zu(u`R6AdE|S8O+nrgT=34{xS~(|TmhgNC&LNGt Bq@9Hm)??%dn#jXK5gTmaDC;nv&;@yIcYJ6#HN+(9 5BF ?LY>Ww0$Tp56{iQHJS=TU z)bn79*=lOhAy<|LV3XysqD(RX%!CAnkFnO>Le%>sS2Qb(n^?*MjMGa}?y~|{0g|%8 zEKsAIGjFlJzW&Rg=n^KQei820&t&r=Ayyu|CP5PVM?gDpbsV@>0k6sQ+0mDT6;YkI zSSclWc}Y*`6zKb`4&@IQXkQar-kxg%z3STcfZsScI;J-qvhwgKx#oQU#YnAQk;Qw^ zcgsA%Mz@e&jR1f-Z}?| lnDx?#m|w?cW(M+e zVJ!5Nf(Q7U`@NkXN#gTg)Vi<1k`d4sN(A@xna=@t!amniW}_ZGI4Hig-vYn{j2B-i z6Rg^YNJM8p63CP3pg>KgG}1q*Tk>YxwWT8sh4`*!s+Xs)NuF(ef5dM8dQ~37z|*++ zGlVmiOBcQ@2y-mi`h@w(u3jEz%p!}3&=mZ@aOu{5Zp~HZnm8%uM)~L$2oEV~p|>$k zh+M&>IqYmuY5EPoQ;OGz$1MP9C~o|kmyYano~_&2|E41PZO0fl<9kRhQE}pX`VPG` z9d?Go{h)3{p_%G%Cx(YVs83mrT1m+C;~?X{hfIxIAH&JtJ>}E(c7XWzu$k;~+!daR z+t1Qkg&g?eNaV5>U*^8;J%%&gftZLfx9J{3Je@#HiXf&nrMe0zS*%+hr0uMQ(p&mO zk*}e}U;Yc-tp$(ex@HHU_ebMULE+S5A!H|Z#9ZEe>u~9cHOYm$LXNEryw2_P7o$xO zyugHy?Zom)%bveRuD8LTyp7exclTT4C_m>3X`LolwMP`2uS+;hrp*<)JGsfY*a&=R zEHKI)UI#w-Zens8$>!J7DMH3}VgrTROQhDB(u8f$cK6&x1)JwX1t+FuPF6?`9o!!V zV-SCNYd0U?j )811ETc?NwnN_dCW*LXFss0io?_ycGO@0HY& z1nqy|-hv4 >iJHpq&(AXGdm%6AJ1Z{_ycFKKl2h?qAiZe|*kC#SES*&3R(i~9E2 z4>KguU6(wN8WdG(eP vq#@f%d^PDYh;``}yE{wF~Q! zZ!-1aY`=bE`dS@V9huK_bOR(5s(E|<@r$Qinl4o?E-pzAT$3+(Js{r@9sw^iRHza4 zAYttkxUFmYWOuzEY#Bz*jYZwEdqxRfT3GLT4_fPXph`H>4S(jpk4k%pTHXr(+Uo?a zQ^gn&eca8SAT`J!deEeV{iLmin6 ` zgK|(0toWc#dRx8?ZGL2zsd ?}@GA%!gl3zqD|4e#Tj}I9(%A94N*@ zrC;9uZOB$CjGBx?cr%W;M?(Yr$18vtmhZOY)7pL3(?euR_kQ&zg=@AXth6?i#F37> zO3@;Ix%h@@eY4dDw|R|}AskfZh*~NC yZMN*-7 zH!^c`bdlU9_3lsjF%~ 6SgLF8kFqxY;}G8w7*9;c0D;rRPfa9B?+2j$Ka1)x_)%F#8iKg zcA^^;$sz18mTBl1uE;c(7Q?jgAr5}}Hh;3;I}iWP3$P%9rP;*&IyRY;P^`qG@OA3l z`&Sk(_o8`L8inr*7trI~9!dCxvL5Ff@06l0xURJ3^_GMKymDpA&3jwfv0eR7pl=y} zf_<@y-r^ACl`dXBggM^yC)L~N(bJGgTMX~=15+o33l`_vvqHKP#;30}=j!e y~{L$^79m{j@gJ KR?J-oqUx}Tr24=P8-dFHs#B{*TlpNP~$J#5t>-J(eE Ia!#&e{XnWpLVNI<0o z?+eFvqCH!2>EWnbv~)X2_P5!Oq&~qeTWPTL#I@LSl`T^{XX}qam`IO`bl1OAps8c9 zJH|a@Tc _rD?!yu5KK#Dq|@4#C4n2?Rm{f-A+} zt{JQD?@j;AZtcgL1FppMr<>pYc+e<<$0pzDP*uEk0!-Wg$-(fqTFk$r(0^~q_;;>^ zly{RVg_dzh6NPQjd@jtqxrt2>j29Z2CB;2Z=WthF;N=2vcf2`|F_4p1SC2}tmi<4~ zTvt?6Tes$j=n<4Ef)EaZ3P=$t0Yb~63sMffL_jehgf7w{L8O-;(hi{sk&-|_dJE{G zh# A$@3>>^J@&&IYwSJOoMW%KzHfe0D@qRx@D(FZ;yink z>+tBw_NT5-Tdbyx$K=>&L39T|dCRTswU%@=9^-Q@aro(~ZFs);Z=W$f^SIv08Y %xbm}sV2~7GC|b5q3G>wUqm~y$_nos+Kw&L5TXy$uLihAJmv*923JlH zl}(+H7}Kg9mZJdT+1z9~oCKmO?wiEeaak*iO7394x~r+zjw+6@{(EL}ozYQ9%1$OC zKHMAFaZQvdStH${7!qvb%84BG$|@HiI!m*ynUpXPi0z$x&uNX&K5>NYABJ1(>|VKt z&NYJbv(Vkb0v%d-PQ6{;6GRWDfc7zF3~hR{uPT?4X2wNYXLTm=;qkxQI(?%o_1&_v zoGU(HWGs(~K$FM0Ro!bc8K5lXbZ;V^h3Uh3tIjFY7bvkemBb=F!@VHhynhKqoo3dr zv$K|qp3GU$AaC!qi|35Suu=mR?xhN_Zkr^Y=64T1W1_T^KSzD?h5KchD*^_AuQOzA z?u_eb-kItAO^gKy9qDcl7sY$|fw+=7jSKnWld@x&A{QD>)jr;=?24Pk6;I)9c&q%N z)6W>U9YlrHeTUGnG62;JyIQqxqqtODm@IcDBNZ24+JVSI-E09G9susAFv*^wg7-NV z6nrmxodkk^Pp_J?NF}+{!%8W$aWBO1SQXifbUioDQn5S5(bDzko=PsA^?YH6`>7f% zY+OrWF$@`+oR{N78Lqg8ytb|(I7=F{#TD~d5uV%=Z~pm*TNnE5PG(0+MqdcDKJhdc zg+$f?ckZ>fd;*$&yPFrxN3;yJqBHmhPaK2WpZclI)9AW*AvfvD4Bw#LjF_!(;Oaj@ zkT_CrP(@|d2}LR!12yze?&AI!ZDvr)X_Vx@e!x)JnnOFj&M>Rr{}*Tw i<*lQi6&YNkmnNsCj{9T= zrtQje#PCP;^0VTSBH|wY{`&)x#1FljW)T5DGPrVsHyWkeClwaq3LAj%uCm_W+LC%m z!!_S1oqt^_f1f|Z+V8OfI{-xlpKX0_-Z* )(h!Be-}U=AIRq- zo&U+|il^G$6>hH14*7LL3f-5q*sB)vOyleSe3ZU9+QI^Du$nlvwBxW;6;Tot|4tc4 z5xpid%3Ev^;#skPa^`&?mNSkcMs*`LL(4&Ou>j#~%IG^|^zuyJNnsHGE2JdPF)9 zZLGcW)nWmn{aAT|{yC_skr(Me|Kg6nD=2=Mdt}d>7|;{6T_!`Y>a7)qg#<;KPO8?= z RDGMOy#&!N%-0F^ekU&)4fG0JJ4$aoQLF~9 zL+D}gBQX5IB;}YU<$e`-OW}^qqlWf5!JL3W7Eh6K0(Vq0QhNuaVeBR!bRBqBx+|&t zVjFY%=GU*`ORIC6dI(L?7Mnb^ZZ5#A8>%!dz<)}{h}cP;6y9PMIPwc}7Ty%+J6VB5 zIVcS|fd=}nTXST#+*gR1XXb8hZ_nWK@#k&goE}u}@~FGCNj9k0<{SEEkaU4T<*QEu z!gQx#N65cfZNJ7=z-(mrH3rVj99&=?&n^_&Y)XZM4%CVz<~nO9F|N|yT7jsc#H^?V z&axCMu^;(?e5yJvW9*5 Y;vx*d|k?GXnR9m*O)#;H{qbS*Uf>Vo`QH)D}Ac0 zTl?2zxC1J#KZBTJpm@Ft)5vNM(&(>CY^p0PHZ7ZEf^e_#*3BWGgr31IQ Vztxb3S{0xbo*ljMt!?1?7HJ4fomv=K3DQ}k75`xQTzWHvG*xG8bm7ibDeDfw2 zaEM0Nk ZhIMLu?{(%OUJ0jv_GwwnIJ{7;$3Q)E&Uu^eGSCWP6hPWMHNjr z%w26%c(!dJWX5fD0b6bXO`7mITt02{wb@R1 =_;9JbgA ze;He6M31s}e&*1H(xEcZ%7d7qePT&ugh=bCqm3jL4!eAAX2*7Sh^tjMQ5Gjlxm>$w zP%+Mp;A104r3{ac%zGVSXV%>N%nc?3PTfu;&9%5@^srnloqb;gULfP`waht;x+Y*> zn{?&0q*WejZCvy5c;}NYAyS#0eY@6 Tf&mQP zmv!YjQ-jquocpsKne>1l&gBv74$QIsYqL!U!7!W`Dpc$ewX`AG1g6mhP^#v8pL#>p z6YDF 7FG9fbuXl~ECDK$wJnhcM&wl Av-;4Q z#^#YfYIoPO4@F!MeF;Lw1{Ll{!;PhE^WP Vu-ib~ zYnp0S{3A^v#qN8}RB^!KXCoP?eH32z2TJZrP5capm~nsU=%Di3V9?&3#4H?G2I4#8 zv({_PnMJY}I*U+O ZWy&SN&Dg#`vYo;**PGZvNBOs6REpQ}c_M*7QJS z<>|U`gc~76seyIiutavpOX#J?X(QVzsbs<8^>9IojB)wjtz_I~-dQ#a1ap6oE@*wu zk1J%|%J_Pr;wC2?<8jTV4__dXmVXmGL3HG()z@zsmq5W47giG-9^}Fu>)J1o*_>XM zfC+yf{UKe+dLjBBUf?GT)+`Fd5J3lIM-NmiSM*EQchS+MqL*-@?7Z z`awrFscFIPjlz9~AAE#7V#&okmy5O{c=>$=Bai#!3sw5P!dY7#a)psgQ0YM7DW1PV zW;6KcZ;eFrBLnu axfBHgmG$8kA=;f%I<7laE;)ih3yJdgA2)a% z34fevqS87M2Wver=*dzningFPk)PJ(lfXBmO4-Y8O$KBzIZzaBjUS1kwzJ%~IHQSG zkVC(}280_DTuV8 _BjT$t3kZlQUxT#R%56X5_ZLrKh;X-W;mFhxxM3&pocZ z8Iv0!g1eqGtd!iU+mrhCp(ouLScc+S^3ln5Rr^0x%pS-luZb+$y2-N%{Y7{ftGcWt zA8>s^Ul7}xn6b~ehomSarEz@~;;pr}D>@i&-6wB3s9m9Lb l1y; z49_Wlje?1h@@B_Y^zqK>$lb{5N`RZH4^hff4y=0b^`R`DOEOo<-=kZvKO16dqQD#f z(dgd<)8_<8Di?2`_nvu^lzmRpsJ;LYQo6%0=cm;FKLa$D#{~3K4&&r;;Irv;wG1`O I)t`j_2R%=qQUCw| literal 23455 zcmcG$cUV(fyFD6Z3n~Jl6e)sIM7oNAbQKVhru2?<=~6=vHhNb;L5fQ6y# &zEl}S7~^Fc9Wn^yA-vTZycn0&B!WPC`HJZw5I?u5A@HZtkX&L2 zB*nl?5WGOK TE0(;;=UbBSH|dX`#2xJB&YX!3HRW$())B_DKF&$L zgO7bt6f?=6Fk{(j&DWEKc4RIY?zUD7SGH{BmzowvBR>7e7=Kx9MyBstv-8 {ps=rCDq;%gKs+oM5yILevIjnM} zn11;C*W$G`r+3ru*Q`HU^+2t=v7bgbj?Ua4evl{_L{oX?(qdk>Q<&{J>t~yn4cb&x zWNhX~^%%V9BFwGn Z^y6g#P|#yUoE($8~Wxf3yX+sOqvOEVOWR>1?&|b|I@E({L_ztRj1Gx zGKun^vN2-IExcqgvWLWpgsHly&*{>))6yO)BARGvtnhOB l*Adf5@gTxR&7QL2F~qm>#dPhpOX0m&tIOW!CIU(>QQ^;QTHfgVDWQy z7ZFhu312fw=g=)E(U #y)9uM`z(`QYD`Qp@km zOodk7bP!wkoGq4DbSe7%*w$9Jsi?t=nQNh4`so82<>7Mrju*Z)>=GeS3)kLJl;8ft z+jBC8lleV5yWx6WR77SZtNWxA?(_DUtEX~ZvtzE(zK4f(y-;4Ks{wg8`VF5ozGHvM zABPJJ)9d!4udb=Tmo&4oaD^l3l?+b&iDbo*TgBvFEMe@(i@zes#fUqH%#+Ibc8oYa z4e8@qrPJCz*4qvXQ97PRM@6xdYt4uH{_c6HMnxQ!=B9(V8%{eHB(^cjcibk&KMl zqy=?bV7b=M@#i|~rh O;KO)Y06-G{TJZ|+zVtA>lMbu{ vU7;-P_y)G)#M8m#U z_dG{g-)Q*R@!@dMVq{w Ci+fJ!ja5$U?wn`QTW$NJfE^2x1Qw4{Av#qHszBMl3ad5qdi%W_fQ9U?6@~WK4 zIYHdW@Kc#gNK@nZb1P9PLrn*C-K6@bzC#mZk4-^Qg$uY{nFr^u$9fK2owhBc9)h~- zP8QIyZ&Ok~FRKzqY`R-MF_)Hu%1N6)S>AfA=9A2t9udDQNG0*Y*zGfz7XI2AL`hBY z%^9hnRwc&rw`u$Ln%}W|zk9&5m;P%$k*-Bow7N&jvNZNfw%!j9#3x?Ixu8cI%W_hA zL+Qnu(p_ojaQ}OEwZvzw1`2JLwmG )Q>7?eOI7>qE~#IMU?M7y!^ uF>w?E0Os{8 I8Bx|0vdUW<4${3r3hXYgmt7(<15(xPQ z+7O?-HJ5NhUuFIywW$Hq>pgJaO)rOE2<8_XnNFtF``uc$3uFdfu0}7(YWY#56$NMX z!fWQi89elm@FmXa-1EFNo|nDOF@G<{uusFOUVpxwPj@(Q_3(y^A^6tJ&3W&FHY}5j z n@eQ3rmwxc3)y;RTx+p`%3t%UKu=!)U zI`=y-jYqf{GuN3CnAY>fQebtaovV!N?uG~%)^JyG{_V-dN_tVg-5g_H>zvko#7Db< zqz0*@y*JBZ^k?&b1<4p0ppKKde`MC^Iv~vG0!#htpYzy}?Zxq+x57_MB{UVvUKqFW zsJ&|%Uo(29>>Jfund6Kc9vNd#i@7xo^QMy}8-6p~?u{)-i;=Bs-^Mb?66fB;59spd z8JKiN)iLpRxId|LDbuxOiB?lL+!!gbShXsoJ+>2iXjRoG%*xSn+oWh508am*Kcl!N z8jfVmsHwiEzq9L#YsI 0BF2z86j!0e{)mRviv z3jT~go+b!Bj(9|soK#3+Y}Avs?v!2KiP3K7mvWP-KJlbzxc=e{F;Cpa(V7$D$Bm5Q z0qZRO_CVZ^rIqyyk}@6HDu+vQ_H*Z{Wsn`8DPmuf^^Z7nx=Sw(rBMn|=`37TQ8bZ~ zI^xXB-}RDHj7jSs8l(ND$JY^A5U0RD0woU>laaZnxNJuh_vyHiak$P%e$^N6AriAJ z7Ag@#;m|HMtTm?N(C(z&J+eDgqi??ne{|oB=Rrp#Ld91yvL;**&HGcA%AG^c|K{{7 zp7G?X4d#8#U;P9gDTlw CKhpZ@-OBDr>b%&a@82(J zspn8!9r{&=Jg8J^{LDP6eB5xtUZg`JgT%K%lMdxKze*-3HI`NQ7yJA7Zv>aO7_Iq= ztOQU0UZI#Yh5;?(R5B4;MD)9uGjh*kZ{FYJv=iD6x1@^ESckb}wdm@6nGd#(8EOuF zrN^TiOuP7=dMJaV^U=y{{kV5SZ%8fawq=p8uOlh7_DxIn$KFl5Mr2A^&kN ^PdQV5RiaUtgYYt~~b2QsdQ+qdgI4xR3eGTki%B zl52MvN34c^H;q%);j*ESdcl3vLJ`jup%I%9>_kPe=9r+-7)d>vB$Dp0oP+gsSWk;% z2<4~Ppj}Th4d9iXGR-?ardRwB Qp>Kxgr%$ZQ@6O!2&M!B8Sj;$;9)R^OJJD`PV+xoZEn= z(FxYTrzMnovez`OCP< z^)62zQ@Y8S+I2qVr8(Mu!K_LNoqUx&hUIpS7@Epig5MU6r_rP2-d+vTNbOEqk+S|) zTznSa9N;kbpgQ4~7UOCC+ VHO)*qIY^urbG7Jtn6_5 zj@5d|9j!*|vQ|k`s#5_v|5NiAvN%s-Thl3i)UhinEvfh60JLt~eFB$mW2&5Cmy(gO z=j~I~2eof&gYmg5whrqinO=f!mEL QAu=`(Bn2*wXmg60&2Zrhd1q0j%(^ap%=#X1e|5mTd ZKgdJIPWmeE0tAiF zZT215Ir75}j(Z}pFZ8|#HE0z!8aDeB{xM;sUZv8BgR<(1@qf6~55Lx~cj`r~C(Ykw zFbB5!=5k9~Pu_OPjxTeoq_cDa<6YT{VX^+-y?;zkWz!K$j}B Bw zS=K!yelcAvWV87i)qW9$Jf|s;CN}n1-)qk=u z&wTO%6&CCl8)@UVmk} zI_+$%14pgohEGZoTxROn2LOqmh3nL_rCOAAX_|UX#SHJ3uMDzpGi-JI)ThU2W5w5j zXPgYhmuIuOg06I5OEF~2K7JTC>ezF$NJYkMI%nj&ebHw$5!r14muI~-t;tDg X2R@Dd{4@$%IU^?ym-pxZePMew9?X(s92UftBa&!Z3nsHrPsWY; z!L~JK^tFQ3OU<11%3+s |2Avo4Cl%p=+^p{J(i0$oQTQ|$>*MH zCYY61Ejw?F-fbcmMMtjWlU4PI7oDV$js~wVOSvx$p=X|aK})jNbEIk)#}9~{8g^vO zffE$N57axnu2Y)$4FE!A=ZP#U1*coHxiJEz|HJ#-ugxZt9xWxFEnl9hAI9_pt6%Ge zcPHmPx8Q fW_e? uaM@naf8HOH0+C o2ZxLp#N6>&&G|eUXSxVykH)qjA`ITBCO$vqD{KE455uG2q9~c4~Rex|Z zzM``y!(acnW%~(B^tvd%V_$s%E4n^(e1~n@qx4HhF?XuDx^bY}*l4Hu*q-dj70-u2 zxwy4VH*r{`VD4zxODmSIMO4UgL?3!6i!<^>7nZsOOLmShLIS(omx~zZ@8UVmYV$6Y zrxZ{~UzXO{Qz-XzR>Yc|qr=qfvNq%lwUJtTBk28NiV>OO>rJ#B?TmXZq5h#;ZxqP* z5yoEmX 1avvorI(`~8epEmtQ3MfZf8pxl_I{CRp0JL zirK6mb}z3pL?6t!9SuQpKc5aIV#+?r+jPxZCV4DrzvIO(q9u2V$zf-0bYfS%ji5^5 zWwWCKJ>t%l>4NK{ic&^CNIoXYfejzeo^Rz!h~T}=sY@vFjKyNaukh6zRds2jnuZ*x6VjRYc^b=9V3+%@GS9`sQ?sqo1ygv2X7Q7c)e z`DWKBA1^Fl)$_*%XW2-As+MvEn(B$tYbqD!pFE$mp{$#4tQvQoD3(?cZC-3tNqKGm zL^u-F{hly5l-Ja)@)4|uaCRwU${C=~`8^YlT6^_S8}2x( LQxh z)nuU2?udFTujP8W;F mvA@JU{M8@S JXV_}8gLy-zLA7^6^+62z (SN2e?B@4P2Yerp7cQbXT8r$a!M(`i>PiBG`c zty*QA8mBbp^!94FF*0XVKf7Ao`K>+Ac{pQ=B#<#5l0Cv&Go5b9OONQ$zP&|4oL*P~ zC05+=uVCOe({iPT7d&z{*jz%r-oa>wfO-7$JM~7LMc9=R|8-%$gF0Pav!6S^utpVh z$~f&=(!LW~_-1T|+6Jorr-RkbdMoKlXh`9|rs?A2<5qCTn#hwk7^dD@xnx0iJ`-oC z?;-lerpQsA$rhj6{D+NfK9!8ok?l)$dX$sSC+ N0iSMBo-=6IS~U(yXu z+OM&Q`&E9v;|zTYz!~ciAlpLBcXMuP!%W*&$>CTnua?#5-$%1AUiKL{&c*`Km)kGb zA95PTZYfISTVUNTF@Z!Py}egLx#P#gl#}U1k&{TIuTVu+JAeHdh@ZKf=DWDsd6zai z5wGC|VJowziYl~$fw(Mbk9S(gqL4{?rcSZlPlhrVlZ51#HGTm-nL8ktnE!Ov8HM7w zc)~FSJ}^ 53HIActCFy<`ds=Z5q2D(t7SA2&hn+q$^y7PT MeiI=eD;N#f0*S#i%>7L?;l(C5 zNVbuD1F!8ij)8%JAwD)@Cf7tP4=nlYdVZhqya``B zDv>jt8b0??xdPK=Ss*qQ9|F%l+b|GDTkKk$z0Oe^qA%q!1&b D(&k{X!kNGMlxz$cv5FQN{;DpI}X7^ ztEge1dO}-(qK;w^&JQUlCH$m OMuIT5-vxWA8c)1kKhqh0z;CH zp%@pJP;@x x64-Z)4r^N#Lie~6>;tc z0n8ujpM@9g*X`5x4=t`5SAzrsv;2q^6&iVNQep|&UWp)T<~ThF^Q$&$Dd|RzR4dcl zIvAe6@c7Zz^DGkwlTe;QQ&cml)FwI1-zD{f3hbxTO@O>}j^H+hFoh|VSHms;xPP0< z!({M7#fkrwrhyM>rCSUm5+1h~T+J{@pNq8k ej$~3&p^jM2A{6bxPK&xD5%I>Q=P2l7vZew4r3UJ^MRffJL_}Z zMp*eoC+;MKe)^pKnN^<2!gYZ9u`6>#-{pYk)X15_&_SF1_G)NFoSn&&1(>x9F=-v$ zjnoL9Ot|8qz1kvD2y1X5U+-F7tmX5%1*un`2S$qAW{;KJPAgQdlkdzKqrKR(jdchp z>bM>8#5d0IoWTR|fdaVnq?Vf$*D2 =dr&i$8q=(?Q9^E6*`YCbvCxlA3d(*K$~ z9yhwp>oosiZseW6j=^;sTEl}!V6fv-9az0#gr3r&Nf~K+c78AX#hZf i I19<8HzsfTO3a_TTNl8}b`&$0sK>;~I?? zo}NeODY&)P8^JKJ>QAFpq)uIojUS=7Oavq(e2(|+%5r|jKlzW&;h#Xqc@)Z-G4RF7 z+*FVdh`>a|1Caj*FOjVc;Ib;Z>Ku81sjaOdimNc4FjjehlF6x)I}bC`( jm&U*N6BZ5Y5TG^%2;~JhPm3 zN_u*FO3IBO>N5{Z!Gvidz)b8q;P)MbZGE-lVrlMoR2AOAzT9YyVg);RTt<_qP}BD4 z+162B#5tv}2&fGjajKsd40&k<-Y%;0K6H9NG3SP!JlrdQNmNni=^7XqBztemS5{F- zooost4!agKKVB4v~i&4_7tgla0I2c{w)(!a@Ldrr|HSf)Ol3>!6y(6%&w`%zyuK@?- z>gW{9oQPz)?>LLIYiYq`s`rf-KajY|0^8<*U9o?IILbjB?N=ZYC% l zRazW5XS9X7KU8gPIfgWSe*oQC>f%1K_4C4_eKu!%@!M&<2_q!abG N>JK5`x (_%Q%L| Q`KeP3zR{G+R~&qPx~IDe*JpfRCT >t^F9#&@alAlmlb?SI<4Vx)Uy(ES9TP@i6Z= z0Co_7IEEwCzV6|Uw@!vib@TT2_9$r{cX@aY8X*g@{er=C3`A|e)VQf|$d4q#Bay2@(LWJsM_SsV0y{sS;W z6U+l2ixqcgz{~)L9a;@vat_$@y?V@`kWCLgVqv7xhr6LHrH;q)?dZOhpq0CtiXOqI za3#s7w(Cbq>m%oqyJ-?bt~#s9%F3>p3(8M?tvU>9k zm1EW^(LqV!Cr@UNF?KzZVB75`nHmf$3kK_Qo;!Dr6KnZ^o7-lh+|F97$a8mpAGc_P zTlDV?cx=hr*~QnXjMyKy;e @JJy zW~qF)K1!-6dgMml6^!PFq8{z!qiqCqV%i;(G`Ah%OisCqMwjd6Jt`q4A(34$vY-)< z+Nw&?nI}~vgW`;JNR5=&UDuV(Pam!98X*x|QR2^ku-Ls81=V?{f>957V#&IccV#;t zAK=J)xRumNBE>R(JLzVcdBnv;$ =n21f He|Uj9&~nw5^}@a#o`6QkOU#Si>Ew2 z-QAMzmshig8 ;N!Tu&j9e9SMc~be)o>+DH!!w*%WNpt6_SJj#F_Wn?6&9w^tdX@5>etrCtGU*UFB z_fBkNG^N?jal}U?=W}sVI{MU)8`lP|P$Y|q>8on=FC6&_+Q|s&= d!h#`?j@8~J4&gjfrmO>79IhZEKt21Zenf)T$_xf|VAS#0(#Lxre|f@vj{lLS zwAoR^@;F6+BJYDfr0?SxPZk}-Vqa+D#Xd*e0Cea!C}!Us9w!GW`(mqYToz-ns5X zF_!JcFwX}68S-ulOZ%*ZAsMqNe=;jQDq>M~JCFR=HvpB3^h6_Ty;dl2Hzr-HMHBOn z2D94R+fzrVrIt@}ADF-FzIju}&fd6t&sI3*nHn7+q<(_}!onj^l ramaiW*# zVG^MPrLgKNdxszKy0lLC`bIo ZEyEnx%uHvDkYs5 zX}=WKY-Ja&WvKOoF*lIvxD(QmQ&eGH!&%F6KiT=Y>(GMJkuod({^=pGdzjF zZ+&z55b6lC=%#bx=U`#YG2Tl^poi_yB34dFJ_N)^L_}Dw3Hf3v)mCzoRZetSBq8LG z%iU <=^Wyyp~!nn%ge0D&4P}Xp=TlD7M7NPMn48z ziPY$|M6rAy^C|e(HGR@`G0q>1Fw#U3E(jfB80m@4T` =%c2vEkK0Sk6wJ7yGlxG?{1K*}q}XXo(| z#t!GSl8ZZ3iB_dIkp|TQ+l8Lb&(f8QaC59p0gp4Lt=1#Y30{0$qq-qL1bJ%ko4mI$ z6B-fwfX3_h1kf~iR+hZu@WO&wf5#h9Ldo)K5C9bJqzCVvsGKoyt|xf&x|Oy$p^jp! z0_3UOZbB7JrzRjEu!c0;thm*Hud!6 7^LVj&2qC@*>TNU|E2}i>ib=CTdWvW>n2mq >V7W5+>9a<7Oa`pH8efH={wuNiX5JC?m5Q&{GEY ztrisj3|--@4Wtsci|)>OF9_*t>*-NxvQ$JNYxVvtFfYIHF}v;1^VD?aTBeWLQzz(} ztc)2UwbC0iQaw}`vKvnwSRKq~5d!HFAouTLc=-)WaeX>>K>WnSUjMYVQ~K5_;ItL~ zByol)-05+LZ=BcJiX*Xky)HobA6#ofK5;qTNBvQ8Ij66$ud%~0h`&B~Q;4Uthr_U> z%R&K=g` s*vlV|RDk@s!ZecayR#Z}w9UC+gQQ>{(VsvTWH)qvYq|Eo%);W9p_{I5 zJljt1a9c4 ?+u3S9rt@CF($_7+7ops7f!UGlszT zdIP?=+qge>idc~z(T`Q}iu|Kk_iOUcJ*#!KyE%3sV{R3H^d9d|v(TKV@o)xg`esgA zG~glBqt>Y^*y59n#FH2Epzh^m8l~*{(Pt@`uLY8&N&+Dv(^7i1FeI9IR{wO3iuW?X zYxLZQXpbKp9L&w#!;a*ag3`6EP5yWAA?R7S9`t#yxM;|K3|zSGu#cqlbgN9wPL*fF zxbKL3r}w)}MnNHUxbQK{H4C?}umCvI&i3{o-yb%h+gYKPS#repfxAh4(Ek3_HGqdd z<9}TP`o({1lKvA-PEJlhsY%%1Or9&>x)OwQ{uSsq >U3F1YTo4i zp}hPmB(0a>tnHGgf TbZWlNOMb(g1&D@Z%9DUtg}a8f0cm<7*~2DFh|6_^{&|f3Tneq z!LEXgqR!KVG-NGrn$NC7Y@vX70%tCD7Vj=^rn>B=axVo5 {0E~O7;uC+<4Wp&0HS$T!Sx0RqJUpibq%#B$T6tTcN zZLi*?iis=N(BE!mQc%eor2g zYQvG|_LW@UCoceFz~p yzWkTzhp2?@1x7|<%iWuu z!UStwZ|2B)8f#5_0{4|&(38Ju^n~qo33`!N!k2$px2haz>s Ah)7ydZ6U|&p(B#s$T+Z8 z)FDH+gmPrZxr%)l+V@@FoTI&>K;4J>1Cq%_oqX37k2_V7Jd`2ec9U~$JoI3|tKm&i zrZUfPuR@K!mZnF`qpO&WA|2lRt)CFI_X3$sY|?nYd7Xsd94WjcI?#mmk0RZP)IkZ& zRq92hd<6}V!88*d6zi&EsVZYPvRv6owc-nPrVJc>vC++~k*1-S1NDu&Z1W3TWm{L= zMQg+-i@0NH%Li$P!3y97U+1qrN)TMS#>SCxzq6Z!FxVGhu#l%BcP$0+UKeYG8MQsF z8^VwtMDNp(Vx!9!HTIC|R~xWH^xU W*27W8@bX@1*%A`xkM+hK1a zGrzb0-kPxAtJ_@s)Iprt=Z17{^YRAAd4BLPPN>T5g=!$U^US^8Y8xn2iHM~tn}(HC zbbAfyxP9m=!TN6x_tAtv{i`O+g1H;a*V{YG&%-g(sm4&kfIjaP@!H>Za3#hY)-`V9 zc20c-2#+;93SqGMs+?v-Bz$#MR(k1Bh|Ye#K4+}c+*tHNjNt?KcxVL=csRlMnZ`JH zYJ~=cCb2IQ?`I%_aJ6=HD1gjuZec;752aLI!!6G?$sPy0*Rd$AGO0oyng}@{I|0ej zZW=8pr>ASz^UAA!oVa|kpn8SGjIh)+I!Y{L^0z9x%#mzB`gT^$ n%gLu367Y`yNV`a=typ|#^ZXFpKCJ# zeVHsrl5i8%kGI6pH6z+lD9>AJGdo}PBlvjl`5XNC35lFB&rUnv9)yzw(OPuVj&?Vb zib}k2_6I$}`{!~ba&+?S=6rV30iiu)vbN{h_7`+e4=ELg+_*~+L
I|6WAV6+J1{^po-av-p9 zO_oP9;aW^m6Z)df5~G5h)nTUb>LQq$Xxp-gH}u?k&nCFSJsc $)VnnAU#_nOQ!#4Y;R#*|QP=KtnqD z2MVd@SoxT(xFLSG0f&JBaTB-^{gK@OOC~4vfv7-mJD;UdT!P$4^8sRU)9Xu2(h_Y*d6DOpeV)XGh dN0z-8bo zASERwEL>qVaI1{89u!>C>V&F;dH-~6{WXzaCP5|g0WQeD9DaZ+aDv0nM7#D_Fl)C5 zJbU+3mrxD=_aOHoC3s$G{63r@=f(Wj=pL(f%^7EJv~BPw hi)5o< z64%z(SBD3Wg2)hKB>!tav9-<2%uG&x1>W8gP;QuECq;kNcK_hVfq^CIfovAd@4FSk ziM`|pD(-Ybx%p@Dc0(SJ+?xPq=z2cCUHgx8HY ~#fCul=)oxV!7ZC24AHVe#Z|>+s&4JCUG>1qD;Y@7fs1 z6aU}^0y4ifd6rO26ClNQtk`k>$=_2ZPdMj%bC{W6X2{*=0N(z`qmX`VpaaAWblhlB zCVcpC4&1HlZ{HGJ{EnDd4xvNj^XC~lwdeo&>B&DYzcE%4@Yn1_vvG4P{BN~( ;=JKe?WOeFP*$@hOX= z4Dv-XLys0d7Et`|kV~Y|M!n5Y>i38#B!>J9Hoipl0+istt&9Drn{7VhF*9!eb^{U< z6Ki33+_vT&DJf=5wj&ZMgt!A+?oMc~FFw1HHbq^nTgJz=n+t+b2)_b;E=tCF{=Wh3&2;efc8q zZE0y?ab@yxE&=*@j=^T^& W1$14}jWp&gVsi9J9}TFaca*Vq#mx1O5Fnu_Dqk?hO6I1u8Wb@9HCGXiWA-O(WP1 z_kr-l{>A6A=x-=&KZ&5 {Sd37q=NXxJO;}2X_yAkY$jBw4pb(KTAbq^5dc!c z;Igj|s8g;rKcpo5fl@@Re-$^i=V}c?qMJNUJ?4JZt;<6YnKlrd85!#?@=VMMt-pRB zzcsSobu}f`*H;cwlmnL_=Rw3G|4S#-)vH%49Hy68q%s5ldAk8|tEu)J(D}xIKYp~w zxev7jyn<6pK$9+93T$HW?N(OnxXUHGySszcj?_66|49%7MeDqa=n#;0fMN=arGNK1 zz;Mg3q{KuG0H9zeU811)3-kVa*$*T*00?tcgyH;_@E+j)(%1eYI0Ki96C0Y<)Fk^i zQfwzopWGsdW|ETKKwJCIPhtOgrNdveb&*azHse4y0s0I9!WD{o0Ecq@-MjX`33T@M zd?2$3N=X&`O?*7CQ&0lEl$MtMYZm_b$!~Z2GeCiMLyb2PXj0m!B{3wjn#pJP#s8KE zt`L#{p?~)2-@pCy75>EgDrd`f2~#d0Qvu74FeKh4NdaIV5Mn+H=$-d|AHOmE6sW=f zq<7wvl1c{HudA*7oWPiWtEIbGYz6>K$&*d#KLK8v@rXfz& YEZ1NA z|K0hRU1Wsv1f;F2)jDt}Z??WhT4hx>b;jzWiy?dN8Azei0iS+j>u Yhp5 zS)WZ+5Lg|)8ttH+Ca^|IXu>#?Dh^a049bN67XWP85zgW}5_i44w2hTAoPBM*x0@Xv zFY_oWt(rN$Zl)2nadN!XQ1w7UBJt%Ih) Gc>xTnyh}hwCaH% zAB!5%JLd|_A6@ZfW3me+ACAA7OKE?li~>4XV+T#f&JQo=V5QpI%3nM#r)SYFb1>f) z+B<2im8EP-XEOSHB|~5<-XK7~hhtzu;B7>0eUT337iPSRqs6^f!@o{@WXwEU*Dh80 zde7og0~L7`17g9cMiLU-$CQ`9+gU#<%37vL>=p?yQ4^zGrnO}J=yMUz-R0w^*O)ar z2&K6tYeq*N;a)}F4PqVu^t*=H&tJa0$ms*98K@5z{7B<;_R!2pS!RjDVf}IV Poejiv>m&~@zkTKgnf>)Q8rs#x6 z*ax?^I768pSiZFg>yCiabJZ6c zB7qqQt;FJV1SR<^wbE$=S{E z?zj}-;*BeSqf;q>mXNUUa6Sw-ym;J*V)A(XjaM*fr;pHm>{#TlONr=uI7Y%9Tl-oM zH*q0kZr9E^8Sb%TaY7B+R~sAO2a1nSmJ2eS?BK83$DS6znCyoITUtgKnYp{GotKs8 z%=sTIV)7_(lAR(7%};K%JfT|d)Rtm8#NsV0yZmj|TD}4}- RNllSe{Os&n7Z5Js?v6i@>u8kX zVkS1dcNKm9OMLt@Z%Ymi4%Ekz9^CdoA?bUOY}tj6Bfd2Dnj`O^4PC_(s0* N{WYAROgWE~gngo`~ zQj&z%6>c41vf5Q}X9NH{eY)C}8;o;TWdvwbwn7v625=$!$!qs*z^Bd37MzohC)1S@ zsD$Cp%iVw^fHLM7gTP#D`35|Ez}oT;-Zz4BVa-MKUHxTILMjIP3?xg<$t8a>hVAX` zE4dyfCMISwB9E$Z9)Z0{U_$}^|EPq9h9*}t$FN`;*ducmWW){os0lzT8YrY(_7dM8 z?GC7bjSAHK6(0DMq?j1oW+cB?2jsP+uU|Xc+Fne88lRB!uIAFogKB7}o`m^!x6}3H z2#NhsX$lD{Q7kyqWSx(frl#gf?s-cE%C`3Qi_mAG$d#4Mby&u8C@B1(pur={)!X|7 zn1oeTRn?KojX?B vhk^(>Yqi=b0Zr!BB~biGOvSZZ=Rbdn`l&MdN|XFyI%Z zAa kF@8f`y84I3EB(Uv&RR(~8a&{vftFzno z1X*y>#k2lar|8g4JuY_?^)mL?t?4d0q|e=RQ-ze;Wz%c&yrRwN`v}uf#5Y;0{nv|Z z!-L4hXfb5+Lp74z#2O3oO#aOn>FjVvjOJ%2!HXn;+erCW#~jk1l=3Q}#^bO>_QAmp zM|J)Nuj{L^qJZdVEqHYdr2xjOmAqdYdiAMsxsfjxjwto;J@G%boQ@FoJqmL;+4Z+v zWso{;7OtDsX|4V0V81 l@-C-}jeJ!IL>BI=8wU->}$M^F68 za2>F;D&%JMerf8~U% 89T5dS1=`I#|%?8)F-oB--PwoooneeBlH^H zMZ?uFzL$oTr%em}pKP!YdKcbR=b>1o?~ST2;)9-v8ZmB?h94zX&51H_s{4RWC@rKT ztY3pm%t=jwVAD7U#5^vnoexunMn0_`O%T2F%pH0^YtG&};sBS+-a0YduHnU71eIUP zd$I-D+UnR;sK7r9DbJ#&Fy5nBUr87jTTSHd*yMN9KesEKL??<1P~o;O#9L?JX|-L2 z$e67NJ|v$~fxB}5yDGVH(3C^<6lSXNk@2@7X|pEoT;0G&m>drlV?dChOEjly0gZ`- z9ys 4GWrw)CI|IonQ?0&y9*9uU$N@n~?KAd)6#z zU7WVJ45jn4U>!a~5drrSgDzDcV@|%u2ZGu_Od@)ykRG%ieFe{hY)Gzej9#4zl&Qa< zA{UI?j4}&{R|1_(3z)QfyBnC!Fi$0{$Bj1WYkXURWnKpOlIQoD#s>Gp2iOZ*v0%O? z5F7<;wO0kY)A=3%Qy 1=QCx%1pVkz4IC(z91RU#n`aH)c2D5@#}7oApz>-*r_zRz(hb zjR(;og1YX&Ch!DIU^3msIvwQ51#~jy<3oe7UVKRUc~ZWLKjL*|&K6|I$IHZzOC^s@ z|3AfCdpJ~Wzt*QxF+xg_4uncb8Vr@*LS>ke879ok%Q#OO$&hnJ5)DOi$RTIODKufw z 7B`G7{_rMdwIX_+SlIK^?v)0{m0(x&*xg}S?l?&XRYVHfA{@+Dx&HI z-rY0vEi(SV$6N*}a! 9p{-vA@5m~Q*7fq zBe5Bi|7l1{5Mw1~==pK}>6)8{dPJ>WwV$&-_P(YDNRqAY?h~Sp=r3|<2n7WwVjSZo z(G1JTHGos5HH))W7?5{W6GSP6-tIk0Z7fPSdP?Pi`5&&bmV{cNu9EwOic13fpPb2+ zr)QZDRwjk{CI*uZ;ie9?zJmEG{_v(-b*@rIoN4iSTS^B8o8#SI36>rEJoB10o}FjS zSY^cS J+7_bIghZgcn_?(%6Dpwt3tjRxa`Z~F3wj7Nzc=6)+<^w96*MQgzbp{kwi-?^D+_Vph*4%oS93azm*r>=i28}iNidk^ZyU2b+(Lz|| z(3T}3)zot+Z fWT5`?8?+ehSKF$=GWzD6Q8V3205((ZCZu zfC)ScGqf_w?EYBgGhM%GHIkpH)nTP{zfb03-SUPLG gJYUWT|2~6&)r1GhJvFsApTBW-=K7|fyXj5Kx5t8l zhhChLD|ecSxKSgQAy)8EWwy=W;i7F dn$>ztY}< zPj+-DXq|_U$IjYLe~R8_-g^4oQqDr~* Js>H`(r#cY>#OS4a!wzo+4|%^^avquZXh$aJx`i}7D8{44uD8;%NE z*QM$eWtoFJWen9M%Wo>JpGr?Vc1Ek1Su$X%y|tqKS|&TvW>Da-Zn}77Iuh+IxaEkW zRGUw|%e=dVMCO3UOEJ@L6ZBT6ANLq AMPUVz6bfl-=r^UOoIKm< z^xt@)R+}4#t;%Z2`iQxR3*xHe-s8B- &p6M52s2uO%#2COIKQmGjq+k&IV<*YT;c$SqYkoYSL`A{i%U6Iy z`2&&!L>c1ot0U;(HROH$xIRE{`dU`T&bPy2$A5LE@0|C3t;qO0y&pIL=2IFKE~S>d zgXBU#BX>$*a7ERcjtXj3^R)w|j?geCSFkkE0^?6;GfEERuPw6MV >3J$ggDfRkx+in<-nhEnvT; z-V`X&DaqAuohQ#+UvK%roa1M8yWM;7O7yrltFb9Q9K)Ya$qXs|+Sv1KKW4opbuNH! zRvNR_N35K1IjNhX?Kd-jyn;S7iZKE?CdoeKrQZ6s5)&WJ+#EV-1QJrvUijV+8<`ka z!DD`9o&zV6e^l=5lK5}l=>;P8{9_YFQeh%a>oDyczx@UzD{9c%7IWkn5es9&OPZW2 z9+Z1NDb#eEb;vKrX=Pu1L@TSts+Qhz2%ke9_2eR7UsK_sd7amOqA1JOl@Q3huuQqz zlLrd1erRMlZ&%Wv`WhC#?=O2oZxrsmfN&fk5-)Vp6P6e9rcmu2e?+)aYyG)~AIzeE zRfX&?thS$Kdmuu&hjVPF<+s0s^b0cdks5o`zW$*)LT@#K3R5Po;}9!lSlXLh_XboE z!G_`)g^eph)*aBvV|x$#Gfqsne0RwqRCmgVZc%M%@J>`f>45R@ZJn&N%dT2g7!Tu2 z=Y-Zbxw{Qa8%|~xrWAifP=j{{e>vK#ututtpRAjnQY!6AV+QyLLQWfCmbRl0g^H!& zS-WHVg?0NQW_6n6x^B;UwLKQ07%bL){^S;rz7}Kc )I& zr@l1rV&1iSy`)5&X8wJ@WJO@}x=##8V4az5$=BRy)H#%*5aQv2+;=*pQ>-yhd;E8$ z2!}M#8M7A@h_j3{*$ek+*`(y2Z8U0pc gNW(=<>tHip4UZr8 z(vzOEz1bvKQMsFW`W}V#*^4h<6DZFtd-N+);@e0*ULE2fTz5|oQc3nf8e+fd`qk9P zD^w_nfa>2ukjdtAp`MqaIa8>jyu1YU66rLJc@dR#TD=~qe8rrnqA~}qRSz0ydfrPf z85%qhpZZ8dXA%~#alAI}(mw;GUkSdf$eMjZG5#>(6lN#Ws06kS#;(`d!wFGJ`HAV# zh^BxxAE^G$1g&H-2N9O^?|N$+v4=-7kefso@H*B>3upVbkrpggn__%#+UI8Ih|iVe zTb-H(h6{`Y@vOieml;|J+G0z2xI7_M{s5^dw)lC=+r$9fI3eI9rwH|9w|lQ~$WlEn zbq52|e#?C8)Q^rEI 7_m zB%s?8JoU~65uOzm3)9%VatVL!Y!OYeC$4mYwZsU(?Q5N @qPvrMNmYS!PzJ@ZQTKDyGG+*Gk(R{Clo# z`%^?K&o-*)NM(F@iZ
PWM>m%(F1@%A&(8^1&~L_N`?n_I(kk1vR!!8lj(35g%xBVD;ZS}Wfz z-BZ=GX&I!Wp_beQ@805g(t?vb`vsXDmp^*yK!lCMxD;rjnq&RqK(=#`eY_u9r9~!N zTD3S*BN9g11wF2!Aa5aPe&(CYue-yM7R8qcA}HpU#B<5Rs^9V=&CRah;U44KLoGMq za~;Q0)=D(rTJ+UBYvcZK<5a)BSEU}NdNIDQ$644hR?G#3KO@0^W8Yb&Z0?bAdQ@XL zx`+~yeRO=SEkK9p5R6CLsU6FTZ2jh&L6S-GbRA30865pwRD5*CqvPtz)Fp_JZ@cDO zV;gBoPU)}&uqrB#t<0jQSRI $jqkx z>kcT(tA1|v YQw%T{lV5mMDH9Gt&ShNeIss{;4Hpbyvo5A2+*LSw$TUk+{K| z#=`W5_G4dNd|IPWU2qlH2jX_YG}qpsPm{4$N;F7vSSY*bPRcQ_`%&M0SJ#*!55{&l zmjz|1N{enthX+`XrV-Gw=d}B2 $fiXo_?Ma-(WGqt&BZvVCr&c&MwQT;S;U!T-g0%Q|7!+!|z|FTTUIq zu@gp#9=cC==P2&25s7dR+0-P;rn`_wsX_p}d9L|rp-QFF-)bi5ifS0i3#)r%`8JtE z#Ei9Y;%l;Pt|o}jWZyp&)O3DKM%b#Z*f2!XEVBDe|7D*}x3kB)_RFFknk1tyQH)tN z$@?x0>{ZrStFo-Y<&L@yNcfETAy^Oa29oWI=CXpP!imHnJ)f~?J@19ifw1lAh9Ncn z!tB4W!Ayt47`+t$T`Q%Oa;K=5aNnuizM^ld9fz3l6(JvEG3%oTzXh($4BQ_-AA{2> ztFL&eRe?Rf<-?~trFZhSVyJ =H)38%RNMXKZe-9!AW0N>%M|o$sBQIxF7LJ`As( zp3D=qeH`~+0UlCtk7CsZ6Xm!x`p}+PS#9O1jnu|_`LfrYR>oF2G16^1m8+vGNr6>h zUv5%mW=N34%pk+xk*%j8#az*LguS!|g_@xQ7Fo^sVQa!sq=bQ~C%(K4y}e8ltWfh? z;`nX{aM^hg|FB>GoxP%VjYlJ;BLg=bgv5Z#;f3mo>^ra|9l|D$8zon3Tg`0%4B3Nm zrBOdm_|DY7KD2|{3au;LXX#{!vMFMDqA3~xf!?TUpB@6+pUUHL$FpHc=g*~)|AkS9 mRRFy6|Bhb&*BE(vdnxoq`9GQnW56&3?ij%I3vc}X;y(b~HD0X% diff --git a/tests/testthat/_snaps/windows-4.4/UI-mod_la_lvl_table/la-charts-la_line_chart.png b/tests/testthat/_snaps/windows-4.4/UI-mod_la_lvl_table/la-charts-la_line_chart.png index 23881829a191d6b82bee5e47e338e35f952c1030..065f8ff5292db5f5d395e1dbd6e8c8d8b9c61d80 100644 GIT binary patch literal 25497 zcmeFZRa6|&(=SSlAOV7h1PSi$9^4_gySuwZAOx4e2MO*H+%32UhXDq6cNygL 5T0WqJqONQ zGUuuzAbdoS5f@SON;_Ec_EVevN`0rA2jNbrE1vkF5yWD}$<+mZ>GAC+s|v(gm#5-G z95SM>fiSyZ25W@yB YaLx# zZBem<{q=*ht)>j!*IfGC3 znhhtOU}~NDa-@YC&ICe5^GL2Z_sew75T&wP`nq?CYqFB}u?~Ert4>kej7Q_-ygLFU z?EaRAp<)S?yM*W=e`J`81l)>Qv!nAIpTfOWAidaqw&cPB42))MU)0NLPwf_F%5)c^ zW;q~p )bD}6(T9ehsrEX--y2@o z^p=xu9 jG-+`70MDyTQrmzGxT{VghvtWYOrIuKBQ{G5)?z*hr$R%%d}56Rp?p+g-S zD)xwrR-C?qCDy?Cf&RLlor7rhr5lp<2c-i`AI%B5E0T)Ci?ZUfq7A30S?+WirERAP zxhM_@5^3EiWF0o-!U=^Y|KUvk3Y+0h=Tpl7*u~MPPMvze-sEW^sKv7NSK%%nTfOl; zx)ew^pdnwCq$aGb`s#-8@``Y}o!mm-LWyh4e1+mjP^o|1zWNe#p3fFt( lWq~RG^EVz^62Ia+Ce;_HHcEnWNfsWaKfnjk!8)_Qk!= zaL ({cAwdv1hYfq=L&h*e+B{0%$CPI#i+aJBu%YX1b zhOYEfI}Y8iaZVqNO#}2N2*U#Dco(9uTml?Tx|i-MyR8tk^72Oy$#Yj)@lx}pis@UJ z3H&W(k-c*|_Y7fsthJtKwnM&oHgOuxrA_5oS>< OZUikB%acpvDA z>APP})21HrSA)DX9eF&rBGYX|r(W;pCll#b5HIZM`yFkxsayhLgIrWde9DlqZ`3JS zOpi3* $s`Ds>{&G~cT1-S+Xx(<~5NJUCq@Lz-QdQ_{sBB=tM$ zt7})$YOj|cV)sx)`#brb+E*B<<+xw=yt4hHYqOkWJmmZ8*)j^$X$=NRg&7%-($J(_ zq|fg@iQ0Hqe2EF$`-0|}e!-j(JMc}T)o0ky)Z&z3d6Rq^H>hRP(4vgL5L#IQ@m&38 z<6!SaZZFo8qKi4rxRc7XQ8nzUk9W8J26JEw(_kQ_FO{#JnWl3XdtmEPdW^-A3JhyG zg3X#n$ k5ygsdu-QIJ|bJZ6|Z5JNJ P_beN#Z#`*mCt|v^8GhKU+YD|*ZC0y{VCf|>aoo2o*6jcY|jRg#r+(_3>Q-g-3&@Hv-BjNTJc2p0@96)z#lmK)mYgqolcxrF=-Y z_$zuIFFyw57HGZ|?H9nD$e+bhd3Q!TVKsrgJG gN?nsCT+bJ&+*vP5WDnEXsqka@vXPq(3rl!7PS+vFMRFu zcL>W#pV&zgLk~1hJ5-DwcYdkh!{$f ;inqdu#BX;9=lle zU`gJriJ-v@H-Y^#TCOdT2Lc}Dr2Q%1ZO(Q>b&gw22df7Co2oAr>hgQB`2sV+lB%-O z{+8X#u6GcU a~S<7OOfG2x*RKa(o4|g5l;hG19 zAT_*vY*F#-=Pr$$Hy@NL4k>cU>?WtbD{m#L6A7s=OgSF%t7gGAPaztj6Rw8nhqaS4 z8hJ^C)-{YZ4yf%6)doqhx#<@(X2$X6>W(qdHXknG{FTMf9L2IDgGoy{Jf7?18b%`o zQ^KY Fy) zI;;AeTy(Hxkh86~c=RrH2s#^V4nvhzFjAEae9#VT9}~rp?0;Rb_hRd!kk>imfSy^| zC;Flq`)edsI%k0pneGtkA9p=yK|Z#5Bjq#I{&0@>$H9|0iN_S%V~A=M?WYIK$2KUg z5~yVhUCcwJvztO5mtQ!wKPt;?>h4AFDNWDT-S&o!yxo=JGr>%oUAy;rnPEMjwaz~v z6@otflA6zdJv#bczW#D<)rFFDFz(Es6gE4XDG1FM(&9SiseC<;r}1Mx P@pw2k|U-aA(!hIg*Z27lYS7AFXH_1=kif?p-b zPZLq(uB@aqvA7y*=_aQLLU~+Axlcnp+rnc|TKeSUI^< d?>Z5+1{nE98ekP~cx-=Vsy*=;k86qcX_lLS~(c>;#Mz35WQru56 z!+rjYau++k@*9`XsFw~vL~Ub2y>lL|i5b~$h^r 8%9 zx11P8OH(Div*z)x%y#<@X}