Merge pull request #55 from nhs-r-community:francisbarton/issue53

Improve logic of suggest_fixes()

Author: francisbarton

.lintr

@@ -1,4 +1,4 @@
-linters: all_linters()
+linters: linters_with_defaults()
 exclusions: list(
   "vignettes"
   )

DESCRIPTION

@@ -16,10 +16,10 @@ Authors@R:
         )
     )
 Maintainer: Zoë Turner <zoe.turner3@nhs.net>
-Description: Extracts data from the postcodes.io API for a given UK postcode,
-    such as its LSOA (or equivalent), parliamentary constituency, and spatial
-    coordinates. It can also check a list of postcodes for currency/validity
-    and suggest a replacement current postcode for an expired code.
+Description: Extracts data from the postcodes.io API for collections of UK
+    postcodes, such as their LSOA (or equivalent), parliamentary constituency,
+    and spatial coordinates. It can also check postcodes for currency/validity
+    and suggest replacement current postcodes for terminated codes.
 License: MIT + file LICENSE
 Encoding: UTF-8
 RoxygenNote: 7.3.2
@@ -37,7 +37,6 @@ Imports:
     rlang,
     tibble,
     tidyr,
-    tidyselect,
     utils
 Suggests:
     testthat (>= 3.0.0)

NAMESPACE

@@ -1,8 +1,10 @@
 # Generated by roxygen2: do not edit by hand
 
 export(batch_it)
+export(exclude_codes)
+export(filter_fields)
 export(get_postcode_data)
+export(minimal_fields)
 export(postcode_data_join)
 export(suggest_fixes)
 importFrom(rlang,.data)
-importFrom(rlang,`:=`)

R/NHSRpostcodetools-package.R

@@ -1,28 +1,7 @@
 #' @keywords internal
 "_PACKAGE"
 
-#' @importFrom rlang .data `:=`
+## usethis namespace: start
+#' @importFrom rlang .data
+## usethis namespace: end
 NULL
-
-
-#' Batch a vector or list into a list of elements with a maximum size
-#'
-#' @param x A vector or list
-#' @param batch_size integer. The size (length) of batches to create
-#' @examples
-#'   batch_it(letters, 6L)
-#' @returns A list
-#' @export
-batch_it <- function(x, batch_size) {
-  assertthat::assert_that(
-    rlang::is_vector(x),
-    rlang::is_scalar_integerish(batch_size),
-    batch_size >= 1L
-  )
-  bsize <- min(length(x), batch_size)
-
-  # Create a vector of factors of length length(x), then pass this as the factor
-  # argument to [split()].
-  f <- rep(seq_len(ceiling(length(x) / bsize)), each = bsize)[seq_along(x)]
-  unname(split(x, f))
-}

R/get_postcode_data.R

@@ -18,14 +18,14 @@
 #' @export
 get_postcode_data <- function(x, as_list = FALSE, include_codes = TRUE) {
   x <- unique(toupper(purrr::discard(x, is.na)))
-  assertthat::assert_that(length(x) > 0, msg = "No postcodes have been found.")
+  assertthat::assert_that(length(x) > 0L, msg = "No postcodes have been found.")
 
   valid_index <- purrr::map_lgl(x, validate_code, .progress = "Checking codes")
   valid_codes <- x[valid_index]
   invalid_codes <- x[!valid_index]
 
   if (length(invalid_codes) > 0L) {
-    inv <- cli::cli_vec(invalid_codes, list(`vec-trunc` = 5))
+    inv <- cli::cli_vec(invalid_codes, list(`vec-trunc` = 5L)) # nolint
     paste0(
       "{.fn get_postcode_data} found {length(invalid_codes)} invalid ",
       "postcode{?s}. Example{?s}: {.val {inv}}. You can use ",
@@ -64,7 +64,7 @@ get_postcode_data <- function(x, as_list = FALSE, include_codes = TRUE) {
 #'
 #' @examples
 #' tibble::tibble(
-#'   place = paste0("place_", 1:3),
+#'   place = paste0("place_", seq(3L)),
 #'   postcode = c("NP22 3PS", "NP22 4PS", "NP22 5PS")
 #' ) |>
 #'   postcode_data_join()
@@ -78,17 +78,15 @@ postcode_data_join <- function(tbl, .col = "postcode", include_codes = TRUE) {
   dplyr::left_join(tbl, api_data, by = dplyr::join_by({{ .col }} == "postcode"))
 }
 
-
-#' Unnest codes (wider): from a list-col to a column each
-#' @param tbl A data frame with ONS (etc.) codes data in a list-col
-#' @keywords internal
-unnest_codes <- function(tbl) {
-  tbl |>
-    dplyr::mutate(codes_names = names(.data[["codes"]])) |>
-    dplyr::mutate(dplyr::across("codes", unlist)) |>
-    tidyr::pivot_wider(
-      names_from = "codes_names",
-      names_glue = "{codes_names}_code",
-      values_from = "codes"
-    )
+tibblise_results_list <- function(results_list) {
+  results_list |>
+    purrr::map("result") |>
+    purrr::list_flatten() |>
+    purrr::map("result") |>
+    purrr::map(purrr::compact) |>
+    # If result contains nested codes then flatten these out and rename.
+    # Hopefully this doesn't break things if codes are not included!
+    purrr::map(\(x) purrr::list_flatten(x, name_spec = "{inner}_code")) |>
+    purrr::map(tibble::as_tibble_row) |>
+    purrr::list_rbind()
 }

R/helpers.R

@@ -0,0 +1,20 @@
+#' Batch a vector or list into a list of elements with a maximum size
+#'
+#' @param x A vector or list
+#' @param batch_size integer. The size (length) of batches to create
+#' @examples batch_it(letters, 6L)
+#' @returns A list
+#' @export
+batch_it <- function(x, batch_size) {
+  assertthat::assert_that(
+    rlang::is_vector(x),
+    rlang::is_scalar_integerish(batch_size),
+    batch_size >= 1L
+  )
+  bsize <- min(length(x), batch_size)
+
+  # Create a vector of factors of length length(x), then pass this as the factor
+  # argument to [split()].
+  f <- rep(seq_len(ceiling(length(x) / bsize)), each = bsize)[seq_along(x)]
+  unname(split(x, f))
+}

R/requests.R

@@ -22,73 +22,23 @@ check_terminated <- function(code) {
 check_terminated_possibly <- purrr::possibly(check_terminated)
 
 
-bulk_reverse_geocode <- function(dat, prev_data = NULL, curr_radius = 125L) {
-  if (curr_radius > 2000L) {
-    cli::cli_alert_info(paste0(
-      "Geocoding searches have not found some replacement postcodes despite ",
-      "searching up to 2km in radius from the original postcode location."
-    ))
-    prev_data # return early
-  }
-
-  geodata_return <- dat |>
-    dplyr::select(c("longitude", "latitude")) |>
-    dplyr::mutate(limit = 1L) |>
-    dplyr::mutate(radius = curr_radius) |>
-    dplyr::mutate(batch = ceiling(dplyr::row_number() / 100L)) |>
-    # batch into groups of max 100 rows
-    tidyr::nest(.by = "batch") |>
-    dplyr::pull("data") |>
-    purrr::map(get_geodata_return) |>
-    purrr::list_flatten() # re-combine batches into a single list
-
-  geodata_queries <- geodata_return |>
-    purrr::map("query")
-
-  geodata_query_results <- geodata_return |>
-    purrr::map("result") |>
-    purrr::list_flatten()
-
-  nifty_bind_cols <- function(x, y) {
-    x2 <- x |>
-      tibble::as_tibble_row() |>
-      dplyr::select(c("longitude", "latitude")) |>
-      dplyr::rename_with(\(x) paste0("orig_", x))
-    if (!is.null(y)) {
-      y2 <- y |>
-        purrr::compact() |>
-        tibble::as_tibble() |>
-        unnest_codes()
-    } else {
-      y2 <- NULL
-    }
-    dplyr::bind_cols(x2, y2)
-  }
-
-  data_out <- geodata_queries |>
-    purrr::map2(geodata_query_results, nifty_bind_cols) |>
-    purrr::list_rbind()
-
-  if (!"postcode" %in% colnames(data_out)) {
-    data_out <- data_out |>
-      dplyr::mutate(postcode = NA_character_)
-  }
-
-  dat_done <- data_out |>
-    dplyr::filter(!dplyr::if_any("postcode", is.na)) |>
-    dplyr::bind_rows(prev_data)
+get_geodata_return <- function(x) {
+  base_request() |>
+    httr2::req_body_json(list(geolocations = x)) |>
+    pluck_result()
+}
 
-  dat_missing <- data_out |>
-    dplyr::filter(dplyr::if_any("postcode", is.na)) |>
-    dplyr::select(tidyselect::starts_with("orig_")) |>
-    # rename to "longitude" and "latitude" for resubmission
-    dplyr::rename_with(\(x) sub("^orig_", "", x))
 
-  if (nrow(dat_missing) > 0L) {
-    bulk_reverse_geocode(dat_missing, dat_done, curr_radius * 2)
+bulk_lookup <- function(x, filter_fields = filter_fields()) {
+  if (is.null(filter_fields)) {
+    req <- base_request()
   } else {
-    dat_done
+    req <- base_request() |>
+      httr2::req_url_query(filter = filter_fields, .multi = "comma")
   }
+  req |>
+    httr2::req_body_json(list(postcodes = x), auto_unbox = FALSE) |>
+    get_json_data()
 }
 
 
@@ -107,21 +57,7 @@ autocomplete <- function(code) {
     unlist() |>
     sample(1L)
 }
-autocomplete_possibly <- purrr::possibly(autocomplete)
-
-
-bulk_lookup <- function(x) {
-  base_request() |>
-    httr2::req_body_json(list(postcodes = x), auto_unbox = FALSE) |>
-    get_json_data()
-}
-
-
-get_geodata_return <- function(x) {
-  base_request() |>
-    httr2::req_body_json(list(geolocations = x)) |>
-    pluck_result()
-}
+autocomplete_possibly <- purrr::possibly(autocomplete, NA_character_)
 
 
 pluck_result <- \(req) purrr::pluck(get_json_data(req), "result")

R/reverse_geocode.R

@@ -0,0 +1,51 @@
+#' Recursive function to use the reverse geocoding API to find current
+#'  postcodes to replace terminated codes, by proximity
+#' @keywords internal
+reverse_geocode <- function(dat, prev_data = NULL, curr_radius = 125L) {
+  if (curr_radius > 2000L) {
+    paste0(
+      "Geocoding searches have not found some replacement postcodes despite ",
+      "searching up to 2km in radius from the original postcode location."
+    ) |>
+      cli::cli_alert_info()
+    prev_data # return early
+  }
+
+  geodata_return <- dat |>
+    dplyr::select(c("longitude", "latitude")) |>
+    dplyr::mutate(
+      limit = 1L,
+      radius = curr_radius,
+      batch = ceiling(dplyr::row_number() / 100L)
+    ) |>
+    # batch into groups of max 100 rows
+    tidyr::nest(.by = "batch") |>
+    dplyr::pull("data") |>
+    purrr::map(get_geodata_return) |>
+    purrr::list_flatten() # re-combine batches into a single list
+
+  geodata_query_data <- geodata_return |>
+    purrr::map("query") |>
+    purrr::map(tibble::as_tibble_row) |>
+    purrr::list_rbind() |>
+    dplyr::select(c("longitude", "latitude"))
+
+  geodata_found_postcodes <- geodata_return |>
+    purrr::map("result") |>
+    purrr::list_flatten() |>
+    purrr::map_chr("postcode", .default = NA_character_) |>
+    tibble::as_tibble_col("new_postcode")
+
+  data_out <- dplyr::bind_cols(geodata_query_data, geodata_found_postcodes)
+
+  dat_done <- prev_data |>
+    dplyr::bind_rows(dplyr::filter(data_out, !is.na(.data[["new_postcode"]])))
+  dat_still_missing <- data_out |>
+    dplyr::filter(dplyr::if_any("new_postcode", is.na))
+
+  if (nrow(dat_still_missing) > 0L) {
+    reverse_geocode(dat_still_missing, dat_done, curr_radius * 2L)
+  } else {
+    dat_done
+  }
+}