diff --git a/R/lait_modules/mod_app_helpers.R b/R/lait_modules/mod_app_helpers.R index ea5310c..1683b06 100644 --- a/R/lait_modules/mod_app_helpers.R +++ b/R/lait_modules/mod_app_helpers.R @@ -1,203 +1,216 @@ -# nolint start: object_name -# -#' Page Header UI Module -#' -#' Creates a UI output for rendering a page header dynamically. -#' -#' @param id The namespace ID for the module. -#' -#' @return A `uiOutput` object for displaying the page header. -#' -#' @examples -#' PageHeaderUI("header1") -#' -PageHeaderUI <- function(id) { - ns <- shiny::NS(id) # Create a namespace function - shiny::uiOutput(ns("page_header")) # Use uiOutput to render the header -} - - -#' Page Header Server Module -#' -#' Server logic for dynamically updating the page header based on input values. -#' If the `la_value` is not yet available, it will display a placeholder title. -#' -#' @param id The namespace ID for the module. -#' @param app_inputs A reactive input object that includes a `la()` function. -#' @param page_title A string containing the default page title to display. -#' -#' @return A rendered UI object displaying the page header, which includes -#' the LA value and the page title when available. -#' -#' @examples -#' PageHeaderServer("header1", app_inputs, "Dashboard") -#' -PageHeaderServer <- function(id, app_inputs, page_title) { - moduleServer(id, function(input, output, session) { - output$page_header <- shiny::renderUI({ - la_value <- app_inputs$la() # Get LA value - - # Display "Loading..." if la_value is NULL, otherwise show the complete title - if (is.null(la_value)) { - shiny::h1(paste0("Loading... ", page_title)) - } else { - shiny::h1(paste0(la_value, " - ", page_title)) - } - }) - }) -} - - -#' Internal Link UI Function -#' -#' Creates an internal action link within a Shiny module. This link is -#' used to switch between tabs within a Shiny app. -#' -#' @param id Character string that serves as the namespace for the module. -#' -#' @return A UI element (action link) that can be clicked to switch tabs. -#' -InternalLinkUI <- function(id) { - ns <- shiny::NS(id) # Namespace the module - actionLink(ns("internal_link"), "LA Level page") -} - - -#' Internal Link Server Function -#' -#' Handles the server-side logic for switching tabs in a Shiny app using -#' the action link defined in `InternalLinkUI()`. It listens for the link's -#' click event and switches the tab accordingly. -#' -#' @param id Character string for namespacing the module. -#' @param tab_value Character string representing the value of the tab to -#' switch to. -#' @param parent_session Shiny session object from the parent server. -#' @param tabset_id Character string defining the ID of the tabset panel -#' (defaults to "navsetpillslist"). -#' -#' @return None. This function is called for its side effects, which include -#' switching the active tab. -#' -InternalLinkServer <- function(id, - tab_value, - parent_session, - tabset_id = "navsetpillslist") { - moduleServer(id, function(input, output, session) { - observeEvent(input$internal_link, { - # Switch to the specified tab - bslib::nav_select( - id = tabset_id, - selected = tab_value, - session = parent_session - ) - }) - }) -} - - -#' UI function for creating a download button in a Shiny module. -#' -#' @param id A unique identifier for the module. This is used to namespace -#' inputs and outputs in the UI. -#' @param download_label A label to customize the download button text. -#' It will be prefixed with "Download ". -#' -#' @return A download button UI element that allows users to download data -#' in a specified format. -#' -#' @examples -#' # Example usage in UI -#' Download_DataUI("download_data", "LA table") -#' -Download_DataUI <- function(id, download_label) { - ns <- NS(id) - - shiny::downloadButton( - ns("download"), - label = paste0("Download ", download_label), - class = "gov-uk-button", - icon = NULL - ) -} - - -#' Download Data Server Module -#' -#' This function creates a server module for downloading data in various formats -#' (e.g., CSV, XLSX, PNG, HTML). The module observes changes in the file type -#' input and the data for download, generates the appropriate file based on the -#' selected format, and provides a download handler for the user to download -#' the file. -#' -#' @param id A string representing the module ID, used for namespacing -#' UI and server logic of the download functionality. -#' @param file_type_input A reactive expression that returns the selected file -#' type for the download (e.g., "CSV", "XLSX", "PNG", "HTML"). -#' @param data_for_download A reactive expression that provides the data to be -#' downloaded. The structure of the data should match the format expected -#' by the file type (e.g., a data frame for tables or a ggplot object -#' for images). -#' @param download_name A reactive expression that returns a character vector -#' representing the name components to be concatenated for the downloaded -#' file (e.g., "LA-Indicator-Local-Authority-View"). -#' -#' @return A module server that handles file generation and download, enabling -#' the user to download data in the desired format. -#' -#' @details -#' This module tracks changes to the file type input and the data, generating a -#' new file when either changes. It supports multiple file formats including: -#' - CSV and XLSX for tables -#' - PNG for plots -#' - HTML for interactive elements -#' -#' The file name for the download is generated by combining the elements -#' provided in `download_name()` and appending the current date and file extension. -#' -#' @examples -#' \dontrun{ -#' # In server: -#' Download_DataServer( -#' "data_download", reactive(input$file_type), -#' reactive(my_data), reactive(c("Region", "Indicator")) -#' ) -#' } -#' -Download_DataServer <- function(id, file_type_input, data_for_download, download_name) { - moduleServer(id, function(input, output, session) { - # Reactive values for storing file path - local <- reactiveValues(export_file = NULL, data = NULL, plot_width = NULL, file_type = NULL, file_name = NULL) - - # Observe changes in file type or data and generate export file - observeEvent(list(file_type_input(), data_for_download(), download_name()), { - # Ensure inputs are not NULL - req(file_type_input(), data_for_download(), download_name()) - - # Setting parameters - local$file_type <- file_type_input() - local$file_name <- download_name() - - # For charts we need to pull the relevant object from the reactive list - if (grepl("svg", local$file_type, ignore.case = TRUE)) { - local$data <- data_for_download()$"svg" - # Getting plot width from ggiraph obj ratio - local$plot_width <- data_for_download()$"html"$x$ratio * 5 - } else if (grepl("html", local$file_type, ignore.case = TRUE)) { - local$data <- data_for_download()$"html" - } else { - local$data <- data_for_download() - } - - # Generate the file based on the selected file type - local$export_file <- generate_download_file(local$data, local$file_type, local$plot_width) - }) - - # Download handler - output$download <- create_download_handler( - local - ) - }) -} - -# nolint end +# nolint start: object_name +# +#' Page Header UI Module +#' +#' Creates a UI output for rendering a page header dynamically. +#' +#' @param id The namespace ID for the module. +#' +#' @return A `uiOutput` object for displaying the page header. +#' +#' @examples +#' PageHeaderUI("header1") +#' +PageHeaderUI <- function(id) { + ns <- shiny::NS(id) # Create a namespace function + shiny::uiOutput(ns("page_header")) # Use uiOutput to render the header +} + + +#' Page Header Server Module +#' +#' Server logic for dynamically updating the page header based on input values. +#' If the `la_value` is not yet available, it will display a placeholder title. +#' +#' @param id The namespace ID for the module. +#' @param app_inputs A reactive input object that includes a `la()` function. +#' @param page_title A string containing the default page title to display. +#' +#' @return A rendered UI object displaying the page header, which includes +#' the LA value and the page title when available. +#' +#' @examples +#' PageHeaderServer("header1", app_inputs, "Dashboard") +#' +PageHeaderServer <- function(id, app_inputs, page_title) { + moduleServer(id, function(input, output, session) { + output$page_header <- shiny::renderUI({ + la_value <- app_inputs$la() # Get LA value + + # Display "Loading..." if la_value is NULL, otherwise show the complete title + if (is.null(la_value)) { + shiny::h1(paste0("Loading... ", page_title)) + } else { + shiny::h1(paste0(la_value, " - ", page_title)) + } + }) + }) +} + + +#' Internal Link UI Function +#' +#' Creates an internal action link within a Shiny module. This link is +#' used to switch between tabs within a Shiny app. +#' +#' @param id Character string that serves as the namespace for the module. +#' +#' @return A UI element (action link) that can be clicked to switch tabs. +#' +InternalLinkUI <- function(id) { + ns <- shiny::NS(id) # Namespace the module + actionLink(ns("internal_link"), "LA Level page") +} + + +#' Internal Link Server Function +#' +#' Handles the server-side logic for switching tabs in a Shiny app using +#' the action link defined in `InternalLinkUI()`. It listens for the link's +#' click event and switches the tab accordingly. +#' +#' @param id Character string for namespacing the module. +#' @param tab_value Character string representing the value of the tab to +#' switch to. +#' @param parent_session Shiny session object from the parent server. +#' @param tabset_id Character string defining the ID of the tabset panel +#' (defaults to "navsetpillslist"). +#' +#' @return None. This function is called for its side effects, which include +#' switching the active tab. +#' +InternalLinkServer <- function(id, + tab_value, + parent_session, + tabset_id = "navsetpillslist") { + moduleServer(id, function(input, output, session) { + observeEvent(input$internal_link, { + # Switch to the specified tab + bslib::nav_select( + id = tabset_id, + selected = tab_value, + session = parent_session + ) + }) + }) +} + + +#' UI function for creating a download button in a Shiny module. +#' +#' @param id A unique identifier for the module. This is used to namespace +#' inputs and outputs in the UI. +#' @param download_label A label to customize the download button text. +#' It will be prefixed with "Download ". +#' +#' @return A download button UI element that allows users to download data +#' in a specified format. +#' +#' @examples +#' # Example usage in UI +#' Download_DataUI("download_data", "LA table") +#' +Download_DataUI <- function(id, download_label) { + ns <- NS(id) + + shiny::downloadButton( + ns("download"), + label = paste0("Download ", download_label), + class = "gov-uk-button", + icon = NULL + ) +} + + +#' Download Data Server Module +#' +#' This function creates a server module for downloading data in various formats +#' (e.g., CSV, XLSX, PNG, HTML). The module observes changes in the file type +#' input and the data for download, generates the appropriate file based on the +#' selected format, and provides a download handler for the user to download +#' the file. +#' +#' @param id A string representing the module ID, used for namespacing +#' UI and server logic of the download functionality. +#' @param file_type_input A reactive expression that returns the selected file +#' type for the download (e.g., "CSV", "XLSX", "PNG", "HTML"). +#' @param data_for_download A reactive expression that provides the data to be +#' downloaded. The structure of the data should match the format expected +#' by the file type (e.g., a data frame for tables or a ggplot object +#' for images). +#' @param download_name A reactive expression that returns a character vector +#' representing the name components to be concatenated for the downloaded +#' file (e.g., "LA-Indicator-Local-Authority-View"). +#' +#' @return A module server that handles file generation and download, enabling +#' the user to download data in the desired format. +#' +#' @details +#' This module tracks changes to the file type input and the data, generating a +#' new file when either changes. It supports multiple file formats including: +#' - CSV and XLSX for tables +#' - PNG for plots +#' - HTML for interactive elements +#' +#' The file name for the download is generated by combining the elements +#' provided in `download_name()` and appending the current date and file extension. +#' +#' @examples +#' \dontrun{ +#' # In server: +#' Download_DataServer( +#' "data_download", reactive(input$file_type), +#' reactive(my_data), reactive(c("Region", "Indicator")) +#' ) +#' } +#' +Download_DataServer <- function(id, file_type_input, data_for_download, download_name) { + moduleServer(id, function(input, output, session) { + # Reactive values for storing file path + local <- reactiveValues(export_file = NULL, data = NULL, plot_width = NULL, file_type = NULL, file_name = NULL) + + # Observe changes in file type or data and generate export file + observeEvent(list(file_type_input(), data_for_download(), download_name()), { + # Ensure inputs are not NULL + req(file_type_input(), data_for_download(), download_name()) + + # Setting parameters + local$file_type <- file_type_input() + local$file_name <- download_name() + + # For charts we need to pull the relevant object from the reactive list + if (grepl("svg", local$file_type, ignore.case = TRUE)) { + local$data <- data_for_download()$"svg" + # Getting plot width from ggiraph obj ratio + local$plot_width <- data_for_download()$"html"$x$ratio * 5 + } else if (grepl("html", local$file_type, ignore.case = TRUE)) { + local$data <- data_for_download()$"html" + } else { + local$data <- data_for_download() + } + + # Generate the file based on the selected file type + local$export_file <- generate_download_file(local$data, local$file_type, local$plot_width) + }) + + # Download handler + output$download <- create_download_handler( + local + ) + }) +} + + +# Download Chart Modal UI Module +DownloadChartModalUI <- function(id) { + ns <- NS(id) # Create a namespace + shiny::modalDialog( + title = "Download Line Chart", + file_type_input_btn(ns("file_type"), file_type = "chart"), + Download_DataUI(ns("chart_download"), "Download line chart"), + easyClose = TRUE, + footer = shiny::modalButton("Close") + ) +} + +# nolint end diff --git a/R/lait_modules/mod_region_charts.R b/R/lait_modules/mod_region_charts.R index c45d101..d265665 100644 --- a/R/lait_modules/mod_region_charts.R +++ b/R/lait_modules/mod_region_charts.R @@ -1,506 +1,495 @@ -# nolint start: object_name -# -# General modules ============================================================= -# Building data for plotting -# -#' Long Plot Server Module for Regions -#' -#' This module handles the server-side logic for creating long format data -#' for regional local authorities. It filters data based on selected topics -#' and indicators, and removes London regions with all NA values, along with -#' England from the final output. -#' -#' @param id A unique identifier for the module instance. -#' @param app_inputs A list of input parameters from the application. -#' @param bds_metrics A data frame containing metrics for filtering. -#' @param region_names_bds A data frame of regional names for mapping. -#' -#' @return A reactive expression containing filtered long format data for -#' regions, excluding specified regions and handling NA values. -#' -#' @examples -#' Region_LongPlotServer( -#' "region_plot", app_inputs, metrics_data, -#' region_names -#' ) -#' -Region_LongPlotServer <- function(id, app_inputs, bds_metrics, region_names_bds) { - moduleServer(id, function(input, output, session) { - # Filter for selected topic and indicator - filtered_bds <- BDS_FilteredServer("filtered_bds", app_inputs, bds_metrics) - - # Long format Region LA data - region_long <- Region_LongDataServer("region_long", filtered_bds, region_names_bds) - - # Filter region_long data for any (Ldn) regions with all NA values, and England - reactive({ - region_long() |> - dplyr::group_by(`LA and Regions`) |> - dplyr::filter( - !(grepl("^London \\(", `LA and Regions`) & dplyr::n() == sum(is.na(values_num))), - `LA and Regions` %notin% "England" - ) |> - dplyr::ungroup() - }) - }) -} - - -# Multi-choice chart input module ============================================= -#' Chart Input UI Module -#' -#' Creates a user interface component for selecting regions to compare in -#' a chart. Users can select up to three regions from a provided list. -#' -#' @param id A unique identifier for the module instance. -#' -#' @return A `div` containing a selectize input for region selection. -#' -#' @examples -#' Chart_InputUI("chart_input_module") -#' -Chart_InputUI <- function(id) { - ns <- NS(id) - - div( - shiny::selectizeInput( - inputId = ns("chart_input"), - label = "Select region to compare (max 3)", - choices = region_names_bds, - multiple = TRUE, - options = list( - maxItems = 3, - plugins = list("remove_button"), - dropdownParent = "body" - ) - ) - ) -} - - -#' Chart Input Server Module -#' -#' Handles server-side logic for the Chart Input module. It filters the -#' available regions based on user input and updates the selection -#' dynamically when the default region changes. Ensures that the default -#' region is not selectable. -#' -#' @param id A unique identifier for the module instance. -#' @param app_inputs A list of input parameters from the application. -#' @param region_long_plot A reactive expression providing long format -#' region data. -#' @param region_clean A reactive expression for the default region to -#' exclude from selection. -#' -#' @return A reactive expression containing the valid selected regions -#' for the chart, excluding the default region. -#' -#' @examples -#' Chart_InputServer( -#' "chart_input_module", app_inputs, region_long_data, -#' region_default -#' ) -#' -Chart_InputServer <- function(id, app_inputs, region_long_plot, region_clean) { - moduleServer(id, function(input, output, session) { - # Reactive expression to generate multi_chart_data - multi_chart_data <- reactive({ - region_long_plot() |> - dplyr::filter( - `LA and Regions` != region_clean() - ) |> - pull_uniques("LA and Regions") - }) - - # Update chart input selection when region_clean changes - shiny::observeEvent(region_clean(), { - shiny::updateSelectizeInput( - session = session, - inputId = "chart_input", - choices = multi_chart_data(), - selected = setdiff(input$chart_input, region_clean()) - ) - }) - - # Return valid selected chart input - reactive({ - # Remove region_clean() (default region from selected LA) from - # chart selected Regions - setdiff(input$chart_input, region_clean()) - }) - }) -} - - -# Region chart module ========================================================= -#' Region Focus Line Chart UI Module -#' -#' Creates a user interface component for displaying a focus line chart -#' of regions. The chart is embedded in a navigational panel and styled -#' as a card for better presentation. -#' -#' @param id A unique identifier for the module instance. -#' -#' @return A `nav_panel` containing a card with a line chart output. -#' -#' @examples -#' Region_FocusLine_chartUI("focus_line_chart_module") -#' -Region_FocusLine_chartUI <- function(id) { - ns <- NS(id) - - # Define the nav panel properly - bslib::nav_panel( - title = "Line chart - Focus", - - # Main UI with modal trigger button to the right of the chart - div( - style = "display: flex; justify-content: space-between; align-items: center;", - - # Chart on the left - bslib::card( - bslib::card_body( - ggiraph::girafeOutput(ns("region_focus_line_chart")), - style = "padding: 0 15px;" # Add padding to the left and right - ), - full_screen = TRUE, - style = "flex-grow: 1; display: flex; justify-content: center; padding: 0 10px;" - ), - - # Modal trigger button on the right - shiny::actionButton( - ns("open_modal"), - label = "Download Chart", - icon = shiny::icon("download"), - class = "gov-uk-button", - style = "margin-left: 15px; align-self: flex-start;" - ) - ) - ) -} - - - -#' Region Focus Line Chart Server Module -#' -#' Handles server-side logic for the Region Focus Line Chart module. It -#' retrieves and processes data for the chart, including filtering and -#' formatting. The chart is interactive and allows for a dynamic display -#' of region data over time. -#' -#' @param id A unique identifier for the module instance. -#' @param app_inputs A list of input parameters from the application. -#' @param bds_metrics A dataset containing metrics for plotting. -#' @param stat_n_geog A geographic identifier for statistics. -#' @param region_names_bds A dataset containing names of regions. -#' -#' @return None. Outputs an interactive line chart for the selected regions. -#' -#' @examples -#' Region_FocusLine_chartServer( -#' "focus_line_chart_module", app_inputs, -#' bds_metrics, stat_n_geog, region_names_bds -#' ) -#' -Region_FocusLine_chartServer <- function(id, - app_inputs, - bds_metrics, - stat_n_geog, - region_names_bds) { - moduleServer(id, function(input, output, session) { - # Modal UI - ns <- NS(id) - modal_ui <- shiny::modalDialog( - title = "Download Line Chart", - file_type_input_btn(ns("file_type"), file_type = "chart"), - Download_DataUI(ns("chart_download"), "Download line chart"), - easyClose = TRUE, - footer = shiny::modalButton("Close") - ) - - # Show the modal when the button is clicked (move observeEvent to server) - observeEvent(input$open_modal, { - shiny::showModal(modal_ui) - }) - - # Get Region plotting data - region_long_plot <- Region_LongPlotServer( - "region_long_plot", - app_inputs, - bds_metrics, - region_names_bds - ) - - # Get clean Region names - region_clean <- Clean_RegionServer( - "region_clean", - app_inputs, - stat_n_geog, - bds_metrics - ) - - # Filter for selected topic and indicator - filtered_bds <- BDS_FilteredServer("filtered_bds", app_inputs, bds_metrics) - - # Current year - current_year <- Current_YearServer("current_year", region_long_plot) - - # Plot data - # Set selected region to last level so appears at front of plot - chart_data <- reactive({ - region_long_plot() |> - reorder_la_regions(region_clean(), after = Inf) - }) - - # Build focus line plot - static_chart <- reactive({ - # Built focus plot - region_line_chart <- chart_data() |> - ggplot2::ggplot() + - ggiraph::geom_line_interactive( - ggplot2::aes( - x = Years_num, - y = values_num, - color = `LA and Regions`, - size = `LA and Regions`, - data_id = `LA and Regions`, - ), - na.rm = TRUE - ) + - format_axes(chart_data()) + - set_plot_colours(chart_data(), - colour_type = "focus", - focus_group = region_clean() - ) + - set_plot_labs(filtered_bds()) + - ggrepel::geom_label_repel( - data = subset(chart_data(), Years == current_year()), - aes( - x = Years_num, - y = values_num, - label = `LA and Regions` - ), - color = "black", - segment.colour = NA, - label.size = NA, - max.overlaps = Inf, - nudge_x = 2, - direction = "y", - vjust = .5, - hjust = 1, - show.legend = FALSE, - na.rm = TRUE - ) + - custom_theme() + - coord_cartesian(clip = "off") + - # theme(plot.margin = margin(5.5, 66, 5.5, 5.5)) + - guides(colour = "none", size = "none") - }) - - interactive_chart <- reactive({ - # Creating vertical geoms to make vertical hover tooltip - vertical_hover <- lapply( - get_years(chart_data()), - tooltip_vlines, - chart_data(), - get_indicator_dps(filtered_bds()) - ) - - # Plotting interactive graph - ggiraph::girafe( - ggobj = (static_chart() + vertical_hover), - width_svg = 12, - options = generic_ggiraph_options( - opts_hover( - css = "stroke-dasharray:5,5;stroke:black;stroke-width:2px;" - ) - ), - fonts = list(sans = "Arial") - ) - }) - - # Download handler for the line chart - Download_DataServer( - "chart_download", - reactive(input$file_type), - reactive(list("svg" = static_chart(), "html" = interactive_chart())), - reactive(c(app_inputs$la(), app_inputs$indicator(), "Regional-Level-Focus-Line-Chart")) - ) - - # Chart output - output$region_focus_line_chart <- ggiraph::renderGirafe({ - interactive_chart() - }) - }) -} - - -# Region multi-choice line chart module ======================================= -#' Region Multi-Choice Line Chart UI Module -#' -#' Creates a user interface component for displaying a line chart based -#' on user-selected regions. The UI includes a filter sidebar for selecting -#' multiple regions to compare. -#' -#' @param id A unique identifier for the module instance. -#' -#' @return A `nav_panel` containing a card with a sidebar and line chart output. -#' -#' @examples -#' Region_Multi_chartUI("multi_chart_module") -#' -Region_Multi_chartUI <- function(id) { - ns <- NS(id) - - bslib::nav_panel( - title = "Line chart - user selection", - bslib::card( - id = "region_multi_line", - bslib::card_body( - bslib::layout_sidebar( - sidebar = bslib::sidebar( - title = "Filter options", - position = "left", - width = "30%", - open = list(desktop = "open", mobile = "always-above"), - Chart_InputUI(ns("chart_input")) - ), - ggiraph::girafeOutput(ns("region_multi_line_chart")) - ) - ), - full_screen = TRUE - ) - ) -} - - -#' Region Multi-Choice Line Chart Server Module -#' -#' Handles server-side logic for the Region Multi-Choice Line Chart module. -#' It retrieves and processes data for the chart, filtering based on user -#' selections and building an interactive line chart that displays selected -#' regions over time. -#' -#' @param id A unique identifier for the module instance. -#' @param app_inputs A list of input parameters from the application. -#' @param bds_metrics A dataset containing metrics for plotting. -#' @param stat_n_geog A geographic identifier for statistics. -#' @param region_names_bds A dataset containing names of regions. -#' -#' @return None. Outputs an interactive multi-choice line chart for selected regions. -#' -#' @examples -#' Region_Multi_chartServer( -#' "multi_chart_module", app_inputs, -#' bds_metrics, stat_n_geog, region_names_bds -#' ) -#' -Region_Multi_chartServer <- function(id, - app_inputs, - bds_metrics, - stat_n_geog, - region_names_bds) { - moduleServer(id, function(input, output, session) { - # Get Region plotting data - region_long_plot <- Region_LongPlotServer( - "region_long_plot", - app_inputs, - bds_metrics, - region_names_bds - ) - - # Get clean Region names - region_clean <- Clean_RegionServer( - "region_clean", - app_inputs, - stat_n_geog, - bds_metrics - ) - - # Filter for selected topic and indicator - filtered_bds <- BDS_FilteredServer("filtered_bds", app_inputs, bds_metrics) - - # Current year - current_year <- Current_YearServer("current_year", region_long_plot) - - # Pulling specific choices available for selected LA & indicator - chart_input <- Chart_InputServer( - "chart_input", - app_inputs, - region_long_plot, - region_clean - ) - - # Built multi-choice plot - region_multi_line_chart <- reactive({ - # Filtering plotting data for selected LA region and others user choices - region_multi_choice_data <- region_long_plot() |> - dplyr::filter( - (`LA and Regions` %in% chart_input()) | - (`LA and Regions` %in% region_clean()) - ) |> - # Reordering so lines are layered by selection choice, ensuring no duplicates - reorder_la_regions( - rev(c(region_clean(), chart_input())) - ) - - # Reactive expression to handle plot building - region_multi_line <- region_multi_choice_data |> - ggplot2::ggplot() + - ggiraph::geom_point_interactive( - ggplot2::aes( - x = Years_num, - y = values_num, - color = `LA and Regions`, - data_id = `LA and Regions` - ), - na.rm = TRUE - ) + - ggiraph::geom_line_interactive( - ggplot2::aes( - x = Years_num, - y = values_num, - color = `LA and Regions`, - data_id = `LA and Regions` - ), - na.rm = TRUE - ) + - format_axes(region_multi_choice_data) + - manual_colour_mapping( - unique(c(region_clean(), chart_input())), - type = "line" - ) + - set_plot_labs(filtered_bds()) + - 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(region_multi_choice_data), - tooltip_vlines, - region_multi_choice_data, - get_indicator_dps(filtered_bds()) - ) - - # Plotting interactive graph - ggiraph::girafe( - ggobj = region_multi_line + 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") - ) - }) - - # Render the reactive plot output separately - output$region_multi_line_chart <- ggiraph::renderGirafe({ - region_multi_line_chart() - }) - }) -} - -# nolint end +# nolint start: object_name +# +# General modules ============================================================= +# Building data for plotting +# +#' Long Plot Server Module for Regions +#' +#' This module handles the server-side logic for creating long format data +#' for regional local authorities. It filters data based on selected topics +#' and indicators, and removes London regions with all NA values, along with +#' England from the final output. +#' +#' @param id A unique identifier for the module instance. +#' @param app_inputs A list of input parameters from the application. +#' @param bds_metrics A data frame containing metrics for filtering. +#' @param region_names_bds A data frame of regional names for mapping. +#' +#' @return A reactive expression containing filtered long format data for +#' regions, excluding specified regions and handling NA values. +#' +#' @examples +#' Region_LongPlotServer( +#' "region_plot", app_inputs, metrics_data, +#' region_names +#' ) +#' +Region_LongPlotServer <- function(id, app_inputs, bds_metrics, region_names_bds) { + moduleServer(id, function(input, output, session) { + # Filter for selected topic and indicator + filtered_bds <- BDS_FilteredServer("filtered_bds", app_inputs, bds_metrics) + + # Long format Region LA data + region_long <- Region_LongDataServer("region_long", filtered_bds, region_names_bds) + + # Filter region_long data for any (Ldn) regions with all NA values, and England + reactive({ + region_long() |> + dplyr::group_by(`LA and Regions`) |> + dplyr::filter( + !(grepl("^London \\(", `LA and Regions`) & dplyr::n() == sum(is.na(values_num))), + `LA and Regions` %notin% "England" + ) |> + dplyr::ungroup() + }) + }) +} + + +# Multi-choice chart input module ============================================= +#' Chart Input UI Module +#' +#' Creates a user interface component for selecting regions to compare in +#' a chart. Users can select up to three regions from a provided list. +#' +#' @param id A unique identifier for the module instance. +#' +#' @return A `div` containing a selectize input for region selection. +#' +#' @examples +#' Chart_InputUI("chart_input_module") +#' +Chart_InputUI <- function(id) { + ns <- NS(id) + + div( + shiny::selectizeInput( + inputId = ns("chart_input"), + label = "Select region to compare (max 3)", + choices = region_names_bds, + multiple = TRUE, + options = list( + maxItems = 3, + plugins = list("remove_button"), + dropdownParent = "body" + ) + ) + ) +} + + +#' Chart Input Server Module +#' +#' Handles server-side logic for the Chart Input module. It filters the +#' available regions based on user input and updates the selection +#' dynamically when the default region changes. Ensures that the default +#' region is not selectable. +#' +#' @param id A unique identifier for the module instance. +#' @param app_inputs A list of input parameters from the application. +#' @param region_long_plot A reactive expression providing long format +#' region data. +#' @param region_clean A reactive expression for the default region to +#' exclude from selection. +#' +#' @return A reactive expression containing the valid selected regions +#' for the chart, excluding the default region. +#' +#' @examples +#' Chart_InputServer( +#' "chart_input_module", app_inputs, region_long_data, +#' region_default +#' ) +#' +Chart_InputServer <- function(id, app_inputs, region_long_plot, region_clean) { + moduleServer(id, function(input, output, session) { + # Reactive expression to generate multi_chart_data + multi_chart_data <- reactive({ + region_long_plot() |> + dplyr::filter( + `LA and Regions` != region_clean() + ) |> + pull_uniques("LA and Regions") + }) + + # Update chart input selection when region_clean changes + shiny::observeEvent(region_clean(), { + shiny::updateSelectizeInput( + session = session, + inputId = "chart_input", + choices = multi_chart_data(), + selected = setdiff(input$chart_input, region_clean()) + ) + }) + + # Return valid selected chart input + reactive({ + # Remove region_clean() (default region from selected LA) from + # chart selected Regions + setdiff(input$chart_input, region_clean()) + }) + }) +} + + +# Region chart module ========================================================= +#' Region Focus Line Chart UI Module +#' +#' Creates a user interface component for displaying a focus line chart +#' of regions. The chart is embedded in a navigational panel and styled +#' as a card for better presentation. +#' +#' @param id A unique identifier for the module instance. +#' +#' @return A `nav_panel` containing a card with a line chart output. +#' +#' @examples +#' Region_FocusLine_chartUI("focus_line_chart_module") +#' +Region_FocusLine_chartUI <- function(id) { + ns <- NS(id) + + # Define the nav panel properly + bslib::nav_panel( + title = "Line chart - Focus", + + # Main UI with modal trigger button to the right of the chart + div( + style = "display: flex; justify-content: space-between; align-items: center;", + + # Chart on the left + bslib::card( + bslib::card_body( + ggiraph::girafeOutput(ns("region_focus_line_chart")), + style = "padding: 0 15px;" # Add padding to the left and right + ), + full_screen = TRUE, + style = "flex-grow: 1; display: flex; justify-content: center; padding: 0 10px;" + ), + + # Modal trigger button on the right + shiny::actionButton( + ns("open_modal"), + label = "Download Chart", + icon = shiny::icon("download"), + class = "gov-uk-button", + style = "margin-left: 15px; align-self: flex-start;" + ) + ) + ) +} + + + +#' Region Focus Line Chart Server Module +#' +#' Handles server-side logic for the Region Focus Line Chart module. It +#' retrieves and processes data for the chart, including filtering and +#' formatting. The chart is interactive and allows for a dynamic display +#' of region data over time. +#' +#' @param id A unique identifier for the module instance. +#' @param app_inputs A list of input parameters from the application. +#' @param bds_metrics A dataset containing metrics for plotting. +#' @param stat_n_geog A geographic identifier for statistics. +#' @param region_names_bds A dataset containing names of regions. +#' +#' @return None. Outputs an interactive line chart for the selected regions. +#' +#' @examples +#' Region_FocusLine_chartServer( +#' "focus_line_chart_module", app_inputs, +#' bds_metrics, stat_n_geog, region_names_bds +#' ) +#' +Region_FocusLine_chartServer <- function(id, + app_inputs, + bds_metrics, + stat_n_geog, + region_names_bds) { + moduleServer(id, function(input, output, session) { + observeEvent(input$open_modal, { + shiny::showModal(DownloadChartModalUI(id)) + }) + + # Get Region plotting data + region_long_plot <- Region_LongPlotServer( + "region_long_plot", + app_inputs, + bds_metrics, + region_names_bds + ) + + # Get clean Region names + region_clean <- Clean_RegionServer( + "region_clean", + app_inputs, + stat_n_geog, + bds_metrics + ) + + # Filter for selected topic and indicator + filtered_bds <- BDS_FilteredServer("filtered_bds", app_inputs, bds_metrics) + + # Current year + current_year <- Current_YearServer("current_year", region_long_plot) + + # Plot data + # Set selected region to last level so appears at front of plot + chart_data <- reactive({ + region_long_plot() |> + reorder_la_regions(region_clean(), after = Inf) + }) + + # Build focus line plot + static_chart <- reactive({ + # Built focus plot + region_line_chart <- chart_data() |> + ggplot2::ggplot() + + ggiraph::geom_line_interactive( + ggplot2::aes( + x = Years_num, + y = values_num, + color = `LA and Regions`, + size = `LA and Regions`, + data_id = `LA and Regions`, + ), + na.rm = TRUE + ) + + format_axes(chart_data()) + + set_plot_colours(chart_data(), + colour_type = "focus", + focus_group = region_clean() + ) + + set_plot_labs(filtered_bds()) + + ggrepel::geom_label_repel( + data = subset(chart_data(), Years == current_year()), + aes( + x = Years_num, + y = values_num, + label = `LA and Regions` + ), + color = "black", + segment.colour = NA, + label.size = NA, + max.overlaps = Inf, + nudge_x = 2, + direction = "y", + vjust = .5, + hjust = 1, + show.legend = FALSE, + na.rm = TRUE + ) + + custom_theme() + + coord_cartesian(clip = "off") + + theme(plot.margin = margin(5.5, 66, 5.5, 5.5)) + + guides(colour = "none", size = "none") + }) + + interactive_chart <- reactive({ + # Creating vertical geoms to make vertical hover tooltip + vertical_hover <- lapply( + get_years(chart_data()), + tooltip_vlines, + chart_data(), + get_indicator_dps(filtered_bds()) + ) + + # Plotting interactive graph + ggiraph::girafe( + ggobj = (static_chart() + vertical_hover), + width_svg = 12, + options = generic_ggiraph_options( + opts_hover( + css = "stroke-dasharray:5,5;stroke:black;stroke-width:2px;" + ) + ), + fonts = list(sans = "Arial") + ) + }) + + # Download handler for the line chart + Download_DataServer( + "chart_download", + reactive(input$file_type), + reactive(list("svg" = static_chart(), "html" = interactive_chart())), + reactive(c(app_inputs$la(), app_inputs$indicator(), "Regional-Level-Focus-Line-Chart")) + ) + + # Chart output + output$region_focus_line_chart <- ggiraph::renderGirafe({ + interactive_chart() + }) + }) +} + + +# Region multi-choice line chart module ======================================= +#' Region Multi-Choice Line Chart UI Module +#' +#' Creates a user interface component for displaying a line chart based +#' on user-selected regions. The UI includes a filter sidebar for selecting +#' multiple regions to compare. +#' +#' @param id A unique identifier for the module instance. +#' +#' @return A `nav_panel` containing a card with a sidebar and line chart output. +#' +#' @examples +#' Region_Multi_chartUI("multi_chart_module") +#' +Region_Multi_chartUI <- function(id) { + ns <- NS(id) + + bslib::nav_panel( + title = "Line chart - user selection", + bslib::card( + id = "region_multi_line", + bslib::card_body( + bslib::layout_sidebar( + sidebar = bslib::sidebar( + title = "Filter options", + position = "left", + width = "30%", + open = list(desktop = "open", mobile = "always-above"), + Chart_InputUI(ns("chart_input")) + ), + ggiraph::girafeOutput(ns("region_multi_line_chart")) + ) + ), + full_screen = TRUE + ) + ) +} + + +#' Region Multi-Choice Line Chart Server Module +#' +#' Handles server-side logic for the Region Multi-Choice Line Chart module. +#' It retrieves and processes data for the chart, filtering based on user +#' selections and building an interactive line chart that displays selected +#' regions over time. +#' +#' @param id A unique identifier for the module instance. +#' @param app_inputs A list of input parameters from the application. +#' @param bds_metrics A dataset containing metrics for plotting. +#' @param stat_n_geog A geographic identifier for statistics. +#' @param region_names_bds A dataset containing names of regions. +#' +#' @return None. Outputs an interactive multi-choice line chart for selected regions. +#' +#' @examples +#' Region_Multi_chartServer( +#' "multi_chart_module", app_inputs, +#' bds_metrics, stat_n_geog, region_names_bds +#' ) +#' +Region_Multi_chartServer <- function(id, + app_inputs, + bds_metrics, + stat_n_geog, + region_names_bds) { + moduleServer(id, function(input, output, session) { + # Get Region plotting data + region_long_plot <- Region_LongPlotServer( + "region_long_plot", + app_inputs, + bds_metrics, + region_names_bds + ) + + # Get clean Region names + region_clean <- Clean_RegionServer( + "region_clean", + app_inputs, + stat_n_geog, + bds_metrics + ) + + # Filter for selected topic and indicator + filtered_bds <- BDS_FilteredServer("filtered_bds", app_inputs, bds_metrics) + + # Current year + current_year <- Current_YearServer("current_year", region_long_plot) + + # Pulling specific choices available for selected LA & indicator + chart_input <- Chart_InputServer( + "chart_input", + app_inputs, + region_long_plot, + region_clean + ) + + # Built multi-choice plot + region_multi_line_chart <- reactive({ + # Filtering plotting data for selected LA region and others user choices + region_multi_choice_data <- region_long_plot() |> + dplyr::filter( + (`LA and Regions` %in% chart_input()) | + (`LA and Regions` %in% region_clean()) + ) |> + # Reordering so lines are layered by selection choice, ensuring no duplicates + reorder_la_regions( + rev(c(region_clean(), chart_input())) + ) + + # Reactive expression to handle plot building + region_multi_line <- region_multi_choice_data |> + ggplot2::ggplot() + + ggiraph::geom_point_interactive( + ggplot2::aes( + x = Years_num, + y = values_num, + color = `LA and Regions`, + data_id = `LA and Regions` + ), + na.rm = TRUE + ) + + ggiraph::geom_line_interactive( + ggplot2::aes( + x = Years_num, + y = values_num, + color = `LA and Regions`, + data_id = `LA and Regions` + ), + na.rm = TRUE + ) + + format_axes(region_multi_choice_data) + + manual_colour_mapping( + unique(c(region_clean(), chart_input())), + type = "line" + ) + + set_plot_labs(filtered_bds()) + + 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(region_multi_choice_data), + tooltip_vlines, + region_multi_choice_data, + get_indicator_dps(filtered_bds()) + ) + + # Plotting interactive graph + ggiraph::girafe( + ggobj = region_multi_line + 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") + ) + }) + + # Render the reactive plot output separately + output$region_multi_line_chart <- ggiraph::renderGirafe({ + region_multi_line_chart() + }) + }) +} + +# nolint end