Fixes as qa (#44)

* Fix: Dealing with NA Year_Type in plot label

* Data: CAFCASS now has a year type value

* Fix: High polarity and negative trend now corrected to show red colour

* Fix: Changing pretty_num so it can deal with large numbers like 1 million and doesn't lose accuracy, also truncating zeros from y-axis labels

* Fix: Removing follow cursor option for tippy, can't get to appear above. Trial remove duplicates from filtered_bds due to dupe in BDS

* Fix: Attempting to fix the issue where a user may switch between topics quickly causing the url to hav emismatch topic and indicator

* Fix: Changed back to warning in pretty_num_table for empty data

* Fix: Shortened pretty_num removing zero fn name due to linting

* Fix: Adding shinyGovstyle css for radio buttons, and setting max-width to none

* Fix: Removing pretty_num_table from building of regions stats table fn

* Chore: Adding fullstop to end of Create Own graph error message

* Chore: Adding warning for duplicate data in filtered_bds mod

* Data: Updating Data Dict for new No QB column

* Feat: Including No Quartile column from Data Dict and applying to LA stats table, also updating all scripts for this

* Feat: Adding No Quartile column handling to stat neigh page

* Chore: Updated no polarity QB handling msg to a dash

* Feat: First effort to disentagle topic and indicator

* Feat: Now have all topics option, clear button on the topic input and user friendly changes when changing inputs

* Feat: Applying new input selection to Region dev app, tidying up some comments

* Feat: Applying new input choice method for topic and indicator to main modules

* Feat: Removing topic input from bookmark and making metadata compatible with new inputs

* Feat: Added Create Your Own inputs to bookmarking

* Fix: Can now delete LA choice and app does not crash

* Feat: Custom indicator label to show topic

* Feat: Adding custom label to selected indicator to show topic, added dfs needed to app_inputs mod

* Fix: Applied rule that if no polarity for indicator then rank appears as NA, made seperate df for topic-indicator pairs

* Feat: Adding custom labels for other input labels so drop down in sync with the indicator input

* Feat: Updated BDS long

* Feat: Moving dynamic topic label to within topic label and only appear when topic not selected

* Feat: Dynamic topic label appears when All Topics selected too

* Chore: Modularising new metatdata logic in dev apps to appease linting

* Tests: Fixing tests for new app_inputs mod param topic_indicator_full

02_dev/all_la_page/all_la_dev_app.R

@@ -94,7 +94,7 @@ server_dev <- function(input, output, session) {
     # Get indicator choices for selected topic
     filtered_topic_bds <- bds_metrics |>
       dplyr::filter(
-        Topic == input$topic_input
+        if (!is.null(input$topic_input)) .data$Topic == input$topic_input else TRUE
       ) |>
       pull_uniques("Measure")
 
@@ -117,7 +117,6 @@ server_dev <- function(input, output, session) {
     # Filter for selected topic and indicator
     filtered_bds$data <- bds_metrics |>
       dplyr::filter(
-        Topic == input$topic_input,
         Measure == input$indicator
       )
   })

02_dev/all_la_page/all_la_dev_app_mod.R

@@ -43,7 +43,12 @@ server_mod <- function(input, output, session) {
   )
 
   # Extract selected LA, Topic and Indicator
-  app_inputs <- appInputsServer("all_la_inputs", shared_values)
+  app_inputs <- appInputsServer(
+    "all_la_inputs",
+    shared_values,
+    bds_metrics,
+    topic_indicator_full
+  )
 
 
   # LA and Region table -------------------------------------------------------

02_dev/create_your_own_page/create_own_table_dev_app.R

@@ -1020,7 +1020,7 @@ server <- function(input, output, session) {
     # Error messages for missing selections
     if ("Message from tool" %in% colnames(clean_final_table())) {
       ggiraph::girafe(
-        ggobj = display_no_data_plot("No plot as not enough selections made"),
+        ggobj = display_no_data_plot("No plot as not enough selections made."),
         width_svg = 8.5,
         options = generic_ggiraph_options(
           opts_hover(
@@ -1035,7 +1035,7 @@ server <- function(input, output, session) {
       number_of_geogs() > 4
     ) {
       ggiraph::girafe(
-        ggobj = display_no_data_plot(label = "No plot as too many Geographies selected"),
+        ggobj = display_no_data_plot(label = "No plot as too many Geographies selected."),
         width_svg = 8.5,
         options = generic_ggiraph_options(
           opts_hover(
@@ -1048,7 +1048,7 @@ server <- function(input, output, session) {
       number_of_indicators() > 3
     ) {
       ggiraph::girafe(
-        ggobj = display_no_data_plot(label = "No plot as too many Indicators selected"),
+        ggobj = display_no_data_plot(label = "No plot as too many Indicators selected."),
         width_svg = 8.5,
         options = generic_ggiraph_options(
           opts_hover(
@@ -1184,7 +1184,7 @@ server <- function(input, output, session) {
     # Error messages for missing or too many selections
     if ("Message from tool" %in% colnames(clean_final_table())) {
       ggiraph::girafe(
-        ggobj = display_no_data_plot("No plot as not enough selections made"),
+        ggobj = display_no_data_plot("No plot as not enough selections made."),
         width_svg = 8.5,
         options = generic_ggiraph_options(
           opts_hover(
@@ -1197,7 +1197,7 @@ server <- function(input, output, session) {
       number_of_geogs() > 4
     ) {
       ggiraph::girafe(
-        ggobj = display_no_data_plot(label = "No plot as too many Geographies selected"),
+        ggobj = display_no_data_plot(label = "No plot as too many Geographies selected."),
         width_svg = 8.5,
         options = generic_ggiraph_options(
           opts_hover(
@@ -1210,7 +1210,7 @@ server <- function(input, output, session) {
       number_of_indicators() > 3
     ) {
       ggiraph::girafe(
-        ggobj = display_no_data_plot(label = "No plot as too many Indicators selected"),
+        ggobj = display_no_data_plot(label = "No plot as too many Indicators selected."),
         width_svg = 8.5,
         options = generic_ggiraph_options(
           opts_hover(

02_dev/la_level_page/la_dev_app.R

@@ -22,19 +22,26 @@ ui_dev <- bslib::page_fillable(
     style = "overflow-y: visible;",
     bslib::layout_column_wrap(
       width = "15rem", # Minimum width for each input box before wrapping
-      shiny::selectInput(
+      shiny::selectizeInput(
         inputId = "la_input",
         label = "LA:",
         choices = la_names_bds
       ),
-      shiny::selectInput(
+      shiny::selectizeInput(
         inputId = "topic_input",
         label = "Topic:",
-        choices = metric_topics
+        choices = c("All topics", metric_topics),
+        multiple = TRUE,
+        options = list(
+          maxItems = 1,
+          placeholder = "No topic selected, showing all indicators.",
+          plugins = list("clear_button"),
+          dropdownParent = "body"
+        )
       ),
-      shiny::selectInput(
+      shiny::selectizeInput(
         inputId = "indicator",
-        label = NULL,
+        label = "Indicator:",
         choices = metric_names
       )
     ),
@@ -165,34 +172,58 @@ ui_dev <- bslib::page_fillable(
 server_dev <- function(input, output, session) {
   # Input ----------------------------------
   # Using the server to power to the provider dropdown for increased speed
-  shiny::observeEvent(input$topic_input, {
-    # Get indicator choices for selected topic
-    filtered_topic_bds <- bds_metrics |>
-      dplyr::filter(
-        Topic == input$topic_input
-      ) |>
-      pull_uniques("Measure")
+  shiny::observeEvent(input$topic_input,
+    {
+      # Save the currently selected indicator
+      current_indicator <- input$indicator
+
+      # Get indicator choices for selected topic
+      # Include all rows if no topic is selected or "All topics" is selected
+      filtered_topic_bds <- bds_metrics |>
+        dplyr::filter(
+          if (is.null(input$topic_input) || "All topics" %in% input$topic_input) {
+            TRUE
+          } else {
+            .data$Topic %in% input$topic_input # Filter by selected topic(s)
+          }
+        ) |>
+        pull_uniques("Measure")
+
+      # Ensure the current indicator stays selected if it's in the new list of available indicators
+      # Default to the first available indicator if the current one is no longer valid
+      selected_indicator <- if (current_indicator %in% filtered_topic_bds) {
+        current_indicator
+      } else {
+        filtered_topic_bds[1]
+      }
 
-    updateSelectInput(
-      session = session,
-      inputId = "indicator",
-      label = "Indicator:",
-      choices = filtered_topic_bds
-    )
-  })
+      shiny::updateSelectizeInput(
+        session = session,
+        inputId = "indicator",
+        label = "Indicator:",
+        choices = filtered_topic_bds,
+        selected = selected_indicator
+      )
+    },
+    ignoreNULL = FALSE
+  )
 
 
   # Main LA Level table ----------------------------------
-  # Filter for selected topic and indicator
+  # Filter for selectedindicator
   # Define filtered_bds outside of observeEvent
   filtered_bds <- reactiveValues(data = NULL)
 
   observeEvent(input$indicator, {
+    # Don't change the currently selected indicator if no indicator is selected
+    if (is.null(input$indicator) || input$indicator == "") {
+      return()
+    }
+
     # Main LA Level table ----------------------------------
-    # Filter for selected topic and indicator
+    # Filter for selected indicator
     filtered_bds$data <- bds_metrics |>
       dplyr::filter(
-        Topic == input$topic_input,
         Measure == input$indicator
       )
   })
@@ -350,6 +381,9 @@ server_dev <- function(input, output, session) {
     la_indicator_val <- filtered_bds$data |>
       filter_la_regions(input$la_input, latest = TRUE, pull_col = "values_num")
 
+    # Boolean as to whether to include Quartile Banding
+    no_show_qb <- input$indicator %in% no_qb_indicators
+
     # Calculating which quartile this value sits in
     la_quartile <- calculate_quartile_band(
       la_indicator_val,
@@ -367,7 +401,8 @@ server_dev <- function(input, output, session) {
       la_quartile,
       la_quartile_bands,
       get_indicator_dps(filtered_bds$data),
-      la_indicator_polarity
+      la_indicator_polarity,
+      no_show_qb
     )
 
     la_stats_table
@@ -541,40 +576,60 @@ server_dev <- function(input, output, session) {
 
 
   # LA Metadata ----------------------------------
+  # Reactive values to store previous data
+  previous_metadata <- reactiveValues(
+    description = NULL,
+    methodology = NULL,
+    last_update = NULL,
+    next_update = NULL,
+    source = NULL
+  )
 
-  # Description
+  # Outputs using the helper function
   output$description <- renderText({
-    metrics_clean |>
-      get_metadata(input$indicator, "Description")
+    update_and_fetch_metadata(
+      input$indicator,
+      "Description",
+      previous_metadata,
+      "description"
+    )
   })
 
-  # Methodology
   output$methodology <- renderUI({
-    metrics_clean |>
-      get_metadata(input$indicator, "Methodology")
+    update_and_fetch_metadata(
+      input$indicator,
+      "Methodology",
+      previous_metadata,
+      "methodology"
+    )
   })
 
-  # Last updated
   output$last_update <- renderText({
-    metrics_clean |>
-      get_metadata(input$indicator, "Last Update")
+    update_and_fetch_metadata(
+      input$indicator,
+      "Last Update",
+      previous_metadata,
+      "last_update"
+    )
   })
 
-  # Next updated
   output$next_update <- renderUI({
-    metrics_clean |>
-      get_metadata(input$indicator, "Next Update")
+    update_and_fetch_metadata(
+      input$indicator,
+      "Next Update",
+      previous_metadata,
+      "next_update"
+    )
   })
 
-  # Source (hyperlink)
   output$source <- renderUI({
-    hyperlink <- metrics_clean |>
-      get_metadata(input$indicator, "Hyperlink(s)")
-    label <- input$indicator
-    dfeshiny::external_link(
-      href = hyperlink,
-      link_text = label
+    hyperlink <- update_and_fetch_metadata(
+      input$indicator,
+      "Hyperlink(s)",
+      previous_metadata,
+      "source"
     )
+    dfeshiny::external_link(href = hyperlink, link_text = input$indicator)
   })
 }
 

02_dev/la_level_page/la_dev_app_mod.R

@@ -19,6 +19,7 @@ ui_mod <- bslib::page_fillable(
   shiny::includeCSS(here::here("www/dfe_shiny_gov_style.css")),
   tags$head(htmltools::includeScript("www/custom_js.js")),
   shinyToastify::useShinyToastify(),
+  shinyjs::useShinyjs(),
 
   # Tab header ================================================================
   h1("Local Authority View"),
@@ -62,8 +63,12 @@ server_mod <- function(input, output, session) {
   )
 
   # Extract selected LA, Topic and Indicator
-  app_inputs <- appInputsServer("la_inputs", shared_values)
-
+  app_inputs <- appInputsServer(
+    "la_inputs",
+    shared_values,
+    bds_metrics,
+    metrics_raw
+  )
 
   # LA level table ----------------------------------
   LA_LevelTableServer(
@@ -78,7 +83,8 @@ server_mod <- function(input, output, session) {
     "la_stats",
     app_inputs,
     bds_metrics,
-    stat_n_la
+    stat_n_la,
+    no_qb_indicators
   )
 
   # LA line chart  ----------------------------------

02_dev/la_level_page/la_page_features_workshop.R

@@ -181,10 +181,13 @@ if (la_indicator_polarity %in% "Low") {
   la_quartile <- "-"
 }
 
+no_show_qb <- selected_indicator %in% no_qb_indicators
+
 la_quartile <- calculate_quartile_band(
   la_indicator_val,
   la_quartile_bands,
-  la_indicator_polarity
+  la_indicator_polarity,
+  no_show_qb
 )
 
 # Build stats table - code logic
@@ -225,7 +228,8 @@ la_stats_table <- build_la_stats_table(
   la_quartile,
   la_quartile_bands,
   indicator_dps,
-  la_indicator_polarity
+  la_indicator_polarity,
+  no_show_qb
 )