R/fetch_utils.R

In dfeR: Common Department for Education Analysis Tasks

#' Validation for fetch location lookups
#'
#' @param year_input the value of the years input
#' @param country_input the value of the countries input
#' @param lookup_data the data frame to check the years against, defaults to
#' dfeR::geo_hierarchy
#' @param valid_years optional vector of the years actually published for this
#' lookup. Give this where the lookup has gaps in its years, as the year
#' columns only record the first and most recent year for each location, so a
#' plain range check would accept a year that was never published. Leave as
#' NULL to check the year falls within the range of the lookup instead
#'
#' @return nothing, unless a failure, and then it will give an error
#' @keywords internal
#' @noRd
check_fetch_location_inputs <- function(
  year_input,
  country_input,
  lookup_data = dfeR::geo_hierarchy,
  valid_years = NULL
) {
  if (year_input != "All") {
    if (!grepl("^\\d{4}$", as.character(year_input))) {
      stop("year must either be 'All', or a valid 4 digit year e.g. '2024'")
    }

    year_num <- as.numeric(year_input)

    if (!is.null(valid_years)) {
      # Where we know the exact years published, check against those
      if (!year_num %in% valid_years) {
        stop(
          sprintf(
            "year must either be 'All' or one of: %s",
            paste(valid_years, collapse = ", ")
          ),
          call. = FALSE
        )
      }
    } else {
      min_year <- min(lookup_data$first_available_year_included)
      max_year <- max(lookup_data$most_recent_year_included)
      if (year_num < min_year || year_num > max_year) {
        stop(
          sprintf(
            "year must either be 'All' or a valid year between %d and %d",
            min_year,
            max_year
          ),
          call. = FALSE
        )
      }
    }
  }

  allowed_countries <- c("England", "Scotland", "Wales", "Northern Ireland")

  if (paste0(country_input, collapse = "") != "All") {
    if (!all(country_input %in% allowed_countries)) {
      stop(paste0(
        "countries must either be 'All', or a vector of valid country names ",
        "from: England, Scotland, Wales, or Northern Ireland"
      ))
    }
  }
}

#' Summarise and filter locations by operational years
#'
#' Shared logic for summarising location lookups and filtering
#' by operational years.
#' Used by fetch_locations and fetch_lsips.
#'
#' @param lookup_data The lookup data frame.
#' @param cols Character vector of columns to keep and group by.
#' @param year Year to filter to, or "All" for no filtering.
#' @return A data frame summarised and filtered by operational years.
#' @keywords internal
#' @noRd
summarise_locations_by_year <- function(lookup_data, cols, year = "All") {
  cols_to_return <- seq_along(cols)
  lookup <- dplyr::select(
    lookup_data,
    dplyr::all_of(
      c(cols, "first_available_year_included", "most_recent_year_included")
    )
  )
  resummarised_lookup <- lookup |>
    dplyr::summarise(
      "first_available_year_included" = min(
        .data$first_available_year_included
      ),
      "most_recent_year_included" = max(.data$most_recent_year_included),
      .by = dplyr::all_of(cols)
    )
  if (year == "All") {
    return(dplyr::distinct(resummarised_lookup[, cols_to_return]))
  }
  resummarised_lookup <- resummarised_lookup |>
    dplyr::mutate(
      "in_specified_year" = ifelse(
        as.numeric(.data$most_recent_year_included) >= year &
          as.numeric(.data$first_available_year_included) <= year,
        TRUE,
        FALSE
      )
    )
  resummarised_lookup <- with(
    resummarised_lookup,
    subset(resummarised_lookup, in_specified_year == TRUE)
  ) |>
    dplyr::select(-c("in_specified_year"))
  dplyr::distinct(resummarised_lookup[, cols_to_return])
}

#' Fetch locations for a given lookup
#'
#' Helper function for the fetch_xxx() functions to save repeating code
#'
#' @param lookup_data lookup data to use to extract locations from
#' @param cols columns to extract from the main lookup table
#' @param year year of locations to extract, "All" will skip any filtering and
#' return all possible locations
#' @param countries countries for locations to be take from, "All" will skip
#' any filtering and return all
#'
#' @return a data frame of location names and codes
#' @keywords internal
#' @noRd
fetch_locations <- function(lookup_data, cols, year, countries) {
  resummarised_lookup <- summarise_locations_by_year(lookup_data, cols, year)

  # Return early without filtering if defaults are used
  if (all(year == "All", countries == "All")) {
    return(resummarised_lookup)
  }

  # Filter based on country selection if specified
  if (paste0(countries, collapse = "") != "All") {
    # Get the code column
    # Take new_la_code if present (as sometimes there may also be old_la code)
    # Otherwise work it out
    if ("new_la_code" %in% cols) {
      code_col <- "new_la_code"
    } else {
      code_col <- grep("_code$", cols, value = TRUE)
    }

    if (length(code_col) != 1) {
      stop(
        "More than one code column found, there must only be one code column"
      )
    }

    # Filter every value to its first letter as that matches the ONS code
    # then filter the data set to only have codes from the selected countries
    resummarised_lookup <- resummarised_lookup |>
      dplyr::filter(
        grepl(
          paste0("^", unique(substr(countries, 1, 1)), collapse = "|"),
          !!rlang::sym(code_col)
        )
      )
  }

  resummarised_lookup
}