Fix the area_lookup data

DESCRIPTION

@@ -44,6 +44,7 @@ Suggests:
     covr,
     flextable,
     ggplot2,
+    httr2,
     knitr,
     rmarkdown,
     spelling,

NEWS.md

@@ -1,6 +1,7 @@
 # phsmethods (development version)
 
 -   phsmethods now requires R 4.1 or later, allowing use of the native pipe (`|>`) and removing the dependency on `{magrittr}`. Documentation and examples have been updated accordingly.
+-   Refreshed the `area_lookup` dataset used by `match_area()`, improving handling of non-ASCII area names and adding more comprehensive tests.
 
 # phsmethods 1.1.0 (2026-02-24)
 

data-raw/area_lookup.R

@@ -12,55 +12,57 @@
 ###
 ### This code should run successfully on RStudio server
 ### It may time out on RStudio desktop due to network security settings
+get_area_lookup <- function(endpoint, query) {
+  resp <- httr2::request(endpoint) |>
+    httr2::req_url_query(query = trimws(query)) |>
+    httr2::req_perform() |>
+    httr2::resp_body_json(simplifyVector = FALSE)
 
+  tibble::tibble(
+    geo_code = vapply(
+      resp$results$bindings,
+      \(x) x$geo_code$value,
+      character(1)
+    ),
+    area_name = vapply(
+      resp$results$bindings,
+      \(x) {
+        if (is.null(x$area_name)) {
+          NA_character_
+        } else {
+          x$area_name$value
+        }
+      },
+      character(1)
+    )
+  )
+}
 
-library(SPARQL)
-library(magrittr)
-
-# API address for SG open data platform
-endpoint <- "http://statistics.gov.scot/sparql"
+endpoint <- "http://statistics.gov.scot/sparql.json"
 
-# Query for the platform API, written in SPARQL
-query <- "SELECT ?geo_code ?area_name
+query <- "
+SELECT ?geo_code ?area_name
 WHERE {
-?s <http://statistics.data.gov.uk/def/statistical-entity#code> ?entity;
-<http://www.w3.org/2004/02/skos/core#notation> ?geo_code.
-OPTIONAL {?s <http://statistics.data.gov.uk/def/statistical-geography#officialname> ?area_name.}
-}
-ORDER BY ?geo_code "
-
-qd <- SPARQL::SPARQL(endpoint, query)
+  ?s <http://statistics.data.gov.uk/def/statistical-entity#code> ?entity ;
+     <http://www.w3.org/2004/02/skos/core#notation> ?geo_code .
 
-area_lookup <- qd[["results"]] %>%
-  # Extract the code only
-  dplyr::mutate(geo_code = substr(geo_code, 2, 10)) %>%
-  # Drop codes with no area name
-  # Storing them isn't necessary as codes without a corresponding area name
-  # will generate an NA from match_area regardless of whether the code is
-  # present in the lookup file
-  tidyr::drop_na(area_name)
+  OPTIONAL {
+    ?s <http://statistics.data.gov.uk/def/statistical-geography#officialname> ?area_name .
+  }
+}
+"
 
-# A bunch of area names don't parse correctly from the SG open data platform
-# This seems like a problem with their platform, rather than with SPARQL
-# Most of the problems seem to be with parsing non-ASCII characters, although
-# not all of the area names which are parsed incorrectly should even have
-# non-ASCII characters in them
-# This step identifies the problem area names
-area_lookup %>%
-  dplyr::filter(!xfun::is_ascii(area_name))
+area_lookup <- get_area_lookup(endpoint, query) |>
+  tidyr::drop_na(area_name) |>
+  # Two of the area names had non-breaking spaces at the end
+  # Cleaning as this is definitely a mistake.
+  dplyr::mutate(area_name = trimws(area_name, whitespace = "[\\h\\v]")) |>
+  dplyr::arrange(geo_code)
 
-# I did't see an easier solution than googling the codes of the areas with
-# problem names, finding out what the real names are, and manually changing them
-area_lookup %<>%
-  dplyr::mutate(area_name = dplyr::case_when(
-    geo_code == "S13002605" ~ "Ste\U00F2rnabhagh a Deas",
-    geo_code == "S13002606" ~ "Ste\U00F2rnabhagh a Tuath",
-    geo_code == "S13002672" ~ "Eilean a' Ch\U00E8o",
-    geo_code == "S13002891" ~ "Annandale East and Eskdale",
-    geo_code == "S13002936" ~ "Bo'ness and Blackness",
-    geo_code == "S13002999" ~ "Eilean a' Ch\U00E8o",
-    TRUE ~ area_name
-  ))
+# The JSON endpoint correctly preserves Unicode characters in area names,
+# including Gaelic accents and typographic punctuation. Previous versions
+# using the SPARQL package required several names to be corrected manually.
+dplyr::filter(area_lookup, !xfun::is_ascii(area_name))
 
 # Manually add some additional codes which aren't present in the lookup file
 other_areas <- tibble::tibble(
@@ -85,21 +87,18 @@ other_areas <- tibble::tibble(
     "S27000002",
     "S08100001",
     "S08100008",
-    sprintf("RA270%d", seq(1:4)),
-    sprintf("S0820000%d", seq(1:4))
+    paste0("RA270", 1:4),
+    paste0("S0820000", 1:4)
   )
 )
 
 # Should the lookup file ever be updated to include any of the additional codes,
 # this will prevent those codes from being duplicated in the final file
 if (any(other_areas$geo_code %in% area_lookup$geo_code)) {
-  other_areas %<>%
-    dplyr::filter(!geo_code %in% area_lookup$geo_code)
+  other_areas <- dplyr::filter(other_areas, !geo_code %in% area_lookup$geo_code)
 }
 
-area_lookup %<>%
-  tibble::as_tibble() %>%
-  dplyr::bind_rows(other_areas)
+area_lookup <- dplyr::bind_rows(area_lookup, other_areas)
 
 # Save data to data/area_lookup.rda
 usethis::use_data(area_lookup, overwrite = TRUE)

tests/testthat/test-match_area.R

@@ -1,3 +1,19 @@
+test_that("Area lookup contains unique geography codes", {
+  area_lookup$geo_code |>
+    anyDuplicated() |>
+    expect_identical(0L)
+})
+
+test_that("Area lookup contains no missing rows", {
+  area_lookup$geo_code |>
+    anyNA() |>
+    expect_false()
+
+  area_lookup$area_name |>
+    anyNA() |>
+    expect_false()
+})
+
 test_that("Returns the correct area names", {
   expect_equal(
     match_area(c(
@@ -33,6 +49,47 @@ test_that("Returns the correct area names", {
   )
 })
 
+test_that("Returns the correct names containing non-ASCII characters", {
+  match_area(c(
+    "S13002605",
+    "S13002606",
+    "S13002672",
+    "S13002936",
+    "S13002999",
+    "S13003138",
+    "S13003139",
+    "S13003140",
+    "S13003141",
+    "S13003142",
+    "S13003143",
+    "S19002355",
+    "S19002508",
+    "S20001990"
+  )) |>
+    expect_no_warning() |>
+    expect_identical(
+      c(
+        "Steòrnabhagh a Deas",
+        "Steòrnabhagh a Tuath",
+        "Eilean a' Chèo",
+        "Bo’ness and Blackness",
+        "Eilean a' Chèo",
+        "Sgìr’ Ùige agus Càrlabhagh",
+        "Sgìre an Rubha",
+        "Sgìre nan Loch",
+        "Steòrnabhagh a Deas",
+        "Steòrnabhagh a Tuath",
+        "Uibhist a Deas, Èirisgeigh agus Beinn na Faoghla",
+        paste(
+          "Margaidh Ùr, Lacasdal and Bruach Mairi",
+          "(Newmarket, Laxdale and Marybank)"
+        ),
+        "Steòrnabhagh (Stornoway)",
+        "Steòrnabhagh (Stornoway)"
+      )
+    )
+})
+
 test_that("Handles NA input values correctly", {
   expect_true(is.na(match_area(NA)))
   expect_equal(
@@ -55,5 +112,100 @@ test_that("Produces no warning for codes of valid length with no match", {
 
 test_that("Warns about the appropriate number of entries", {
   expect_warning(match_area(123223), "1 non-NA input geography.*")
-  expect_warning(match_area(c(NA, paste0("RA270", 1:7))), "3 non-NA input geographies.*")
+  expect_warning(
+    match_area(c(NA, paste0("RA270", 1:7))),
+    "3 non-NA input geographies.*"
+  )
+})
+
+test_that("Returns the correct names for exceptional RA270 codes", {
+  match_area(paste0("RA270", 1:4)) |>
+    expect_no_warning() |>
+    expect_identical(
+      c(
+        "No Fixed Abode",
+        "Rest of UK (Outside Scotland)",
+        "Outside the UK",
+        "Unknown residency"
+      )
+    )
+})
+
+test_that("Returns NA for unmatched geography codes", {
+  match_area(c("S01000001", "123456789")) |>
+    expect_no_warning() |>
+    expect_identical(c(NA_character_, NA_character_))
+})
+
+test_that("Returns NA for invalid-length unmatched codes", {
+  match_area(c("invalid", "S0101248")) |>
+    expect_identical(c(NA_character_, NA_character_)) |>
+    expect_warning("2 non-NA input geographies")
+})
+
+test_that("Preserves input order and duplicate values", {
+  match_area(c(
+    "S13002781",
+    "S20000010",
+    "S13002781",
+    "RA2703"
+  )) |>
+    expect_no_warning() |>
+    expect_identical(
+      c(
+        "Ayr North",
+        "Eaglesham",
+        "Ayr North",
+        "Outside the UK"
+      )
+    )
+})
+
+test_that("Returns one value for each input value", {
+  x <- c(
+    "S20000010",
+    NA,
+    "S01000001",
+    "RA2701",
+    "invalid",
+    "S20000010"
+  )
+
+  match_area(x) |>
+    expect_length(length(x)) |>
+    expect_warning("1 non-NA input geography is not")
+})
+
+test_that("Matching is case sensitive", {
+  match_area(c("s20000010", "S20000010")) |>
+    expect_no_warning() |>
+    expect_identical(c(NA_character_, "Eaglesham"))
+})
+
+test_that("Matching is sensitive to whitespace", {
+  match_area(c(
+    " S20000010",
+    "S20000010 ",
+    "S20000010"
+  )) |>
+    expect_identical(
+      c(
+        NA_character_,
+        NA_character_,
+        "Eaglesham"
+      )
+    ) |>
+    expect_warning("2 non-NA input geographies")
+})
+
+test_that("Handles zero-length input", {
+  match_area(character()) |>
+    expect_no_warning() |>
+    expect_identical(character())
+})
+
+test_that("Coerces non-character input to character", {
+  match_area(123456789) |>
+    expect_no_warning() |>
+    expect_identical(NA_character_)
 })