Fixes as qa (#42)

* 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

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.

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)

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 |>

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,

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,