Usr testing fixes (#37)

* Fix: Regional other geographies table showing wrong order of values to geog - sort order in fn

* Chore: Move create your own dev scripts into own folder

* Feat: Final download options for the LA level charts now working (also more modularised to get download to work)

* Chore: Added roxygen comments for new UI modules for bar and line charts in LA lvl

* Feat: Adding new LA charts to main ui and server

* Feat: Adding download options for Stat Neigh line charts

* Feat: Stat neigh bar charts download options added

* Feat: Download options added to Regional line charts

* Feat: Adding more descriptive info to download options, e.g., Multi Bar

* Fix: Updated id for region stats table

* Fix: Correcting incorrect display no data plot in stat n charts

* Feat: Added focus bar chart to Regional level

* Feat: Chart input for multi Regional added and working for line

* Fix: Shared chart inputs were not reacting to a change in indicator causing incorrect geogs to show as options

* Feat: Added multi choice bar chart and all working with downloads

* Feat: New region charts added to main ui and server, also split shared input values so that they are not lost when changing page (means SN and Region do not share for charts)

* Fix: Replace geog input with geog_groups input in the staging error tables to allow other geog selections to populate

* Feat: Adding full dataset download for all LA and removing ignore_init from download module so tables cna be downloaded straight away

* Tests: Adding export back to server, updating chart ids, and new snapshots of LA charts

* Feat: Adding x to remove options in create own chart

* Fix: COrrected type of stat neigh panel title in main ui

* Fix: Colouring of QB cell only occurs for single cell in stat neigh

* Feat: Updating qb col colouring def to match the stat neigh and apply across LA page too

* Fix: Convert last and next updated metadata to Month Year format in the global

* Feat: Fn to add linebreaks to y_axis labels

* Feat: X-axis title added to show year type, also formatted distance of these to the labs in custom_theme

* Chore: Removing markers from line plots

* Feat: Removing linebreak from multiple y-axis, as think important to keep each unit on each line

* Feat: Thickening lines, multi plots need slightly thicker also increased focus thickness too

* Fix: Using "-" instead of NA for categorical and polarised indicators that have no polarity

* Fix: Display "-" when no polarity for national rank in stat neigh

* Chore: Updating LA scripts to use "-" for QBs with no polarity

* Feat: Coloruing trend arrow, applied to LA page

* Feat: Adding trend colour styling too region scripts

* Chore: Removing polarity from reactable output in LA page by not showing col

* Feat: Adding colouring to trend arrows in stat neigh scripts

* Chore: Added national_rank formatting fn for stat neigh

* Fix: Correcting how rank and QB show NAs, dependent on polarity - now does it within cell

* Chore: Removing the NA formatting from reactable and doing in code prior for LA stats table QB and ranks

* Feat: Updating rank fn for stat neigh stats table

* Fix: Removed req for stat neighs so that Cumberland will show

* Chore: Adding roxygen comments for reactable formatting fns

* Chore: Updating renv

* Feat: Updating colour of LA in tables for GOV.UK blue and adding England colour too, adding colour to SN geog table

* Feat: Colours in plots now match highlighted LA and England, some playing around with colours too - undecided

* Feat: Consistent colours across charts and tables now added to Region page

* Feat: Consistent colours across charts and tables now added to Stat N page

* Feat: Tooltip now also coloured by geography, implemented in LA page

* Feat: Added option to specify text colour in tooltip for focus plots, applied to stat neigh

* Feat: Applied tooltip text colour to region page

* Fix: Updated create own charts for new tooltip fns, so still show measure

* Tests: Fixed tests for updated calculate rank fn

* Tests: Updated metadata fn to show warning and compute if looks like numeric date, updated test for this too

* Tests: Updated la stats table for new handling of NA polarity rank and QB

* Tests: Updated LA charts screenshots

* Chore: Formatting adding and updating roxygen comments

* Feat: Better pop-up to show outcome of copy-to-clipboard btn, also more streamlined JS for this

* Feat: Copy-to-clipboard pop-up modularised and added to main ui and sever

* Fix: Removing duplicate stat n id in pop-up JS

* Chore: Adding filter out NA years to the global and removing from all scripts

* Feat: Added fn that will show geom_point if NAs either side so no line appears

* Fix: Single bar chart in create own nice width and better dealing with duplicates in create own charts

* Fix: Staging data mod now forced to observe changes in year_input as was not reacting (NOT IDEAL)

* Chore: Roxygen comments for clipboard fn

* Feat: Tidying of the names of new output table logic

* Fix: Further improvements to create table dealing with strange query combos

* Tests: Updated LA screenshots

* Feat: Create own table now working very well with dealing with different table widths

* Fix: Stat neigh doesn't throw a NaN instead NA for table formatting

* Feat: Changed trend arrows to be coloured and bigger

* Tests: Updating LA screenshots

* Style: Linting changes

02_dev/all_la_page/all_la_page_features_workshop.R

@@ -21,8 +21,7 @@ selected_la <- "Barking and Dagenham"
 filtered_bds <- bds_metrics |>
   dplyr::filter(
     Topic == selected_topic,
-    Measure == selected_indicator,
-    !is.na(Years)
+    Measure == selected_indicator
   )
 
 # Decimal point setting

02_dev/create_own_table_dev_app.R → 02_dev/create_your_own_page/create_own_table_dev_app.R

@@ -234,7 +234,7 @@ server <- function(input, output, session) {
   years_choices <- reactive({
     # Get distinct years
     years_dict <- bds_metrics |>
-      dplyr::filter(Measure %in% input$indicator, !is.na(Years)) |>
+      dplyr::filter(Measure %in% input$indicator) |>
       dplyr::distinct(Years, Years_num)
 
     # Boolean for matching years' suffixes
@@ -435,8 +435,7 @@ server <- function(input, output, session) {
         )
       ) |>
       dplyr::filter(
-        `LA and Regions` %in% geog_inputs(),
-        !is.na(Years)
+        `LA and Regions` %in% geog_inputs()
       )
 
     # Cleaning Years
@@ -791,8 +790,7 @@ server <- function(input, output, session) {
     # Boolean for if the output indicators share suffixes
     share_year_suffix <- bds_metrics |>
       dplyr::filter(
-        Measure %in% output_indicators,
-        !is.na(Years)
+        Measure %in% output_indicators
       ) |>
       check_year_suffix_consistency()
 
@@ -801,8 +799,7 @@ server <- function(input, output, session) {
       # Get the years with suffixes
       years_dict <- bds_metrics |>
         dplyr::filter(
-          Measure %in% output_indicators,
-          !is.na(Years)
+          Measure %in% output_indicators
         ) |>
         dplyr::distinct(Years, Years_num)
 
@@ -936,12 +933,6 @@ server <- function(input, output, session) {
       number_of_geogs() <= 4
     )
 
-    # Count year cols - used to determine if to show geom_point
-    # (If only one year then no line will show so point needed)
-    num_year_cols <- chart_plotting_data() |>
-      dplyr::distinct(Years) |>
-      nrow()
-
     # Plot data - colour represents Geographies & linetype represents Indicator
     chart_plotting_data() |>
       ggplot2::ggplot() +
@@ -953,18 +944,19 @@ server <- function(input, output, session) {
           linetype = Measure,
           data_id = `LA and Regions`
         ),
-        na.rm = TRUE
+        na.rm = TRUE,
+        linewidth = 1
       ) +
+      # Only show point data where line won't appear (NAs)
       ggplot2::geom_point(
+        data = subset(create_show_point(chart_plotting_data()), show_point),
         ggplot2::aes(
           x = Years_num,
           y = values_num,
           color = `LA and Regions`
         ),
-        na.rm = TRUE,
-        # Show points if only one year data selected
-        size = ifelse(num_year_cols == 1, 3, 0),
-        shape = 16
+        shape = 15,
+        na.rm = TRUE
       ) +
       format_axes(chart_plotting_data()) +
       set_plot_colours(chart_plotting_data()) +
@@ -1005,7 +997,7 @@ server <- function(input, output, session) {
       tooltip_vlines,
       chart_plotting_data(),
       get_indicator_dps(final_filtered_bds()),
-      TRUE
+      include_measure = TRUE
     )
 
     # Plotting interactive graph
@@ -1130,13 +1122,10 @@ server <- function(input, output, session) {
           x = Years_num,
           y = values_num,
           fill = `LA and Regions`,
-          tooltip = glue::glue_data(
-            chart_plotting_data() |>
-              pretty_num_table(
-                include_columns = "values_num",
-                dp = get_indicator_dps(final_filtered_bds())
-              ),
-            "Measure: {Measure}\nYear: {Years}\n\n{`LA and Regions`}: {values_num}"
+          tooltip = tooltip_bar(
+            chart_plotting_data(),
+            get_indicator_dps(final_filtered_bds()),
+            include_measure = TRUE
           )
         ),
         position = position_dodge(width = 0.6),

02_dev/create_own_table_workshop.R → 02_dev/create_your_own_page/create_own_table_workshop.R

@@ -34,7 +34,7 @@ input$indicator <- selected_indicator
 
 # Filter the dataset for selected indicators and get distinct years
 years_dict <- bds_metrics |>
-  dplyr::filter(Measure %in% input$indicator, !is.na(Years)) |>
+  dplyr::filter(Measure %in% input$indicator) |>
   dplyr::distinct(Years, Years_num)
 
 # Boolean to check for consistent year suffixes
@@ -112,8 +112,7 @@ filtered_bds <- dplyr::semi_join(
   by = c("Topic" = "Topic", "Measure" = "Measure")
 ) |>
   dplyr::filter(
-    `LA and Regions` %in% geog_inputs,
-    !is.na(Years)
+    `LA and Regions` %in% geog_inputs
   )
 
 # Step 2: Check if year suffixes are consistent
@@ -302,8 +301,7 @@ output_indicators <- query$output |>
 # Boolean for if the output indicators share suffixes
 share_year_suffix <- bds_metrics |>
   dplyr::filter(
-    Measure %in% output_indicators,
-    !is.na(Years)
+    Measure %in% output_indicators
   ) |>
   check_year_suffix_consistency()
 
@@ -312,8 +310,7 @@ if (share_year_suffix) {
   # Get the years with suffixes
   years_dict <- bds_metrics |>
     dplyr::filter(
-      Measure %in% output_indicators,
-      !is.na(Years)
+      Measure %in% output_indicators
     ) |>
     dplyr::distinct(Years, Years_num)
 
@@ -405,7 +402,8 @@ line_chart <- chart_plotting_data |>
       linetype = Measure,
       data_id = `LA and Regions`
     ),
-    na.rm = TRUE
+    na.rm = TRUE,
+    linewidth = 1
   ) +
   ggplot2::geom_point(
     ggplot2::aes(

02_dev/la_level_page/la_dev_app.R

@@ -152,8 +152,7 @@ server_dev <- function(input, output, session) {
     filtered_bds$data <- bds_metrics |>
       dplyr::filter(
         Topic == input$topic_input,
-        Measure == input$indicator,
-        !is.na(Years)
+        Measure == input$indicator
       )
   })
 
@@ -193,7 +192,7 @@ server_dev <- function(input, output, session) {
     sn_avg <- la_filtered_bds |>
       dplyr::filter(`LA and Regions` %in% la_sns) |>
       dplyr::summarise(
-        values_num = mean(values_num, na.rm = TRUE),
+        values_num = dplyr::na_if(mean(values_num, na.rm = TRUE), NaN),
         .by = c("Years", "Years_num")
       ) |>
       dplyr::mutate(
@@ -313,26 +312,34 @@ server_dev <- function(input, output, session) {
 
   output$la_stats_table <- reactable::renderReactable({
     dfe_reactable(
-      la_stats_table() |>
-        dplyr::select(-Polarity),
+      la_stats_table(),
       columns = modifyList(
         # Create the reactable with specific column alignments
         format_num_reactable_cols(
-          la_stats_table() |>
-            dplyr::select(-Polarity),
+          la_stats_table(),
           get_indicator_dps(filtered_bds$data),
           num_exclude = "LA Number",
-          categorical = c("Trend", "Quartile Banding", "Latest National Rank")
+          categorical = c(
+            "Trend", "Quartile Banding", "Latest National Rank",
+            "(A) Up to and including", "(B) Up to and including",
+            "(C) Up to and including", "(D) Up to and including"
+          )
         ),
         # Style Quartile Banding column with colour
         list(
           set_custom_default_col_widths(),
           `Quartile Banding` = reactable::colDef(
-            style = quartile_banding_col_def(la_stats_table())
+            style = function(value, index) {
+              quartile_banding_col_def(la_stats_table()[index, ])
+            }
           ),
           Trend = reactable::colDef(
-            cell = trend_icon_renderer
-          )
+            cell = trend_icon_renderer,
+            style = function(value) {
+              get_trend_colour(value, la_stats_table()$Polarity[1])
+            }
+          ),
+          Polarity = reactable::colDef(show = FALSE)
         )
       )
     )
@@ -344,27 +351,30 @@ server_dev <- function(input, output, session) {
     # Build plot
     la_line_chart <- la_long() |>
       ggplot2::ggplot() +
-      ggiraph::geom_point_interactive(
+      ggiraph::geom_line_interactive(
         ggplot2::aes(
           x = Years_num,
           y = values_num,
           color = `LA and Regions`,
-          shape = `LA and Regions`,
           data_id = `LA and Regions`
         ),
-        na.rm = TRUE
+        na.rm = TRUE,
+        linewidth = 1
       ) +
-      ggiraph::geom_line_interactive(
+      # Only show point data where line won't appear (NAs)
+      ggplot2::geom_point(
+        data = subset(create_show_point(la_long()), show_point),
         ggplot2::aes(
           x = Years_num,
           y = values_num,
-          color = `LA and Regions`,
-          data_id = `LA and Regions`
+          color = `LA and Regions`
         ),
+        shape = 15,
+        size = 1,
         na.rm = TRUE
       ) +
       format_axes(la_long()) +
-      set_plot_colours(la_long()) +
+      set_plot_colours(la_long(), focus_group = input$la_input) +
       set_plot_labs(filtered_bds$data) +
       custom_theme()
 
@@ -374,7 +384,8 @@ server_dev <- function(input, output, session) {
       get_years(la_long()),
       tooltip_vlines,
       la_long(),
-      indicator_dps()
+      indicator_dps(),
+      input$la_input
     )
 
     # Plotting interactive graph
@@ -405,11 +416,7 @@ server_dev <- function(input, output, session) {
           x = Years_num,
           y = values_num,
           fill = `LA and Regions`,
-          tooltip = glue::glue_data(
-            la_long() |>
-              pretty_num_table(include_columns = "values_num", dp = indicator_dps()),
-            "Year: {Years}\n{`LA and Regions`}: {values_num}"
-          ),
+          tooltip = tooltip_bar(la_long(), indicator_dps(), input$la_input),
           data_id = `LA and Regions`
         ),
         position = "dodge",
@@ -418,7 +425,7 @@ server_dev <- function(input, output, session) {
         colour = "black"
       ) +
       format_axes(la_long()) +
-      set_plot_colours(la_long(), "fill") +
+      set_plot_colours(la_long(), "fill", input$la_input) +
       set_plot_labs(filtered_bds$data) +
       custom_theme()
 

02_dev/la_level_page/la_dev_app_mod.R

@@ -17,6 +17,8 @@ list.files("R/lait_modules/", full.names = TRUE) |>
 ui_mod <- bslib::page_fillable(
   ## Custom CSS ===============================================================
   shiny::includeCSS(here::here("www/dfe_shiny_gov_style.css")),
+  tags$head(htmltools::includeScript("www/custom_js.js")),
+  shinyToastify::useShinyToastify(),
 
   # Tab header ================================================================
   h1("Local Authority View"),
@@ -32,7 +34,15 @@ ui_mod <- bslib::page_fillable(
   LA_StatsTableUI("la_stats"),
 
   # LA Charts ----------------------------------
-  LA_ChartUI("la_chart"),
+  div(
+    class = "well",
+    style = "overflow-y: visible;",
+    bslib::navset_card_underline(
+      id = "la_charts",
+      LA_LineChartUI("la_line_chart"),
+      LA_BarChartUI("la_bar_chart")
+    )
+  ),
 
   # LA Metadata ----------------------------------
   LA_LevelMetaUI("la_meta")
@@ -73,15 +83,15 @@ server_mod <- function(input, output, session) {
 
   # LA line chart  ----------------------------------
   LA_LineChartServer(
-    "la_chart",
+    "la_line_chart",
     app_inputs,
     bds_metrics,
     stat_n_la
   )
 
   # LA bar chart  ----------------------------------
   LA_BarChartServer(
-    "la_chart",
+    "la_bar_chart",
     app_inputs,
     bds_metrics,
     stat_n_la
@@ -93,6 +103,9 @@ server_mod <- function(input, output, session) {
     app_inputs$indicator,
     metrics_clean
   )
+
+  # Copy-to-clipboard pop-up notification
+  CopyToClipboardPopUpServer("copy-to-clipboard")
 }