diff --git a/01_data/02_prod/LAIT Data Dictionary.csv b/01_data/02_prod/LAIT Data Dictionary.csv index cda0014..491e8c9 100644 --- a/01_data/02_prod/LAIT Data Dictionary.csv +++ b/01_data/02_prod/LAIT Data Dictionary.csv @@ -248,7 +248,7 @@ Child protection plans ending during the year by duration of the plan. ",2024-10-01,"45931","DfE","The duration of a child protection plan which ended during the year to 31 March is calculated as the time between the child protection plan start date and end date.","https://explore-education-statistics.service.gov.uk/find-statistics/characteristics-of-children-in-need",0,"Financial Year" "275","Child Protection","Cafcass Care applications per 10,000 child population","Cafcass Care applications (rate)","CareApplications","-","Rate per 10,000",NA,"None standard - manual process","Number of care applications per 10,000 children aged 0-17 years of children and young people who are the subject of an application to court in past year (including care orders only).",2024-06-01,"45809","CAFCASS","1. Figures are provided from the Cafcass national case management system (CMS) and the ONS.  The units of measurement are a) care applications, which are recevied from the Court and entered into ChildFirst by Cafcass and b) the child population (0 - 17) as estimated by ONS based on population projection (updated in Oct 2019). -","https://www.cafcass.gov.uk/about-cafcass/our-data/",NA,NA +","https://www.cafcass.gov.uk/about-cafcass/our-data/",NA,"Financial Year" "287","Children's Services Workforce","Number FTE of children's social workers","Number of children's social workers (FTE)","Work_Force_NoSW","-","Social Workers",NA,"csww_indicators_2017_to_2023.csv","National and local level information on the children and family social work workforce in English local authorities for the year ending 30 September. Definition : Children and family social workers are social workers registered with Social Work England (SWE) working in a local authority in a children’s services department or, if working in an authority where the services are joined up, a social worker that works primarily on children and families work. Children and family social workers are employed and paid directly by the local authority. diff --git a/02_dev/la_level_page/la_dev_app.R b/02_dev/la_level_page/la_dev_app.R index 29f6a7b..dc81553 100644 --- a/02_dev/la_level_page/la_dev_app.R +++ b/02_dev/la_level_page/la_dev_app.R @@ -409,10 +409,7 @@ server_dev <- function(input, output, session) { `Latest National Rank` = reactable::colDef( header = add_tooltip_to_reactcol( "Latest National Rank", - paste0( - "Rank 1 corresponds to the best value based on the ", - "indicator's direction." - ) + "Rank 1 is always best/top" ) ), Polarity = reactable::colDef(show = FALSE) diff --git a/02_dev/la_level_page/la_page_features_workshop.R b/02_dev/la_level_page/la_page_features_workshop.R index 5697c5d..048c5ac 100644 --- a/02_dev/la_level_page/la_page_features_workshop.R +++ b/02_dev/la_level_page/la_page_features_workshop.R @@ -11,11 +11,11 @@ list.files("R/", full.names = TRUE) |> # LAIT LA Level ---------------------------------- # - Local Authority, Region and England table --- -selected_topic <- "Health and Wellbeing" -selected_indicator <- "Children killed or seriously injured in road traffic accidents" +selected_topic <- "Key Stage 2" +selected_indicator <- "KS2 TA - % working at greater depth in writing - All Pupils" # "Children killed or seriously injured in road traffic accidents" # "Infant Mortality" # "Assessed Child Deaths - modifiable factors" -selected_la <- "Bedford Borough" # "Barnet" # Cumberland +selected_la <- "Barking and Dagenham" # "Barnet" # Cumberland # Filter stat neighbour for selected LA filtered_sn <- stat_n_la |> @@ -47,7 +47,9 @@ la_region_ldn_clean <- clean_ldn_region(la_region, filtered_bds) la_filtered_bds <- filtered_bds |> dplyr::filter( `LA and Regions` %in% c(selected_la, la_region_ldn_clean, la_sns, "England") - ) + ) |> + dplyr::distinct(`LA and Regions`, Years, .keep_all = TRUE) + # SN average sn_avg <- la_filtered_bds |> diff --git a/R/fn_plotting.R b/R/fn_plotting.R index ab493c3..d6c89d2 100644 --- a/R/fn_plotting.R +++ b/R/fn_plotting.R @@ -76,7 +76,9 @@ get_xaxis_title <- function(data_full) { pull_uniques("Year_Type") # If more than one y-axis title then give generic - if (length(x_axis_title) == 1) { + if (is.na(x_axis_title)) { + "Years (no type given)" + } else if (length(x_axis_title) == 1) { add_line_breaks(x_axis_title) } else { "Mixed Year Types" @@ -361,6 +363,38 @@ get_years <- function(data_long, type = "numeric") { } +#' Remove Trailing Zeroes from Formatted Numbers +#' +#' This function takes numeric values, formats them using `pretty_num_large()` +#' and removes any trailing zeroes from the decimal part, but only for values +#' greater than zero. +#' +#' @param x A numeric vector to be formatted. +#' @param dp Integer. The default number of decimal places to be used if the +#' number has decimals. Default is 0. +#' @param ... Additional arguments passed to `pretty_num_large`. +#' +#' @return A character vector with formatted numeric values and no trailing zeroes, +#' only for values greater than 0. +#' +#' @examples +#' pretty_num_remove_trailing_zeroes(c(1000000, 1234567.8901, 100.0), dp = 3) +#' pretty_num_remove_trailing_zeroes(c(5000000000, 9876543210), dp = 2) +#' +#' @export +pretty_num_remove_zero <- function(x, dp = 2, ...) { + # Apply pretty_num_large to format the numbers + formatted_numbers <- pretty_num_large(x, dp = dp, ...) + + # Remove trailing zeroes after decimal point + if (abs(as.numeric(x)) >= 1 || abs(as.numeric(x)) == 0) { + formatted_numbers <- sub("\\.0+(?=\\s|$)", "", formatted_numbers, perl = TRUE) + } + + formatted_numbers +} + + #' Format Axes for Plotting #' #' This function formats the axes for a ggplot2 plot based on the provided @@ -386,7 +420,7 @@ get_years <- function(data_long, type = "numeric") { #' ggplot(data_long) + #' axes + #' geom_line() -format_axes <- function(data_long) { +format_axes <- function(data_long, indicator_dps = 2) { # Get pretty Y-axis breaks y_breaks <- pretty_y_gridlines(data_long) @@ -407,7 +441,7 @@ format_axes <- function(data_long) { limits = range(y_breaks), expand = expansion(0, 0), breaks = pretty(y_breaks), - labels = unlist(lapply(pretty(y_breaks), dfeR::pretty_num)) + labels = unlist(lapply(pretty(y_breaks), pretty_num_remove_zero, indicator_dps)) ), ggplot2::scale_x_continuous( breaks = num_years, diff --git a/R/fn_table_helpers.R b/R/fn_table_helpers.R index 6c299a5..5370557 100644 --- a/R/fn_table_helpers.R +++ b/R/fn_table_helpers.R @@ -59,6 +59,77 @@ filter_la_regions <- function(data, filter_col, latest = FALSE, pull_col = NA) { } +#' Determine Decimal Places for Large Numeric Values +#' +#' This helper function calculates the appropriate number of decimal places +#' based on the value's magnitude. Values smaller than 1 million use the +#' supplied default decimal places. For values over 1 million or 1 billion, +#' decimal places are conditionally applied if the value normalised by a +#' million or billion is not divisible by 10. +#' +#' @param value A single numeric value. +#' @param dp Integer. The default number of decimal places for values +#' over 1 million or 1 billion. +#' +#' @return An integer indicating the number of decimal places to use. +#' @examples +#' determine_decimal_places(999, dp = 2) # Returns 2 +#' determine_decimal_places(1234567, dp = 3) # Returns 3 +#' determine_decimal_places(10000000, dp = 2) # Returns 0 +#' determine_decimal_places(5000000000, dp = 3) # Returns 3 +#' @export +determine_decimal_places <- function(value, dp = 0) { + if (is.na(value)) { + return(dp) + } else if (abs(value) >= 1e9) { + # For values over 1 billion, check divisibility by 10 after dividing by 1 billion + if ((value / 1e9) %% 10 != 0) { + return(3) + } else { + return(0) + } + } else if (abs(value) >= 1e6) { + # For values between 1 million and 1 billion, + # check divisibility by 10 after dividing by 1 million + if ((value / 1e6) %% 10 != 0) { + return(3) + } else { + return(0) + } + } else { + # For values less than 1 million, use the default decimal places + return(dp) + } +} + + +#' Format Large Numeric Values with Conditional Decimal Places +#' +#' This function formats numeric values, applying specific rules for values +#' greater than 1 million or 1 billion. Numbers smaller than 1 million use +#' the user-supplied default decimal places. Decimal places for larger values +#' are applied only if the value normalised by a million or billion is not +#' divisible by 10. +#' +#' @param x A numeric vector to be formatted. +#' @param dp Integer. The default number of decimal places for values +#' over 1 million or 1 billion. Default is 3. +#' @param ... Additional arguments passed to `dfeR::pretty_num`. +#' +#' @return A character vector with formatted numeric values. +#' @examples +#' pretty_num_large(c(999, 1000000, 1234567), dp = 2) +#' pretty_num_large(c(5000000000, 9876543210), dp = 3) +#' @export +pretty_num_large <- function(x, dp = 0, ...) { + # Determine decimal places for each value + decimal_places <- sapply(x, determine_decimal_places, dp = dp) + + # Format the numbers using dfeR::pretty_num + dfeR::pretty_num(x, dp = decimal_places, ...) +} + + #' Format Numeric Columns with Pretty Numbers #' #' This function formats numeric columns in a data frame using the @@ -100,25 +171,30 @@ pretty_num_table <- function(data, include_columns = NULL, exclude_columns = NULL, ...) { + # Check if data is empty if (nrow(data) < 1) { - warning("Data seems to be empty") + warning("Data seems to be empty. Returning unmodified.") + return(data) } - # Determine the columns to include or exclude - if (!is.null(include_columns)) { - cols_to_include <- include_columns + # Determine numeric columns to process + numeric_cols <- names(data)[sapply(data, is.numeric)] + cols_to_include <- if (!is.null(include_columns)) { + include_columns } else if (!is.null(exclude_columns)) { - cols_to_include <- setdiff(names(data)[sapply(data, is.numeric)], exclude_columns) + setdiff(numeric_cols, exclude_columns) } else { - cols_to_include <- names(data)[sapply(data, is.numeric)] + numeric_cols } - # Apply the pretty_num function across the selected columns - data |> + # Apply formatting to selected columns + data <- data |> dplyr::mutate(dplyr::across( .cols = dplyr::all_of(cols_to_include), - ~ sapply(., dfeR::pretty_num, ...) + ~ sapply(., pretty_num_large, ...) )) + + data } @@ -220,7 +296,7 @@ format_reactable_num_col <- function(col, indicator_dps) { ifelse( is.nan(value), "", - dfeR::pretty_num(value, dp = indicator_dps) + pretty_num_large(value, dp = indicator_dps) ) } ) @@ -665,7 +741,7 @@ get_trend_colour <- function(value, polarity) { polarity == "Low" & value < 0 ~ green_colour, polarity == "Low" & value > 0 ~ red_colour, polarity == "High" & value > 0 ~ green_colour, - polarity == "High" & value > 0 ~ red_colour, + polarity == "High" & value < 0 ~ red_colour, TRUE ~ "black" ) @@ -920,10 +996,8 @@ add_tooltip_to_reactcol <- function(value, tooltip, ...) { style = "color: #5694ca; padding-right: 7px; cursor: help; font-size: 1.2em;" ) ), - tooltip = div(tooltip), + tooltip = tooltip, theme = "gov", - placement = "top", - followCursor = TRUE, interactive = TRUE, interactiveBorder = 10, arrow = TRUE, diff --git a/server.R b/server.R index a52c144..8d85846 100644 --- a/server.R +++ b/server.R @@ -1,478 +1,491 @@ -# ----------------------------------------------------------------------------- -# This is the server file. -# -# Use it to create interactive elements like tables, charts and text for your -# app. -# -# Anything you create in the server file won't appear in your app until you call -# it in the UI file. This server script gives examples of plots and value boxes -# -# There are many other elements you can add in too, and you can play around with -# their reactivity. The "outputs" section of the shiny cheatsheet has a few -# examples of render calls you can use: -# https://shiny.rstudio.com/images/shiny-cheatsheet.pdf -# -# Find out more about building applications with Shiny here: -# -# http://shiny.rstudio.com/ -# -# ----------------------------------------------------------------------------- -server <- function(input, output, session) { - # Bookmarking =============================================================== - # This uses bookmarking to store input choices in the url. - # All inputs are excluded by default, and inputs can be added explicitly - # in the included_inputs variable below - shiny::observe({ - # Include these inputs - included_inputs <- c( - "la_inputs-la_name", - "la_inputs-topic_name", - "navsetpillslist" - ) - - # Exclude all inputs except the specified ones - excluded_inputs <- setdiff( - names(shiny::reactiveValuesToList(input)), - included_inputs - ) - - # Set the excluded inputs for bookmarking - shiny::setBookmarkExclude(excluded_inputs) - - # Trigger bookmarking whenever relevant inputs change - session$doBookmark() - }) - - shiny::onBookmarked(function(url) { - # Update the query string with the bookmark URL - shiny::updateQueryString(url) - }) - - # Dynamically changes window title to be LAIT - page - LA - indicator - # (Selected by user) - shiny::observe({ - if (input$navsetpillslist %in% c("LA Level", "Regional Level")) { - shinytitle::change_window_title( - session, - paste0( - site_title, " - ", - input$navsetpillslist, ": ", - la_app_inputs$la(), ", ", - la_app_inputs$indicator() - ) - ) - } else { - shinytitle::change_window_title( - session, - paste0( - site_title, " - ", - input$navsetpillslist - ) - ) - } - }) - - # Cookies logic ============================================================= - output$cookie_status <- dfeshiny::cookies_banner_server( - "cookie-banner", - input_cookies = shiny::reactive(input$cookies), - parent_session = session, - google_analytics_key = google_analytics_key, - cookies_link_panel = "cookies_panel_ui" - ) - - dfeshiny::cookies_panel_server( - id = "cookie-panel", - input_cookies = shiny::reactive(input$cookies), - google_analytics_key = google_analytics_key - ) - - # =========================================================================== - # Start of LAIT - # =========================================================================== - - # reactiveValues object to store shared input values across pages - shared_page_inputs <- reactiveValues( - la = NULL, - topic = NULL, - indicator = NULL - ) - - # =========================================================================== - # LA Level Page - # =========================================================================== - # User Inputs =============================================================== - la_app_inputs <- appInputsServer("la_inputs", shared_page_inputs) - - # Page header - PageHeaderServer("la_header", la_app_inputs, "Local Authority View") - - # LA level tables =========================================================== - # Main table - la_main_tbl <- LA_LevelTableServer( - "la_table", - la_app_inputs, - bds_metrics, - stat_n_la - ) - - # Stats table - LA_StatsTableServer( - "la_stats", - la_app_inputs, - bds_metrics, - stat_n_la - ) - - # LA level charts =========================================================== - # LA line chart - la_linechart <- LA_LineChartServer( - "la_line_chart", - la_app_inputs, - bds_metrics, - stat_n_la, - covid_affected_indicators - ) - - # LA bar chart - la_barchart <- LA_BarChartServer( - "la_bar_chart", - la_app_inputs, - bds_metrics, - stat_n_la, - covid_affected_indicators - ) - - # LA Metadata =============================================================== - LA_LevelMetaServer( - "la_meta", - la_app_inputs$indicator, - metrics_clean - ) - - # Export values for use in UI tests - shiny::exportTestValues( - la_main_tbl = la_main_tbl(), - la_linechart = la_linechart(), - la_barchart = la_barchart() - ) - - - # =========================================================================== - # Regional Level Page - # =========================================================================== - # User Inputs =============================================================== - region_app_inputs <- appInputsServer("region_inputs", shared_page_inputs) - - # Header - PageHeaderServer("region_header", region_app_inputs, "Regional View") - - # Region tables ============================================================= - # Region LA table ----------------------------------------------------------- - RegionLA_TableServer( - "region_tables", - region_app_inputs, - bds_metrics, - stat_n_geog - ) - - # Region table -------------------------------------------------------------- - Region_TableServer( - "region_tables", - region_app_inputs, - bds_metrics, - stat_n_geog, - region_names_bds - ) - - # Region stats table -------------------------------------------------------- - Region_StatsTableServer( - "region_stats_mod", - region_app_inputs, - bds_metrics, - stat_n_geog, - region_names_bds - ) - - # Region charts ============================================================= - # Shared inputs for Region multi-choice charts - region_shared_inputs <- reactiveValues( - chart_line_input = NULL, - chart_bar_input = NULL - ) - - # Region focus line chart --------------------------------------------------- - Region_FocusLineChartServer( - "region_focus_line", - region_app_inputs, - bds_metrics, - stat_n_geog, - region_names_bds, - covid_affected_indicators - ) - - # Region multi-choice line chart -------------------------------------------- - Region_MultiLineChartServer( - "region_multi_line", - region_app_inputs, - bds_metrics, - stat_n_geog, - region_names_bds, - region_shared_inputs, - covid_affected_indicators - ) - - # Region focus bar chart --------------------------------------------------- - Region_FocusBarChartServer( - "region_focus_bar", - region_app_inputs, - bds_metrics, - stat_n_geog, - region_names_bds, - covid_affected_indicators - ) - - # Region multi-choice bar chart --------------------------------------------- - Region_MultiBarChartServer( - "region_multi_bar", - region_app_inputs, - bds_metrics, - stat_n_geog, - region_names_bds, - region_shared_inputs, - covid_affected_indicators - ) - - # Region Metadata =========================================================== - LA_LevelMetaServer( - "region_meta", - region_app_inputs$indicator, - metrics_clean - ) - - # =========================================================================== - # Statistical Neighbour Level Page - # =========================================================================== - # User Inputs =============================================================== - stat_n_app_inputs <- appInputsServer("stat_n_inputs", shared_page_inputs) - - # Header - PageHeaderServer("stat_n_header", stat_n_app_inputs, "Statistical Neighbour View") - - # Statistical Neighbour tables ============================================== - # LA statistical neighbours table ------------------------------------------- - StatN_LASNsTableServer( - "stat_n_tables", - stat_n_app_inputs, - bds_metrics, - stat_n_la - ) - - # LA geographic comparison table -------------------------------------------- - StatN_GeogCompTableServer( - "stat_n_tables", - stat_n_app_inputs, - bds_metrics, - stat_n_la - ) - - # Statistics Table ---------------------------------------------------------- - StatN_StatsTableServer( - "stat_n_stats_mod", - stat_n_app_inputs, - bds_metrics, - stat_n_la, - la_names_bds - ) - - # Statistical Neighbour charts ============================================== - # Shared inputs for Statistical Neighbour multi-choice charts - stat_n_shared_inputs <- reactiveValues( - chart_line_input = NULL, - chart_bar_input = NULL - ) - - # Focus line chart ---------------------------------------------------------- - StatN_FocusLineChartServer( - "stat_n_focus_line", - stat_n_app_inputs, - bds_metrics, - stat_n_la, - covid_affected_indicators - ) - - # Multi-choice line chart --------------------------------------------------- - StatN_MultiLineChartServer( - "stat_n_multi_line", - stat_n_app_inputs, - bds_metrics, - stat_n_la, - stat_n_shared_inputs, - covid_affected_indicators - ) - - # Focus bar chart ----------------------------------------------------------- - StatN_FocusBarChartServer( - "stat_n_focus_bar", - stat_n_app_inputs, - bds_metrics, - stat_n_la, - covid_affected_indicators - ) - - # Multi-choice bar chart ---------------------------------------------------- - StatN_MultiBarChartServer( - "stat_n_multi_bar", - stat_n_app_inputs, - bds_metrics, - stat_n_la, - stat_n_shared_inputs, - covid_affected_indicators - ) - - # Statistical Neighbour Metadata ============================================ - LA_LevelMetaServer( - "stat_n_meta", - stat_n_app_inputs$indicator, - metrics_clean - ) - - # =========================================================================== - # All LA Level Page - # =========================================================================== - # User Inputs =============================================================== - all_la_app_inputs <- appInputsServer("all_la_inputs", shared_page_inputs) - - # Header - PageHeaderServer("all_la_header", all_la_app_inputs, "All LA View") - - # All LA tables ============================================================= - # LA and Region table ------------------------------------------------------- - AllLA_TableServer( - "all_la_table", - all_la_app_inputs, - bds_metrics, - la_names_bds - ) - - # All LA Metadata =========================================================== - LA_LevelMetaServer( - "all_la_meta", - all_la_app_inputs$indicator, - metrics_clean - ) - - # User guide ================================================================ - InternalLinkServer( - "la_level_link", - "LA Level", - session - ) - - - # =========================================================================== - # Create Your Own Page - # =========================================================================== - # User Inputs =============================================================== - # Create own main inputs ---------------------------------------------------- - create_inputs <- Create_MainInputsServer("create_inputs", bds_metrics) - - # Year range input ---------------------------------------------------------- - year_input <- YearRangeServer( - "year_range", - bds_metrics, - create_inputs$indicator - ) - - # Logic to create own ======================================================= - # Geog Groupings ------------------------------------------------------------ - geog_groups <- GroupingInputServer( - "geog_groups", - create_inputs, - la_names_bds, - region_names_bds, - stat_n_geog, - stat_n_la - ) - - # Staging Table ============================================================= - # 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 staging table ------------------------------------------------------ - StagingTableServer( - "staging_table", - create_inputs, - region_names_bds, - la_names_bds, - stat_n_la, - geog_groups, - year_input, - bds_metrics - ) - - # Query Table =============================================================== - # Building query data ------------------------------------------------------- - query_data <- QueryDataServer( - "query_data", - create_inputs, - geog_groups, - year_input, - staging_data - ) - - # Output query table -------------------------------------------------------- - query_table <- QueryTableServer( - "query_table", - query_data - ) - - # Create Own Table ========================================================== - CreateOwnTableServer( - "create_own_table", - query_table, - bds_metrics - ) - - # Create Own Charts ========================================================= - # Line chart ---------------------------------------------------------------- - CreateOwnLineChartServer( - "create_own_line", - query_table, - bds_metrics, - covid_affected_indicators - ) - - # Bar chart ----------------------------------------------------------------- - CreateOwnBarChartServer( - "create_own_bar", - query_table, - bds_metrics, - covid_affected_indicators - ) - - # Extras ==================================================================== - # Copy-to-clipboard pop-up notification - CopyToClipboardPopUpServer("copy-to-clipboard") - - # Stop app ================================================================== - session$onSessionEnded(function() { - shiny::stopApp() - }) -} +# ----------------------------------------------------------------------------- +# This is the server file. +# +# Use it to create interactive elements like tables, charts and text for your +# app. +# +# Anything you create in the server file won't appear in your app until you call +# it in the UI file. This server script gives examples of plots and value boxes +# +# There are many other elements you can add in too, and you can play around with +# their reactivity. The "outputs" section of the shiny cheatsheet has a few +# examples of render calls you can use: +# https://shiny.rstudio.com/images/shiny-cheatsheet.pdf +# +# Find out more about building applications with Shiny here: +# +# http://shiny.rstudio.com/ +# +# ----------------------------------------------------------------------------- +server <- function(input, output, session) { + # Bookmarking =============================================================== + # This uses bookmarking to store input choices in the url. + # All inputs are excluded by default, and inputs can be added explicitly + # in the included_inputs variable below + shiny::observe({ + # Include these inputs for bookmarking + included_inputs <- c( + "la_inputs-la_name", + "la_inputs-topic_name", + "la_inputs-indicator_name", + "navsetpillslist" + ) + + # Exclude all other inputs + excluded_inputs <- setdiff( + names(shiny::reactiveValuesToList(input)), + included_inputs + ) + + # Set the excluded inputs for bookmarking + shiny::setBookmarkExclude(excluded_inputs) + + # Validate topic and indicator consistency + valid_indicators <- bds_metrics |> + dplyr::filter(Topic == input$`la_inputs-topic_name`) |> + dplyr::pull(Measure) + + if (input$`la_inputs-indicator_name` %in% valid_indicators) { + # Trigger bookmarking if topic and indicator are consistent + session$doBookmark() + } else { + # Redirect to a default URL if there is a mismatch + default_url <- site_primary # Replace with your default URL + shiny::updateQueryString(default_url, mode = "replace") + } + }) + + shiny::onBookmarked(function(url) { + # Update the query string with the bookmark URL + shiny::updateQueryString(url, mode = "replace") + }) + + + # Dynamically changes window title to be LAIT - page - LA - indicator + # (Selected by user) + shiny::observe({ + if (input$navsetpillslist %in% c("LA Level", "Regional Level")) { + shinytitle::change_window_title( + session, + paste0( + site_title, " - ", + input$navsetpillslist, ": ", + la_app_inputs$la(), ", ", + la_app_inputs$indicator() + ) + ) + } else { + shinytitle::change_window_title( + session, + paste0( + site_title, " - ", + input$navsetpillslist + ) + ) + } + }) + + # Cookies logic ============================================================= + output$cookie_status <- dfeshiny::cookies_banner_server( + "cookie-banner", + input_cookies = shiny::reactive(input$cookies), + parent_session = session, + google_analytics_key = google_analytics_key, + cookies_link_panel = "cookies_panel_ui" + ) + + dfeshiny::cookies_panel_server( + id = "cookie-panel", + input_cookies = shiny::reactive(input$cookies), + google_analytics_key = google_analytics_key + ) + + # =========================================================================== + # Start of LAIT + # =========================================================================== + + # reactiveValues object to store shared input values across pages + shared_page_inputs <- reactiveValues( + la = NULL, + topic = NULL, + indicator = NULL + ) + + # =========================================================================== + # LA Level Page + # =========================================================================== + # User Inputs =============================================================== + la_app_inputs <- appInputsServer("la_inputs", shared_page_inputs) + + # Page header + PageHeaderServer("la_header", la_app_inputs, "Local Authority View") + + # LA level tables =========================================================== + # Main table + la_main_tbl <- LA_LevelTableServer( + "la_table", + la_app_inputs, + bds_metrics, + stat_n_la + ) + + # Stats table + LA_StatsTableServer( + "la_stats", + la_app_inputs, + bds_metrics, + stat_n_la + ) + + # LA level charts =========================================================== + # LA line chart + la_linechart <- LA_LineChartServer( + "la_line_chart", + la_app_inputs, + bds_metrics, + stat_n_la, + covid_affected_indicators + ) + + # LA bar chart + la_barchart <- LA_BarChartServer( + "la_bar_chart", + la_app_inputs, + bds_metrics, + stat_n_la, + covid_affected_indicators + ) + + # LA Metadata =============================================================== + LA_LevelMetaServer( + "la_meta", + la_app_inputs$indicator, + metrics_clean + ) + + # Export values for use in UI tests + shiny::exportTestValues( + la_main_tbl = la_main_tbl(), + la_linechart = la_linechart(), + la_barchart = la_barchart() + ) + + + # =========================================================================== + # Regional Level Page + # =========================================================================== + # User Inputs =============================================================== + region_app_inputs <- appInputsServer("region_inputs", shared_page_inputs) + + # Header + PageHeaderServer("region_header", region_app_inputs, "Regional View") + + # Region tables ============================================================= + # Region LA table ----------------------------------------------------------- + RegionLA_TableServer( + "region_tables", + region_app_inputs, + bds_metrics, + stat_n_geog + ) + + # Region table -------------------------------------------------------------- + Region_TableServer( + "region_tables", + region_app_inputs, + bds_metrics, + stat_n_geog, + region_names_bds + ) + + # Region stats table -------------------------------------------------------- + Region_StatsTableServer( + "region_stats_mod", + region_app_inputs, + bds_metrics, + stat_n_geog, + region_names_bds + ) + + # Region charts ============================================================= + # Shared inputs for Region multi-choice charts + region_shared_inputs <- reactiveValues( + chart_line_input = NULL, + chart_bar_input = NULL + ) + + # Region focus line chart --------------------------------------------------- + Region_FocusLineChartServer( + "region_focus_line", + region_app_inputs, + bds_metrics, + stat_n_geog, + region_names_bds, + covid_affected_indicators + ) + + # Region multi-choice line chart -------------------------------------------- + Region_MultiLineChartServer( + "region_multi_line", + region_app_inputs, + bds_metrics, + stat_n_geog, + region_names_bds, + region_shared_inputs, + covid_affected_indicators + ) + + # Region focus bar chart --------------------------------------------------- + Region_FocusBarChartServer( + "region_focus_bar", + region_app_inputs, + bds_metrics, + stat_n_geog, + region_names_bds, + covid_affected_indicators + ) + + # Region multi-choice bar chart --------------------------------------------- + Region_MultiBarChartServer( + "region_multi_bar", + region_app_inputs, + bds_metrics, + stat_n_geog, + region_names_bds, + region_shared_inputs, + covid_affected_indicators + ) + + # Region Metadata =========================================================== + LA_LevelMetaServer( + "region_meta", + region_app_inputs$indicator, + metrics_clean + ) + + # =========================================================================== + # Statistical Neighbour Level Page + # =========================================================================== + # User Inputs =============================================================== + stat_n_app_inputs <- appInputsServer("stat_n_inputs", shared_page_inputs) + + # Header + PageHeaderServer("stat_n_header", stat_n_app_inputs, "Statistical Neighbour View") + + # Statistical Neighbour tables ============================================== + # LA statistical neighbours table ------------------------------------------- + StatN_LASNsTableServer( + "stat_n_tables", + stat_n_app_inputs, + bds_metrics, + stat_n_la + ) + + # LA geographic comparison table -------------------------------------------- + StatN_GeogCompTableServer( + "stat_n_tables", + stat_n_app_inputs, + bds_metrics, + stat_n_la + ) + + # Statistics Table ---------------------------------------------------------- + StatN_StatsTableServer( + "stat_n_stats_mod", + stat_n_app_inputs, + bds_metrics, + stat_n_la, + la_names_bds + ) + + # Statistical Neighbour charts ============================================== + # Shared inputs for Statistical Neighbour multi-choice charts + stat_n_shared_inputs <- reactiveValues( + chart_line_input = NULL, + chart_bar_input = NULL + ) + + # Focus line chart ---------------------------------------------------------- + StatN_FocusLineChartServer( + "stat_n_focus_line", + stat_n_app_inputs, + bds_metrics, + stat_n_la, + covid_affected_indicators + ) + + # Multi-choice line chart --------------------------------------------------- + StatN_MultiLineChartServer( + "stat_n_multi_line", + stat_n_app_inputs, + bds_metrics, + stat_n_la, + stat_n_shared_inputs, + covid_affected_indicators + ) + + # Focus bar chart ----------------------------------------------------------- + StatN_FocusBarChartServer( + "stat_n_focus_bar", + stat_n_app_inputs, + bds_metrics, + stat_n_la, + covid_affected_indicators + ) + + # Multi-choice bar chart ---------------------------------------------------- + StatN_MultiBarChartServer( + "stat_n_multi_bar", + stat_n_app_inputs, + bds_metrics, + stat_n_la, + stat_n_shared_inputs, + covid_affected_indicators + ) + + # Statistical Neighbour Metadata ============================================ + LA_LevelMetaServer( + "stat_n_meta", + stat_n_app_inputs$indicator, + metrics_clean + ) + + # =========================================================================== + # All LA Level Page + # =========================================================================== + # User Inputs =============================================================== + all_la_app_inputs <- appInputsServer("all_la_inputs", shared_page_inputs) + + # Header + PageHeaderServer("all_la_header", all_la_app_inputs, "All LA View") + + # All LA tables ============================================================= + # LA and Region table ------------------------------------------------------- + AllLA_TableServer( + "all_la_table", + all_la_app_inputs, + bds_metrics, + la_names_bds + ) + + # All LA Metadata =========================================================== + LA_LevelMetaServer( + "all_la_meta", + all_la_app_inputs$indicator, + metrics_clean + ) + + # User guide ================================================================ + InternalLinkServer( + "la_level_link", + "LA Level", + session + ) + + + # =========================================================================== + # Create Your Own Page + # =========================================================================== + # User Inputs =============================================================== + # Create own main inputs ---------------------------------------------------- + create_inputs <- Create_MainInputsServer("create_inputs", bds_metrics) + + # Year range input ---------------------------------------------------------- + year_input <- YearRangeServer( + "year_range", + bds_metrics, + create_inputs$indicator + ) + + # Logic to create own ======================================================= + # Geog Groupings ------------------------------------------------------------ + geog_groups <- GroupingInputServer( + "geog_groups", + create_inputs, + la_names_bds, + region_names_bds, + stat_n_geog, + stat_n_la + ) + + # Staging Table ============================================================= + # 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 staging table ------------------------------------------------------ + StagingTableServer( + "staging_table", + create_inputs, + region_names_bds, + la_names_bds, + stat_n_la, + geog_groups, + year_input, + bds_metrics + ) + + # Query Table =============================================================== + # Building query data ------------------------------------------------------- + query_data <- QueryDataServer( + "query_data", + create_inputs, + geog_groups, + year_input, + staging_data + ) + + # Output query table -------------------------------------------------------- + query_table <- QueryTableServer( + "query_table", + query_data + ) + + # Create Own Table ========================================================== + CreateOwnTableServer( + "create_own_table", + query_table, + bds_metrics + ) + + # Create Own Charts ========================================================= + # Line chart ---------------------------------------------------------------- + CreateOwnLineChartServer( + "create_own_line", + query_table, + bds_metrics, + covid_affected_indicators + ) + + # Bar chart ----------------------------------------------------------------- + CreateOwnBarChartServer( + "create_own_bar", + query_table, + bds_metrics, + covid_affected_indicators + ) + + # Extras ==================================================================== + # Copy-to-clipboard pop-up notification + CopyToClipboardPopUpServer("copy-to-clipboard") + + # Stop app ================================================================== + session$onSessionEnded(function() { + shiny::stopApp() + }) +}