From ea89f1f1c22dccc0a311a2ab32eba86067aad172 Mon Sep 17 00:00:00 2001 From: Brian Maitner Date: Tue, 22 Sep 2026 13:29:25 -0400 Subject: [PATCH 1/7] working on local implementation --- .Rbuildignore | 1 + DESCRIPTION | 2 + R/GNRS_local.R | 80 ++++- R/GNRS_local_citations.R | 7 +- R/local_build.R | 14 + R/local_cache.R | 33 ++ R/local_history.R | 221 ++++++++++++ R/local_history_assemble.R | 265 +++++++++++++++ R/local_history_resolve.R | 391 ++++++++++++++++++++++ R/local_reference.R | 14 +- data-raw/history_crosswalk.R | 250 ++++++++++++++ inst/extdata/SOURCES.md | 27 ++ inst/extdata/history_codes.csv | 63 ++++ inst/extdata/history_curated_entities.csv | 22 ++ inst/extdata/history_curated_lineage.csv | 58 ++++ inst/extdata/history_curated_names.csv | 112 +++++++ inst/extdata/history_curated_periods.csv | 30 ++ inst/extdata/history_current_entities.csv | 251 ++++++++++++++ inst/extdata/history_geonames_names.csv | 250 ++++++++++++++ tests/testthat/helper-local.R | 18 + tests/testthat/test-local-gadm.R | 1 + tests/testthat/test-local-history.R | 116 +++++++ tests/testthat/test-local-resolve.R | 19 +- 23 files changed, 2232 insertions(+), 13 deletions(-) create mode 100644 R/local_history.R create mode 100644 R/local_history_assemble.R create mode 100644 R/local_history_resolve.R create mode 100644 data-raw/history_crosswalk.R create mode 100644 inst/extdata/SOURCES.md create mode 100644 inst/extdata/history_codes.csv create mode 100644 inst/extdata/history_curated_entities.csv create mode 100644 inst/extdata/history_curated_lineage.csv create mode 100644 inst/extdata/history_curated_names.csv create mode 100644 inst/extdata/history_curated_periods.csv create mode 100644 inst/extdata/history_current_entities.csv create mode 100644 inst/extdata/history_geonames_names.csv create mode 100644 tests/testthat/test-local-history.R diff --git a/.Rbuildignore b/.Rbuildignore index fd42ca0..9b757e4 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -8,3 +8,4 @@ ^CRAN-RELEASE$ ^dev_notes$ ^\.github$ +^data-raw$ diff --git a/DESCRIPTION b/DESCRIPTION index a87431e..e9c5446 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -19,6 +19,8 @@ Imports: tools, utils Suggests: + countrycode, + cshapes, DBI, RSQLite, sf, diff --git a/R/GNRS_local.R b/R/GNRS_local.R index cfcc0a6..33e31b3 100644 --- a/R/GNRS_local.R +++ b/R/GNRS_local.R @@ -24,9 +24,28 @@ #' the size and asks first. In a script it is therefore FALSE and nothing is #' downloaded silently: the function reports what is missing and the call that #' would fix it. Set it to TRUE to allow an unattended build. +#' @param history Historical political divisions: \code{"all"} (the default; +#' also matches former countries such as the USSR, Yugoslavia or +#' Czechoslovakia, flagging such matches, so a record named with a political +#' division that was ever accurate resolves), \code{"current"} (today's +#' divisions only, as the web service does), or \code{"at_date"} (as "all", +#' but a former country is accepted only if it existed at the record's date, +#' taken from an optional \code{date} column of years or ISO dates; a name +#' marked as former, such as "Former USSR", is accepted for any later date, +#' and a state or county that resolves within a successor is kept and flagged +#' whatever the date). Needs the \code{"history"} component, which is built +#' from tables shipped with the package and downloads nothing. +#' @param tolerance_years With \code{history = "at_date"}, how many years +#' either side of a former country's existence a record date may fall. #' @param quiet Suppress progress messages? #' @return A data.frame with the same columns as \code{GNRS()}, one row per -#' input row in input order. Scores are numeric rather than the character +#' input row in input order. With \code{history} other than "current", +#' further columns: \code{entity_key}, \code{is_historical}, +#' \code{entity_valid_from}, \code{entity_valid_to}, \code{successors} (the +#' current countries descending from a matched former country), +#' \code{subnational_resolved_in} and \code{subnational_status} (a state or +#' county given under a former country is looked up within its successors; +#' "unverifiable" if none contains it), and \code{date_check}. Scores are numeric rather than the character #' strings the web service returns; identifiers are character, as the web #' service returns them; empty values are "". #' @note \strong{This is a new implementation and should be treated as beta.} @@ -67,7 +86,10 @@ GNRS_local <- function(political_division_dataframe, alternate_names = TRUE, dir = gnrs_cache_dir(), build_missing = interactive(), + history = c("all", "current", "at_date"), + tolerance_years = 1, quiet = FALSE) { + history <- match.arg(history) if (!inherits(political_division_dataframe, "data.frame")) { stop("political_division_dataframe should be a data.frame", call. = FALSE) } @@ -81,10 +103,45 @@ GNRS_local <- function(political_division_dataframe, input <- gnrs_check_input(political_division_dataframe) + dates <- if (history == "at_date") { + if (!"date" %in% names(political_division_dataframe)) { + message("history = \"at_date\" but no date column: former countries are matched without a date check.") + NULL + } else { + gnrs_parse_record_date(political_division_dataframe$date) + } + } else { + NULL + } + sources <- if (alternate_names) c("gnrs", "geonames") else "gnrs" if (!gnrs_require_sources(sources, dir = dir, build_missing = build_missing, quiet = quiet)) { return(invisible(NULL)) } + # The history component is assembled from the curation shipped with the package and + # the user's own copy of CShapes (nothing derived from CShapes ships: it is CC BY-NC-SA + # 4.0 and the package is MIT). With the cshapes package installed that downloads + # nothing, so it happens on first use as it always did; without it CShapes has to be + # downloaded, which follows build_missing like every other download. + if (history != "current" && !gnrs_is_built("history", dir)) { + need <- c("sf", "countrycode")[!vapply(c("sf", "countrycode"), requireNamespace, logical(1), quietly = TRUE)] + if (length(need)) { + message("history = \"", history, "\" needs the ", paste(need, collapse = " and "), + " package", if (length(need) > 1) "s" else "", ". Install ", + if (length(need) > 1) "them" else "it", ", or call again with history = \"current\".") + return(invisible(NULL)) + } + if (!gnrs_is_built("cshapes", dir)) { + if (requireNamespace("cshapes", quietly = TRUE)) { + if (!quiet) message("Building the CShapes component from the cshapes package (no download) ...") + gnrs_build_cshapes(dir = dir, quiet = TRUE) + } else if (!gnrs_require_sources("cshapes", dir = dir, build_missing = build_missing, quiet = quiet)) { + return(invisible(NULL)) + } + } + if (!quiet) message("Building the history component (no download) ...") + gnrs_build_history(dir = dir, quiet = TRUE) + } if (!alternate_names && gnrs_is_built("geonames", dir)) { # Built but not wanted: the name table on disk includes the GeoNames # names, so they are set aside when loading @@ -113,10 +170,25 @@ GNRS_local <- function(political_division_dataframe, if (!quiet && nrow(u) > 0) { message("Resolving ", nrow(u), " distinct political division", if (nrow(u) == 1) "" else "s", " ...") } - resolved <- gnrs_resolve(u, bb, threshold = threshold) - m <- match(key, key[distinct]) - gnrs_build_output(resolved[m, , drop = FALSE], input, threshold) + if (history == "current") { + resolved <- gnrs_resolve(u, bb, threshold = threshold) + return(gnrs_build_output(resolved[m, , drop = FALSE], input, threshold)) + } + + r <- gnrs_resolve_history(u, m, dates, bb, dir = dir, threshold = threshold, + history = history, tolerance_years = tolerance_years) + out <- gnrs_build_output(r, input, threshold) + chr <- function(x) { x <- as.character(x); x[is.na(x)] <- ""; x } + out$entity_key <- chr(r$entity_key) + out$is_historical <- r$is_historical + out$entity_valid_from <- chr(r$entity_valid_from) + out$entity_valid_to <- chr(r$entity_valid_to) + out$successors <- chr(r$successors) + out$subnational_resolved_in <- chr(r$subnational_resolved_in) + out$subnational_status <- chr(r$subnational_status) + out$date_check <- chr(r$date_check) + out } #' Check the submitted data.frame and put it in a standard form diff --git a/R/GNRS_local_citations.R b/R/GNRS_local_citations.R index 93e83ab..1a0a053 100644 --- a/R/GNRS_local_citations.R +++ b/R/GNRS_local_citations.R @@ -108,11 +108,16 @@ GNRS_local_citations <- function(dir = gnrs_cache_dir(), bibtex_file = NULL, qui "GeoNames. Gazetteer (allCountries), file dated ", version, ". https://www.geonames.org/ (CC BY 4.0). Accessed ", accessed, "." ) - } else { + } else if (source %in% c("history", "cshapes")) { + # the registry carries the full citation for these components + paste0(spec$citation, if (!is.na(accessed)) paste0(" Built ", accessed, ".") else "") + } else if (source == "geonames") { paste0( "GeoNames. Alternate names (alternateNamesV2), file dated ", version, ". https://www.geonames.org/ (CC BY 4.0). Accessed ", accessed, "." ) + } else { + paste0(spec$full_name, ". ", spec$citation %||% spec$url) } rows[[length(rows) + 1]] <- data.frame( what = "source", name = spec$full_name, version = version, diff --git a/R/local_build.R b/R/local_build.R index 070f470..cad9dd8 100644 --- a/R/local_build.R +++ b/R/local_build.R @@ -111,6 +111,10 @@ GNRS_local_build <- function(sources = c("gnrs", "geonames"), # The reference tables come first whatever order was given, then the # alternate names and the coordinates, then the GADM layer, whose linking # uses the alternate names and the coordinates when it has them + # The history component checks its names against the assembled name table, so it + # is built last; CShapes geometry is independent of the other components + history_wanted <- "history" %in% sources + cshapes_wanted <- "cshapes" %in% sources sources <- intersect(c("gnrs", "geonames", "points", "gadm"), sources) if (!dir.exists(dir)) { @@ -159,6 +163,16 @@ GNRS_local_build <- function(sources = c("gnrs", "geonames"), if (gnrs_is_built("gnrs", dir)) { gnrs_assemble_names(dir = dir, quiet = quiet) } + # the history component is derived from CShapes at build time, so it needs CShapes + # built even when only "history" was asked for (without rebuilding an existing copy) + if ((cshapes_wanted && (overwrite || !gnrs_is_built("cshapes", dir))) || + (history_wanted && !gnrs_is_built("cshapes", dir))) { + gnrs_build_cshapes(dir = dir, quiet = quiet) + } + if (history_wanted && (overwrite || !gnrs_is_built("history", dir))) { + if (!quiet) message("Building the history component ...") + gnrs_build_history(dir = dir, quiet = quiet) + } gnrs_forget_backbone() status <- suppressMessages(GNRS_local_status(dir)) diff --git a/R/local_cache.R b/R/local_cache.R index c116695..18b8784 100644 --- a/R/local_cache.R +++ b/R/local_cache.R @@ -85,6 +85,37 @@ gnrs_builtin_registry <- function() { download_mb = 195, disk_mb = 8 ), + history = list( + source = "history", + full_name = "Historical political divisions (entities, names, lineage)", + publisher = "Botanical Information and Ecology Network", + url = "shipped with the package", + license = "Curated tables: package licence; names from GeoNames (CC BY 4.0), CShapes 2.0 (CC BY-NC-SA 4.0), Unicode CLDR, ISO 3166-3 (Debian iso-codes)", + citation = paste( + "Historical country entities, names and lineage compiled for GNRS from CShapes 2.0", + "(Schvitz et al. 2022, Journal of Conflict Resolution 66: 144-161), GeoNames, Unicode CLDR", + "and ISO 3166-3." + ), + # Built from tables shipped with the package; nothing is downloaded + download_mb = 0, + disk_mb = 1 + ), + cshapes = list( + source = "cshapes", + full_name = "CShapes 2.0 historical state boundaries", + publisher = "International Conflict Research, ETH Zurich", + version = "2.0", + url = "https://icr.ethz.ch/data/cshapes/CShapes-2.0.geojson", + license = "CC BY-NC-SA 4.0", + citation = paste( + "Schvitz G., Girardin L., Ruegger S., Weidmann N. B., Cederman L.-E. & Gleditsch K. S.", + "(2022). Mapping the International System, 1886-2019: The CShapes 2.0 Dataset.", + "Journal of Conflict Resolution 66(1): 144-161." + ), + # Read from the cshapes package when installed; otherwise the GeoJSON + download_mb = 60, + disk_mb = 25 + ), points = list( source = "points", full_name = "GeoNames coordinates", @@ -183,6 +214,8 @@ gnrs_is_built <- function(source, dir = gnrs_cache_dir()) { gadm = file.exists(gnrs_gadm_path(dir)), geonames = file.exists(gnrs_altnames_path(dir)), points = file.exists(gnrs_points_path(dir)), + history = file.exists(gnrs_history_path("entities", dir)), + cshapes = file.exists(gnrs_cshapes_versions_path(dir)), FALSE ) } diff --git a/R/local_history.R b/R/local_history.R new file mode 100644 index 0000000..b425475 --- /dev/null +++ b/R/local_history.R @@ -0,0 +1,221 @@ +#' Historical political divisions: the CShapes component +#' +#' Internal. Part of the time-versioned division reference shared by GNRS and +#' GVS (dev_notes/03 and 04). Either package can build it; the code here is kept +#' identical in both. +#' +#' CShapes 2.0 (Schvitz et al. 2022) gives the borders of independent states and +#' dependencies from 1886 to 2019, one row per country-period with start and end +#' dates. It codes STATES, not names: Gleditsch & Ward code 365 "Russia (Soviet +#' Union)" runs from 1886 to 2019 in 24 periods, so the Russian Empire, the USSR +#' and the Russian Federation share it. Entities (the USSR as a named division) +#' are assigned to periods by the crosswalk, not here. +#' +#' Licence: CC BY-NC-SA 4.0. The data are read from the `cshapes` package when +#' it is installed, otherwise downloaded on the user's machine; nothing derived is +#' shipped with the package. +#' @keywords internal +#' @noRd +gnrs_cshapes_spec <- function() { + list( + source = "cshapes", + full_name = "CShapes 2.0 historical state boundaries", + publisher = "International Conflict Research, ETH Zurich", + version = "2.0", + url = "https://icr.ethz.ch/data/cshapes/CShapes-2.0.geojson", + license = "CC BY-NC-SA 4.0", + citation = paste( + "Schvitz G., Girardin L., Ruegger S., Weidmann N. B., Cederman L.-E. &", + "Gleditsch K. S. (2022). Mapping the International System, 1886-2019:", + "The CShapes 2.0 Dataset. Journal of Conflict Resolution 66(1): 144-161.", + "https://doi.org/10.1177/00220027211013563" + ), + download_mb = 60, + disk_mb = 25 + ) +} + +#' @keywords internal +#' @noRd +gnrs_cshapes_versions_path <- function(dir = gnrs_cache_dir()) { + file.path(dir, "cshapes-versions.gz.parquet") +} + +#' @keywords internal +#' @noRd +gnrs_cshapes_geom_path <- function(dir = gnrs_cache_dir()) { + file.path(dir, "cshapes-geometry.gpkg") +} + +#' Read CShapes 2.0 as sf, from the cshapes package or the publisher +#' @keywords internal +#' @noRd +gnrs_read_cshapes <- function(dir = gnrs_cache_dir(), quiet = FALSE) { + if (requireNamespace("cshapes", quietly = TRUE)) { + if (!quiet) message("Reading CShapes 2.0 from the cshapes package ...") + return(cshapes::cshp(date = NA, useGW = TRUE, dependencies = TRUE)) + } + spec <- gnrs_cshapes_spec() + f <- file.path(dir, "cshapes-2.0.geojson") + if (!file.exists(f)) { + if (!quiet) message("Downloading ", spec$full_name, " (about ", spec$download_mb, " MB) ...") + partial <- paste0(f, ".part") + status <- utils::download.file(spec$url, partial, mode = "wb", quiet = quiet) + if (status != 0) { + unlink(partial) + stop("Download failed for CShapes.", call. = FALSE) + } + file.rename(partial, f) + } + x <- sf::st_read(f, quiet = TRUE) + # the geojson spells the Gleditsch & Ward code and dates like the package does + x$start <- as.Date(x$gwsdate %||% x$start) + x$end <- as.Date(x$gwedate %||% x$end) + x +} + +#' Build the CShapes component: one row per country-period, with its six centroids +#' +#' Internal. Writes +#' \itemize{ +#' \item \code{cshapes-versions.gz.parquet}: version_id, gwcode, country_name, +#' valid_from, valid_to, status, owner, capital name and coordinates, b_def, +#' area_km2, and the six planar centroids with their maximum distances +#' (\code{c1_lon} ... \code{c6_dmax}), exactly as GVS computes them for GADM; +#' \item \code{cshapes-geometry.gpkg}: the polygons, keyed by version_id. +#' } +#' @keywords internal +#' @noRd +gnrs_build_cshapes <- function(dir = gnrs_cache_dir(create = TRUE), quiet = FALSE) { + for (pkg in c("sf", "nanoparquet")) { + if (!requireNamespace(pkg, quietly = TRUE)) { + stop("Building the CShapes component needs the '", pkg, "' package.", call. = FALSE) + } + } + x <- gnrs_read_cshapes(dir = dir, quiet = quiet) + n <- nrow(x) + version_id <- sprintf("cshapes:%d:%s", as.integer(x$gwcode), format(as.Date(x$start))) + if (anyDuplicated(version_id)) stop("CShapes version ids are not unique.", call. = FALSE) + + old_s2 <- sf::sf_use_s2() + on.exit(suppressMessages(sf::sf_use_s2(old_s2)), add = TRUE) + # Repair with GEOS, not s2: s2's st_make_valid re-expresses polygons that cross the + # antimeridian with longitudes beyond 180 (Russia's planar centroid came out at + # 214.8 degrees instead of 96.8), which breaks point-in-polygon and the planar + # centroids GVS compares against GADM. Area is then ellipsoidal (lwgeom), because + # s2 rejects some unrepaired CShapes rings (degenerate edges). + suppressMessages(sf::sf_use_s2(FALSE)) + x <- sf::st_make_valid(x) + area_km2 <- suppressWarnings(as.numeric(sf::st_area(x)) / 1e6) + bb <- sf::st_bbox(x) + if (bb[["xmin"]] < -180 || bb[["xmax"]] > 180 || bb[["ymin"]] < -90 || bb[["ymax"]] > 90) { + stop("CShapes geometry outside WGS84 longitude/latitude bounds after repair.", call. = FALSE) + } + + if (!quiet) message("Deriving centroids for ", n, " country-periods ...") + cents <- gnrs_six_centroids(sf::st_geometry(x)) + + attrs <- sf::st_drop_geometry(x) + versions <- data.frame( + version_id = version_id, + gwcode = as.integer(attrs$gwcode), + country_name = attrs$country_name, + valid_from = as.Date(attrs$start), + valid_to = as.Date(attrs$end), + status = attrs$status, + owner = suppressWarnings(as.integer(attrs$owner)), + capital = attrs$capname, + capital_lon = attrs$caplong, + capital_lat = attrs$caplat, + border_defined = as.integer(attrs$b_def), + area_km2 = round(area_km2, 1), + stringsAsFactors = FALSE + ) + versions <- cbind(versions, cents) + nanoparquet::write_parquet(versions, gnrs_cshapes_versions_path(dir), compression = "gzip") + + g <- sf::st_sf(version_id = version_id, geometry = sf::st_geometry(x)) + unlink(gnrs_cshapes_geom_path(dir)) + sf::st_write(g, gnrs_cshapes_geom_path(dir), layer = "country", quiet = TRUE) + + spec <- gnrs_cshapes_spec() + provenance <- list( + source = spec$source, full_name = spec$full_name, version = spec$version, + url = spec$url, license = spec$license, citation = spec$citation, + downloaded = as.character(Sys.Date()), + via = if (requireNamespace("cshapes", quietly = TRUE)) { + paste("cshapes package", as.character(utils::packageVersion("cshapes"))) + } else { + "publisher download" + }, + n_versions = n, + n_states = length(unique(versions$gwcode)), + first_date = as.character(min(versions$valid_from)), + last_date = as.character(max(versions$valid_to)) + ) + saveRDS(provenance, gnrs_provenance_path("cshapes", dir)) + if (!quiet) { + message(" ", n, " country-periods of ", provenance$n_states, " states, ", + provenance$first_date, " to ", provenance$last_date) + } + invisible(provenance) +} + +#' The six GVS centroids of each (multi)polygon +#' +#' Internal. Identical to RGVS's \code{gvs_six_centroids()}: centre of mass, +#' point on surface and bounding-box centre, for the whole division and for its +#' largest part, each with the greatest planar distance from it to the WHOLE +#' division's vertices. Planar WGS84 throughout, including across the +#' antimeridian, deliberately: GVS detects centroids that users computed naively. +#' @keywords internal +#' @noRd +gnrs_six_centroids <- function(geom) { + n <- length(geom) + out <- matrix(NA_real_, n, 18) + main <- gnrs_largest_part(geom) + for (half in 1:2) { + g <- if (half == 1) geom else main + cent <- suppressWarnings(sf::st_coordinates(sf::st_centroid(g))) + pos <- suppressWarnings(sf::st_coordinates(sf::st_point_on_surface(g))) + bb <- vapply(g, function(x) { + b <- sf::st_bbox(x) + c((b[["xmin"]] + b[["xmax"]]) / 2, (b[["ymin"]] + b[["ymax"]]) / 2) + }, numeric(2)) + types <- list(cent[, 1:2, drop = FALSE], pos[, 1:2, drop = FALSE], t(bb)) + for (k in seq_along(types)) { + col <- (half - 1) * 9 + (k - 1) * 3 + 1 + out[, col] <- types[[k]][, 1] + out[, col + 1] <- types[[k]][, 2] + out[, col + 2] <- gnrs_max_vertex_distance(geom, types[[k]]) + } + } + colnames(out) <- paste0("c", rep(1:6, each = 3), c("_lon", "_lat", "_dmax")) + as.data.frame(out) +} + +#' @keywords internal +#' @noRd +gnrs_largest_part <- function(geom) { + parts <- lapply(geom, function(g) { + pieces <- suppressWarnings(sf::st_cast(sf::st_sfc(g), "POLYGON")) + if (length(pieces) <= 1) { + return(g) + } + areas <- suppressWarnings(as.numeric(sf::st_area(sf::st_set_crs(pieces, NA)))) + pieces[[which.max(areas)]] + }) + sf::st_sfc(parts, crs = sf::st_crs(geom)) +} + +#' @keywords internal +#' @noRd +gnrs_max_vertex_distance <- function(geom, centres) { + vapply(seq_along(geom), function(i) { + xy <- sf::st_coordinates(sf::st_sfc(geom[[i]])) + if (!nrow(xy) || any(is.na(centres[i, ]))) { + return(NA_real_) + } + max(sqrt((xy[, 1] - centres[i, 1])^2 + (xy[, 2] - centres[i, 2])^2)) + }, numeric(1)) +} diff --git a/R/local_history_assemble.R b/R/local_history_assemble.R new file mode 100644 index 0000000..cd1eb6b --- /dev/null +++ b/R/local_history_assemble.R @@ -0,0 +1,265 @@ +# =========================================================================== +# Assembling the history tables at build time +# +# CShapes 2.0 is CC BY-NC-SA 4.0 and this package is MIT, so nothing derived from +# CShapes ships with it (BM, 2026-09-22). The package carries only the curation +# (inst/extdata, from data-raw/history_crosswalk.R) and extracts from +# redistributable sources. Everything that depends on CShapes - the periods of +# every state code the curation does not assign, the synthetic CSH +# entities and their names, the coverage check, and the lineage derived from +# CShapes geometry - is computed here from the user's own copy of CShapes, which +# GNRS_local_build("cshapes") puts in the cache. +# +# This reproduces what data-raw/history_crosswalk.R computed before 2026-09-22 +# step for step; the test suite checks the result against those tables. +# =========================================================================== + +#' Minimum share of a predecessor's area a successor must receive to be linked +#' @keywords internal +#' @noRd +gnrs_history_min_share <- function() 0.05 + +#' Days after a predecessor ends within which a successor may first appear +#' +#' Successor states often appear weeks after the predecessor ends +#' (Austria-Hungary ended 1918-11-02; Czechoslovakia starts 1918-11-11). +#' @keywords internal +#' @noRd +gnrs_history_window_days <- function() 365 + +#' Names kept out of fuzzy matching +#' +#' Short former names that are prefixes or near-duplicates of other entities' +#' names ("Rhodesia": "N. Rhodesia", which is Zambia, fuzzy-matched it). +#' @keywords internal +#' @noRd +gnrs_history_exact_only_names <- function() c("Rhodesia") + +#' Assemble the history tables from the curation and the cached CShapes +#' +#' Internal. Returns a list of data frames - \code{ent}, \code{nm}, \code{lin}, +#' \code{per}, \code{codes} - with the columns and types of the tables that +#' previously shipped in inst/extdata, so \code{gnrs_build_history()} treats them +#' exactly as it treated those. +#' @keywords internal +#' @noRd +gnrs_history_assemble <- function(dir = gnrs_cache_dir(), quiet = FALSE) { + for (pkg in c("sf", "countrycode")) { + if (!requireNamespace(pkg, quietly = TRUE)) { + stop("Building the history component needs the '", pkg, "' package.", call. = FALSE) + } + } + if (!file.exists(gnrs_cshapes_versions_path(dir)) || !file.exists(gnrs_cshapes_geom_path(dir))) { + stop("The history component is derived from CShapes, which has not been built. ", + "Run GNRS_local_build(\"cshapes\").", call. = FALSE) + } + # Only empty cells are missing: "NA" is Namibia's ISO code + rd <- function(f) utils::read.csv(gnrs_extdata(f), stringsAsFactors = FALSE, encoding = "UTF-8", + na.strings = "", colClasses = "character") + num <- function(x) as.integer(x) + day <- function(x) as.Date(x) + + # ---- current entities: the snapshot shipped with the curation --------------- + # Fixed with the curation, as it always was: which uncurated state codes map to a + # current country depends on this list, so it must not drift with the user's backbone. + cur <- rd("history_current_entities.csv") + cur$valid_from <- day(cur$valid_from) + cur$valid_to <- day(cur$valid_to) + + # ---- curated historical entities ------------------------------------------- + hist <- rd("history_curated_entities.csv") + hist$valid_from <- day(hist$valid_from) + hist$valid_to <- day(hist$valid_to) + + # ---- CShapes, from the cache ------------------------------------------------- + csd <- as.data.frame(nanoparquet::read_parquet(gnrs_cshapes_versions_path(dir))) + csd <- data.frame(version_id = csd$version_id, gwcode = as.integer(csd$gwcode), + country_name = csd$country_name, start = day(csd$valid_from), + end = day(csd$valid_to), stringsAsFactors = FALSE) + by_gw <- split(seq_len(nrow(csd)), csd$gwcode) + g <- data.frame( + gwcode = as.integer(names(by_gw)), + first = as.Date(vapply(by_gw, function(i) as.numeric(min(csd$start[i])), numeric(1)), origin = "1970-01-01"), + last = as.Date(vapply(by_gw, function(i) as.numeric(max(csd$end[i])), numeric(1)), origin = "1970-01-01"), + cs_name = vapply(by_gw, function(i) csd$country_name[i][which.max(csd$end[i])], character(1)), + stringsAsFactors = FALSE + ) + g$iso2 <- suppressWarnings(countrycode::countrycode(g$gwcode, "gwn", "iso2c", warn = FALSE)) + + # ---- state code -> entity over periods --------------------------------------- + # curated assignments; every other code follows countrycode when it gives a current + # country, else becomes a synthetic entity CSH + cp <- rd("history_curated_periods.csv") + curated_periods <- data.frame(gwcode = num(cp$gwcode), from = day(cp$from), to = day(cp$to), + entity_key = cp$entity_key, note = cp$note, basis = cp$basis, + stringsAsFactors = FALSE) + auto <- g[!g$gwcode %in% curated_periods$gwcode, , drop = FALSE] + auto$entity_key <- ifelse(!is.na(auto$iso2) & auto$iso2 %in% cur$entity_key, auto$iso2, + paste0("CSH", auto$gwcode)) + syn <- startsWith(auto$entity_key, "CSH") + auto_periods <- data.frame(gwcode = auto$gwcode, from = auto$first, to = auto$last, + entity_key = auto$entity_key, + note = ifelse(syn, paste("synthetic entity:", auto$cs_name), NA_character_), + basis = ifelse(syn, "synthetic", "countrycode gwn->iso2c"), + stringsAsFactors = FALSE) + periods <- rbind(curated_periods, auto_periods) + periods <- periods[order(periods$gwcode, periods$from), , drop = FALSE] + + # every other CShapes state without a current country is a synthetic historical + # entity, named as CShapes names it (colonies, protectorates, former states) + synth <- data.frame(entity_key = auto$entity_key[syn], name = auto$cs_name[syn], + geonameid = NA_character_, iso3166_1 = NA_character_, iso3166_3 = NA_character_, + valid_from = auto$first[syn], valid_to = auto$last[syn], kind = "historical", + note = "synthetic entity from a CShapes state with no current country", + stringsAsFactors = FALSE) + entities <- rbind(cur, hist, synth) + if (anyDuplicated(entities$entity_key)) stop("History entity keys are not unique.", call. = FALSE) + missing_ent <- setdiff(periods$entity_key, entities$entity_key) + if (length(missing_ent)) { + stop("History periods reference unknown entities: ", paste(missing_ent, collapse = ", "), call. = FALSE) + } + + # every CShapes version must be covered by an entity period on the days it is valid + covered <- vapply(seq_len(nrow(csd)), function(i) { + any(periods$gwcode == csd$gwcode[i] & periods$from <= csd$end[i] & periods$to >= csd$start[i]) + }, logical(1)) + if (!all(covered)) { + stop("CShapes versions not covered by any entity period: ", + paste(csd$version_id[!covered], collapse = ", "), call. = FALSE) + } + + # ---- lineage --------------------------------------------------------------------- + cl <- rd("history_curated_lineage.csv") + lin <- data.frame(from_entity = cl$from_entity, to_entity = cl$to_entity, relation = cl$relation, + date = day(cl$date), source = cl$source, stringsAsFactors = FALSE) + geo_lin <- gnrs_history_geometry_lineage(dir, csd, periods, entities, lin, quiet = quiet) + lin <- rbind(lin, geo_lin) + bad <- setdiff(c(lin$from_entity, lin$to_entity), entities$entity_key) + if (length(bad)) stop("History lineage references unknown entities: ", paste(bad, collapse = ", "), call. = FALSE) + + # ---- former codes -> entity ------------------------------------------------------- + codes <- rd("history_codes.csv") + codes <- codes[codes$entity_key %in% entities$entity_key, , drop = FALSE] + + # ---- names ------------------------------------------------------------------------- + # Names by which records refer to an entity, each with its source. The order of the + # sources matters: where two give the same name, the first keeps it. + hist_keys <- entities$entity_key[entities$kind == "historical"] + ent_names <- data.frame(entity_key = hist_keys, name = entities$name[entities$kind == "historical"], + source = "entity name", stringsAsFactors = FALSE) + curated_names <- rd("history_curated_names.csv")[, c("entity_key", "name", "source")] + cs_names <- merge(periods[, c("gwcode", "entity_key")], + data.frame(gwcode = csd$gwcode, name = csd$country_name, stringsAsFactors = FALSE), + by = "gwcode") + cs_names <- cs_names[cs_names$entity_key %in% hist_keys, c("entity_key", "name")] + cs_names$source <- "CShapes 2.0" + cs_names <- unique(cs_names) + gn <- rd("history_geonames_names.csv") + gn_names <- merge(gn, entities[!is.na(entities$geonameid), c("geonameid", "entity_key")], by = "geonameid") + gn_names <- gn_names[nzchar(gn_names$name), c("entity_key", "name")] + gn_names$source <- "GeoNames (CC BY 4.0)" + iso_names <- unique(data.frame(entity_key = codes$entity_key, name = codes$name, source = "ISO 3166-3", + stringsAsFactors = FALSE)) + hnames <- rbind(ent_names, curated_names, cs_names, gn_names, iso_names) + hnames <- hnames[!duplicated(hnames[, c("entity_key", "name")]), , drop = FALSE] + hnames <- hnames[nzchar(trimws(hnames$name)), , drop = FALSE] + # fuzzy: may this name take part in GNRS fuzzy matching? Exact-only for names of + # synthetic entities made from CShapes colonies (obscure names that drew fuzzy matches + # from current countries on GBIF data: "Northern Rhodesia> Zambia" -> "Northeastern + # Rhodesia") and for short former names that are near-duplicates of other entities' + hnames$fuzzy <- !grepl("^CSH[0-9]+$", hnames$entity_key) & + !(hnames$name %in% gnrs_history_exact_only_names()) + bad <- setdiff(hnames$entity_key, entities$entity_key) + if (length(bad)) stop("History names reference unknown entities: ", paste(bad, collapse = ", "), call. = FALSE) + + if (!quiet) { + message(" from CShapes: ", nrow(synth), " synthetic entities, ", sum(periods$basis != "curated"), + " uncurated state-code periods, ", nrow(geo_lin), " geometry-derived lineage links") + } + lapply(list(ent = entities, nm = hnames, lin = lin, per = periods, codes = codes), gnrs_csv_types) +} + +#' Successors of historical entities without curated lineage, from CShapes geometry +#' +#' Internal. Mostly CShapes colonies and protectorates: the entity's last polygon +#' is intersected with the CShapes versions valid on the day after it ends, or, for +#' states with no such version, their first version starting within +#' \code{gnrs_history_window_days()}; every successor receiving at least +#' \code{gnrs_history_min_share()} of its area is linked. Shares are planar in +#' degrees, adequate for apportioning one territory among neighbours. Geometry is +#' used here only. +#' @keywords internal +#' @noRd +gnrs_history_geometry_lineage <- function(dir, csd, periods, entities, lin, quiet = FALSE) { + min_share <- gnrs_history_min_share() + window <- gnrs_history_window_days() + old_s2 <- sf::sf_use_s2() + on.exit(suppressMessages(sf::sf_use_s2(old_s2)), add = TRUE) + suppressMessages(sf::sf_use_s2(FALSE)) + + cs <- sf::st_read(gnrs_cshapes_geom_path(dir), layer = "country", quiet = TRUE) + m <- match(cs$version_id, csd$version_id) + if (anyNA(m)) stop("CShapes geometry and versions disagree; rebuild the CShapes component.", call. = FALSE) + cs$gwcode <- csd$gwcode[m] + cs$start <- csd$start[m] + cs$end <- csd$end[m] + + ent_of <- function(gw, d) { + hit <- periods$entity_key[periods$gwcode == gw & periods$from <= d & periods$to >= d] + if (length(hit)) hit[1] else NA_character_ + } + need <- setdiff(entities$entity_key[entities$kind == "historical"], lin$from_entity) + out <- list() + for (ek in need) { + pr <- periods[periods$entity_key == ek, , drop = FALSE] + if (!nrow(pr)) next + last_day <- max(pr$to) + if (last_day >= as.Date("2019-12-31")) next + last_v <- cs[cs$gwcode %in% pr$gwcode & cs$start <= last_day & cs$end >= last_day, ] + if (!nrow(last_v)) next + # planar on purpose (see above); sf says so on every call, so it is silenced + pred <- suppressMessages(sf::st_union(sf::st_make_valid(sf::st_geometry(last_v)))) + a0 <- as.numeric(sf::st_area(sf::st_set_crs(pred, NA))) + on_day <- cs$start <= last_day + 1 & cs$end >= last_day + 1 + soon <- cs$start > last_day + 1 & cs$start <= last_day + window & !(cs$gwcode %in% cs$gwcode[on_day]) + nxt <- cs[on_day | soon, ] + nxt <- nxt[order(nxt$gwcode, nxt$start), ] + nxt <- nxt[!duplicated(nxt$gwcode), ] + nxt <- nxt[lengths(suppressMessages(sf::st_intersects(nxt, pred))) > 0, ] + if (!nrow(nxt)) next + inter <- suppressMessages(suppressWarnings(sf::st_intersection(sf::st_make_valid(sf::st_geometry(nxt)), pred))) + share <- as.numeric(sf::st_area(sf::st_set_crs(inter, NA))) / a0 + keep <- share >= min_share + if (!any(keep)) next + gw <- nxt$gwcode[keep] + d <- pmax(last_day + 1, nxt$start[keep]) + to <- vapply(seq_along(gw), function(i) ent_of(gw[i], d[i]), character(1)) + ok <- !is.na(to) & to != ek + if (!any(ok)) next + s <- tapply(share[keep][ok], factor(to[ok], levels = unique(to[ok])), sum) + out[[ek]] <- data.frame(from_entity = ek, to_entity = names(s), relation = "territory_to", + date = last_day + 1, source = sprintf("CShapes geometry overlap (share %.2f)", as.numeric(s)), + stringsAsFactors = FALSE) + } + if (!length(out)) { + return(data.frame(from_entity = character(0), to_entity = character(0), relation = character(0), + date = as.Date(character(0)), source = character(0), stringsAsFactors = FALSE)) + } + do.call(rbind, unname(out)) +} + +#' Give a table the column types it would have if read back from CSV +#' +#' Internal. gnrs_build_history() was written against tables read from shipped +#' CSVs (dates and codes as text, identifiers as integers); a round trip through a +#' temporary CSV reproduces those types exactly, so the cache is unchanged by the +#' move from shipped tables to tables assembled at build time. +#' @keywords internal +#' @noRd +gnrs_csv_types <- function(x) { + f <- tempfile(fileext = ".csv") + on.exit(unlink(f), add = TRUE) + for (j in seq_along(x)) if (inherits(x[[j]], "Date")) x[[j]] <- format(x[[j]]) + utils::write.csv(x, f, row.names = FALSE, na = "", fileEncoding = "UTF-8") + utils::read.csv(f, stringsAsFactors = FALSE, encoding = "UTF-8", na.strings = "") +} diff --git a/R/local_history_resolve.R b/R/local_history_resolve.R new file mode 100644 index 0000000..4db9fee --- /dev/null +++ b/R/local_history_resolve.R @@ -0,0 +1,391 @@ +# =========================================================================== +# The history component: entities, names, lineage, CShapes periods and former +# codes, assembled at build time from the curation shipped in inst/extdata +# (data-raw/history_crosswalk.R) and the user's cached CShapes +# (gnrs_history_assemble(), R/local_history_assemble.R), and resolution against them. +# =========================================================================== + +#' Path of a shipped history table +#' +#' Internal. In an installed package these are under inst/extdata; while +#' developing from source, set \code{options(GNRS.extdata_dir = )}. +#' @keywords internal +#' @noRd +gnrs_extdata <- function(file) { + dev <- getOption("GNRS.extdata_dir") + if (!is.null(dev)) { + return(file.path(dev, file)) + } + path <- system.file("extdata", file, package = "GNRS") + if (!nzchar(path)) stop("History table not found in the package: ", file, call. = FALSE) + path +} + +#' @keywords internal +#' @noRd +gnrs_history_path <- function(table, dir = gnrs_cache_dir()) { + file.path(dir, paste0("history-", table, ".gz.parquet")) +} + +#' First identifier of the range reserved for entities without a GeoNames id +#' +#' GeoNames identifiers are below 13 million; the reserved range starts well above. +#' @keywords internal +#' @noRd +gnrs_history_synthetic_base <- function() 990000000L + +#' Build the history component +#' +#' Internal. Assembles the tables (gnrs_history_assemble()), gives every entity a numeric identifier +#' (its GeoNames id where it has one, so results join to GeoNames and to the web +#' service; otherwise one in a reserved range, stable across builds because it is +#' assigned in order of entity key), and writes them to the cache. No download, +#' but it needs the CShapes component built first. +#' +#' Names that collide with a CURRENT country's standard or alternate name are +#' handled so that a current country wins ties: a colliding name from a +#' non-curated source is dropped; a colliding curated name is kept and reported, +#' because it was added deliberately. +#' @keywords internal +#' @noRd +gnrs_build_history <- function(dir = gnrs_cache_dir(create = TRUE), quiet = FALSE) { + # Nothing derived from CShapes ships (it is CC BY-NC-SA 4.0; the package is MIT): + # the tables are assembled here from the curation and the user's cached CShapes. + h <- gnrs_history_assemble(dir = dir, quiet = quiet) + ent <- h$ent + nm <- h$nm + lin <- h$lin + per <- h$per + codes <- h$codes + + synth <- sort(ent$entity_key[is.na(ent$geonameid)]) + ent$entity_id <- suppressWarnings(as.integer(ent$geonameid)) + no_id <- is.na(ent$entity_id) + ent$entity_id[no_id] <- gnrs_history_synthetic_base() + match(ent$entity_key[no_id], synth) + if (anyDuplicated(ent$entity_id)) stop("History entity identifiers are not unique.", call. = FALSE) + ent$short_name <- sub(" \\(.*\\)$", "", ent$name) + id_of <- function(k) ent$entity_id[match(k, ent$entity_key)] + + nm$entity_id <- id_of(nm$entity_key) + lin$from_id <- id_of(lin$from_entity) + lin$to_id <- id_of(lin$to_entity) + per$entity_id <- id_of(per$entity_key) + codes$entity_id <- id_of(codes$entity_key) + + # collisions with current country names (standard and GeoNames alternate) + collisions <- data.frame(entity_key = character(0), name = character(0), + source = character(0), current_country_id = integer(0)) + if (gnrs_is_built("gnrs", dir)) { + cur_country <- as.data.frame(nanoparquet::read_parquet(gnrs_reference_path("country", dir))) + cur_names <- data.frame(id = integer(0), name = character(0)) + if (file.exists(gnrs_names_path(dir))) { + x <- as.data.frame(nanoparquet::read_parquet(gnrs_names_path(dir))) + cur_names <- x[x$level == "country", c("id", "name"), drop = FALSE] + } + current_lower <- gnrs_lower(c(cur_country$country, cur_names$name)) + current_id <- c(cur_country$country_id, cur_names$id) + hit <- match(gnrs_lower(nm$name), current_lower) + clash <- !is.na(hit) & current_id[hit] != nm$entity_id + if (any(clash)) { + collisions <- nm[clash, c("entity_key", "name", "source")] + collisions$current_country_id <- current_id[hit[clash]] + } + drop <- clash & nm$source != "curated" + nm <- nm[!drop, , drop = FALSE] + if (!quiet && any(clash)) { + message(" ", sum(drop), " historical names dropped because a current country has the same name; ", + sum(clash & !drop), " curated collisions kept (see history-collisions)") + } + } + + w <- function(x, table) nanoparquet::write_parquet(x, gnrs_history_path(table, dir), compression = "gzip") + w(ent, "entities") + w(nm, "names") + w(lin, "lineage") + w(per, "periods") + w(codes, "codes") + w(collisions, "collisions") + + provenance <- list( + source = "history", full_name = "Historical political divisions (entities, names, lineage)", + version = "1", downloaded = as.character(Sys.Date()), + n_entities = nrow(ent), n_historical = sum(ent$kind == "historical"), + n_names = nrow(nm), n_lineage = nrow(lin), n_periods = nrow(per), + sources = paste("Curated; derived at build time from the user's CShapes 2.0 copy (CC BY-NC-SA 4.0,", + "not redistributed); GeoNames (CC BY 4.0); Unicode CLDR; ISO 3166-3 via Debian iso-codes") + ) + saveRDS(provenance, gnrs_provenance_path("history", dir)) + gnrs_env$history <- NULL + if (!quiet) { + message(" ", provenance$n_historical, " historical entities, ", provenance$n_names, + " names, ", provenance$n_lineage, " lineage links") + } + invisible(provenance) +} + +#' The history tables, cached for the session +#' @keywords internal +#' @noRd +gnrs_history <- function(dir = gnrs_cache_dir()) { + paths <- gnrs_history_path(c("entities", "names", "lineage", "periods"), dir) + if (!all(file.exists(paths))) { + stop("The history component has not been built. Run GNRS_local_build(\"history\").", call. = FALSE) + } + key <- paste(paths, file.mtime(paths), collapse = "|") + if (identical(gnrs_env$history_key, key) && !is.null(gnrs_env$history)) { + return(gnrs_env$history) + } + rd <- function(p) as.data.frame(nanoparquet::read_parquet(p)) + h <- list(entities = rd(paths[1]), names = rd(paths[2]), lineage = rd(paths[3]), periods = rd(paths[4])) + gnrs_env$history <- h + gnrs_env$history_key <- key + h +} + +#' The backbone with historical countries added +#' +#' Internal. Historical entities are appended to the country table and their +#' names (and former names of continuing states) to the country name table, as +#' alternate names, so the unchanged cascade finds them by exact or fuzzy +#' alternate name. They carry no ISO or GADM codes. The copy has its own match +#' cache, so indexes built for the current-only backbone are not reused. +#' @keywords internal +#' @noRd +gnrs_backbone_with_history <- function(bb, dir = gnrs_cache_dir()) { + h <- gnrs_history(dir) + he <- h$entities[h$entities$kind == "historical", , drop = FALSE] + co <- bb$country + add <- co[rep(NA_integer_, nrow(he)), , drop = FALSE] + add$country_id <- he$entity_id + add$country <- he$short_name + if ("is_geoname" %in% names(add)) add$is_geoname <- !is.na(he$geonameid) + add$lower <- gnrs_lower(add$country) + # Synthetic entities made from CShapes colonies match their standard name exactly only; + # per-name fuzzy flags for alternate names come from the shipped names table. On GBIF + # names, fuzzy matching of such names drew records away from the right current country + # ("N. Rhodesia", correctly Zambia, went to Zimbabwe via "Rhodesia"). + # synthetic keys are CSH followed by the CShapes code; note Czechoslovakia is CSHH + synthetic <- grepl("^CSH[0-9]+$", he$entity_key) + co$fuzzy <- TRUE + add$fuzzy <- !synthetic + country <- rbind(co, add) + country <- country[order(country$country_id), , drop = FALSE] + rownames(country) <- NULL + + cn <- bb$country_names + new_names <- data.frame( + level = "country", id = h$names$entity_id, name = h$names$name, + name_type = paste("historical:", h$names$source), stringsAsFactors = FALSE + ) + new_names <- new_names[!is.na(new_names$id), , drop = FALSE] + new_names$lower <- gnrs_lower(new_names$name) + new_names$original <- TRUE + # per-name decision shipped in history_names.csv (data-raw/history_crosswalk.R) + new_names$fuzzy <- as.logical(h$names$fuzzy[!is.na(h$names$entity_id)]) + cn$fuzzy <- TRUE + for (col in setdiff(names(cn), names(new_names))) new_names[[col]] <- NA + new_names <- new_names[, names(cn), drop = FALSE] + country_names <- rbind(cn, new_names) + country_names <- country_names[order(country_names$id, country_names$name), , drop = FALSE] + rownames(country_names) <- NULL + + bb2 <- bb + bb2$country <- country + bb2$country_names <- country_names + bb2$country_name_rows_by_id <- split(seq_len(nrow(country_names)), country_names$id) + bb2$cache <- new.env(parent = emptyenv()) + bb2$history_ids <- he$entity_id + bb2 +} + +#' Parse the optional date column: a year, an ISO date, or a Date +#' @keywords internal +#' @noRd +gnrs_parse_record_date <- function(x) { + if (is.null(x)) { + return(NULL) + } + if (inherits(x, "Date")) { + return(x) + } + x <- trimws(as.character(x)) + out <- rep(as.Date(NA), length(x)) + year <- !is.na(x) & grepl("^[0-9]{3,4}$", x) + if (any(year)) out[year] <- as.Date(sprintf("%04d-07-01", as.integer(x[year]))) + iso <- !is.na(x) & !year & grepl("^[0-9]{4}-[0-9]{2}", x) + # guarded: paste0(character(0), "-01") is "-01", not character(0) + if (any(iso)) out[iso] <- suppressWarnings(as.Date(substr(paste0(x[iso], "-01"), 1, 10))) + out +} + +#' Does a submitted name mark the division as former? +#' +#' Internal. "Former USSR", "Ex-USSR", "EX-YUGOSLAVIA", "Czechoslovakia (former)", +#' "formerly Zaire", and the German, Spanish and French equivalents ("ehemalige", +#' "antigua", "ancienne"). +#' @keywords internal +#' @noRd +gnrs_is_former_label <- function(x) { + x <- gnrs_unaccent(tolower(ifelse(is.na(x), "", x))) + grepl("(^|[^a-z])(former|formerly|ex|ehemalig[a-z]*|antigu[ao]s?|ancien(ne)?s?)([^a-z]|$)", x, perl = TRUE) +} + +#' Current successors of a historical entity, following the lineage to the present +#' @keywords internal +#' @noRd +gnrs_current_successors <- function(entity_id, h) { + cur <- h$entities$entity_id[h$entities$kind == "current"] + seen <- integer(0) + front <- entity_id + out <- integer(0) + while (length(front)) { + nxt <- setdiff(unique(h$lineage$to_id[h$lineage$from_id %in% front]), seen) + seen <- c(seen, nxt) + out <- c(out, intersect(nxt, cur)) + front <- setdiff(nxt, cur) + } + unique(out) +} + +#' Resolve with historical divisions +#' +#' Internal. \code{u} is the distinct-row table GNRS_local passes to +#' \code{gnrs_resolve()}; \code{m} maps input rows to it; \code{dates} are the +#' parsed input dates (or NULL). Returns the per-input-row resolution plus the +#' history columns. +#' +#' \describe{ +#' \item{history = "all"}{Resolve against current and historical countries +#' together. A current country wins an exact tie (colliding historical names +#' from non-curated sources were dropped at build).} +#' \item{history = "at_date"}{As "all", but a historical match whose validity +#' does not include the record's date (with \code{tolerance_years} either +#' side) is replaced by the current-only resolution of that row. Rows without +#' a date keep the "all" answer, flagged.} +#' } +#' A state or county submitted under a historical country is resolved within the +#' entity's current successors (the USSR's successors for "USSR" / "Kamchatka"), +#' and the successor used is reported; if none contains it, the sub-national +#' result is "unverifiable". +#' @keywords internal +#' @noRd +gnrs_resolve_history <- function(u, m, dates, bb_current, dir, threshold, history, tolerance_years = 1) { + h <- gnrs_history(dir) + bb_all <- gnrs_backbone_with_history(bb_current, dir) + + old <- gnrs_env$backbone + on.exit(gnrs_env$backbone <- old, add = TRUE) + + gnrs_env$backbone <- bb_all + r_all <- gnrs_resolve(u, bb_all, threshold = threshold) + gnrs_env$backbone <- bb_current + r_cur <- gnrs_resolve(u, bb_current, threshold = threshold) + + ent <- h$entities + is_hist_id <- function(id) !is.na(id) & id %in% bb_all$history_ids + + # ---- sub-national names under a historical country: resolve within successors + r_all$subnational_resolved_in <- NA_character_ + r_all$subnational_status <- NA_character_ + hrows <- which(is_hist_id(r_all$country_id)) + sub_rows <- hrows[!gnrs_blank(u$state_province_verbatim[hrows]) | !gnrs_blank(u$county_parish_verbatim[hrows])] + if (length(sub_rows)) { + cand <- do.call(rbind, lapply(sub_rows, function(i) { + succ <- gnrs_current_successors(r_all$country_id[i], h) + if (!length(succ)) return(NULL) + data.frame(row = i, successor_id = succ, + country_verbatim = bb_current$country$country[match(succ, bb_current$country$country_id)], + state_province_verbatim = u$state_province_verbatim[i], + county_parish_verbatim = u$county_parish_verbatim[i], stringsAsFactors = FALSE) + })) + if (!is.null(cand) && nrow(cand)) { + cand <- cand[!is.na(cand$country_verbatim), , drop = FALSE] + rs <- gnrs_resolve(cand[, c("country_verbatim", "state_province_verbatim", "county_parish_verbatim")], + bb_current, threshold = threshold) + rs$row <- cand$row + rs$successor_id <- cand$successor_id + ok <- !is.na(rs$state_province_id) + rs <- rs[ok, , drop = FALSE] + if (nrow(rs)) { + exact <- !grepl("^fuzzy", rs$match_method_state_province) + score <- ifelse(is.na(rs$match_score_state_province), 1, rs$match_score_state_province) + rs <- rs[order(rs$row, -exact, -score, rs$successor_id), , drop = FALSE] + rs <- rs[!duplicated(rs$row), , drop = FALSE] + cols <- c("state_province", "state_province_id", "county_parish", "county_parish_id", + "match_method_state_province", "match_method_county_parish", + "match_score_state_province", "match_score_county_parish", + "state_province_iso", "county_parish_iso", "gid_1", "gid_2") + cols <- intersect(cols, intersect(names(rs), names(r_all))) + r_all[rs$row, cols] <- rs[, cols] + r_all$subnational_resolved_in[rs$row] <- ent$entity_key[match(rs$successor_id, ent$entity_id)] + r_all$subnational_status[rs$row] <- "resolved in successor" + # the match level and status were summarized before the state was filled in + sv <- u$state_province_verbatim[rs$row] + cv <- u$county_parish_verbatim[rs$row] + lvl_sub <- ifelse(gnrs_blank(cv), "state_province", "county_parish") + lvl_mat <- ifelse(is.na(r_all$county_parish_id[rs$row]), "state_province", "county_parish") + r_all$poldiv_submitted[rs$row] <- lvl_sub + r_all$poldiv_matched[rs$row] <- lvl_mat + r_all$match_status[rs$row] <- ifelse(lvl_sub == lvl_mat, "full match", "partial match") + } + } + unres <- sub_rows[is.na(r_all$subnational_status[sub_rows])] + r_all$subnational_status[unres] <- "unverifiable" + } + + # ---- per input row + out <- r_all[m, , drop = FALSE] + cur_rows <- r_cur[m, , drop = FALSE] + hist_match <- is_hist_id(out$country_id) + e <- match(out$country_id, ent$entity_id) + out$entity_key <- ent$entity_key[e] + out$is_historical <- ifelse(is.na(out$country_id), NA, hist_match) + out$entity_valid_from <- ent$valid_from[e] + out$entity_valid_to <- ent$valid_to[e] + out$successors <- vapply(seq_len(nrow(out)), function(i) { + if (!isTRUE(hist_match[i])) return(NA_character_) + s <- gnrs_current_successors(out$country_id[i], h) + paste(ent$entity_key[match(s, ent$entity_id)], collapse = ";") + }, character(1)) + out$date_check <- NA_character_ + + if (history == "at_date") { + from <- as.Date(out$entity_valid_from) + to <- as.Date(out$entity_valid_to) + tol <- 365.25 * tolerance_years + has_date <- !is.null(dates) & !is.na(dates) + if (is.null(dates)) has_date <- rep(FALSE, nrow(out)) + inside <- (is.na(from) | dates >= from - tol) & (is.na(to) | dates <= to + tol) + # A name that marks the division as former ("Former USSR", "Ex-Yugoslavia", + # "Czechoslovakia (former)") is correct for any date after the division ended: it + # places the record in the former territory (BM, 2026-09-17). Dates before the + # division existed are still rejected. + former_label <- gnrs_is_former_label(out$country_verbatim) + after_end <- has_date & !is.na(to) & dates > to + tol + exempt <- hist_match & !inside & former_label & after_end + # A state or county resolved within a successor is kept, and flagged, even when the + # record's date falls outside the former country's existence ("USSR" + "Kamchatka" + # dated 2005): the place is identified, only the country label is out of date + # (BM, 2026-09-17). + kept_sub <- hist_match & has_date & !inside & !exempt & (out$subnational_status %in% "resolved in successor") + replace <- hist_match & has_date & !inside & !exempt & !kept_sub + out$date_check[hist_match & has_date & inside] <- "historical entity valid at record date" + out$date_check[exempt] <- "record dated after the entity ended, but named as former; historical match kept" + out$date_check[kept_sub] <- paste("historical match outside its validity at the record date;", + "kept because the state or county resolves in a successor") + out$date_check[hist_match & !has_date] <- "no record date; historical match kept" + if (any(replace)) { + keep_cols <- names(cur_rows) + out[replace, keep_cols] <- cur_rows[replace, keep_cols] + out$entity_key[replace] <- ent$entity_key[match(out$country_id[replace], ent$entity_id)] + out$is_historical[replace] <- FALSE + out$entity_valid_from[replace] <- NA + out$entity_valid_to[replace] <- NA + out$successors[replace] <- NA + out$subnational_resolved_in[replace] <- NA + out$subnational_status[replace] <- NA + out$date_check[replace] <- "historical match outside its validity at the record date; current-only resolution used" + } + } + out +} diff --git a/R/local_reference.R b/R/local_reference.R index 4b10d97..c597f93 100644 --- a/R/local_reference.R +++ b/R/local_reference.R @@ -262,10 +262,16 @@ gnrs_scope <- function(bb, what, parent = NA, index = FALSE) { co <- bb$country scope <- switch(what, - # Every country, by its standard name - country_std = pick(co, seq_len(nrow(co)), "country_id", "country"), - # Every country's GeoNames alternate names - country_alt = pick(bb$country_names, which(bb$country_names$original), "id", "name"), + # Every country, by its standard name. Rows flagged fuzzy = FALSE (added by the + # history component) take part in exact matching only. + country_std = pick(co, if (is.null(co$fuzzy)) seq_len(nrow(co)) else which(co$fuzzy %in% TRUE), + "country_id", "country"), + # Every country's GeoNames alternate names (and, with the history component, + # historical names flagged for fuzzy matching) + country_alt = pick(bb$country_names, + which(bb$country_names$original & + (if (is.null(bb$country_names$fuzzy)) TRUE else bb$country_names$fuzzy %in% TRUE)), + "id", "name"), # Countries that are subdivisions of the given country, by standard name sac_std = pick(co, which(!is.na(co$alt_country_id) & co$alt_country_id == parent), "country_id", "country"), # Their alternate names, of every type diff --git a/data-raw/history_crosswalk.R b/data-raw/history_crosswalk.R new file mode 100644 index 0000000..546ae04 --- /dev/null +++ b/data-raw/history_crosswalk.R @@ -0,0 +1,250 @@ +# --------------------------------------------------------------------------- +# data-raw/history_crosswalk.R +# +# Generates the CURATED inputs of the time-versioned division reference +# (dev_notes/04). They ship with the package in inst/extdata/: +# +# history_current_entities.csv snapshot of the service's current countries +# history_curated_entities.csv historical entities keyed by ISO 3166-3 alpha-4 +# or a synthetic key, with their dates +# history_curated_periods.csv curated assignments of CShapes state codes to +# entities over periods (gwcode 365 is the Russian +# Empire, the USSR and the Russian Federation) +# history_curated_lineage.csv curated predecessor -> successor links, CLDR +# successor lists resolved +# history_curated_names.csv curated names and former names of entities +# history_geonames_names.csv GeoNames names of the historical entities +# history_codes.csv former country codes and the entity each denotes +# +# NOTHING DERIVED FROM CShapes SHIPS (BM, 2026-09-22). CShapes 2.0 is CC BY-NC-SA +# 4.0 and this package is MIT, so the CShapes-derived parts - periods for every +# uncurated state code, the synthetic CSH entities, their names, the +# coverage check and the geometry-derived lineage - are computed at build time +# from the user's own CShapes copy by gnrs_history_assemble() (R/local_history_assemble.R), +# after GNRS_local_build("cshapes"). This script holds only the curation, which is +# original work, and extracts from redistributable sources. +# +# Modelling rule: a new ENTITY only where the political unit changed (dissolution, +# unification, partition, absorption, a colony that is not today's country). A pure +# rename of a continuing state (Burma -> Myanmar, Zaire -> DR Congo, Dahomey -> Benin, +# Byelorussian SSR -> Belarus, Russian Empire / RSFSR -> Russian Federation outside +# the USSR period) stays ONE entity; its former names and codes go in the names and +# codes tables with their periods. +# +# Sources (read from gvs_ms/data/history_sources/, downloaded 2026-09-16), all +# redistributable in this form: +# GNRS country table (the service's own identifiers; cached API snapshot; names +# and GeoNames ids, CC BY 4.0) +# Unicode CLDR supplementalMetadata.xml territoryAlias (Unicode License v3) +# Debian iso-codes iso_3166-3.json (LGPL-2.1+) +# GeoNames allCountries, PCLH historical political entities (CC BY 4.0) +# Every curated decision is written as data below, with a note. +# --------------------------------------------------------------------------- + +suppressMessages({library(data.table); library(nanoparquet); library(jsonlite); library(arrow)}) + +SRC <- "C:/Users/bmaitner/Desktop/current_projects/gvs_ms/data/history_sources" +GNRS_CACHE <- "C:/Users/bmaitner/AppData/Local/R/cache/R/GNRS" +OUT <- file.path("C:/Users/bmaitner/Desktop/current_projects/RGNRS", "inst", "extdata") +dir.create(OUT, recursive = TRUE, showWarnings = FALSE) +D <- function(x) as.Date(x) + +# ---- current entities: the service's country table -------------------------- +ct <- as.data.table(read_parquet(file.path(GNRS_CACHE, "gnrs-api-country.gz.parquet"))) +cur <- ct[!is.na(iso) & nzchar(iso), .(entity_key = iso, name = country, geonameid = as.character(country_id), + iso3166_1 = iso, iso3166_3 = NA_character_, + valid_from = as.Date(NA), valid_to = as.Date(NA), kind = "current", + note = NA_character_)] +cur <- unique(cur, by = "entity_key") +# shipped as a snapshot, as the entities table always carried it: which uncurated state +# codes map to a current country depends on this list, so it is fixed with the curation +fwrite(cur, file.path(OUT, "history_current_entities.csv")) + +# ---- historical entities (curated) ----------------------------------------- +# valid_from/valid_to: dates of the political unit, not of any one border. +hist <- rbindlist(list( + list("SUHH", "Union of Soviet Socialist Republics", "8354411", NA, "SUHH", D("1922-12-30"), D("1991-12-25"), "historical", "Treaty on the Creation of the USSR to dissolution"), + list("CSHH", "Czechoslovakia", "8505031", NA, "CSHH", D("1918-10-28"), D("1992-12-31"), "historical", "including the Czechoslovak Socialist Republic"), + list("DDDE", "German Democratic Republic", "8354410", NA, "DDDE", D("1949-10-07"), D("1990-10-02"), "historical", "absorbed by the Federal Republic of Germany"), + list("YUCS", "Yugoslavia (Kingdom of Serbs, Croats and Slovenes; Kingdom of Yugoslavia; SFR Yugoslavia)", NA, NA, "YUCS", D("1918-12-01"), D("1992-04-26"), "historical", "no GeoNames PCLH; ISO YUCS also covered FR Yugoslavia, modelled separately as CSXX"), + list("CSXX", "Serbia and Montenegro (Federal Republic of Yugoslavia to 2003)", "8505033", NA, "CSXX", D("1992-04-27"), D("2006-06-03"), "historical", "GeoNames also has FR Yugoslavia as 7500737; one state renamed in 2003"), + list("YDYE", "People's Democratic Republic of Yemen", "8505034", NA, "YDYE", D("1967-11-30"), D("1990-05-21"), "historical", "merged with the Yemen Arab Republic"), + list("VNRV", "Republic of Vietnam", "11608491", NA, NA, D("1955-10-26"), D("1975-04-30"), "historical", "synthetic key; absorbed into Vietnam"), + list("ANHH", "Netherlands Antilles", "8505032", NA, "ANHH", D("1954-12-15"), D("2010-10-09"), "historical", "Aruba separated 1986"), + list("RUBI", "Ruanda-Urundi", "11612757", NA, NA, D("1922-07-20"), D("1962-06-30"), "historical", "synthetic key; Belgian mandate"), + list("GEHH", "Gilbert and Ellice Islands", NA, NA, "GEHH", D("1892-05-27"), D("1975-12-31"), "historical", "split into Kiribati and Tuvalu"), + list("PCHH", "Trust Territory of the Pacific Islands", NA, NA, "PCHH", D("1947-07-18"), D("1994-10-01"), "historical", "divided into FM, MH, MP and PW"), + list("SKIN", "Sikkim", NA, NA, "SKIN", D("1642-01-01"), D("1975-05-16"), "historical", "absorbed by India"), + list("PZPA", "Panama Canal Zone", NA, NA, "PZPA", D("1903-11-18"), D("1979-09-30"), "historical", "returned to Panama"), + list("NTHH", "Saudi Arabian-Iraqi Neutral Zone", NA, NA, "NTHH", D("1922-12-02"), D("1991-12-26"), "historical", "divided between SA and IQ"), + list("CTKI", "Canton and Enderbury Islands", NA, NA, "CTKI", D("1939-04-06"), D("1979-07-12"), "historical", "to Kiribati"), + list("FQHH", "French Southern and Antarctic Territories (former code)", NA, NA, "FQHH", NA, D("1979-12-31"), "historical", "now AQ and TF"), + list("CSH665", "Mandatory Palestine", NA, NA, NA, D("1920-04-26"), D("1948-05-14"), "historical", "synthetic key from CShapes 665"), + list("CSH3", "Territory of Alaska", NA, NA, NA, D("1867-10-18"), D("1959-01-02"), "historical", "US territory; a US state since 1959"), + list("CSH4", "Territory of Hawaii", NA, NA, NA, D("1898-07-07"), D("1959-08-20"), "historical", "US territory; a US state since 1959"), + list("CSH21", "Dominion of Newfoundland", NA, NA, NA, D("1907-09-26"), D("1949-03-31"), "historical", "joined Canada"), + list("CSH730", "Korea (before partition)", NA, NA, NA, NA, D("1945-08-14"), "historical", "Korean Empire / Japanese Korea; successors KP and KR") +), use.names = FALSE) +setnames(hist, names(cur)) + + +# ---- CShapes code -> entity over periods --------------------------------------- +# curated splits and assignments; everything else follows countrycode when it gives a +# current country, else a synthetic entity CSH +curated_periods <- rbindlist(list( + list(365L, D("1886-01-01"), D("1922-12-29"), "RU", "Russian Empire and Soviet Russia: same continuing state as the Russian Federation (rename rule)"), + list(365L, D("1922-12-30"), D("1991-12-25"), "SUHH", "USSR"), + list(365L, D("1991-12-26"), D("2019-12-31"), "RU", "Russian Federation"), + list(345L, D("1918-12-01"), D("1992-04-26"), "YUCS", "Yugoslavia to the break-up"), + list(345L, D("1992-04-27"), D("2006-06-02"), "CSXX", "FR Yugoslavia / Serbia and Montenegro"), + list(265L, D("1945-05-08"), D("1990-10-02"), "DDDE", "CShapes starts the unit at the Soviet occupation zone (1945); the GDR was founded 1949-10-07"), + list(315L, D("1918-11-11"), D("1992-12-31"), "CSHH", "Czechoslovakia"), + list(680L, D("1967-11-30"), D("1990-05-21"), "YDYE", "South Yemen"), + list(678L, D("1918-10-30"), D("2019-12-31"), "YE", "Yemen Arab Republic continues as Yemen after unification (ISO YE retained)"), + list(816L, D("1954-05-01"), D("2019-12-31"), "VN", "Democratic Republic of Vietnam continues as Vietnam (rename rule)"), + list(817L, D("1954-05-01"), D("1975-04-30"), "VNRV", "Republic of Vietnam"), + list(515L, D("1920-06-28"), D("1962-06-30"), "RUBI", "Ruanda-Urundi"), + list(255L, D("1886-01-01"), D("1945-05-07"), "DE", "German Empire / Reich: same continuing state as Germany (rename rule)"), + list(6L, D("1886-01-01"), D("2019-12-31"), "PR", "territory still exists"), + list(65L, D("1886-01-01"), D("2019-12-31"), "GP", "territory still exists"), + list(66L, D("1886-01-01"), D("2019-12-31"), "MQ", "territory still exists"), + list(120L, D("1886-01-01"), D("2019-12-31"), "GF", "territory still exists"), + list(585L, D("1886-01-01"), D("2019-12-31"), "RE", "territory still exists"), + list(930L, D("1886-01-01"), D("2019-12-31"), "NC", "territory still exists"), + list(960L, D("1903-05-19"), D("2019-12-31"), "PF", "territory still exists"), + list(347L, D("2008-02-20"), D("2019-12-31"), "XK", "Kosovo"), + list(609L, D("1958-10-10"), D("1975-11-13"), "EH", "Spanish Sahara is today's Western Sahara territory"), + list(6511L, D("1948-05-14"), D("1967-06-09"), "PS", "Gaza under Egyptian administration; territory of today's PS"), + list(6631L, D("1948-05-14"), D("1967-06-09"), "PS", "West Bank under Jordanian administration; territory of today's PS"), + list(665L, D("1920-04-26"), D("1948-05-13"), "CSH665", "Mandatory Palestine"), + list(3L, D("1886-01-01"), D("1959-01-02"), "CSH3", "Territory of Alaska"), + list(4L, D("1898-07-06"), D("1959-08-20"), "CSH4", "Territory of Hawaii"), + list(21L, D("1886-01-01"), D("1948-07-21"), "CSH21", "Newfoundland"), + list(730L, D("1886-01-01"), D("1945-08-14"), "CSH730", "Korea before partition") +), use.names = FALSE) +setnames(curated_periods, c("gwcode", "from", "to", "entity_key", "note")) +curated_periods[, basis := "curated"] + +fwrite(curated_periods, file.path(OUT, "history_curated_periods.csv")) +fwrite(hist, file.path(OUT, "history_curated_entities.csv")) + +# ---- lineage ------------------------------------------------------------------ +xml <- readLines(file.path(SRC, "cldr_supplementalMetadata.xml"), encoding = "UTF-8", warn = FALSE) +ta <- regmatches(xml, regexec(' entity ----------------------------------------------------- +iso3 <- as.data.table(fromJSON(file.path(SRC, "iso_3166-3.json"))[["3166-3"]]) +rename_to <- c(BYAA = "BY", BUMM = "MM", DYBJ = "BJ", HVBF = "BF", NHVU = "VU", RHZW = "ZW", TPTL = "TL", ZRCD = "CD", + AIDJ = "DJ", FXFR = "FR", VDVN = "VN", BQAQ = "AQ", NQAQ = "AQ", JTUM = "UM", MIUM = "UM", WKUM = "UM", PUUM = "UM") +codes <- iso3[, .(code = alpha_4, code_type = "ISO 3166-3 alpha-4", name, withdrawn = withdrawal_date, + entity_key = fifelse(alpha_4 %in% names(rename_to), rename_to[alpha_4], alpha_4))] +codes <- rbind(codes, iso3[, .(code = alpha_2, code_type = "ISO 3166-1 alpha-2 (former)", name, withdrawn = withdrawal_date, + entity_key = fifelse(alpha_4 %in% names(rename_to), rename_to[alpha_4], alpha_4))]) +fwrite(codes, file.path(OUT, "history_codes.csv")) # filtered to known entities at build time + +# ---- names ------------------------------------------------------------------------ +# Names by which records refer to an entity, each with its source. Historical entities +# get all four sources; current entities get only FORMER names (renames of a continuing +# state), since their current names are already in the GNRS reference. +curated_names <- rbindlist(list( + data.table(entity_key = "SUHH", name = c("USSR", "U.S.S.R.", "U.S.S.R", "Soviet Union", "SSSR", "CCCP", "UdSSR", "URSS", + "Union of Soviet Socialist Republics", "Former USSR", "Former U.S.S.R.", "Ex-USSR", "Ex USSR", "Former Soviet Union", "USSR (former)")), + data.table(entity_key = "YUCS", name = c("Yugoslavia", "Jugoslavija", "Jugoslawien", "Yougoslavie", "Yugoslavia (Former)", + "Former Yugoslavia", "Ex-Yugoslavia", "SFR Yugoslavia", "SFRY", "Socialist Federal Republic of Yugoslavia", + "Kingdom of Yugoslavia", "Kingdom of Serbs, Croats and Slovenes")), + data.table(entity_key = "CSXX", name = c("Serbia and Montenegro", "Serbia & Montenegro", "Federal Republic of Yugoslavia", + "FR Yugoslavia", "Srbija i Crna Gora")), + data.table(entity_key = "CSHH", name = c("Czechoslovakia", "Czecho-Slovakia", "Tschechoslowakei", "Tchécoslovaquie", + "Checoslovaquia", "ČSSR", "CSSR", "ČSR", "Czechoslovakia (Former)", "Former Czechoslovakia")), + data.table(entity_key = "DDDE", name = c("German Democratic Republic", "GDR", "DDR", "East Germany", "Germany, East", + "Deutsche Demokratische Republik", "RDA")), + data.table(entity_key = "YDYE", name = c("South Yemen", "People's Democratic Republic of Yemen", "Yemen, Democratic", + "Democratic Yemen", "PDR Yemen")), + data.table(entity_key = "VNRV", name = c("Republic of Vietnam", "South Vietnam", "Vietnam, South", "South Viet Nam")), + data.table(entity_key = "ANHH", name = c("Netherlands Antilles", "Nederlandse Antillen", "Antilles néerlandaises")), + data.table(entity_key = "RUBI", name = c("Ruanda-Urundi", "Ruanda Urundi")), + data.table(entity_key = "CSH665", name = c("Mandatory Palestine", "British Mandate of Palestine", "Palestine Mandate")), + data.table(entity_key = "CSH21", name = c("Newfoundland", "Dominion of Newfoundland")), + # former names of continuing states (rename rule): attach to the current entity + data.table(entity_key = "MM", name = c("Burma")), + data.table(entity_key = "CD", name = c("Zaire", "Zaïre", "Belgian Congo", "Congo (Kinshasa)", "Congo-Kinshasa")), + data.table(entity_key = "CG", name = c("Congo (Brazzaville)", "Congo-Brazzaville", "French Congo")), + data.table(entity_key = "BJ", name = c("Dahomey")), + data.table(entity_key = "BF", name = c("Upper Volta", "Haute-Volta")), + data.table(entity_key = "LK", name = c("Ceylon")), + data.table(entity_key = "TH", name = c("Siam")), + data.table(entity_key = "IR", name = c("Persia")), + data.table(entity_key = "BY", name = c("Byelorussia", "Belorussia", "Byelorussian SSR", "Belorussian SSR")), + data.table(entity_key = "ZW", name = c("Rhodesia", "Southern Rhodesia")), + data.table(entity_key = "ZM", name = c("Northern Rhodesia")), + data.table(entity_key = "MW", name = c("Nyasaland")), + data.table(entity_key = "LS", name = c("Basutoland")), + data.table(entity_key = "BW", name = c("Bechuanaland")), + data.table(entity_key = "GH", name = c("Gold Coast")), + data.table(entity_key = "ML", name = c("French Sudan")), + data.table(entity_key = "BZ", name = c("British Honduras")), + data.table(entity_key = "GY", name = c("British Guiana")), + data.table(entity_key = "SR", name = c("Dutch Guiana", "Netherlands Guiana")), + data.table(entity_key = "GQ", name = c("Spanish Guinea")), + data.table(entity_key = "ET", name = c("Abyssinia")), + data.table(entity_key = "KH", name = c("Kampuchea", "Khmer Republic")), + data.table(entity_key = "VU", name = c("New Hebrides")), + data.table(entity_key = "TL", name = c("East Timor", "Portuguese Timor")), + data.table(entity_key = "DJ", name = c("French Somaliland", "French Territory of the Afars and the Issas")), + data.table(entity_key = "TZ", name = c("Tanganyika")), + data.table(entity_key = "KI", name = c("Gilbert Islands")), + data.table(entity_key = "TV", name = c("Ellice Islands")) +)) +curated_names[, source := "curated"] +fwrite(curated_names, file.path(OUT, "history_curated_names.csv")) + +gn <- as.data.table(arrow::read_parquet(file.path(SRC, "geonames_political_features.parquet"))) +# only PCLH records of entities that can carry a GeoNames id: the curated historical +# entities and the current countries (synthetic CShapes entities never have one) +gn <- gn[feature_code == "PCLH" & geonameid %in% c(cur$geonameid, hist$geonameid, "7500737")] +gn[geonameid == "7500737", geonameid := "8505033"] # FR Yugoslavia -> CSXX entity +gn_names <- gn[, .(name = unique(c(name, asciiname, trimws(strsplit(alternatenames, ",", fixed = TRUE)[[1]])))), by = geonameid] +fwrite(gn_names[nzchar(name)], file.path(OUT, "history_geonames_names.csv")) # joined to entities at build time + +# The rest - CShapes periods for uncurated codes, synthetic entities, coverage, +# geometry-derived lineage, CShapes names and final assembly - runs at build time in +# gnrs_history_assemble(). Remove the tables the previous version of this script wrote, +# which were CShapes-derived and must not ship. +unlink(file.path(OUT, c("history_entities.csv", "cshapes_entity_periods.csv", + "history_lineage.csv", "history_names.csv"))) +cat(sprintf("curated: %d entities, %d periods, %d lineage links, %d names | GeoNames names: %d | codes: %d +", + nrow(hist), nrow(curated_periods), nrow(lin), nrow(curated_names), nrow(gn_names[nzchar(name)]), nrow(codes))) diff --git a/inst/extdata/SOURCES.md b/inst/extdata/SOURCES.md new file mode 100644 index 0000000..c0f1239 --- /dev/null +++ b/inst/extdata/SOURCES.md @@ -0,0 +1,27 @@ +# Sources of the shipped history tables + +These tables are the *curated inputs* of the time-versioned division reference, written +by `data-raw/history_crosswalk.R`. They are combined at build time with the user's own +copy of CShapes 2.0 by `gnrs_history_assemble()`. + +**Nothing derived from CShapes 2.0 ships with this package.** CShapes is licensed +CC BY-NC-SA 4.0 and this package is MIT, so every CShapes-derived part of the history +component (periods of uncurated state codes, synthetic `CSH` entities and their +names, the coverage check, and geometry-derived lineage) is computed in the user's cache +from CShapes obtained under its own licence. `CSH` keys that appear below are +identifiers only, for entities whose names and dates were curated by hand. + +| File | Content | Source and licence | +|---|---|---| +| `history_current_entities.csv` | snapshot of the service's current countries | GNRS country table; names and ids from GeoNames (CC BY 4.0) | +| `history_curated_entities.csv` | historical entities and their dates | curated for GNRS (MIT) | +| `history_curated_periods.csv` | assignments of CShapes state codes to entities over periods | curated for GNRS (MIT) | +| `history_curated_lineage.csv` | predecessor -> successor links | curated for GNRS (MIT); successor lists from Unicode CLDR `territoryAlias` (Unicode License v3) | +| `history_curated_names.csv` | curated names and former names | curated for GNRS (MIT) | +| `history_geonames_names.csv` | names of historical political entities (feature code PCLH) | GeoNames, https://www.geonames.org/ (CC BY 4.0) | +| `history_codes.csv` | former country codes and the entity each denotes | ISO 3166-3 via Debian iso-codes (LGPL-2.1+); mapping to entities curated for GNRS | + +When the history component is built, `GNRS_local_citations()` also cites CShapes 2.0: +Schvitz G., Girardin L., Ruegger S., Weidmann N. B., Cederman L.-E. & Gleditsch K. S. +(2022). Mapping the International System, 1886-2019: The CShapes 2.0 Dataset. *Journal of +Conflict Resolution* 66(1): 144-161. https://doi.org/10.1177/00220027211013563 diff --git a/inst/extdata/history_codes.csv b/inst/extdata/history_codes.csv new file mode 100644 index 0000000..46f9628 --- /dev/null +++ b/inst/extdata/history_codes.csv @@ -0,0 +1,63 @@ +code,code_type,name,withdrawn,entity_key +AIDJ,ISO 3166-3 alpha-4,French Afars and Issas,1977,DJ +ANHH,ISO 3166-3 alpha-4,Netherlands Antilles,2010-12-15,ANHH +BQAQ,ISO 3166-3 alpha-4,British Antarctic Territory,1979,AQ +BUMM,ISO 3166-3 alpha-4,"Burma, Socialist Republic of the Union of",1989-12-05,MM +BYAA,ISO 3166-3 alpha-4,Byelorussian SSR Soviet Socialist Republic,1992-06-15,BY +CSHH,ISO 3166-3 alpha-4,"Czechoslovakia, Czechoslovak Socialist Republic",1993-06-15,CSHH +CSXX,ISO 3166-3 alpha-4,Serbia and Montenegro,2006-09-26,CSXX +CTKI,ISO 3166-3 alpha-4,Canton and Enderbury Islands,1984,CTKI +DDDE,ISO 3166-3 alpha-4,German Democratic Republic,1990-10-30,DDDE +DYBJ,ISO 3166-3 alpha-4,Dahomey,1977,BJ +FQHH,ISO 3166-3 alpha-4,French Southern and Antarctic Territories,1979,FQHH +FXFR,ISO 3166-3 alpha-4,"France, Metropolitan",1997-07-14,FR +GEHH,ISO 3166-3 alpha-4,Gilbert and Ellice Islands,1979,GEHH +HVBF,ISO 3166-3 alpha-4,"Upper Volta, Republic of",1984,BF +JTUM,ISO 3166-3 alpha-4,Johnston Island,1986,UM +MIUM,ISO 3166-3 alpha-4,Midway Islands,1986,UM +NHVU,ISO 3166-3 alpha-4,New Hebrides,1980,VU +NQAQ,ISO 3166-3 alpha-4,Dronning Maud Land,1983,AQ +NTHH,ISO 3166-3 alpha-4,Neutral Zone,1993-07-12,NTHH +PCHH,ISO 3166-3 alpha-4,Pacific Islands (trust territory),1986,PCHH +PUUM,ISO 3166-3 alpha-4,US Miscellaneous Pacific Islands,1986,UM +PZPA,ISO 3166-3 alpha-4,Panama Canal Zone,1980,PZPA +RHZW,ISO 3166-3 alpha-4,Southern Rhodesia,1980,ZW +SKIN,ISO 3166-3 alpha-4,Sikkim,1975,SKIN +SUHH,ISO 3166-3 alpha-4,"USSR, Union of Soviet Socialist Republics",1992-08-30,SUHH +TPTL,ISO 3166-3 alpha-4,East Timor,2002-05-20,TL +VDVN,ISO 3166-3 alpha-4,"Viet-Nam, Democratic Republic of",1977,VN +WKUM,ISO 3166-3 alpha-4,Wake Island,1986,UM +YDYE,ISO 3166-3 alpha-4,"Yemen, Democratic, People's Democratic Republic of",1990-08-14,YDYE +YUCS,ISO 3166-3 alpha-4,"Yugoslavia, (Socialist) Federal Republic of",2003-07-23,YUCS +ZRCD,ISO 3166-3 alpha-4,"Zaire, Republic of",1997-07-14,CD +AI,ISO 3166-1 alpha-2 (former),French Afars and Issas,1977,DJ +AN,ISO 3166-1 alpha-2 (former),Netherlands Antilles,2010-12-15,ANHH +BQ,ISO 3166-1 alpha-2 (former),British Antarctic Territory,1979,AQ +BU,ISO 3166-1 alpha-2 (former),"Burma, Socialist Republic of the Union of",1989-12-05,MM +BY,ISO 3166-1 alpha-2 (former),Byelorussian SSR Soviet Socialist Republic,1992-06-15,BY +CS,ISO 3166-1 alpha-2 (former),"Czechoslovakia, Czechoslovak Socialist Republic",1993-06-15,CSHH +CS,ISO 3166-1 alpha-2 (former),Serbia and Montenegro,2006-09-26,CSXX +CT,ISO 3166-1 alpha-2 (former),Canton and Enderbury Islands,1984,CTKI +DD,ISO 3166-1 alpha-2 (former),German Democratic Republic,1990-10-30,DDDE +DY,ISO 3166-1 alpha-2 (former),Dahomey,1977,BJ +FQ,ISO 3166-1 alpha-2 (former),French Southern and Antarctic Territories,1979,FQHH +FX,ISO 3166-1 alpha-2 (former),"France, Metropolitan",1997-07-14,FR +GE,ISO 3166-1 alpha-2 (former),Gilbert and Ellice Islands,1979,GEHH +HV,ISO 3166-1 alpha-2 (former),"Upper Volta, Republic of",1984,BF +JT,ISO 3166-1 alpha-2 (former),Johnston Island,1986,UM +MI,ISO 3166-1 alpha-2 (former),Midway Islands,1986,UM +NH,ISO 3166-1 alpha-2 (former),New Hebrides,1980,VU +NQ,ISO 3166-1 alpha-2 (former),Dronning Maud Land,1983,AQ +NT,ISO 3166-1 alpha-2 (former),Neutral Zone,1993-07-12,NTHH +PC,ISO 3166-1 alpha-2 (former),Pacific Islands (trust territory),1986,PCHH +PU,ISO 3166-1 alpha-2 (former),US Miscellaneous Pacific Islands,1986,UM +PZ,ISO 3166-1 alpha-2 (former),Panama Canal Zone,1980,PZPA +RH,ISO 3166-1 alpha-2 (former),Southern Rhodesia,1980,ZW +SK,ISO 3166-1 alpha-2 (former),Sikkim,1975,SKIN +SU,ISO 3166-1 alpha-2 (former),"USSR, Union of Soviet Socialist Republics",1992-08-30,SUHH +TP,ISO 3166-1 alpha-2 (former),East Timor,2002-05-20,TL +VD,ISO 3166-1 alpha-2 (former),"Viet-Nam, Democratic Republic of",1977,VN +WK,ISO 3166-1 alpha-2 (former),Wake Island,1986,UM +YD,ISO 3166-1 alpha-2 (former),"Yemen, Democratic, People's Democratic Republic of",1990-08-14,YDYE +YU,ISO 3166-1 alpha-2 (former),"Yugoslavia, (Socialist) Federal Republic of",2003-07-23,YUCS +ZR,ISO 3166-1 alpha-2 (former),"Zaire, Republic of",1997-07-14,CD diff --git a/inst/extdata/history_curated_entities.csv b/inst/extdata/history_curated_entities.csv new file mode 100644 index 0000000..cd0be58 --- /dev/null +++ b/inst/extdata/history_curated_entities.csv @@ -0,0 +1,22 @@ +entity_key,name,geonameid,iso3166_1,iso3166_3,valid_from,valid_to,kind,note +SUHH,Union of Soviet Socialist Republics,8354411,,SUHH,1922-12-30,1991-12-25,historical,Treaty on the Creation of the USSR to dissolution +CSHH,Czechoslovakia,8505031,,CSHH,1918-10-28,1992-12-31,historical,including the Czechoslovak Socialist Republic +DDDE,German Democratic Republic,8354410,,DDDE,1949-10-07,1990-10-02,historical,absorbed by the Federal Republic of Germany +YUCS,"Yugoslavia (Kingdom of Serbs, Croats and Slovenes; Kingdom of Yugoslavia; SFR Yugoslavia)",,,YUCS,1918-12-01,1992-04-26,historical,"no GeoNames PCLH; ISO YUCS also covered FR Yugoslavia, modelled separately as CSXX" +CSXX,Serbia and Montenegro (Federal Republic of Yugoslavia to 2003),8505033,,CSXX,1992-04-27,2006-06-03,historical,GeoNames also has FR Yugoslavia as 7500737; one state renamed in 2003 +YDYE,People's Democratic Republic of Yemen,8505034,,YDYE,1967-11-30,1990-05-21,historical,merged with the Yemen Arab Republic +VNRV,Republic of Vietnam,11608491,,,1955-10-26,1975-04-30,historical,synthetic key; absorbed into Vietnam +ANHH,Netherlands Antilles,8505032,,ANHH,1954-12-15,2010-10-09,historical,Aruba separated 1986 +RUBI,Ruanda-Urundi,11612757,,,1922-07-20,1962-06-30,historical,synthetic key; Belgian mandate +GEHH,Gilbert and Ellice Islands,,,GEHH,1892-05-27,1975-12-31,historical,split into Kiribati and Tuvalu +PCHH,Trust Territory of the Pacific Islands,,,PCHH,1947-07-18,1994-10-01,historical,"divided into FM, MH, MP and PW" +SKIN,Sikkim,,,SKIN,1642-01-01,1975-05-16,historical,absorbed by India +PZPA,Panama Canal Zone,,,PZPA,1903-11-18,1979-09-30,historical,returned to Panama +NTHH,Saudi Arabian-Iraqi Neutral Zone,,,NTHH,1922-12-02,1991-12-26,historical,divided between SA and IQ +CTKI,Canton and Enderbury Islands,,,CTKI,1939-04-06,1979-07-12,historical,to Kiribati +FQHH,French Southern and Antarctic Territories (former code),,,FQHH,,1979-12-31,historical,now AQ and TF +CSH665,Mandatory Palestine,,,,1920-04-26,1948-05-14,historical,synthetic key from CShapes 665 +CSH3,Territory of Alaska,,,,1867-10-18,1959-01-02,historical,US territory; a US state since 1959 +CSH4,Territory of Hawaii,,,,1898-07-07,1959-08-20,historical,US territory; a US state since 1959 +CSH21,Dominion of Newfoundland,,,,1907-09-26,1949-03-31,historical,joined Canada +CSH730,Korea (before partition),,,,,1945-08-14,historical,Korean Empire / Japanese Korea; successors KP and KR diff --git a/inst/extdata/history_curated_lineage.csv b/inst/extdata/history_curated_lineage.csv new file mode 100644 index 0000000..2fe0b10 --- /dev/null +++ b/inst/extdata/history_curated_lineage.csv @@ -0,0 +1,58 @@ +from_entity,to_entity,relation,date,source +SUHH,RU,dissolution,1991-12-26,CLDR territoryAlias SU +SUHH,AM,dissolution,1991-12-26,CLDR territoryAlias SU +SUHH,AZ,dissolution,1991-12-26,CLDR territoryAlias SU +SUHH,BY,dissolution,1991-12-26,CLDR territoryAlias SU +SUHH,EE,dissolution,1991-12-26,CLDR territoryAlias SU +SUHH,GE,dissolution,1991-12-26,CLDR territoryAlias SU +SUHH,KZ,dissolution,1991-12-26,CLDR territoryAlias SU +SUHH,KG,dissolution,1991-12-26,CLDR territoryAlias SU +SUHH,LV,dissolution,1991-12-26,CLDR territoryAlias SU +SUHH,LT,dissolution,1991-12-26,CLDR territoryAlias SU +SUHH,MD,dissolution,1991-12-26,CLDR territoryAlias SU +SUHH,TJ,dissolution,1991-12-26,CLDR territoryAlias SU +SUHH,TM,dissolution,1991-12-26,CLDR territoryAlias SU +SUHH,UA,dissolution,1991-12-26,CLDR territoryAlias SU +SUHH,UZ,dissolution,1991-12-26,CLDR territoryAlias SU +CSHH,CZ,dissolution,1993-01-01,CLDR territoryAlias 200 +CSHH,SK,dissolution,1993-01-01,CLDR territoryAlias 200 +DDDE,DE,absorbed,1990-10-03,CLDR territoryAlias DD +YDYE,YE,merged,1990-05-22,CLDR territoryAlias YD +YUCS,SI,dissolution,1992-04-27,"CLDR territoryAlias 890 (RS ME replaced by CSXX, their direct predecessor)" +YUCS,HR,dissolution,1992-04-27,"CLDR territoryAlias 890 (RS ME replaced by CSXX, their direct predecessor)" +YUCS,MK,dissolution,1992-04-27,"CLDR territoryAlias 890 (RS ME replaced by CSXX, their direct predecessor)" +YUCS,BA,dissolution,1992-04-27,"CLDR territoryAlias 890 (RS ME replaced by CSXX, their direct predecessor)" +YUCS,CSXX,dissolution,1992-04-27,"CLDR territoryAlias 890 (RS ME replaced by CSXX, their direct predecessor)" +CSXX,RS,dissolution,2006-06-03,CLDR territoryAlias CS +CSXX,ME,dissolution,2006-06-03,CLDR territoryAlias CS +RS,XK,secession,2008-02-17,curated +ANHH,CW,dissolution,2010-10-10,CLDR territoryAlias AN +ANHH,SX,dissolution,2010-10-10,CLDR territoryAlias AN +ANHH,BQ,dissolution,2010-10-10,CLDR territoryAlias AN +ANHH,AW,secession,1986-01-01,curated (ISO 3166-3 comment) +VNRV,VN,absorbed,1976-07-02,curated +RUBI,RW,dissolution,1962-07-01,curated +RUBI,BI,dissolution,1962-07-01,curated +GEHH,KI,dissolution,1976-01-01,ISO 3166-3 comment +GEHH,TV,dissolution,1976-01-01,ISO 3166-3 comment +PCHH,FM,dissolution,1994-10-01,ISO 3166-3 comment +PCHH,MH,dissolution,1994-10-01,ISO 3166-3 comment +PCHH,MP,dissolution,1994-10-01,ISO 3166-3 comment +PCHH,PW,dissolution,1994-10-01,ISO 3166-3 comment +SKIN,IN,absorbed,1975-05-16,curated +PZPA,PA,absorbed,1979-10-01,curated +NTHH,SA,dissolution,1991-12-26,CLDR territoryAlias NT +NTHH,IQ,dissolution,1991-12-26,CLDR territoryAlias NT +CTKI,KI,absorbed,1979-07-12,curated +CSH665,IL,partition,1948-05-14,curated +CSH665,PS,partition,1948-05-14,curated +CSH3,US,absorbed,1959-01-03,curated +CSH4,US,absorbed,1959-08-21,curated +CSH21,CA,absorbed,1949-03-31,curated +CSH730,KP,partition,1945-08-15,curated +CSH730,KR,partition,1945-08-15,curated +FQHH,AQ,dissolution,1980-01-01,CLDR territoryAlias FQ +FQHH,TF,dissolution,1980-01-01,CLDR territoryAlias FQ +CSH291,DE,territory_to,1939-09-01,"curated: annexed by Germany 1939, part of Poland from 1945" +CSH291,PL,territory_to,1939-09-01,"curated: annexed by Germany 1939, part of Poland from 1945" +CSH462,GH,absorbed,1957-03-06,curated: joined the Gold Coast at Ghana's independence (outside the one-year geometry window) diff --git a/inst/extdata/history_curated_names.csv b/inst/extdata/history_curated_names.csv new file mode 100644 index 0000000..b94c60e --- /dev/null +++ b/inst/extdata/history_curated_names.csv @@ -0,0 +1,112 @@ +entity_key,name,source +SUHH,USSR,curated +SUHH,U.S.S.R.,curated +SUHH,U.S.S.R,curated +SUHH,Soviet Union,curated +SUHH,SSSR,curated +SUHH,CCCP,curated +SUHH,UdSSR,curated +SUHH,URSS,curated +SUHH,Union of Soviet Socialist Republics,curated +SUHH,Former USSR,curated +SUHH,Former U.S.S.R.,curated +SUHH,Ex-USSR,curated +SUHH,Ex USSR,curated +SUHH,Former Soviet Union,curated +SUHH,USSR (former),curated +YUCS,Yugoslavia,curated +YUCS,Jugoslavija,curated +YUCS,Jugoslawien,curated +YUCS,Yougoslavie,curated +YUCS,Yugoslavia (Former),curated +YUCS,Former Yugoslavia,curated +YUCS,Ex-Yugoslavia,curated +YUCS,SFR Yugoslavia,curated +YUCS,SFRY,curated +YUCS,Socialist Federal Republic of Yugoslavia,curated +YUCS,Kingdom of Yugoslavia,curated +YUCS,"Kingdom of Serbs, Croats and Slovenes",curated +CSXX,Serbia and Montenegro,curated +CSXX,Serbia & Montenegro,curated +CSXX,Federal Republic of Yugoslavia,curated +CSXX,FR Yugoslavia,curated +CSXX,Srbija i Crna Gora,curated +CSHH,Czechoslovakia,curated +CSHH,Czecho-Slovakia,curated +CSHH,Tschechoslowakei,curated +CSHH,Tchécoslovaquie,curated +CSHH,Checoslovaquia,curated +CSHH,ČSSR,curated +CSHH,CSSR,curated +CSHH,ČSR,curated +CSHH,Czechoslovakia (Former),curated +CSHH,Former Czechoslovakia,curated +DDDE,German Democratic Republic,curated +DDDE,GDR,curated +DDDE,DDR,curated +DDDE,East Germany,curated +DDDE,"Germany, East",curated +DDDE,Deutsche Demokratische Republik,curated +DDDE,RDA,curated +YDYE,South Yemen,curated +YDYE,People's Democratic Republic of Yemen,curated +YDYE,"Yemen, Democratic",curated +YDYE,Democratic Yemen,curated +YDYE,PDR Yemen,curated +VNRV,Republic of Vietnam,curated +VNRV,South Vietnam,curated +VNRV,"Vietnam, South",curated +VNRV,South Viet Nam,curated +ANHH,Netherlands Antilles,curated +ANHH,Nederlandse Antillen,curated +ANHH,Antilles néerlandaises,curated +RUBI,Ruanda-Urundi,curated +RUBI,Ruanda Urundi,curated +CSH665,Mandatory Palestine,curated +CSH665,British Mandate of Palestine,curated +CSH665,Palestine Mandate,curated +CSH21,Newfoundland,curated +CSH21,Dominion of Newfoundland,curated +MM,Burma,curated +CD,Zaire,curated +CD,Zaïre,curated +CD,Belgian Congo,curated +CD,Congo (Kinshasa),curated +CD,Congo-Kinshasa,curated +CG,Congo (Brazzaville),curated +CG,Congo-Brazzaville,curated +CG,French Congo,curated +BJ,Dahomey,curated +BF,Upper Volta,curated +BF,Haute-Volta,curated +LK,Ceylon,curated +TH,Siam,curated +IR,Persia,curated +BY,Byelorussia,curated +BY,Belorussia,curated +BY,Byelorussian SSR,curated +BY,Belorussian SSR,curated +ZW,Rhodesia,curated +ZW,Southern Rhodesia,curated +ZM,Northern Rhodesia,curated +MW,Nyasaland,curated +LS,Basutoland,curated +BW,Bechuanaland,curated +GH,Gold Coast,curated +ML,French Sudan,curated +BZ,British Honduras,curated +GY,British Guiana,curated +SR,Dutch Guiana,curated +SR,Netherlands Guiana,curated +GQ,Spanish Guinea,curated +ET,Abyssinia,curated +KH,Kampuchea,curated +KH,Khmer Republic,curated +VU,New Hebrides,curated +TL,East Timor,curated +TL,Portuguese Timor,curated +DJ,French Somaliland,curated +DJ,French Territory of the Afars and the Issas,curated +TZ,Tanganyika,curated +KI,Gilbert Islands,curated +TV,Ellice Islands,curated diff --git a/inst/extdata/history_curated_periods.csv b/inst/extdata/history_curated_periods.csv new file mode 100644 index 0000000..2797131 --- /dev/null +++ b/inst/extdata/history_curated_periods.csv @@ -0,0 +1,30 @@ +gwcode,from,to,entity_key,note,basis +365,1886-01-01,1922-12-29,RU,Russian Empire and Soviet Russia: same continuing state as the Russian Federation (rename rule),curated +365,1922-12-30,1991-12-25,SUHH,USSR,curated +365,1991-12-26,2019-12-31,RU,Russian Federation,curated +345,1918-12-01,1992-04-26,YUCS,Yugoslavia to the break-up,curated +345,1992-04-27,2006-06-02,CSXX,FR Yugoslavia / Serbia and Montenegro,curated +265,1945-05-08,1990-10-02,DDDE,CShapes starts the unit at the Soviet occupation zone (1945); the GDR was founded 1949-10-07,curated +315,1918-11-11,1992-12-31,CSHH,Czechoslovakia,curated +680,1967-11-30,1990-05-21,YDYE,South Yemen,curated +678,1918-10-30,2019-12-31,YE,Yemen Arab Republic continues as Yemen after unification (ISO YE retained),curated +816,1954-05-01,2019-12-31,VN,Democratic Republic of Vietnam continues as Vietnam (rename rule),curated +817,1954-05-01,1975-04-30,VNRV,Republic of Vietnam,curated +515,1920-06-28,1962-06-30,RUBI,Ruanda-Urundi,curated +255,1886-01-01,1945-05-07,DE,German Empire / Reich: same continuing state as Germany (rename rule),curated +6,1886-01-01,2019-12-31,PR,territory still exists,curated +65,1886-01-01,2019-12-31,GP,territory still exists,curated +66,1886-01-01,2019-12-31,MQ,territory still exists,curated +120,1886-01-01,2019-12-31,GF,territory still exists,curated +585,1886-01-01,2019-12-31,RE,territory still exists,curated +930,1886-01-01,2019-12-31,NC,territory still exists,curated +960,1903-05-19,2019-12-31,PF,territory still exists,curated +347,2008-02-20,2019-12-31,XK,Kosovo,curated +609,1958-10-10,1975-11-13,EH,Spanish Sahara is today's Western Sahara territory,curated +6511,1948-05-14,1967-06-09,PS,Gaza under Egyptian administration; territory of today's PS,curated +6631,1948-05-14,1967-06-09,PS,West Bank under Jordanian administration; territory of today's PS,curated +665,1920-04-26,1948-05-13,CSH665,Mandatory Palestine,curated +3,1886-01-01,1959-01-02,CSH3,Territory of Alaska,curated +4,1898-07-06,1959-08-20,CSH4,Territory of Hawaii,curated +21,1886-01-01,1948-07-21,CSH21,Newfoundland,curated +730,1886-01-01,1945-08-14,CSH730,Korea before partition,curated diff --git a/inst/extdata/history_current_entities.csv b/inst/extdata/history_current_entities.csv new file mode 100644 index 0000000..e4ecea8 --- /dev/null +++ b/inst/extdata/history_current_entities.csv @@ -0,0 +1,251 @@ +entity_key,name,geonameid,iso3166_1,iso3166_3,valid_from,valid_to,kind,note +RW,Rwanda,49518,RW,,,,current, +SO,Somalia,51537,SO,,,,current, +YE,Yemen,69543,YE,,,,current, +IQ,Iraq,99237,IQ,,,,current, +SA,Saudi Arabia,102358,SA,,,,current, +IR,Iran,130758,IR,,,,current, +CY,Cyprus,146669,CY,,,,current, +TZ,Tanzania,149590,TZ,,,,current, +SY,Syria,163843,SY,,,,current, +AM,Armenia,174982,AM,,,,current, +KE,Kenya,192950,KE,,,,current, +CD,Democratic Republic of the Congo,203312,CD,,,,current, +DJ,Djibouti,223816,DJ,,,,current, +UG,Uganda,226074,UG,,,,current, +CF,Central African Republic,239880,CF,,,,current, +SC,Seychelles,241170,SC,,,,current, +JO,Jordan,248816,JO,,,,current, +LB,Lebanon,272103,LB,,,,current, +KW,Kuwait,285570,KW,,,,current, +OM,Oman,286963,OM,,,,current, +QA,Qatar,289688,QA,,,,current, +BH,Bahrain,290291,BH,,,,current, +AE,United Arab Emirates,290557,AE,,,,current, +IL,Israel,294640,IL,,,,current, +TR,Turkey,298795,TR,,,,current, +ET,Ethiopia,337996,ET,,,,current, +ER,Eritrea,338010,ER,,,,current, +EG,Egypt,357994,EG,,,,current, +SD,Sudan,366755,SD,,,,current, +GR,Greece,390903,GR,,,,current, +BI,Burundi,433561,BI,,,,current, +EE,Estonia,453733,EE,,,,current, +LV,Latvia,458258,LV,,,,current, +AZ,Azerbaijan,587116,AZ,,,,current, +LT,Lithuania,597427,LT,,,,current, +SJ,Svalbard and Jan Mayen,607072,SJ,,,,current, +GE,Georgia,614540,GE,,,,current, +MD,Moldova,617790,MD,,,,current, +BY,Belarus,630336,BY,,,,current, +FI,Finland,660013,FI,,,,current, +AX,Aland Islands,661882,AX,,,,current, +UA,Ukraine,690791,UA,,,,current, +MK,Macedonia,718075,MK,,,,current, +HU,Hungary,719819,HU,,,,current, +BG,Bulgaria,732800,BG,,,,current, +AL,Albania,783754,AL,,,,current, +PL,Poland,798544,PL,,,,current, +RO,Romania,798549,RO,,,,current, +XK,Kosovo,831053,XK,,,,current, +ZW,Zimbabwe,878675,ZW,,,,current, +ZM,Zambia,895949,ZM,,,,current, +KM,Comoros,921929,KM,,,,current, +MW,Malawi,927384,MW,,,,current, +LS,Lesotho,932692,LS,,,,current, +BW,Botswana,933860,BW,,,,current, +MU,Mauritius,934292,MU,,,,current, +SZ,Swaziland,934841,SZ,,,,current, +RE,Reunion,935317,RE,,,,current, +ZA,South Africa,953987,ZA,,,,current, +YT,Mayotte,1024031,YT,,,,current, +MZ,Mozambique,1036973,MZ,,,,current, +MG,Madagascar,1062947,MG,,,,current, +AF,Afghanistan,1149361,AF,,,,current, +PK,Pakistan,1168579,PK,,,,current, +BD,Bangladesh,1210997,BD,,,,current, +TM,Turkmenistan,1218197,TM,,,,current, +TJ,Tajikistan,1220409,TJ,,,,current, +LK,Sri Lanka,1227603,LK,,,,current, +BT,Bhutan,1252634,BT,,,,current, +IN,India,1269750,IN,,,,current, +MV,Maldives,1282028,MV,,,,current, +IO,British Indian Ocean Territory,1282588,IO,,,,current, +NP,Nepal,1282988,NP,,,,current, +MM,Myanmar,1327865,MM,,,,current, +UZ,Uzbekistan,1512440,UZ,,,,current, +KZ,Kazakhstan,1522867,KZ,,,,current, +KG,Kyrgyzstan,1527747,KG,,,,current, +TF,French Southern Territories,1546748,TF,,,,current, +HM,Heard Island and McDonald Islands,1547314,HM,,,,current, +CC,Cocos Islands,1547376,CC,,,,current, +PW,Palau,1559582,PW,,,,current, +VN,Vietnam,1562822,VN,,,,current, +TH,Thailand,1605651,TH,,,,current, +ID,Indonesia,1643084,ID,,,,current, +LA,Laos,1655842,LA,,,,current, +TW,Taiwan,1668284,TW,,,,current, +PH,Philippines,1694008,PH,,,,current, +MY,Malaysia,1733045,MY,,,,current, +CN,China,1814991,CN,,,,current, +HK,Hong Kong,1819730,HK,,,,current, +BN,Brunei,1820814,BN,,,,current, +MO,Macao,1821275,MO,,,,current, +KH,Cambodia,1831722,KH,,,,current, +KR,South Korea,1835841,KR,,,,current, +JP,Japan,1861060,JP,,,,current, +KP,North Korea,1873107,KP,,,,current, +SG,Singapore,1880251,SG,,,,current, +CK,Cook Islands,1899402,CK,,,,current, +TL,East Timor,1966436,TL,,,,current, +RU,Russia,2017370,RU,,,,current, +MN,Mongolia,2029969,MN,,,,current, +AU,Australia,2077456,AU,,,,current, +CX,Christmas Island,2078138,CX,,,,current, +MH,Marshall Islands,2080185,MH,,,,current, +FM,Micronesia,2081918,FM,,,,current, +PG,Papua New Guinea,2088628,PG,,,,current, +SB,Solomon Islands,2103350,SB,,,,current, +TV,Tuvalu,2110297,TV,,,,current, +NR,Nauru,2110425,NR,,,,current, +VU,Vanuatu,2134431,VU,,,,current, +NC,New Caledonia,2139685,NC,,,,current, +NF,Norfolk Island,2155115,NF,,,,current, +NZ,New Zealand,2186224,NZ,,,,current, +FJ,Fiji,2205218,FJ,,,,current, +LY,Libya,2215636,LY,,,,current, +CM,Cameroon,2233387,CM,,,,current, +SN,Senegal,2245662,SN,,,,current, +CG,Republic of the Congo,2260494,CG,,,,current, +PT,Portugal,2264397,PT,,,,current, +LR,Liberia,2275384,LR,,,,current, +CI,Ivory Coast,2287781,CI,,,,current, +GH,Ghana,2300660,GH,,,,current, +GQ,Equatorial Guinea,2309096,GQ,,,,current, +NG,Nigeria,2328926,NG,,,,current, +BF,Burkina Faso,2361809,BF,,,,current, +TG,Togo,2363686,TG,,,,current, +GW,Guinea-Bissau,2372248,GW,,,,current, +MR,Mauritania,2378080,MR,,,,current, +BJ,Benin,2395170,BJ,,,,current, +GA,Gabon,2400553,GA,,,,current, +SL,Sierra Leone,2403846,SL,,,,current, +ST,Sao Tome and Principe,2410758,ST,,,,current, +GI,Gibraltar,2411586,GI,,,,current, +GM,Gambia,2413451,GM,,,,current, +GN,Guinea,2420477,GN,,,,current, +TD,Chad,2434508,TD,,,,current, +NE,Niger,2440476,NE,,,,current, +ML,Mali,2453866,ML,,,,current, +EH,Western Sahara,2461445,EH,,,,current, +TN,Tunisia,2464461,TN,,,,current, +ES,Spain,2510769,ES,,,,current, +MA,Morocco,2542007,MA,,,,current, +MT,Malta,2562770,MT,,,,current, +DZ,Algeria,2589581,DZ,,,,current, +FO,Faroe Islands,2622320,FO,,,,current, +DK,Denmark,2623032,DK,,,,current, +IS,Iceland,2629691,IS,,,,current, +GB,United Kingdom,2635167,GB,,,,current, +CH,Switzerland,2658434,CH,,,,current, +SE,Sweden,2661886,SE,,,,current, +NL,Netherlands,2750405,NL,,,,current, +AT,Austria,2782113,AT,,,,current, +BE,Belgium,2802361,BE,,,,current, +DE,Germany,2921044,DE,,,,current, +LU,Luxembourg,2960313,LU,,,,current, +IE,Ireland,2963597,IE,,,,current, +MC,Monaco,2993457,MC,,,,current, +FR,France,3017382,FR,,,,current, +AD,Andorra,3041565,AD,,,,current, +LI,Liechtenstein,3042058,LI,,,,current, +JE,Jersey,3042142,JE,,,,current, +IM,Isle of Man,3042225,IM,,,,current, +GG,Guernsey,3042362,GG,,,,current, +SK,Slovakia,3057568,SK,,,,current, +CZ,Czech Republic,3077311,CZ,,,,current, +NO,Norway,3144096,NO,,,,current, +VA,Vatican,3164670,VA,,,,current, +SM,San Marino,3168068,SM,,,,current, +IT,Italy,3175395,IT,,,,current, +SI,Slovenia,3190538,SI,,,,current, +ME,Montenegro,3194884,ME,,,,current, +HR,Croatia,3202326,HR,,,,current, +BA,Bosnia and Herzegovina,3277605,BA,,,,current, +AO,Angola,3351879,AO,,,,current, +NA,Namibia,3355338,NA,,,,current, +SH,Saint Helena,3370751,SH,,,,current, +BV,Bouvet Island,3371123,BV,,,,current, +BB,Barbados,3374084,BB,,,,current, +CV,Cape Verde,3374766,CV,,,,current, +GY,Guyana,3378535,GY,,,,current, +GF,French Guiana,3381670,GF,,,,current, +SR,Suriname,3382998,SR,,,,current, +PM,Saint Pierre and Miquelon,3424932,PM,,,,current, +GL,Greenland,3425505,GL,,,,current, +PY,Paraguay,3437598,PY,,,,current, +UY,Uruguay,3439705,UY,,,,current, +BR,Brazil,3469034,BR,,,,current, +FK,Falkland Islands,3474414,FK,,,,current, +GS,South Georgia and the South Sandwich Islands,3474415,GS,,,,current, +JM,Jamaica,3489940,JM,,,,current, +DO,Dominican Republic,3508796,DO,,,,current, +CU,Cuba,3562981,CU,,,,current, +MQ,Martinique,3570311,MQ,,,,current, +BS,Bahamas,3572887,BS,,,,current, +BM,Bermuda,3573345,BM,,,,current, +AI,Anguilla,3573511,AI,,,,current, +TT,Trinidad and Tobago,3573591,TT,,,,current, +KN,Saint Kitts and Nevis,3575174,KN,,,,current, +DM,Dominica,3575830,DM,,,,current, +AG,Antigua and Barbuda,3576396,AG,,,,current, +LC,Saint Lucia,3576468,LC,,,,current, +TC,Turks and Caicos Islands,3576916,TC,,,,current, +AW,Aruba,3577279,AW,,,,current, +VG,British Virgin Islands,3577718,VG,,,,current, +VC,Saint Vincent and the Grenadines,3577815,VC,,,,current, +MS,Montserrat,3578097,MS,,,,current, +MF,Saint Martin,3578421,MF,,,,current, +BL,Saint Barthelemy,3578476,BL,,,,current, +GP,Guadeloupe,3579143,GP,,,,current, +GD,Grenada,3580239,GD,,,,current, +KY,Cayman Islands,3580718,KY,,,,current, +BZ,Belize,3582678,BZ,,,,current, +SV,El Salvador,3585968,SV,,,,current, +GT,Guatemala,3595528,GT,,,,current, +HN,Honduras,3608932,HN,,,,current, +NI,Nicaragua,3617476,NI,,,,current, +CR,Costa Rica,3624060,CR,,,,current, +VE,Venezuela,3625428,VE,,,,current, +EC,Ecuador,3658394,EC,,,,current, +CO,Colombia,3686110,CO,,,,current, +PA,Panama,3703430,PA,,,,current, +HT,Haiti,3723988,HT,,,,current, +AR,Argentina,3865483,AR,,,,current, +CL,Chile,3895114,CL,,,,current, +BO,Bolivia,3923057,BO,,,,current, +PE,Peru,3932488,PE,,,,current, +MX,Mexico,3996063,MX,,,,current, +PF,French Polynesia,4030656,PF,,,,current, +PN,Pitcairn,4030699,PN,,,,current, +KI,Kiribati,4030945,KI,,,,current, +TK,Tokelau,4031074,TK,,,,current, +TO,Tonga,4032283,TO,,,,current, +WF,Wallis and Futuna,4034749,WF,,,,current, +WS,Samoa,4034894,WS,,,,current, +NU,Niue,4036232,NU,,,,current, +MP,Northern Mariana Islands,4041468,MP,,,,current, +GU,Guam,4043988,GU,,,,current, +PR,Puerto Rico,4566966,PR,,,,current, +VI,U.S. Virgin Islands,4796775,VI,,,,current, +UM,United States Minor Outlying Islands,5854968,UM,,,,current, +AS,American Samoa,5880801,AS,,,,current, +CA,Canada,6251999,CA,,,,current, +US,United States,6252001,US,,,,current, +PS,Palestinian Territory,6254930,PS,,,,current, +RS,Serbia,6290252,RS,,,,current, +AQ,Antarctica,6697173,AQ,,,,current, +SX,Sint Maarten,7609695,SX,,,,current, +CW,Curacao,7626836,CW,,,,current, +BQ,"Bonaire, Saint Eustatius and Saba",7626844,BQ,,,,current, +SS,South Sudan,7909807,SS,,,,current, diff --git a/inst/extdata/history_geonames_names.csv b/inst/extdata/history_geonames_names.csv new file mode 100644 index 0000000..43045f6 --- /dev/null +++ b/inst/extdata/history_geonames_names.csv @@ -0,0 +1,250 @@ +geonameid,name +8505032,Netherlands Antilles +8505032,Antia Hulandes +8505032,Antias Hulandes +8505032,Antilhas Neerlandesas +8505032,Antillas Holandesas +8505032,Antille Olandesi +8505032,Antilles Neerlandaises +8505032,Antilles Néerlandaises +8505032,De nederlandske antiller +8505032,Dutch Antilles +8505032,Nederlandsch West-Indie +8505032,Nederlandsch West-Indië +8505032,Nederlandse Antillen +8505032,Niderlands'ki Antil's'ki ostrovi +8505032,Niderlandskie Antil'skie ostrova +8505032,Niederlaendische Antillen +8505032,Niederländische Antillen +8505032,alantyl alhwlndyt +8505032,he shu an de lie si +8505032,nedeollandeulyeong antilleseu +8505032,oranda lingantiru +8505032,Нидерландские Антильские острова +8505032,Нідерландські Антильські острови +8505032,الأنتيل الهولندية +8505032,オランダ領アンティル +8505032,荷属安的列斯 +8505032,荷屬安地列斯 +8505032,네덜란드령 안틸레스 +8505031,Czechoslovakia +8505031,An t-Seic-Slobhac +8505031,An t-Seic-Slòbhac +8505031,An tSeicslovaic +8505031,An tSeicslóvaic +8505031,CHSSR +8505031,CS +8505031,CSK +8505031,Cechoslovacia +8505031,Cecoslofacia +8505031,Cecoslovacchia +8505031,Cecoslovachia +8505031,Cecoslovachie +8505031,Cecusluvachia +8505031,Cehoslovacia +8505031,Cehoslovacka +8505031,Cehoslovakii +8505031,Cehoslovakija +8505031,Cehoslovakio +8505031,Cekosllovakia +8505031,Cekoslovakija +8505031,Cekoslovakya +8505031,Cekoslowakia +8505031,Cekoslowakya +8505031,Cesko-Slovensko +8505031,Ceskoslovaska +8505031,Ceskoslovensko +8505031,Ceskoslowakska +8505031,Cexoslovakiya +8505031,Checoslovachia +8505031,Checoslovaquia +8505031,Checoslováquia +8505031,Chehkhaslavakija +8505031,Chekhoslovachchina +8505031,Chekhoslovachka +8505031,Chekhoslovaki +8505031,Chekhoslovakija +8505031,Chekoslovakia +8505031,Chexoslovakiya +8505031,Chikusluwakya +8505031,Csehszlovakia +8505031,Csehszlovákia +8505031,Cssr +8505031,Czechoslovakie +8505031,Czechoslowacja +8505031,Czechosłowacja +8505031,Cékoslowakia +8505031,Tchecoslovakia +8505031,Tchecoslovakie +8505031,Tchecoslovaquie +8505031,Tchekoslovakia +8505031,Tch·ècoslovaquie +8505031,Tchécoslovakie +8505031,Tchécoslovaquie +8505031,Tekkoslovakia +8505031,Tiep Khac +8505031,Tiệp Khắc +8505031,Tjeckoslovakien +8505031,Tjekkiet +8505031,Tschechoslowakaei +8505031,Tschechoslowakei +8505031,Tschechoslowakäi +8505031,Tsechoslovakia +8505031,Tsehhoslovakkia +8505031,Tsekkoslovakia +8505031,Tsekoslobakya +8505031,Tsiecoslofacia +8505031,Tsjecho-Slowakije +8505031,Tsjechoslowakije +8505031,Tsjeggo-Slowakye +8505031,Tsjekkoslovakia +8505031,Txecoslovaquia +8505031,Txecoslovàquia +8505031,Txekoslovakia +8505031,Tzecoslovachia +8505031,Tzecoslovàchia +8505031,Tékkóslóvakía +8505031,Tšehhoslovakkia +8505031,Tšekkoslovakia +8505031,caikosalavaki'a +8505031,cekkeasleavakya +8505031,cekkocilovakkiya +8505031,cekoslobhakiya +8505031,cekoslovakiya +8505031,cekoslovekiya +8505031,cekoslovhakiya +8505031,chekoseullobakia +8505031,chekosurobakia +8505031,chkslwaky +8505031,jie ke si luo fa ke +8505031,pra thes che kos lo wa keiy +8505031,tshykwslwfakya +8505031,zkwslwbqyh +8505031,Çekosllovakia +8505031,Çekoslovakya +8505031,Çekoslowakya +8505031,Çexoslovakiya +8505031,Ĉeĥoslovakio +8505031,Čehoslovakii +8505031,Čehoslovačka +8505031,Čehoslovākija +8505031,Čekoslovakija +8505031,Česko-Slovensko +8505031,Československo +8505031,Českosłowakska +8505031,Češkoslovaška +8505031,Čěskosłowakska +8505031,Τσεχοσλοβακία +8505031,ЧССР +8505031,Чехословаки +8505031,Чехословакия +8505031,Чехословачка +8505031,Чехословаччина +8505031,Чэхаславакія +8505031,Չեխոսլովակիա +8505031,טשעכאסלאוואקיי +8505031,צכוסלובקיה +8505031,تشيكوسلوفاكيا +8505031,چکسلواکی +8505031,چیکوسلواکیہ +8505031,چیکوسلوواکیہ +8505031,چێکۆسلۆڤاکیا +8505031,चेकोस्लोभाकिया +8505031,चेकोस्लोवाकिया +8505031,चेकोस्लोव्हाकिया +8505031,চেকোস্লোভাকিয়া +8505031,ਚੈਕੋਸਲਵਾਕੀਆ +8505031,செக்கோசிலோவாக்கியா +8505031,ಚೆಕೊಸ್ಲೊವೇಕಿಯಾ +8505031,ചെക്കൊസ്ലൊവാക്യ +8505031,චෙකොස්ලෝවැකියාව +8505031,ประเทศเชโกสโลวาเกีย +8505031,ချက်ကိုဆလိုဗားကီးယားနိုင်ငံ +8505031,ჩეხოსლოვაკია +8505031,チェコスロバキア +8505031,捷克斯洛伐克 +8505031,체코슬로바키아 +8505033,Serbia and Montenegro +8505033,Federal Republic of Yugoslavia +8505033,Bundesrepublik Jugoslawien +8505033,CS +8505033,Crbija i Crna Gora +8505033,Cрбија и Црна Гора +8505033,SCG +8505033,Savezna Republika Jugoslavija +8505033,Serbia e Montenegro +8505033,Serbia og Montenegro +8505033,Serbia y Montenegro +8505033,Serbie-et-Montenegro +8505033,Serbie-et-Monténégro +8505033,Serbien und Montenegro +8505033,Serbien-Montenegro +8505033,Serbija i Chernogorija +8505033,Servia e Montenegro +8505033,Srbija i Crna Gora +8505033,State Union of Serbia and Montenegro +8505033,Sérvia e Montenegro +8505033,seleubia montenegeulo +8505033,serubia・monteneguro +8505033,srbya waljbl alaswd +8505033,Савезна Република Југославија +8505033,Сербия и Черногория +8505033,صربيا والجبل الأسود +8505033,セルビア・モンテネグロ +8505033,세르비아 몬테네그로 +8354410,German Democratic Republic +8354410,Allemagne de l'Est +8354410,DDR +8354410,Deutsche Demokratische Republik +8354410,East Germany +8354410,GDR +8354410,Germanskaja Demokraticheskaja Respublika +8354410,Istocna Njemacka +8354410,Istočna Njemačka +8354410,NRD +8354410,Niemiecka Republika Demokratyczna +8354410,Njemacka Demokratska Republika +8354410,Njemačka Demokratska Republika +8354410,RDA +8354410,Repubblica Democratica Tedesca +8354410,Republique democratique allemande +8354410,République démocratique allemande +8354410,SBZ +8354410,Sowjetische Besatzungszone +8354410,ГДР +8354410,Германская Демократическая Республика +11612757,Ruanda-Urundi +11608491,Republic of Vietnam +11608491,South Vietnam +8505034,"Yemen, Democratic" +8505034,Democratic Yemen +8505034,Jumhuriyat Al-Yaman Al-Dimuqratiyah Al-Sha'biyah +8505034,Jumhūrīyat Al-Yaman Al-Dīmuqrāṭīyah Al-Sha'bīyah +8505034,People's Democratic Republic of Yemen +8505034,South Yemen +8505034,YD +8505034,YMD +8505034,Yemen (Aden) +8505034,Yemen Democratic +8505034,jmhwryt alyaman aldymuqratyt alshaʿbit +8505034,جمهورية اليَمَنْ الديمُقراطية الشَعْبِيّة +8354411,Union of Soviet Socialist Republics +8354411,Neuvostoliitto +8354411,SSSR +8354411,Sojuz Sovetskikh Socialisticheskikh Respublik +8354411,Sovetskij Sojuz +8354411,Sovetskiy Soyuz +8354411,Soviet Union +8354411,Sovjet-Unie +8354411,Sowietunion +8354411,Soyuz Sovetskikh Sotsialisticheskikh Respublik +8354411,URSS +8354411,USSR +8354411,UdSSR +8354411,Union des republiques socialistes sovietiques +8354411,Union des républiques socialistes soviétiques +8354411,Union sovietique +8354411,Union soviétique +8354411,СССР +8354411,Советский Союз +8354411,Союз Советских Социалистических Республик diff --git a/tests/testthat/helper-local.R b/tests/testthat/helper-local.R index 2e00f11..b65a5c1 100644 --- a/tests/testthat/helper-local.R +++ b/tests/testthat/helper-local.R @@ -153,3 +153,21 @@ gnrs_test_resolve <- function(dir, country, state = "", county = "", ...) { ) GNRS_local(df, dir = dir, build_missing = FALSE, quiet = TRUE, ...) } + +# CShapes for tests that need the history component. Nothing derived from CShapes ships +# with the package (CC BY-NC-SA 4.0; the package is MIT), so the history component is +# assembled from the user's own CShapes. For tests that copy is built ONCE per session +# from the cshapes package (no download) and copied into each test cache; a test that +# needs it skips where cshapes, countrycode or sf is not installed. +gnrs_test_cshapes <- function(dir) { + testthat::skip_if_not_installed("cshapes") + testthat::skip_if_not_installed("countrycode") + testthat::skip_if_not_installed("sf") + src <- file.path(tempdir(), "gnrs-test-cshapes") + if (!file.exists(gnrs_cshapes_versions_path(src))) { + dir.create(src, recursive = TRUE, showWarnings = FALSE) + gnrs_build_cshapes(dir = src, quiet = TRUE) + } + file.copy(list.files(src, pattern = "^cshapes-", full.names = TRUE), dir, overwrite = TRUE) + invisible(dir) +} diff --git a/tests/testthat/test-local-gadm.R b/tests/testthat/test-local-gadm.R index aa90ddb..9ae9a78 100644 --- a/tests/testthat/test-local-gadm.R +++ b/tests/testthat/test-local-gadm.R @@ -114,6 +114,7 @@ test_that("GADM divisions link by identifier, HASC and name, and the rest are ad test_that("a built layer changes what GNRS_local() reports, and can be removed again", { dir <- gnrs_test_backbone() + gnrs_test_cshapes(dir) # GNRS_local() defaults to history = "all" nanoparquet::write_parquet(gnrs_test_gadm(), gnrs_gadm_path(dir), compression = "gzip") saveRDS(list(source = "gadm", version = "test", downloaded = "2024-06-01"), gnrs_provenance_path("gadm", dir)) gnrs_finalize_reference(dir, quiet = TRUE) diff --git a/tests/testthat/test-local-history.R b/tests/testthat/test-local-history.R new file mode 100644 index 0000000..b072755 --- /dev/null +++ b/tests/testthat/test-local-history.R @@ -0,0 +1,116 @@ +context("offline resolution of historical political divisions") + +# Against the synthetic reference in helper-local.R plus the history component. +# Nothing derived from CShapes ships (CC BY-NC-SA 4.0; the package is MIT), so the +# history component is assembled from the shipped curation and a CShapes copy built +# into the test cache from the cshapes package - no download, but the package is needed. + +dir <- gnrs_test_backbone() +gnrs_test_cshapes(dir) +gnrs_build_history(dir = dir, quiet = TRUE) + +test_that("nothing derived from CShapes ships with the package", { + shipped <- list.files(dirname(gnrs_extdata("history_codes.csv")), pattern = "[.]csv$") + expect_true(file.exists(file.path(dirname(gnrs_extdata("history_codes.csv")), "SOURCES.md"))) + expect_setequal(shipped, c("history_codes.csv", "history_current_entities.csv", + "history_curated_entities.csv", "history_curated_lineage.csv", + "history_curated_names.csv", "history_curated_periods.csv", + "history_geonames_names.csv")) + # the tables that were CShapes-derived must not come back + expect_false(any(c("cshapes_entity_periods.csv", "history_entities.csv", + "history_lineage.csv", "history_names.csv") %in% shipped)) + # the only CSH entities in the curation are the ones named by hand + ent <- utils::read.csv(gnrs_extdata("history_curated_entities.csv"), na.strings = "") + expect_setequal(grep("^CSH[0-9]+$", ent$entity_key, value = TRUE), + c("CSH665", "CSH3", "CSH4", "CSH21", "CSH730")) +}) + +test_that("assembly at build time reproduces the tables that used to ship", { + # counts of the inst/extdata tables written by data-raw/history_crosswalk.R before + # 2026-09-22, which the assembly was checked against row for row + h <- gnrs_history(dir) + expect_equal(nrow(h$entities), 326L) + expect_equal(nrow(h$lineage), 125L) + expect_equal(nrow(h$periods), 255L) + expect_equal(sum(h$entities$kind == "historical" & grepl("^CSH[0-9]+$", h$entities$entity_key)), 60L) + expect_true(any(grepl("^CShapes geometry overlap", h$lineage$source))) +}) + +test_that("record dates parse from years, ISO dates and Dates", { + d <- gnrs_parse_record_date(c(1985, 1970)) + expect_equal(d, as.Date(c("1985-07-01", "1970-07-01"))) + # a vector with no ISO dates must not fail: paste0(character(0), "-01") is "-01" + expect_silent(gnrs_parse_record_date(c("1985", NA))) + expect_equal(gnrs_parse_record_date(c("1991-12", "2005-03-04", "not a date")), + as.Date(c("1991-12-01", "2005-03-04", NA))) + expect_equal(gnrs_parse_record_date(as.Date("2001-01-01")), as.Date("2001-01-01")) +}) + +test_that("the history component gives every entity a unique identifier", { + h <- gnrs_history(dir) + expect_false(anyDuplicated(h$entities$entity_id) > 0) + synthetic <- is.na(h$entities$geonameid) + expect_true(all(h$entities$entity_id[synthetic] > gnrs_history_synthetic_base())) + expect_equal(h$entities$entity_id[h$entities$entity_key == "SUHH"], 8354411L) + # "NA" is Namibia's code, not a missing value + expect_true("NA" %in% h$entities$entity_key) + expect_false(anyNA(h$entities$entity_key)) + expect_true(all(c("entities", "names", "lineage", "periods", "codes", "collisions") %in% + sub("^history-(.*)\\.gz\\.parquet$", "\\1", list.files(dir, pattern = "^history-")))) +}) + +test_that("history = 'current' resolves against today's divisions only; 'all' is the default", { + cur <- gnrs_test_resolve(dir, c("United States", "USSR"), c("Arizona", ""), history = "current") + expect_equal(cur$country, c("United States", "")) + expect_false("entity_key" %in% names(cur)) + def <- gnrs_test_resolve(dir, c("United States", "USSR"), c("Arizona", "")) + all <- gnrs_test_resolve(dir, c("United States", "USSR"), c("Arizona", ""), history = "all") + expect_identical(def, all) + expect_equal(def$entity_key, c("US", "SUHH")) + # the web-service columns agree with "current" wherever no former country is involved + expect_identical(def[1, names(cur)], cur[1, ]) +}) + +test_that("former countries resolve with history = 'all'", { + r <- gnrs_test_resolve(dir, c("USSR", "Yugoslavia", "Czechoslovakia (former)", "United States"), + history = "all") + expect_equal(r$entity_key, c("SUHH", "YUCS", "CSHH", "US")) + expect_equal(r$is_historical, c(TRUE, TRUE, TRUE, FALSE)) + expect_match(r$successors[1], "(^|;)RU(;|$)") + expect_match(r$successors[1], "(^|;)LT(;|$)") + expect_equal(r$successors[4], "") + # "Czechoslovakia (former)" is not an exact alternate name (case differs): fuzzy + expect_match(r$match_method_country[3], "^fuzzy") +}) + +test_that("names of synthetic CShapes entities match exactly only", { + r <- gnrs_test_resolve(dir, c("Northeastern Rhodesia", "Northeastern Rhodesie"), history = "all") + expect_equal(r$entity_key[1], "CSH5518") + expect_false(identical(r$entity_key[2], "CSH5518")) +}) + +test_that("history = 'at_date' keeps a former country only while it existed", { + df <- data.frame(user_id = 1:3, country = "USSR", state_province = "", county_parish = "", + date = c(1985, 1992, 2005), stringsAsFactors = FALSE) + r <- GNRS_local(df, dir = dir, build_missing = FALSE, quiet = TRUE, history = "at_date") + # 1992 is within the default one-year tolerance of 1991-12-25 + expect_equal(r$entity_key, c("SUHH", "SUHH", "")) + expect_match(r$date_check[1], "valid at record date") + expect_match(r$date_check[3], "outside its validity") + r0 <- GNRS_local(df, dir = dir, build_missing = FALSE, quiet = TRUE, history = "at_date", + tolerance_years = 0) + expect_equal(r0$entity_key, c("SUHH", "", "")) +}) + +test_that("a name marked as former is accepted after the division ended, not before it began", { + expect_equal(gnrs_is_former_label(c("Former USSR", "EX-USSR", "Ex USSR", "USSR (former)", + "Yugoslavia (Former)", "ehemalige DDR", "USSR", "Exeter", "Texas")), + c(TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, FALSE, FALSE, FALSE)) + df <- data.frame(user_id = 1:3, country = c("Former USSR", "Ex-USSR", "Former USSR"), + state_province = "", county_parish = "", date = c(1995, 2010, 1900), + stringsAsFactors = FALSE) + r <- GNRS_local(df, dir = dir, build_missing = FALSE, quiet = TRUE, history = "at_date") + expect_equal(r$entity_key, c("SUHH", "SUHH", "")) + expect_match(r$date_check[1], "named as former") + expect_match(r$date_check[3], "outside its validity") +}) diff --git a/tests/testthat/test-local-resolve.R b/tests/testthat/test-local-resolve.R index 6486ab2..4405e50 100644 --- a/tests/testthat/test-local-resolve.R +++ b/tests/testthat/test-local-resolve.R @@ -5,6 +5,8 @@ context("offline resolution") # match-method labels are the service's. dir <- gnrs_test_backbone() +# history = "all" is the default, and the history component needs CShapes +gnrs_test_cshapes(dir) test_that("the output has the web service's columns, in its order", { r <- gnrs_test_resolve(dir, "United States", "Arizona", "Pima County") @@ -17,7 +19,10 @@ test_that("the output has the web service's columns, in its order", { "gid_2", "match_method_country", "match_method_state_province", "match_method_county_parish", "match_score_country", "match_score_state_province", "match_score_county_parish", "threshold_fuzzy", - "overall_score", "poldiv_submitted", "poldiv_matched", "match_status", "user_id" + "overall_score", "poldiv_submitted", "poldiv_matched", "match_status", "user_id", + # history = "all" (the default) appends the historical-division columns + "entity_key", "is_historical", "entity_valid_from", "entity_valid_to", "successors", + "subnational_resolved_in", "subnational_status", "date_check" )) expect_equal(r$poldiv_full, "United States@Arizona@Pima County") expect_equal(r$country_id, "6252001") @@ -195,12 +200,18 @@ test_that("a missing backbone is reported rather than erroring", { test_that("status and citations describe what was built", { s <- suppressMessages(GNRS_local_status(dir)) - expect_equal(s$source, c("gnrs", "gadm", "geonames", "points")) - expect_equal(s$built, c(TRUE, FALSE, TRUE, FALSE)) + expect_equal(s$source, c("gnrs", "gadm", "geonames", "history", "cshapes", "points")) + # the history component is built on first use of GNRS_local() (history = "all"), from + # the CShapes copy in the cache: CShapes is a component of its own, since nothing + # derived from it ships with the package + expect_equal(s$built, c(TRUE, FALSE, TRUE, TRUE, TRUE, FALSE)) expect_equal(s$version[1], "database test (2024-01-01), code test") cit <- GNRS_local_citations(dir, quiet = TRUE) - expect_equal(cit$what, c("method", "software", "source", "source")) + expect_equal(cit$what, c("method", "software", "source", "source", "source", "source")) expect_true(all(grepl("2024-01-01", cit$citation[3:4]))) + expect_match(cit$citation[5], "CShapes 2.0") + # CShapes is CC BY-NC-SA 4.0: attribution is a condition of use, so it is cited in full + expect_match(cit$citation[6], "Mapping the International System") bib <- tempfile(fileext = ".bib") GNRS_local_citations(dir, bibtex_file = bib, quiet = TRUE) expect_true(any(grepl("^@article", readLines(bib)))) From 1a2f22c55d485d4ef4215e21af97ee7d0b1b8ab5 Mon Sep 17 00:00:00 2001 From: Brian Maitner Date: Tue, 22 Sep 2026 16:00:40 -0400 Subject: [PATCH 2/7] added internal bug fix --- R/local_history.R | 34 +++++++++++++++++++++++++++++++--- man/GNRS_local.Rd | 25 ++++++++++++++++++++++++- 2 files changed, 55 insertions(+), 4 deletions(-) diff --git a/R/local_history.R b/R/local_history.R index b425475..070a75c 100644 --- a/R/local_history.R +++ b/R/local_history.R @@ -102,11 +102,20 @@ gnrs_build_cshapes <- function(dir = gnrs_cache_dir(create = TRUE), quiet = FALS # Repair with GEOS, not s2: s2's st_make_valid re-expresses polygons that cross the # antimeridian with longitudes beyond 180 (Russia's planar centroid came out at # 214.8 degrees instead of 96.8), which breaks point-in-polygon and the planar - # centroids GVS compares against GADM. Area is then ellipsoidal (lwgeom), because - # s2 rejects some unrepaired CShapes rings (degenerate edges). + # centroids GVS compares against GADM. s2 also rejects some unrepaired CShapes + # rings (degenerate edges), and an ellipsoidal area with s2 off would need the + # lwgeom package, so the area is taken in an equal-area projection with planar + # geometry, which needs only PROJ. Long straight edges in longitude/latitude + # (the 129th meridian between Western and South Australia has two vertices) + # are densified first, since a chord between distant vertices cuts area off + # one side and adds it to the other once projected; the cylindrical equal-area + # projection keeps meridians and parallels straight and gives the ellipsoidal + # area. Checked against lwgeom's ellipsoidal area over all 710 CShapes + # country-periods: median ratio 1.0000, 99 percent within 0.1 percent, the + # worst 0.4 percent (a diagonal border treated as a rhumb line, not a geodesic). suppressMessages(sf::sf_use_s2(FALSE)) x <- sf::st_make_valid(x) - area_km2 <- suppressWarnings(as.numeric(sf::st_area(x)) / 1e6) + area_km2 <- gnrs_equal_area_km2(sf::st_geometry(x)) bb <- sf::st_bbox(x) if (bb[["xmin"]] < -180 || bb[["xmax"]] > 180 || bb[["ymin"]] < -90 || bb[["ymax"]] > 90) { stop("CShapes geometry outside WGS84 longitude/latitude bounds after repair.", call. = FALSE) @@ -219,3 +228,22 @@ gnrs_max_vertex_distance <- function(geom, centres) { max(sqrt((xy[, 1] - centres[i, 1])^2 + (xy[, 2] - centres[i, 2])^2)) }, numeric(1)) } + +#' Area of longitude/latitude polygons without s2 or lwgeom +#' +#' Internal. Planar densification of the edges (every 0.05 degrees, about +#' 5 km), then the cylindrical equal-area projection on the WGS84 ellipsoid +#' (EPSG:6933) and a planar area. Used where s2 is switched off and the +#' lwgeom package cannot be assumed. +#' +#' @param geometry An sfc of polygons in longitude/latitude. +#' @return Areas in square kilometres. +#' @keywords internal +#' @noRd +gnrs_equal_area_km2 <- function(geometry) { + planar <- sf::st_set_crs(geometry, NA) + dense <- sf::st_segmentize(planar, 0.05) + dense <- sf::st_set_crs(dense, 4326) + projected <- sf::st_transform(dense, "EPSG:6933") + as.numeric(sf::st_area(projected)) / 1e6 +} diff --git a/man/GNRS_local.Rd b/man/GNRS_local.Rd index 08c36c4..0629058 100644 --- a/man/GNRS_local.Rd +++ b/man/GNRS_local.Rd @@ -10,6 +10,8 @@ GNRS_local( alternate_names = TRUE, dir = gnrs_cache_dir(), build_missing = interactive(), + history = c("all", "current", "at_date"), + tolerance_years = 1, quiet = FALSE ) } @@ -37,11 +39,32 @@ the size and asks first. In a script it is therefore FALSE and nothing is downloaded silently: the function reports what is missing and the call that would fix it. Set it to TRUE to allow an unattended build.} +\item{history}{Historical political divisions: \code{"all"} (the default; +also matches former countries such as the USSR, Yugoslavia or +Czechoslovakia, flagging such matches, so a record named with a political +division that was ever accurate resolves), \code{"current"} (today's +divisions only, as the web service does), or \code{"at_date"} (as "all", +but a former country is accepted only if it existed at the record's date, +taken from an optional \code{date} column of years or ISO dates; a name +marked as former, such as "Former USSR", is accepted for any later date, +and a state or county that resolves within a successor is kept and flagged +whatever the date). Needs the \code{"history"} component, which is built +from tables shipped with the package and downloads nothing.} + +\item{tolerance_years}{With \code{history = "at_date"}, how many years +either side of a former country's existence a record date may fall.} + \item{quiet}{Suppress progress messages?} } \value{ A data.frame with the same columns as \code{GNRS()}, one row per - input row in input order. Scores are numeric rather than the character + input row in input order. With \code{history} other than "current", + further columns: \code{entity_key}, \code{is_historical}, + \code{entity_valid_from}, \code{entity_valid_to}, \code{successors} (the + current countries descending from a matched former country), + \code{subnational_resolved_in} and \code{subnational_status} (a state or + county given under a former country is looked up within its successors; + "unverifiable" if none contains it), and \code{date_check}. Scores are numeric rather than the character strings the web service returns; identifiers are character, as the web service returns them; empty values are "". } From 36fbd94979ba3d9ada2d291d6adb3bbc388ecce7 Mon Sep 17 00:00:00 2001 From: Brian Maitner Date: Tue, 22 Sep 2026 16:34:31 -0400 Subject: [PATCH 3/7] addressing copilot flagged bugs --- R/GNRS_local.R | 15 ++++++++++++--- R/local_build.R | 16 +++++++++++++--- R/local_cache.R | 5 +++-- R/local_history.R | 12 +++++++++--- R/local_history_resolve.R | 9 +++++++-- data-raw/history_crosswalk.R | 11 ++++++++--- man/GNRS_local.Rd | 11 ++++++++--- man/GNRS_local_build.Rd | 9 +++++++-- tests/testthat/test-local-history.R | 22 ++++++++++++++++++++++ 9 files changed, 89 insertions(+), 21 deletions(-) diff --git a/R/GNRS_local.R b/R/GNRS_local.R index 33e31b3..8f8ee41 100644 --- a/R/GNRS_local.R +++ b/R/GNRS_local.R @@ -33,10 +33,15 @@ #' taken from an optional \code{date} column of years or ISO dates; a name #' marked as former, such as "Former USSR", is accepted for any later date, #' and a state or county that resolves within a successor is kept and flagged -#' whatever the date). Needs the \code{"history"} component, which is built -#' from tables shipped with the package and downloads nothing. +#' whatever the date). Needs the \code{"history"} component, built from +#' tables shipped with the package plus the CShapes historical boundaries, +#' which are read from the \code{cshapes} package when it is installed and +#' otherwise downloaded from the publisher (about 60 MB) when +#' \code{build_missing} allows building; with \code{history = "current"} +#' nothing beyond the ordinary components is needed. #' @param tolerance_years With \code{history = "at_date"}, how many years -#' either side of a former country's existence a record date may fall. +#' either side of a former country's existence a record date may fall. A +#' single non-negative number. #' @param quiet Suppress progress messages? #' @return A data.frame with the same columns as \code{GNRS()}, one row per #' input row in input order. With \code{history} other than "current", @@ -100,6 +105,10 @@ GNRS_local <- function(political_division_dataframe, if (!is.logical(alternate_names) || length(alternate_names) != 1L || is.na(alternate_names)) { stop("alternate_names should be TRUE or FALSE", call. = FALSE) } + if (!is.numeric(tolerance_years) || length(tolerance_years) != 1L || + !is.finite(tolerance_years) || tolerance_years < 0) { + stop("tolerance_years should be a single non-negative number", call. = FALSE) + } input <- gnrs_check_input(political_division_dataframe) diff --git a/R/local_build.R b/R/local_build.R index cad9dd8..4c40d5b 100644 --- a/R/local_build.R +++ b/R/local_build.R @@ -54,8 +54,13 @@ #' \code{GNRS_local_status()} to see what has been built. #' #' @param sources Character vector of components to build: \code{"gnrs"}, -#' \code{"geonames"} (the two defaults), \code{"points"} and -#' \code{"gadm"}. The other components are layered on or filtered to the +#' \code{"geonames"} (the two defaults), \code{"points"}, \code{"gadm"}, +#' and, for \code{GNRS_local()}'s historical modes, \code{"cshapes"} (the +#' CShapes 2.0 boundaries of former countries, from the \code{cshapes} +#' package when it is installed, otherwise a 60 MB download) and +#' \code{"history"} (the historical entities, names and lineage, assembled +#' from tables shipped with the package and from CShapes, which it builds if +#' it is missing). The other components are layered on or filtered to the #' service's tables, so \code{"gnrs"} is built first if it is missing #' whatever is asked for. #' @param dir Cache directory. Defaults to the standard user cache location. @@ -165,11 +170,16 @@ GNRS_local_build <- function(sources = c("gnrs", "geonames"), } # the history component is derived from CShapes at build time, so it needs CShapes # built even when only "history" was asked for (without rebuilding an existing copy) + cshapes_rebuilt <- FALSE if ((cshapes_wanted && (overwrite || !gnrs_is_built("cshapes", dir))) || (history_wanted && !gnrs_is_built("cshapes", dir))) { gnrs_build_cshapes(dir = dir, quiet = quiet) + cshapes_rebuilt <- TRUE } - if (history_wanted && (overwrite || !gnrs_is_built("history", dir))) { + # a history component already built is derived from the CShapes that was + # replaced, so it is rebuilt with it + if ((history_wanted && (overwrite || !gnrs_is_built("history", dir))) || + (cshapes_rebuilt && gnrs_is_built("history", dir))) { if (!quiet) message("Building the history component ...") gnrs_build_history(dir = dir, quiet = quiet) } diff --git a/R/local_cache.R b/R/local_cache.R index 18b8784..4998148 100644 --- a/R/local_cache.R +++ b/R/local_cache.R @@ -214,8 +214,9 @@ gnrs_is_built <- function(source, dir = gnrs_cache_dir()) { gadm = file.exists(gnrs_gadm_path(dir)), geonames = file.exists(gnrs_altnames_path(dir)), points = file.exists(gnrs_points_path(dir)), - history = file.exists(gnrs_history_path("entities", dir)), - cshapes = file.exists(gnrs_cshapes_versions_path(dir)), + # every table the resolver reads, so an interrupted build is rebuilt + history = all(file.exists(gnrs_history_path(c("entities", "names", "lineage", "periods"), dir))), + cshapes = file.exists(gnrs_cshapes_versions_path(dir)) && file.exists(gnrs_cshapes_geom_path(dir)), FALSE ) } diff --git a/R/local_history.R b/R/local_history.R index 070a75c..f7f4816 100644 --- a/R/local_history.R +++ b/R/local_history.R @@ -60,12 +60,18 @@ gnrs_read_cshapes <- function(dir = gnrs_cache_dir(), quiet = FALSE) { if (!file.exists(f)) { if (!quiet) message("Downloading ", spec$full_name, " (about ", spec$download_mb, " MB) ...") partial <- paste0(f, ".part") - status <- utils::download.file(spec$url, partial, mode = "wb", quiet = quiet) - if (status != 0) { + # R's default of 60 seconds is not enough for a file this size + old <- options(timeout = max(3600, getOption("timeout"))) + on.exit(options(old), add = TRUE) + status <- utils::download.file(spec$url, partial, mode = "wb", quiet = quiet, cacheOK = FALSE) + if (status != 0 || !file.exists(partial)) { unlink(partial) stop("Download failed for CShapes.", call. = FALSE) } - file.rename(partial, f) + if (!file.rename(partial, f)) { + unlink(partial) + stop("Could not move the downloaded CShapes file into place.", call. = FALSE) + } } x <- sf::st_read(f, quiet = TRUE) # the geojson spells the Gleditsch & Ward code and dates like the package does diff --git a/R/local_history_resolve.R b/R/local_history_resolve.R index 4db9fee..d336dbd 100644 --- a/R/local_history_resolve.R +++ b/R/local_history_resolve.R @@ -231,18 +231,23 @@ gnrs_is_former_label <- function(x) { } #' Current successors of a historical entity, following the lineage to the present +#' +#' Internal. The lineage is followed through current countries as well as +#' former ones: a current country can itself have later successors (Kosovo +#' seceded from Serbia in 2008, so it descends from Yugoslavia through +#' Serbia), and every node is visited once. #' @keywords internal #' @noRd gnrs_current_successors <- function(entity_id, h) { cur <- h$entities$entity_id[h$entities$kind == "current"] - seen <- integer(0) + seen <- entity_id front <- entity_id out <- integer(0) while (length(front)) { nxt <- setdiff(unique(h$lineage$to_id[h$lineage$from_id %in% front]), seen) seen <- c(seen, nxt) out <- c(out, intersect(nxt, cur)) - front <- setdiff(nxt, cur) + front <- nxt } unique(out) } diff --git a/data-raw/history_crosswalk.R b/data-raw/history_crosswalk.R index 546ae04..23e18bc 100644 --- a/data-raw/history_crosswalk.R +++ b/data-raw/history_crosswalk.R @@ -43,9 +43,14 @@ suppressMessages({library(data.table); library(nanoparquet); library(jsonlite); library(arrow)}) -SRC <- "C:/Users/bmaitner/Desktop/current_projects/gvs_ms/data/history_sources" -GNRS_CACHE <- "C:/Users/bmaitner/AppData/Local/R/cache/R/GNRS" -OUT <- file.path("C:/Users/bmaitner/Desktop/current_projects/RGNRS", "inst", "extdata") +# Run from the package root. The source downloads (CLDR, GeoNames, ...) live +# wherever GNRS_HISTORY_SOURCES points; the service's country table is read +# from the package's own cache, built with GNRS_local_build(). +SRC <- Sys.getenv("GNRS_HISTORY_SOURCES", unset = NA) +if (is.na(SRC)) stop("Set GNRS_HISTORY_SOURCES to the directory holding the source downloads.") +GNRS_CACHE <- Sys.getenv("GNRS_CACHE_DIR", unset = tools::R_user_dir("GNRS", "cache")) +OUT <- file.path("inst", "extdata") +if (!file.exists("DESCRIPTION")) stop("Run this script from the package root.") dir.create(OUT, recursive = TRUE, showWarnings = FALSE) D <- function(x) as.Date(x) diff --git a/man/GNRS_local.Rd b/man/GNRS_local.Rd index 0629058..cdd8312 100644 --- a/man/GNRS_local.Rd +++ b/man/GNRS_local.Rd @@ -48,11 +48,16 @@ but a former country is accepted only if it existed at the record's date, taken from an optional \code{date} column of years or ISO dates; a name marked as former, such as "Former USSR", is accepted for any later date, and a state or county that resolves within a successor is kept and flagged -whatever the date). Needs the \code{"history"} component, which is built -from tables shipped with the package and downloads nothing.} +whatever the date). Needs the \code{"history"} component, built from +tables shipped with the package plus the CShapes historical boundaries, +which are read from the \code{cshapes} package when it is installed and +otherwise downloaded from the publisher (about 60 MB) when +\code{build_missing} allows building; with \code{history = "current"} +nothing beyond the ordinary components is needed.} \item{tolerance_years}{With \code{history = "at_date"}, how many years -either side of a former country's existence a record date may fall.} +either side of a former country's existence a record date may fall. A +single non-negative number.} \item{quiet}{Suppress progress messages?} } diff --git a/man/GNRS_local_build.Rd b/man/GNRS_local_build.Rd index 11a174f..69fce48 100644 --- a/man/GNRS_local_build.Rd +++ b/man/GNRS_local_build.Rd @@ -15,8 +15,13 @@ GNRS_local_build( } \arguments{ \item{sources}{Character vector of components to build: \code{"gnrs"}, -\code{"geonames"} (the two defaults), \code{"points"} and -\code{"gadm"}. The other components are layered on or filtered to the +\code{"geonames"} (the two defaults), \code{"points"}, \code{"gadm"}, +and, for \code{GNRS_local()}'s historical modes, \code{"cshapes"} (the +CShapes 2.0 boundaries of former countries, from the \code{cshapes} +package when it is installed, otherwise a 60 MB download) and +\code{"history"} (the historical entities, names and lineage, assembled +from tables shipped with the package and from CShapes, which it builds if +it is missing). The other components are layered on or filtered to the service's tables, so \code{"gnrs"} is built first if it is missing whatever is asked for.} diff --git a/tests/testthat/test-local-history.R b/tests/testthat/test-local-history.R index b072755..4eb5df4 100644 --- a/tests/testthat/test-local-history.R +++ b/tests/testthat/test-local-history.R @@ -78,6 +78,9 @@ test_that("former countries resolve with history = 'all'", { expect_equal(r$is_historical, c(TRUE, TRUE, TRUE, FALSE)) expect_match(r$successors[1], "(^|;)RU(;|$)") expect_match(r$successors[1], "(^|;)LT(;|$)") + # the lineage is followed through Serbia to Kosovo, which seceded from it + expect_match(r$successors[2], "(^|;)RS(;|$)") + expect_match(r$successors[2], "(^|;)XK(;|$)") expect_equal(r$successors[4], "") # "Czechoslovakia (former)" is not an exact alternate name (case differs): fuzzy expect_match(r$match_method_country[3], "^fuzzy") @@ -114,3 +117,22 @@ test_that("a name marked as former is accepted after the division ended, not bef expect_match(r$date_check[1], "named as former") expect_match(r$date_check[3], "outside its validity") }) + +test_that("tolerance_years must be a single non-negative number", { + df <- data.frame(user_id = 1, country = "USSR", state_province = "", county_parish = "", date = "1970") + expect_error(GNRS_local(df, dir = dir, history = "at_date", tolerance_years = NA, quiet = TRUE), "tolerance_years") + expect_error(GNRS_local(df, dir = dir, history = "at_date", tolerance_years = c(1, 2), quiet = TRUE), "tolerance_years") + expect_error(GNRS_local(df, dir = dir, history = "at_date", tolerance_years = -1, quiet = TRUE), "tolerance_years") +}) + +test_that("a component counts as built only when every one of its files is there", { + expect_true(gnrs_is_built("history", dir)) + expect_true(gnrs_is_built("cshapes", dir)) + partial <- file.path(tempdir(), "gnrs-partial-history") + unlink(partial, recursive = TRUE) + dir.create(partial) + file.copy(gnrs_history_path("entities", dir), gnrs_history_path("entities", partial)) + file.copy(gnrs_cshapes_versions_path(dir), gnrs_cshapes_versions_path(partial)) + expect_false(gnrs_is_built("history", partial)) + expect_false(gnrs_is_built("cshapes", partial)) +}) From 33d662d80f442888a6b9b4e451a46183d447d1a2 Mon Sep 17 00:00:00 2001 From: Brian Maitner Date: Tue, 22 Sep 2026 17:00:45 -0400 Subject: [PATCH 4/7] addressing copilot bugs --- R/GNRS_local.R | 9 +++++---- R/local_build.R | 23 +++++++++++++++++++---- R/local_history_resolve.R | 19 ++++++++++++++----- man/GNRS_local.Rd | 8 ++++---- man/GNRS_local_build.Rd | 13 ++++++++++++- tests/testthat/test-local-history.R | 15 +++++++++++++++ 6 files changed, 69 insertions(+), 18 deletions(-) diff --git a/R/GNRS_local.R b/R/GNRS_local.R index 8f8ee41..af96c6b 100644 --- a/R/GNRS_local.R +++ b/R/GNRS_local.R @@ -24,6 +24,7 @@ #' the size and asks first. In a script it is therefore FALSE and nothing is #' downloaded silently: the function reports what is missing and the call that #' would fix it. Set it to TRUE to allow an unattended build. +#' @param quiet Suppress progress messages? #' @param history Historical political divisions: \code{"all"} (the default; #' also matches former countries such as the USSR, Yugoslavia or #' Czechoslovakia, flagging such matches, so a record named with a political @@ -42,7 +43,6 @@ #' @param tolerance_years With \code{history = "at_date"}, how many years #' either side of a former country's existence a record date may fall. A #' single non-negative number. -#' @param quiet Suppress progress messages? #' @return A data.frame with the same columns as \code{GNRS()}, one row per #' input row in input order. With \code{history} other than "current", #' further columns: \code{entity_key}, \code{is_historical}, @@ -91,9 +91,9 @@ GNRS_local <- function(political_division_dataframe, alternate_names = TRUE, dir = gnrs_cache_dir(), build_missing = interactive(), + quiet = FALSE, history = c("all", "current", "at_date"), - tolerance_years = 1, - quiet = FALSE) { + tolerance_years = 1) { history <- match.arg(history) if (!inherits(political_division_dataframe, "data.frame")) { stop("political_division_dataframe should be a data.frame", call. = FALSE) @@ -186,7 +186,8 @@ GNRS_local <- function(political_division_dataframe, } r <- gnrs_resolve_history(u, m, dates, bb, dir = dir, threshold = threshold, - history = history, tolerance_years = tolerance_years) + history = history, tolerance_years = tolerance_years, + alternate_names = alternate_names) out <- gnrs_build_output(r, input, threshold) chr <- function(x) { x <- as.character(x); x[is.na(x)] <- ""; x } out$entity_key <- chr(r$entity_key) diff --git a/R/local_build.R b/R/local_build.R index 4c40d5b..08c6e86 100644 --- a/R/local_build.R +++ b/R/local_build.R @@ -6,7 +6,7 @@ #' is kept in the standard user cache directory, and can be removed again with #' \code{GNRS_local_remove()}. #' -#' Two components are fetched by default, and two more can be added. +#' Two components are fetched by default, and four more can be added. #' \code{"gnrs"} is the web service's own #' reference tables of countries, states/provinces and counties/parishes, #' fetched through its API in a few small requests: every political division it @@ -49,6 +49,17 @@ #' GeoNames places its points near an edge often enough. Build it before #' \code{"gadm"} (the order is arranged whatever order is given). #' +#' \code{"cshapes"} and \code{"history"} serve the historical modes of +#' \code{GNRS_local()}. The first is CShapes 2.0, the boundaries of every +#' independent state and dependency from 1886 to 2019, read from the +#' \code{cshapes} package when it is installed and otherwise downloaded from +#' its publisher (about 60 MB; CC BY-NC-SA 4.0, so nothing derived from it +#' ships with the package). The second assembles the historical entities, +#' their names, codes and lineage from tables shipped with the package and +#' from CShapes, and prunes its names against the current name table, so it +#' is built last and rebuilt whenever a component it draws on is rebuilt. +#' Asking for \code{"history"} builds \code{"cshapes"} if it is missing. +#' #' Each component is recorded with its version, so that results obtained locally #' can be cited as precisely as results from the web service. Use #' \code{GNRS_local_status()} to see what has been built. @@ -126,6 +137,9 @@ GNRS_local_build <- function(sources = c("gnrs", "geonames"), dir.create(dir, recursive = TRUE, showWarnings = FALSE) } + # the history component prunes its names against the assembled name table, + # so it is rebuilt when any component that table draws on was rebuilt here + dependency_rebuilt <- FALSE for (source in sources) { if (gnrs_is_built(source, dir) && !overwrite) { if (!quiet) message("Source '", source, "' is already built; skipping.") @@ -145,6 +159,7 @@ GNRS_local_build <- function(sources = c("gnrs", "geonames"), next } + dependency_rebuilt <- TRUE if (source == "gnrs") { gnrs_build_reference(dir = dir, url = url, quiet = quiet) } else if (source == "gadm") { @@ -176,10 +191,10 @@ GNRS_local_build <- function(sources = c("gnrs", "geonames"), gnrs_build_cshapes(dir = dir, quiet = quiet) cshapes_rebuilt <- TRUE } - # a history component already built is derived from the CShapes that was - # replaced, so it is rebuilt with it + # a history component already built is derived from the CShapes and the + # name table that were just replaced, so it is rebuilt with them if ((history_wanted && (overwrite || !gnrs_is_built("history", dir))) || - (cshapes_rebuilt && gnrs_is_built("history", dir))) { + ((cshapes_rebuilt || dependency_rebuilt) && gnrs_is_built("history", dir))) { if (!quiet) message("Building the history component ...") gnrs_build_history(dir = dir, quiet = quiet) } diff --git a/R/local_history_resolve.R b/R/local_history_resolve.R index d336dbd..124f2cd 100644 --- a/R/local_history_resolve.R +++ b/R/local_history_resolve.R @@ -149,9 +149,14 @@ gnrs_history <- function(dir = gnrs_cache_dir()) { #' alternate names, so the unchanged cascade finds them by exact or fuzzy #' alternate name. They carry no ISO or GADM codes. The copy has its own match #' cache, so indexes built for the current-only backbone are not reused. +#' +#' With \code{alternate_names = FALSE} only each entity's own name and its +#' ISO 3166-3 codes are appended, as \code{gnrs_without_alternate_names()} +#' keeps only the current divisions' own names: the curated, CShapes and +#' GeoNames aliases are alternate names in the same sense. #' @keywords internal #' @noRd -gnrs_backbone_with_history <- function(bb, dir = gnrs_cache_dir()) { +gnrs_backbone_with_history <- function(bb, dir = gnrs_cache_dir(), alternate_names = TRUE) { h <- gnrs_history(dir) he <- h$entities[h$entities$kind == "historical", , drop = FALSE] co <- bb$country @@ -177,11 +182,15 @@ gnrs_backbone_with_history <- function(bb, dir = gnrs_cache_dir()) { level = "country", id = h$names$entity_id, name = h$names$name, name_type = paste("historical:", h$names$source), stringsAsFactors = FALSE ) - new_names <- new_names[!is.na(new_names$id), , drop = FALSE] + keep <- !is.na(new_names$id) + if (!alternate_names) { + keep <- keep & h$names$source %in% c("entity name", "ISO 3166-3") + } + new_names <- new_names[keep, , drop = FALSE] new_names$lower <- gnrs_lower(new_names$name) new_names$original <- TRUE # per-name decision shipped in history_names.csv (data-raw/history_crosswalk.R) - new_names$fuzzy <- as.logical(h$names$fuzzy[!is.na(h$names$entity_id)]) + new_names$fuzzy <- as.logical(h$names$fuzzy[keep]) cn$fuzzy <- TRUE for (col in setdiff(names(cn), names(new_names))) new_names[[col]] <- NA new_names <- new_names[, names(cn), drop = FALSE] @@ -274,9 +283,9 @@ gnrs_current_successors <- function(entity_id, h) { #' result is "unverifiable". #' @keywords internal #' @noRd -gnrs_resolve_history <- function(u, m, dates, bb_current, dir, threshold, history, tolerance_years = 1) { +gnrs_resolve_history <- function(u, m, dates, bb_current, dir, threshold, history, tolerance_years = 1, alternate_names = TRUE) { h <- gnrs_history(dir) - bb_all <- gnrs_backbone_with_history(bb_current, dir) + bb_all <- gnrs_backbone_with_history(bb_current, dir, alternate_names = alternate_names) old <- gnrs_env$backbone on.exit(gnrs_env$backbone <- old, add = TRUE) diff --git a/man/GNRS_local.Rd b/man/GNRS_local.Rd index cdd8312..dbc32af 100644 --- a/man/GNRS_local.Rd +++ b/man/GNRS_local.Rd @@ -10,9 +10,9 @@ GNRS_local( alternate_names = TRUE, dir = gnrs_cache_dir(), build_missing = interactive(), + quiet = FALSE, history = c("all", "current", "at_date"), - tolerance_years = 1, - quiet = FALSE + tolerance_years = 1 ) } \arguments{ @@ -39,6 +39,8 @@ the size and asks first. In a script it is therefore FALSE and nothing is downloaded silently: the function reports what is missing and the call that would fix it. Set it to TRUE to allow an unattended build.} +\item{quiet}{Suppress progress messages?} + \item{history}{Historical political divisions: \code{"all"} (the default; also matches former countries such as the USSR, Yugoslavia or Czechoslovakia, flagging such matches, so a record named with a political @@ -58,8 +60,6 @@ nothing beyond the ordinary components is needed.} \item{tolerance_years}{With \code{history = "at_date"}, how many years either side of a former country's existence a record date may fall. A single non-negative number.} - -\item{quiet}{Suppress progress messages?} } \value{ A data.frame with the same columns as \code{GNRS()}, one row per diff --git a/man/GNRS_local_build.Rd b/man/GNRS_local_build.Rd index 69fce48..a55435f 100644 --- a/man/GNRS_local_build.Rd +++ b/man/GNRS_local_build.Rd @@ -49,7 +49,7 @@ is kept in the standard user cache directory, and can be removed again with \code{GNRS_local_remove()}. } \details{ -Two components are fetched by default, and two more can be added. +Two components are fetched by default, and four more can be added. \code{"gnrs"} is the web service's own reference tables of countries, states/provinces and counties/parishes, fetched through its API in a few small requests: every political division it @@ -92,6 +92,17 @@ A link whose names agree outright is kept whatever the point says, since GeoNames places its points near an edge often enough. Build it before \code{"gadm"} (the order is arranged whatever order is given). +\code{"cshapes"} and \code{"history"} serve the historical modes of +\code{GNRS_local()}. The first is CShapes 2.0, the boundaries of every +independent state and dependency from 1886 to 2019, read from the +\code{cshapes} package when it is installed and otherwise downloaded from +its publisher (about 60 MB; CC BY-NC-SA 4.0, so nothing derived from it +ships with the package). The second assembles the historical entities, +their names, codes and lineage from tables shipped with the package and +from CShapes, and prunes its names against the current name table, so it +is built last and rebuilt whenever a component it draws on is rebuilt. +Asking for \code{"history"} builds \code{"cshapes"} if it is missing. + Each component is recorded with its version, so that results obtained locally can be cited as precisely as results from the web service. Use \code{GNRS_local_status()} to see what has been built. diff --git a/tests/testthat/test-local-history.R b/tests/testthat/test-local-history.R index 4eb5df4..c45ac82 100644 --- a/tests/testthat/test-local-history.R +++ b/tests/testthat/test-local-history.R @@ -136,3 +136,18 @@ test_that("a component counts as built only when every one of its files is there expect_false(gnrs_is_built("history", partial)) expect_false(gnrs_is_built("cshapes", partial)) }) + +test_that("without alternate names a former country is found by its own name only", { + with_alt <- gnrs_test_resolve(dir, c("USSR", "Union of Soviet Socialist Republics")) + expect_equal(with_alt$entity_key, c("SUHH", "SUHH")) + without <- gnrs_test_resolve(dir, c("USSR", "Union of Soviet Socialist Republics"), alternate_names = FALSE) + expect_false(without$entity_key[1] == "SUHH") + expect_equal(without$entity_key[2], "SUHH") +}) + +test_that("the history arguments come after quiet, so positional callers still work", { + df <- data.frame(user_id = 1, country = "Mexico", state_province = "", county_parish = "") + r <- GNRS_local(df, 0.5, TRUE, dir, FALSE, TRUE) + expect_equal(r$country, "Mexico") + expect_equal(names(formals(GNRS_local))[6], "quiet") +}) From 68a4774e944b493e61d9bae4b52dc226327653ea Mon Sep 17 00:00:00 2001 From: Brian Maitner Date: Tue, 22 Sep 2026 17:35:44 -0400 Subject: [PATCH 5/7] copilot bugs --- R/local_build.R | 3 ++- R/local_cache.R | 13 ++++++++++++- R/local_history_assemble.R | 12 +++++++++--- man/GNRS_local_remove.Rd | 4 +++- tests/testthat/test-local-history.R | 23 +++++++++++++++++++++++ 5 files changed, 49 insertions(+), 6 deletions(-) diff --git a/R/local_build.R b/R/local_build.R index 08c6e86..24d91b9 100644 --- a/R/local_build.R +++ b/R/local_build.R @@ -803,7 +803,8 @@ gnrs_assemble_names <- function(dir = gnrs_cache_dir(), quiet = FALSE) { is_geo <- tbl$is_geoname rows <- alt[alt$geonameid %in% ids[is_geo], , drop = FALSE] - out <- data.frame(id = rows$geonameid, name = rows$name, name_type = original, stringsAsFactors = FALSE) + # rep(): with no alternate names built there are no rows to recycle over + out <- data.frame(id = rows$geonameid, name = rows$name, name_type = rep(original, nrow(rows)), stringsAsFactors = FALSE) for (col in name_cols) { out <- rbind(out, data.frame( id = ids[is_geo], name = tbl[[col]][is_geo], name_type = original, stringsAsFactors = FALSE diff --git a/R/local_cache.R b/R/local_cache.R index 4998148..3173da5 100644 --- a/R/local_cache.R +++ b/R/local_cache.R @@ -333,7 +333,9 @@ GNRS_local_status <- function(dir = gnrs_cache_dir()) { #' @param sources NULL, the default, removes everything. Otherwise the #' components to remove, for instance \code{"gadm"} to go back to resolving #' against the service's own GADM identifiers; the reference tables are -#' rederived from what remains. +#' rederived from what remains, and a built \code{"history"} component is +#' rebuilt against them, or removed along with \code{"cshapes"}, which it +#' is derived from. #' @param ask Ask for confirmation before deleting? Defaults to TRUE in an #' interactive session. #' @return TRUE if anything was removed, FALSE otherwise, invisibly. @@ -387,9 +389,18 @@ GNRS_local_remove <- function(dir = gnrs_cache_dir(), sources = NULL, ask = inte unlink(files) for (s in sources) unlink(gnrs_provenance_path(s, dir)) if ("gadm" %in% sources) unlink(gnrs_gadm_archive_path(dir)) + # the history component is derived from CShapes and pruned against the + # name table: it goes with CShapes, and is rebuilt when a name source goes + if ("cshapes" %in% sources && !"history" %in% sources) { + unlink(gnrs_source_files("history", dir)) + unlink(gnrs_provenance_path("history", dir)) + } if (gnrs_is_built("gnrs", dir)) { gnrs_finalize_reference(dir, quiet = TRUE) gnrs_assemble_names(dir, quiet = TRUE) + if (any(c("gadm", "geonames") %in% sources) && gnrs_is_built("history", dir) && gnrs_is_built("cshapes", dir)) { + gnrs_build_history(dir = dir, quiet = TRUE) + } } } gnrs_forget_backbone() diff --git a/R/local_history_assemble.R b/R/local_history_assemble.R index cd1eb6b..f2c0ab6 100644 --- a/R/local_history_assemble.R +++ b/R/local_history_assemble.R @@ -158,17 +158,23 @@ gnrs_history_assemble <- function(dir = gnrs_cache_dir(), quiet = FALSE) { gn_names <- merge(gn, entities[!is.na(entities$geonameid), c("geonameid", "entity_key")], by = "geonameid") gn_names <- gn_names[nzchar(gn_names$name), c("entity_key", "name")] gn_names$source <- "GeoNames (CC BY 4.0)" - iso_names <- unique(data.frame(entity_key = codes$entity_key, name = codes$name, source = "ISO 3166-3", + # the former codes themselves ("SUHH", "ANHH"), which a record may carry in place + # of a name, and the names ISO lists them under + iso_codes <- unique(data.frame(entity_key = codes$entity_key, name = codes$code, source = "ISO 3166-3", stringsAsFactors = FALSE)) - hnames <- rbind(ent_names, curated_names, cs_names, gn_names, iso_names) + iso_names <- unique(data.frame(entity_key = codes$entity_key, name = codes$name, source = "ISO 3166-3 name", + stringsAsFactors = FALSE)) + hnames <- rbind(ent_names, curated_names, cs_names, gn_names, iso_codes, iso_names) hnames <- hnames[!duplicated(hnames[, c("entity_key", "name")]), , drop = FALSE] hnames <- hnames[nzchar(trimws(hnames$name)), , drop = FALSE] # fuzzy: may this name take part in GNRS fuzzy matching? Exact-only for names of # synthetic entities made from CShapes colonies (obscure names that drew fuzzy matches # from current countries on GBIF data: "Northern Rhodesia> Zambia" -> "Northeastern # Rhodesia") and for short former names that are near-duplicates of other entities' + # ... and never for a code, which is matched whole or not at all hnames$fuzzy <- !grepl("^CSH[0-9]+$", hnames$entity_key) & - !(hnames$name %in% gnrs_history_exact_only_names()) + !(hnames$name %in% gnrs_history_exact_only_names()) & + hnames$source != "ISO 3166-3" bad <- setdiff(hnames$entity_key, entities$entity_key) if (length(bad)) stop("History names reference unknown entities: ", paste(bad, collapse = ", "), call. = FALSE) diff --git a/man/GNRS_local_remove.Rd b/man/GNRS_local_remove.Rd index 73332e0..d59de45 100644 --- a/man/GNRS_local_remove.Rd +++ b/man/GNRS_local_remove.Rd @@ -12,7 +12,9 @@ GNRS_local_remove(dir = gnrs_cache_dir(), sources = NULL, ask = interactive()) \item{sources}{NULL, the default, removes everything. Otherwise the components to remove, for instance \code{"gadm"} to go back to resolving against the service's own GADM identifiers; the reference tables are -rederived from what remains.} +rederived from what remains, and a built \code{"history"} component is +rebuilt against them, or removed along with \code{"cshapes"}, which it +is derived from.} \item{ask}{Ask for confirmation before deleting? Defaults to TRUE in an interactive session.} diff --git a/tests/testthat/test-local-history.R b/tests/testthat/test-local-history.R index c45ac82..4ef0f5d 100644 --- a/tests/testthat/test-local-history.R +++ b/tests/testthat/test-local-history.R @@ -145,6 +145,29 @@ test_that("without alternate names a former country is found by its own name onl expect_equal(without$entity_key[2], "SUHH") }) +test_that("former ISO 3166-3 codes resolve, with or without alternate names, and never fuzzily", { + r <- gnrs_test_resolve(dir, c("SUHH", "ANHH", "SUHX")) + expect_equal(r$entity_key[1:2], c("SUHH", "ANHH")) + expect_false(r$entity_key[3] %in% c("SUHH", "ANHH")) + strict <- gnrs_test_resolve(dir, c("SUHH", "ANHH"), alternate_names = FALSE) + expect_equal(strict$entity_key, c("SUHH", "ANHH")) +}) + +test_that("removing a name source rebuilds the history component, and removing CShapes removes it", { + # its own cache: the default would rebuild and then strip the file's dir + rm_dir <- gnrs_test_backbone(file.path(tempdir(), "gnrs-test-remove")) + gnrs_test_cshapes(rm_dir) + gnrs_build_history(dir = rm_dir, quiet = TRUE) + before <- file.mtime(gnrs_history_path("names", rm_dir)) + Sys.sleep(1.1) + expect_true(GNRS_local_remove(rm_dir, sources = "geonames", ask = FALSE)) + expect_true(gnrs_is_built("history", rm_dir)) + expect_gt(as.numeric(file.mtime(gnrs_history_path("names", rm_dir))), as.numeric(before)) + expect_true(GNRS_local_remove(rm_dir, sources = "cshapes", ask = FALSE)) + expect_false(gnrs_is_built("cshapes", rm_dir)) + expect_false(gnrs_is_built("history", rm_dir)) +}) + test_that("the history arguments come after quiet, so positional callers still work", { df <- data.frame(user_id = 1, country = "Mexico", state_province = "", county_parish = "") r <- GNRS_local(df, 0.5, TRUE, dir, FALSE, TRUE) From b9a608b2732b838e7e46933906a95a58fbdbc158 Mon Sep 17 00:00:00 2001 From: Brian Maitner Date: Thu, 24 Sep 2026 11:37:35 -0400 Subject: [PATCH 6/7] working on copilot notes --- R/GNRS_local.R | 16 +++ R/local_altdiv.R | 173 ++++++++++++++++++++++++++++ R/local_build.R | 7 ++ R/local_cache.R | 16 +++ R/local_reference.R | 3 + R/local_resolve.R | 107 ++++++++++++++++- data-raw/altdiv.R | 151 ++++++++++++++++++++++++ inst/extdata/altdiv_extent.csv | 37 ++++++ inst/extdata/altdiv_names.csv | 103 +++++++++++++++++ inst/extdata/altdiv_units.csv | 61 ++++++++++ tests/testthat/test-local-altdiv.R | 75 ++++++++++++ tests/testthat/test-local-history.R | 3 +- tests/testthat/test-local-resolve.R | 11 +- 13 files changed, 757 insertions(+), 6 deletions(-) create mode 100644 R/local_altdiv.R create mode 100644 data-raw/altdiv.R create mode 100644 inst/extdata/altdiv_extent.csv create mode 100644 inst/extdata/altdiv_names.csv create mode 100644 inst/extdata/altdiv_units.csv create mode 100644 tests/testthat/test-local-altdiv.R diff --git a/R/GNRS_local.R b/R/GNRS_local.R index af96c6b..3ae3ae8 100644 --- a/R/GNRS_local.R +++ b/R/GNRS_local.R @@ -123,6 +123,14 @@ GNRS_local <- function(political_division_dataframe, NULL } + # Alternative and superseded sub-national divisions (Swedish landskap, Watsonian + # vice-counties, Norwegian counties after the 2018 and 2020 reforms): shipped + # curation, nothing downloaded, so it is built on first use. + if (!gnrs_is_built("altdiv", dir)) { + if (!quiet) message("Building the alternative-division component (no download) ...") + gnrs_build_altdiv(dir = dir, quiet = TRUE) + } + sources <- if (alternate_names) c("gnrs", "geonames") else "gnrs" if (!gnrs_require_sources(sources, dir = dir, build_missing = build_missing, quiet = quiet)) { return(invisible(NULL)) @@ -332,6 +340,14 @@ gnrs_build_output <- function(r, input, threshold) { user_id = input$user_id, stringsAsFactors = FALSE ) + # A declared division belonging to another division system, recognised as itself + # rather than forced onto the nearest GADM unit. Appended after the service's own + # columns, as the history component's are: extent_known says whether the GADM units + # it covers are known, and so whether a coordinate can be checked against it. + out$alt_division <- chr(r$alt_division) + out$alt_division_system <- chr(r$alt_division_system) + out$alt_division_level <- chr(r$alt_division_level) + out$alt_division_extent_known <- r$alt_division_extent_known rownames(out) <- NULL out } diff --git a/R/local_altdiv.R b/R/local_altdiv.R new file mode 100644 index 0000000..2870cd9 --- /dev/null +++ b/R/local_altdiv.R @@ -0,0 +1,173 @@ +# =========================================================================== +# Alternative and superseded sub-national divisions +# +# A large part of the record stream declares a state or county that is not a GADM +# division: Swedish landskap and lappmarker, British Watsonian vice-counties, +# Norwegian counties from after the 2018 and 2020 reforms. Matching those names +# onto the nearest-looking GADM unit is worse than not matching them at all, +# because the coordinate then falls in a different unit and a correctly +# georeferenced, correctly labelled record looks geo-invalid. +# +# This component recognises such names as units in their own right. A unit with a +# known EXTENT - the set of GADM units it covers - can be validated properly: the +# coordinate must fall inside one of them. A unit whose extent has not been sourced +# yet is UNVERIFIABLE: recognised, and never called invalid. +# +# Curation: data-raw/altdiv.R -> inst/extdata/altdiv_{units,names,extent}.csv. +# =========================================================================== + +#' @keywords internal +#' @noRd +gnrs_altdiv_path <- function(table, dir = gnrs_cache_dir()) { + file.path(dir, paste0("altdiv-", table, ".gz.parquet")) +} + +#' Build the alternative-division component +#' +#' Internal. Reads the shipped curation and writes it to the cache. No +#' download. When the GADM layer is present the extents are checked against it, +#' so a unit can never claim a GADM division that does not exist. +#' @keywords internal +#' @noRd +gnrs_build_altdiv <- function(dir = gnrs_cache_dir(create = TRUE), quiet = FALSE) { + rd <- function(f) utils::read.csv(gnrs_extdata(f), stringsAsFactors = FALSE, + encoding = "UTF-8", na.strings = "") + units <- rd("altdiv_units.csv") + names_ <- rd("altdiv_names.csv") + extent <- rd("altdiv_extent.csv") + units$valid_from <- as.Date(units$valid_from) + units$valid_to <- as.Date(units$valid_to) + if (anyDuplicated(units$entity_key)) stop("Alternative-division keys are not unique.", call. = FALSE) + stopifnot(all(names_$entity_key %in% units$entity_key), + all(extent$entity_key %in% units$entity_key)) + + known <- unique(extent$entity_key) + units$extent_known <- units$entity_key %in% known + if (nrow(extent) && gnrs_is_built("gadm", dir) && file.exists(gnrs_gadm_path(dir))) { + g <- as.data.frame(nanoparquet::read_parquet(gnrs_gadm_path(dir))) + have <- unique(c(g$gid_1, g$gid_2)) + have <- have[!is.na(have)] + # only where the layer covers that country at all: a layer may be partial (and in + # the tests is synthetic), and an extent naming a country it does not carry is not + # an error. Within a country the layer does carry, an unknown unit is a typo. + country <- function(x) sub("[.].*", "", x) + covered <- unique(country(have)) + check <- extent$gid[country(extent$gid) %in% covered] + bad <- setdiff(check, have) + if (length(bad)) { + stop("Alternative-division extents name GADM units that are not in the layer: ", + paste(utils::head(bad, 5), collapse = ", "), call. = FALSE) + } + } + + w <- function(x, table) nanoparquet::write_parquet(x, gnrs_altdiv_path(table, dir), compression = "gzip") + w(units, "units"); w(names_, "names"); w(extent, "extent") + provenance <- list( + source = "altdiv", full_name = "Alternative and superseded sub-national divisions", + version = "1", downloaded = as.character(Sys.Date()), + n_units = nrow(units), n_with_extent = length(known), n_names = nrow(names_), + systems = paste(sort(unique(units$system)), collapse = ", "), + sources = "Curated for GNRS; Norwegian county reforms of 2018 and 2020; Swedish landskap, lappmarker and lan name forms; Watsonian vice-counties" + ) + saveRDS(provenance, gnrs_provenance_path("altdiv", dir)) + gnrs_env$altdiv <- NULL + if (!quiet) { + message(" ", nrow(units), " alternative or superseded divisions (", length(known), + " with a known extent), ", nrow(names_), " names") + } + invisible(provenance) +} + +#' The alternative-division tables, cached for the session +#' @keywords internal +#' @noRd +gnrs_altdiv <- function(dir = gnrs_cache_dir()) { + if (!is.null(gnrs_env$altdiv)) return(gnrs_env$altdiv) + paths <- gnrs_altdiv_path(c("units", "names", "extent"), dir) + if (!all(file.exists(paths))) return(NULL) + rd <- function(p) as.data.frame(nanoparquet::read_parquet(p)) + a <- list(units = rd(paths[1]), names = rd(paths[2]), extent = rd(paths[3])) + a$units$valid_from <- as.Date(a$units$valid_from) + a$units$valid_to <- as.Date(a$units$valid_to) + a$names$lower <- gnrs_lower(a$names$name) + a$country_of <- a$units$country_iso[match(a$names$entity_key, a$units$entity_key)] + a$exact <- a$names$match == "exact" + # A name can belong to two units of different systems: "Skane" is a lan and a + # landskap, "Norrbotten" likewise. Prefer the one whose extent is known, so a + # coordinate can still be checked; the order here is what match() picks up. + ord <- order(!a$units$extent_known[match(a$names$entity_key, a$units$entity_key)]) + a$names <- a$names[ord, , drop = FALSE] + a$country_of <- a$country_of[ord] + a$exact <- a$names$match == "exact" + a$key_exact <- paste(a$country_of[a$exact], a$names$lower[a$exact], sep = "\u001f") + gnrs_env$altdiv <- a + a +} + +#' Match declared division names against the alternative divisions +#' +#' Internal. Vectorised. \code{country_iso} and \code{name} are the declared +#' country and the declared state or county; \code{dates} are the record dates, +#' used only for units that existed over a period. +#' +#' @return data.frame with one row per input: \code{entity_key}, \code{system}, +#' \code{kind}, \code{extent_known}, and \code{in_period} - NA when the unit has +#' no dates or the record has none, so that a caller can tell "outside its +#' period" from "no date to check". +#' @keywords internal +#' @noRd +gnrs_altdiv_match <- function(country_iso, name, dates = NULL, dir = gnrs_cache_dir(), + altdiv = NULL) { + n <- length(name) + out <- data.frame(entity_key = rep(NA_character_, n), system = NA_character_, + kind = NA_character_, extent_known = NA, in_period = NA, + stringsAsFactors = FALSE) + # `altdiv` lets a caller that already holds the tables (the resolver, through the + # backbone) skip the cache lookup + a <- if (!is.null(altdiv)) altdiv else gnrs_altdiv(dir) + if (is.null(a) || !n) return(out) + nm <- gnrs_lower(trimws(ifelse(is.na(name), "", name))) + cc <- toupper(ifelse(is.na(country_iso), "", country_iso)) + hit <- match(paste(cc, nm, sep = "\u001f"), a$key_exact) + key <- ifelse(is.na(hit), NA_character_, a$names$entity_key[a$exact][hit]) + + # the regex systems (vice-counties are written "VC57 Derbyshire"), tried only where + # no exact name matched, and only against patterns registered for that country + rx <- which(!a$exact) + todo <- which(is.na(key) & nzchar(nm)) + for (r in rx) { + if (!length(todo)) break + cand <- todo[cc[todo] == a$country_of[r]] + if (!length(cand)) next + ok <- grepl(a$names$name[r], name[cand], perl = TRUE) + key[cand[ok]] <- a$names$entity_key[r] + todo <- setdiff(todo, cand[ok]) + } + + i <- match(key, a$units$entity_key) + out$entity_key <- key + out$system <- a$units$system[i] + out$kind <- a$units$kind[i] + out$extent_known <- a$units$extent_known[i] + if (!is.null(dates)) { + from <- a$units$valid_from[i] + to <- a$units$valid_to[i] + d <- as.Date(dates) + # NA where there is nothing to check: no dates on the unit, or none on the record + out$in_period <- ifelse(is.na(d) | (is.na(from) & is.na(to)), NA, + (is.na(from) | d >= from) & (is.na(to) | d <= to)) + } + out +} + +#' The GADM units an alternative division covers +#' +#' Internal. Returns a character vector of GADM ids, empty when the extent of +#' that unit has not been sourced. +#' @keywords internal +#' @noRd +gnrs_altdiv_extent <- function(entity_key, dir = gnrs_cache_dir()) { + a <- gnrs_altdiv(dir) + if (is.null(a) || is.na(entity_key)) return(character(0)) + a$extent$gid[a$extent$entity_key == entity_key] +} diff --git a/R/local_build.R b/R/local_build.R index 24d91b9..3da23e3 100644 --- a/R/local_build.R +++ b/R/local_build.R @@ -131,6 +131,7 @@ GNRS_local_build <- function(sources = c("gnrs", "geonames"), # is built last; CShapes geometry is independent of the other components history_wanted <- "history" %in% sources cshapes_wanted <- "cshapes" %in% sources + altdiv_wanted <- "altdiv" %in% sources sources <- intersect(c("gnrs", "geonames", "points", "gadm"), sources) if (!dir.exists(dir)) { @@ -198,6 +199,12 @@ GNRS_local_build <- function(sources = c("gnrs", "geonames"), if (!quiet) message("Building the history component ...") gnrs_build_history(dir = dir, quiet = quiet) } + # Alternative and superseded sub-national divisions: shipped curation, nothing + # downloaded and nothing derived from another component, so it stands alone. + if (altdiv_wanted && (overwrite || !gnrs_is_built("altdiv", dir))) { + if (!quiet) message("Building the alternative-division component ...") + gnrs_build_altdiv(dir = dir, quiet = quiet) + } gnrs_forget_backbone() status <- suppressMessages(GNRS_local_status(dir)) diff --git a/R/local_cache.R b/R/local_cache.R index 3173da5..d03ec66 100644 --- a/R/local_cache.R +++ b/R/local_cache.R @@ -100,6 +100,21 @@ gnrs_builtin_registry <- function() { download_mb = 0, disk_mb = 1 ), + altdiv = list( + source = "altdiv", + full_name = "Alternative and superseded sub-national divisions", + publisher = "Botanical Information and Ecology Network", + url = "shipped with the package", + license = "Curated tables: package licence", + citation = paste( + "Alternative and superseded sub-national divisions compiled for GNRS:", + "Swedish landskap, lappmarker and lan name forms; Watsonian vice-counties of", + "Britain and Ireland; Norwegian counties of the 2018 and 2020 reforms." + ), + # Built from tables shipped with the package; nothing is downloaded + download_mb = 0, + disk_mb = 1 + ), cshapes = list( source = "cshapes", full_name = "CShapes 2.0 historical state boundaries", @@ -217,6 +232,7 @@ gnrs_is_built <- function(source, dir = gnrs_cache_dir()) { # every table the resolver reads, so an interrupted build is rebuilt history = all(file.exists(gnrs_history_path(c("entities", "names", "lineage", "periods"), dir))), cshapes = file.exists(gnrs_cshapes_versions_path(dir)) && file.exists(gnrs_cshapes_geom_path(dir)), + altdiv = all(file.exists(gnrs_altdiv_path(c("units", "names", "extent"), dir))), FALSE ) } diff --git a/R/local_reference.R b/R/local_reference.R index c597f93..910c1ad 100644 --- a/R/local_reference.R +++ b/R/local_reference.R @@ -225,6 +225,9 @@ gnrs_backbone <- function(dir = gnrs_cache_dir(), quiet = FALSE) { sep = sep ) + # the alternative and superseded divisions, so a resolution step can reach them + # without the cache directory being threaded through every call + backbone$altdiv <- gnrs_altdiv(dir) gnrs_env$key <- key gnrs_env$backbone <- backbone backbone diff --git a/R/local_resolve.R b/R/local_resolve.R index 9d07608..22c4211 100644 --- a/R/local_resolve.R +++ b/R/local_resolve.R @@ -48,6 +48,13 @@ gnrs_resolve <- function(u, bb, threshold = 0.5) { u$match_score_country <- na_num u$match_score_state_province <- na_num u$match_score_county_parish <- na_num + # a declared division that belongs to another division system (Swedish landskap, + # Watsonian vice-counties, Norwegian counties after the 2018 and 2020 reforms): + # recognised as itself rather than forced onto the nearest-looking GADM unit + u$alt_division <- na_chr + u$alt_division_system <- na_chr + u$alt_division_level <- na_chr + u$alt_division_extent_known <- NA if (n == 0) { return(gnrs_summarize(u, bb)) @@ -60,10 +67,14 @@ gnrs_resolve <- function(u, bb, threshold = 0.5) { u <- gnrs_step_countryasstate_exact(u, ctx) u <- gnrs_step_countryasstate_fuzzy(u, ctx) u <- gnrs_step_state_exact(u, ctx) + u <- gnrs_step_altdiv(u, ctx, "state") + u <- gnrs_step_state_altname(u, ctx) u <- gnrs_step_state_fuzzy(u, ctx) u <- gnrs_step_stateascountry_exact(u, ctx) u <- gnrs_step_stateascountry_fuzzy(u, ctx) u <- gnrs_step_county_exact(u, ctx) + u <- gnrs_step_altdiv(u, ctx, "county") + u <- gnrs_step_county_altname(u, ctx) u <- gnrs_step_county_fuzzy(u, ctx) u <- gnrs_step_stateascounty_exact(u, ctx) u <- gnrs_step_stateascounty_fuzzy(u, ctx) @@ -366,6 +377,21 @@ gnrs_step_state_exact <- function(u, ctx) { u <- gnrs_set_state(u, hit$rows, hit$ids, t[[3]]) } + u +} + +#' The exact match on a state's GeoNames alternate names +#' +#' Internal. Split from \code{gnrs_step_state_exact()} so that +#' \code{gnrs_step_altdiv()} can run between the two: a name that IS a GADM unit's +#' own name wins, a name that is only an alternate of one does not. +#' @keywords internal +#' @noRd +gnrs_step_state_altname <- function(u, ctx) { + st <- ctx$bb$state + sn <- ctx$bb$state_names + sv <- u$state_province_verbatim + cid <- u$country_id rows <- which(!is.na(cid) & is.na(u$state_province_id) & is.na(u$match_method_state_province) & !gnrs_blank(sv)) hit <- gnrs_exact(rows, gnrs_key(cid[rows], sv[rows]), sn$key_original, sn$id) @@ -547,11 +573,90 @@ gnrs_step_county_exact <- function(u, ctx) { u <- gnrs_set_county(u, hit$rows, hit$ids, t[[3]]) } - rows <- which(!is.na(u$country_id) & !is.na(sid) & is.na(u$county_parish_id) & !gnrs_blank(cpv)) + u +} + +#' The exact match on a county's GeoNames alternate names +#' @keywords internal +#' @noRd +gnrs_step_county_altname <- function(u, ctx) { + cn <- ctx$bb$county_names + cpv <- u$county_parish_verbatim + sid <- u$state_province_id + rows <- which(!is.na(u$country_id) & !is.na(sid) & is.na(u$county_parish_id) & + is.na(u$match_method_county_parish) & !gnrs_blank(cpv)) hit <- gnrs_exact(rows, gnrs_key(sid[rows], cpv[rows]), cn$key_original, cn$id) gnrs_set_county(u, hit$rows, hit$ids, "exact alternate name") } +#' Recognise a declared division that belongs to another division system +#' +#' Internal. Runs between the exact matches on a GADM unit's OWN names and codes +#' and the match on its GeoNames alternate names, which is the precedence the data +#' calls for: Skane is both a landskap and a lan and stays the lan, while Uppland is +#' a landskap and stops being matched to Uppsala lan, a division it is not in. +#' +#' Nothing is written to \code{state_province_id} or \code{county_parish_id}, +#' because these are not GADM divisions. The match method records what was +#' recognised, which also stops the later steps, and the \code{alt_division_*} +#' columns carry it to the caller. Where both levels are recognised the finer one +#' is reported. +#' @keywords internal +#' @noRd +gnrs_step_altdiv <- function(u, ctx, level = c("state", "county")) { + level <- match.arg(level) + a <- ctx$bb$altdiv + if (is.null(a)) return(u) + iso <- ctx$bb$country$iso[match(u$country_id, ctx$bb$country$country_id)] + if (level == "state") { + v <- u$state_province_verbatim + rows <- which(!is.na(u$country_id) & is.na(u$state_province_id) & + is.na(u$match_method_state_province) & !gnrs_blank(v)) + } else { + v <- u$county_parish_verbatim + # a county is only looked up once its state is known, EXCEPT here: the declared + # state may itself be an alternative division, in which case there is no state id + rows <- which(!is.na(u$country_id) & is.na(u$county_parish_id) & + is.na(u$match_method_county_parish) & !gnrs_blank(v)) + } + if (!length(rows)) return(u) + # no dates here: the period of a superseded division is checked where record dates + # live, in the geovalidity test, not in name resolution + m <- gnrs_altdiv_match(iso[rows], v[rows], altdiv = a) + ok <- which(!is.na(m$entity_key)) + if (!length(ok)) return(u) + r <- rows[ok] + method <- paste0("alternative division (", m$system[ok], ")") + + # An ALIAS is the same GADM unit under another name - "Norrbottens lan" IS + # Norrbotten - so it resolves like any other match and stays in the ordinary output. + # Only units that are genuinely not GADM divisions are left unresolved and reported + # through alt_division. + for (j in which(m$kind[ok] == "alias")) { + gid <- a$extent$gid[a$extent$entity_key == m$entity_key[ok][j]] + if (length(gid) != 1L) next + if (level == "state") { + id <- ctx$bb$state$state_province_id[match(gid, ctx$bb$state$gid_1)] + if (!is.na(id)) u <- gnrs_set_state(u, r[j], id, method[j]) + } else { + id <- ctx$bb$county$county_parish_id[match(gid, ctx$bb$county$gid_2)] + if (!is.na(id)) u <- gnrs_set_county(u, r[j], id, method[j]) + } + } + if (level == "state") { + u$match_method_state_province[r] <- ifelse(is.na(u$match_method_state_province[r]), + method, u$match_method_state_province[r]) + } else { + u$match_method_county_parish[r] <- ifelse(is.na(u$match_method_county_parish[r]), + method, u$match_method_county_parish[r]) + } + u$alt_division[r] <- m$entity_key[ok] + u$alt_division_system[r] <- m$system[ok] + u$alt_division_level[r] <- level + u$alt_division_extent_known[r] <- m$extent_known[ok] + u +} + gnrs_step_county_fuzzy <- function(u, ctx) { cpv <- u$county_parish_verbatim sid <- u$state_province_id diff --git a/data-raw/altdiv.R b/data-raw/altdiv.R new file mode 100644 index 0000000..60cd8b3 --- /dev/null +++ b/data-raw/altdiv.R @@ -0,0 +1,151 @@ +# --------------------------------------------------------------------------- +# data-raw/altdiv.R +# +# Generates the curated tables of ALTERNATIVE and SUPERSEDED sub-national +# divisions, which ship with the package in inst/extdata/: +# +# altdiv_units.csv one row per unit: which system it belongs to, its country, +# and, for superseded units, the dates it existed +# altdiv_names.csv the names records use for it; match = "exact" or "regex" +# altdiv_extent.csv the GADM units a unit covers, where that is known +# +# Why this exists. GNRS resolves a declared state or county against GADM. Large +# parts of the record stream declare divisions that are not GADM divisions at all: +# +# Sweden landskap (provinces) and lappmarker are a parallel traditional system; +# a landskap spans several lan and vice versa. 53.6% of Swedish records +# with a declared state use one (Smaland 3.7M records, Uppland 3.0M, +# Vastergotland 2.8M). +# Britain the declared county is a Watsonian vice-county, the botanical +# recording unit, frozen at 1852 boundaries: 99.7% of British records +# with a declared county, written "VC57 Derbyshire". +# Norway the declared county is post-reform (Viken, Innlandet, Vestland, +# Trondelag); GADM 4.1 still carries the pre-2018 counties. +# +# Without this, GNRS matches such a name to the nearest-looking GADM unit - a +# landskap onto a lan - and the coordinate then falls in a different unit, so the +# record looks geo-invalid when it is correctly georeferenced and correctly +# labelled in its own system. Measured on the garden pipeline, that mislabelled +# 19.8M records as invalid, 70% of them from these three countries. +# +# A unit with a known EXTENT can be validated properly: the coordinate must fall in +# one of the GADM units the declared unit covers. A unit with no extent yet is +# UNVERIFIABLE - recognised, never called invalid. +# +# Extents shipped here are only those that are exactly determined. Swedish +# landskap and lappmarker and the British vice-counties need their boundaries, +# which is a separate sourcing and licensing job (see the GNRS issue). +# --------------------------------------------------------------------------- +suppressMessages({library(data.table); library(nanoparquet)}) + +OUT <- file.path("C:/Users/bmaitner/Desktop/current_projects/RGNRS", "inst", "extdata") +GADM <- "C:/Users/bmaitner/Desktop/current_projects/garden_variety_traits/data/services_cache/gadmindex-units.gz.parquet" +dir.create(OUT, recursive = TRUE, showWarnings = FALSE) +D <- function(x) as.Date(x) +units <- list(); names_ <- list(); extent <- list() + +add <- function(system, entity_key, country_iso, name, kind, valid_from = NA, valid_to = NA, + note = NA_character_, alt = character(0), gids = character(0), level = NA_integer_, + match = "exact", register_name = TRUE) { + units[[length(units) + 1]] <<- data.table(system, entity_key, country_iso, name, kind, + valid_from = D(valid_from), valid_to = D(valid_to), note) + # the unit's own name is always an exact lookup; only the alternates carry `match`, + # so a regex system ("^VC ?[0-9]+") does not register its label as a pattern. A system + # whose label nobody writes in a record (the vice-counties) supplies alternates only. + if (match == "exact" && register_name) { + names_[[length(names_) + 1]] <<- data.table(entity_key, name = name, match = "exact") + } + if (length(alt)) { + names_[[length(names_) + 1]] <<- data.table(entity_key, name = alt, match = match) + } + if (length(gids)) { + extent[[length(extent) + 1]] <<- data.table(entity_key, level = as.integer(level), gid = gids) + } +} + +# ---- Norway: counties superseded by the 2018 and 2020 reforms ------------------- +# GADM 4.1 carries the 19 pre-2018 counties. The 2020 reform merged them into 11; +# on 2024-01-01 three of those were dissolved and their predecessors re-established, +# so those names are period-specific. Oslo, Nordland, Rogaland and More og Romsdal +# were unchanged and need no entry: they match GADM directly. +n <- function(key, name, from, to, gids, note) { + add("no-fylke", key, "NO", name, "superseded", from, to, note, gids = gids, level = 1L) +} +n("NO-TRONDELAG", "Tr\u00f8ndelag", "2018-01-01", NA, + c("NOR.9_1", "NOR.15_1"), "2018 merger of Nord-Tr\u00f8ndelag and S\u00f8r-Tr\u00f8ndelag") +n("NO-VIKEN", "Viken", "2020-01-01", "2023-12-31", + c("NOR.1_1", "NOR.4_1", "NOR.2_1"), "Akershus, Buskerud and \u00d8stfold; dissolved 2024-01-01") +n("NO-INNLANDET", "Innlandet", "2020-01-01", NA, + c("NOR.6_1", "NOR.11_1"), "Hedmark and Oppland") +n("NO-VESTLAND", "Vestland", "2020-01-01", NA, + c("NOR.7_1", "NOR.14_1"), "Hordaland and Sogn og Fjordane") +n("NO-VESTFOLD-TELEMARK", "Vestfold og Telemark", "2020-01-01", "2023-12-31", + c("NOR.19_1", "NOR.16_1"), "Vestfold and Telemark; dissolved 2024-01-01") +n("NO-TROMS-FINNMARK", "Troms og Finnmark", "2020-01-01", "2023-12-31", + c("NOR.17_1", "NOR.5_1"), "Troms and Finnmark; dissolved 2024-01-01") +n("NO-AGDER", "Agder", "2020-01-01", NA, + c("NOR.3_1", "NOR.18_1"), "Aust-Agder and Vest-Agder") + +# ---- Sweden: the lan under the names records actually use ----------------------- +# GADM stores the bare name ("Norrbotten"); records write "Norrbottens lan" or +# "Norrbotten lan". These are the SAME unit, so they are aliases with a one-unit +# extent: recognising them ADDS validation rather than suppressing it. Both the +# genitive and the plain form are generated; whichever does not occur simply never +# matches. +# +# The BARE name is registered too, because the GNRS reference names these units +# inconsistently - "Norrbotten" but "Vastmanlands lan", "Vestfold fylke" - so a record +# saying "Skane" does not match the reference's "Skane lan" exactly and would +# otherwise fall through to the landskap of the same name and lose a unit it could +# have been checked against. Where a name matches both, the matcher prefers the entry +# that has an extent, which is this one. +gadm <- as.data.table(nanoparquet::read_parquet(GADM)) +lan <- unique(gadm[gid_0 == "SWE", .(gid_1, name_1)]) +for (i in seq_len(nrow(lan))) { + add("se-lan-alias", paste0("SE-LAN-", lan$gid_1[i]), "SE", lan$name_1[i], "alias", + note = "the same GADM unit under the name records use", + alt = paste0(lan$name_1[i], c(" l\u00e4n", "s l\u00e4n")), + gids = lan$gid_1[i], level = 1L) +} + +# ---- Sweden: landskap (provinces), a parallel traditional system ----------------- +# 25 units. Where a landskap shares its name with a lan (Skane, Gotland, Halland and +# others) the exact GADM match wins and this entry never fires; the ones that matter +# are those with no lan of the same name (Smaland, Uppland, Vastergotland ...). +landskap <- c("Blekinge", "Bohusl\u00e4n", "Dalarna", "Dalsland", "Gotland", "G\u00e4strikland", + "Halland", "H\u00e4lsingland", "H\u00e4rjedalen", "J\u00e4mtland", "Lappland", + "Medelpad", "Norrbotten", "N\u00e4rke", "Sk\u00e5ne", "Sm\u00e5land", + "S\u00f6dermanland", "Uppland", "V\u00e4rmland", "V\u00e4sterbotten", + "V\u00e4sterg\u00f6tland", "V\u00e4stmanland", "\u00c5ngermanland", "\u00d6land", + "\u00d6sterg\u00f6tland") +for (x in landskap) { + add("se-landskap", paste0("SE-LS-", gsub("[^A-Za-z]", "", iconv(x, "UTF-8", "ASCII//TRANSLIT"))), + "SE", x, "parallel", note = "landskap (province); extent not yet sourced") +} + +# ---- Sweden: lappmarker ---------------------------------------------------------- +for (x in c("Lule", "Lycksele", "Pite", "Torne", "\u00c5sele")) { + add("se-lappmark", paste0("SE-LP-", gsub("[^A-Za-z]", "", iconv(x, "UTF-8", "ASCII//TRANSLIT"))), + "SE", paste(x, "lappmark"), "parallel", note = "lappmark; extent not yet sourced") +} + +# ---- Britain and Ireland: Watsonian vice-counties --------------------------------- +# 112 vice-counties in Great Britain and 40 in Ireland, written "VC57 Derbyshire". +# One entry recognises the whole system by the way records write it; the individual +# units are only needed once their boundaries are sourced, which is what would give +# them an extent. +for (cc in c("GB", "IE")) { + add("gb-vice-county", paste0(cc, "-VC"), cc, "Watsonian vice-county", "parallel", + note = "botanical recording unit, boundaries frozen at 1852; extent not yet sourced", + alt = "^VC ?[0-9]+", match = "regex") +} + +u <- rbindlist(units); nm <- unique(rbindlist(names_), by = c("entity_key", "name")) +ex <- if (length(extent)) rbindlist(extent) else data.table(entity_key = character(0), level = integer(0), gid = character(0)) +stopifnot(!anyDuplicated(u$entity_key), all(ex$entity_key %in% u$entity_key), all(nm$entity_key %in% u$entity_key)) +fwrite(u, file.path(OUT, "altdiv_units.csv")) +fwrite(nm, file.path(OUT, "altdiv_names.csv")) +fwrite(ex, file.path(OUT, "altdiv_extent.csv")) +cat(sprintf("units %d (%s) | names %d | extents %d over %d units\n", nrow(u), + paste(sprintf("%s %d", names(table(u$system)), table(u$system)), collapse = ", "), + nrow(nm), nrow(ex), uniqueN(ex$entity_key))) diff --git a/inst/extdata/altdiv_extent.csv b/inst/extdata/altdiv_extent.csv new file mode 100644 index 0000000..86cbe3c --- /dev/null +++ b/inst/extdata/altdiv_extent.csv @@ -0,0 +1,37 @@ +entity_key,level,gid +NO-TRONDELAG,1,NOR.9_1 +NO-TRONDELAG,1,NOR.15_1 +NO-VIKEN,1,NOR.1_1 +NO-VIKEN,1,NOR.4_1 +NO-VIKEN,1,NOR.2_1 +NO-INNLANDET,1,NOR.6_1 +NO-INNLANDET,1,NOR.11_1 +NO-VESTLAND,1,NOR.7_1 +NO-VESTLAND,1,NOR.14_1 +NO-VESTFOLD-TELEMARK,1,NOR.19_1 +NO-VESTFOLD-TELEMARK,1,NOR.16_1 +NO-TROMS-FINNMARK,1,NOR.17_1 +NO-TROMS-FINNMARK,1,NOR.5_1 +NO-AGDER,1,NOR.3_1 +NO-AGDER,1,NOR.18_1 +SE-LAN-SWE.1_1,1,SWE.1_1 +SE-LAN-SWE.10_1,1,SWE.10_1 +SE-LAN-SWE.11_1,1,SWE.11_1 +SE-LAN-SWE.12_1,1,SWE.12_1 +SE-LAN-SWE.13_1,1,SWE.13_1 +SE-LAN-SWE.14_1,1,SWE.14_1 +SE-LAN-SWE.15_1,1,SWE.15_1 +SE-LAN-SWE.16_1,1,SWE.16_1 +SE-LAN-SWE.17_1,1,SWE.17_1 +SE-LAN-SWE.18_1,1,SWE.18_1 +SE-LAN-SWE.19_1,1,SWE.19_1 +SE-LAN-SWE.2_1,1,SWE.2_1 +SE-LAN-SWE.20_1,1,SWE.20_1 +SE-LAN-SWE.21_1,1,SWE.21_1 +SE-LAN-SWE.3_1,1,SWE.3_1 +SE-LAN-SWE.4_1,1,SWE.4_1 +SE-LAN-SWE.5_1,1,SWE.5_1 +SE-LAN-SWE.6_1,1,SWE.6_1 +SE-LAN-SWE.7_1,1,SWE.7_1 +SE-LAN-SWE.8_1,1,SWE.8_1 +SE-LAN-SWE.9_1,1,SWE.9_1 diff --git a/inst/extdata/altdiv_names.csv b/inst/extdata/altdiv_names.csv new file mode 100644 index 0000000..3e35aa4 --- /dev/null +++ b/inst/extdata/altdiv_names.csv @@ -0,0 +1,103 @@ +entity_key,name,match +NO-TRONDELAG,Trøndelag,exact +NO-VIKEN,Viken,exact +NO-INNLANDET,Innlandet,exact +NO-VESTLAND,Vestland,exact +NO-VESTFOLD-TELEMARK,Vestfold og Telemark,exact +NO-TROMS-FINNMARK,Troms og Finnmark,exact +NO-AGDER,Agder,exact +SE-LAN-SWE.1_1,Blekinge,exact +SE-LAN-SWE.1_1,Blekinge län,exact +SE-LAN-SWE.1_1,Blekinges län,exact +SE-LAN-SWE.10_1,Norrbotten,exact +SE-LAN-SWE.10_1,Norrbotten län,exact +SE-LAN-SWE.10_1,Norrbottens län,exact +SE-LAN-SWE.11_1,Orebro,exact +SE-LAN-SWE.11_1,Orebro län,exact +SE-LAN-SWE.11_1,Orebros län,exact +SE-LAN-SWE.12_1,Östergötland,exact +SE-LAN-SWE.12_1,Östergötland län,exact +SE-LAN-SWE.12_1,Östergötlands län,exact +SE-LAN-SWE.13_1,Skåne,exact +SE-LAN-SWE.13_1,Skåne län,exact +SE-LAN-SWE.13_1,Skånes län,exact +SE-LAN-SWE.14_1,Södermanland,exact +SE-LAN-SWE.14_1,Södermanland län,exact +SE-LAN-SWE.14_1,Södermanlands län,exact +SE-LAN-SWE.15_1,Stockholm,exact +SE-LAN-SWE.15_1,Stockholm län,exact +SE-LAN-SWE.15_1,Stockholms län,exact +SE-LAN-SWE.16_1,Uppsala,exact +SE-LAN-SWE.16_1,Uppsala län,exact +SE-LAN-SWE.16_1,Uppsalas län,exact +SE-LAN-SWE.17_1,Värmland,exact +SE-LAN-SWE.17_1,Värmland län,exact +SE-LAN-SWE.17_1,Värmlands län,exact +SE-LAN-SWE.18_1,Västerbotten,exact +SE-LAN-SWE.18_1,Västerbotten län,exact +SE-LAN-SWE.18_1,Västerbottens län,exact +SE-LAN-SWE.19_1,Västernorrland,exact +SE-LAN-SWE.19_1,Västernorrland län,exact +SE-LAN-SWE.19_1,Västernorrlands län,exact +SE-LAN-SWE.2_1,Dalarna,exact +SE-LAN-SWE.2_1,Dalarna län,exact +SE-LAN-SWE.2_1,Dalarnas län,exact +SE-LAN-SWE.20_1,Västmanland,exact +SE-LAN-SWE.20_1,Västmanland län,exact +SE-LAN-SWE.20_1,Västmanlands län,exact +SE-LAN-SWE.21_1,Västra Götaland,exact +SE-LAN-SWE.21_1,Västra Götaland län,exact +SE-LAN-SWE.21_1,Västra Götalands län,exact +SE-LAN-SWE.3_1,Gävleborg,exact +SE-LAN-SWE.3_1,Gävleborg län,exact +SE-LAN-SWE.3_1,Gävleborgs län,exact +SE-LAN-SWE.4_1,Gotland,exact +SE-LAN-SWE.4_1,Gotland län,exact +SE-LAN-SWE.4_1,Gotlands län,exact +SE-LAN-SWE.5_1,Halland,exact +SE-LAN-SWE.5_1,Halland län,exact +SE-LAN-SWE.5_1,Hallands län,exact +SE-LAN-SWE.6_1,Jämtland,exact +SE-LAN-SWE.6_1,Jämtland län,exact +SE-LAN-SWE.6_1,Jämtlands län,exact +SE-LAN-SWE.7_1,Jönköping,exact +SE-LAN-SWE.7_1,Jönköping län,exact +SE-LAN-SWE.7_1,Jönköpings län,exact +SE-LAN-SWE.8_1,Kalmar,exact +SE-LAN-SWE.8_1,Kalmar län,exact +SE-LAN-SWE.8_1,Kalmars län,exact +SE-LAN-SWE.9_1,Kronoberg,exact +SE-LAN-SWE.9_1,Kronoberg län,exact +SE-LAN-SWE.9_1,Kronobergs län,exact +SE-LS-Blekinge,Blekinge,exact +SE-LS-Bohuslan,Bohuslän,exact +SE-LS-Dalarna,Dalarna,exact +SE-LS-Dalsland,Dalsland,exact +SE-LS-Gotland,Gotland,exact +SE-LS-Gastrikland,Gästrikland,exact +SE-LS-Halland,Halland,exact +SE-LS-Halsingland,Hälsingland,exact +SE-LS-Harjedalen,Härjedalen,exact +SE-LS-Jamtland,Jämtland,exact +SE-LS-Lappland,Lappland,exact +SE-LS-Medelpad,Medelpad,exact +SE-LS-Norrbotten,Norrbotten,exact +SE-LS-Narke,Närke,exact +SE-LS-Skane,Skåne,exact +SE-LS-Smaland,Småland,exact +SE-LS-Sodermanland,Södermanland,exact +SE-LS-Uppland,Uppland,exact +SE-LS-Varmland,Värmland,exact +SE-LS-Vasterbotten,Västerbotten,exact +SE-LS-Vastergotland,Västergötland,exact +SE-LS-Vastmanland,Västmanland,exact +SE-LS-Angermanland,Ångermanland,exact +SE-LS-Oland,Öland,exact +SE-LS-Ostergotland,Östergötland,exact +SE-LP-Lule,Lule lappmark,exact +SE-LP-Lycksele,Lycksele lappmark,exact +SE-LP-Pite,Pite lappmark,exact +SE-LP-Torne,Torne lappmark,exact +SE-LP-Asele,Åsele lappmark,exact +GB-VC,^VC ?[0-9]+,regex +IE-VC,^VC ?[0-9]+,regex diff --git a/inst/extdata/altdiv_units.csv b/inst/extdata/altdiv_units.csv new file mode 100644 index 0000000..f6a2fd0 --- /dev/null +++ b/inst/extdata/altdiv_units.csv @@ -0,0 +1,61 @@ +system,entity_key,country_iso,name,kind,valid_from,valid_to,note +no-fylke,NO-TRONDELAG,NO,Trøndelag,superseded,2018-01-01,,2018 merger of Nord-Trøndelag and Sør-Trøndelag +no-fylke,NO-VIKEN,NO,Viken,superseded,2020-01-01,2023-12-31,"Akershus, Buskerud and Østfold; dissolved 2024-01-01" +no-fylke,NO-INNLANDET,NO,Innlandet,superseded,2020-01-01,,Hedmark and Oppland +no-fylke,NO-VESTLAND,NO,Vestland,superseded,2020-01-01,,Hordaland and Sogn og Fjordane +no-fylke,NO-VESTFOLD-TELEMARK,NO,Vestfold og Telemark,superseded,2020-01-01,2023-12-31,Vestfold and Telemark; dissolved 2024-01-01 +no-fylke,NO-TROMS-FINNMARK,NO,Troms og Finnmark,superseded,2020-01-01,2023-12-31,Troms and Finnmark; dissolved 2024-01-01 +no-fylke,NO-AGDER,NO,Agder,superseded,2020-01-01,,Aust-Agder and Vest-Agder +se-lan-alias,SE-LAN-SWE.1_1,SE,Blekinge,alias,,,the same GADM unit under the name records use +se-lan-alias,SE-LAN-SWE.10_1,SE,Norrbotten,alias,,,the same GADM unit under the name records use +se-lan-alias,SE-LAN-SWE.11_1,SE,Orebro,alias,,,the same GADM unit under the name records use +se-lan-alias,SE-LAN-SWE.12_1,SE,Östergötland,alias,,,the same GADM unit under the name records use +se-lan-alias,SE-LAN-SWE.13_1,SE,Skåne,alias,,,the same GADM unit under the name records use +se-lan-alias,SE-LAN-SWE.14_1,SE,Södermanland,alias,,,the same GADM unit under the name records use +se-lan-alias,SE-LAN-SWE.15_1,SE,Stockholm,alias,,,the same GADM unit under the name records use +se-lan-alias,SE-LAN-SWE.16_1,SE,Uppsala,alias,,,the same GADM unit under the name records use +se-lan-alias,SE-LAN-SWE.17_1,SE,Värmland,alias,,,the same GADM unit under the name records use +se-lan-alias,SE-LAN-SWE.18_1,SE,Västerbotten,alias,,,the same GADM unit under the name records use +se-lan-alias,SE-LAN-SWE.19_1,SE,Västernorrland,alias,,,the same GADM unit under the name records use +se-lan-alias,SE-LAN-SWE.2_1,SE,Dalarna,alias,,,the same GADM unit under the name records use +se-lan-alias,SE-LAN-SWE.20_1,SE,Västmanland,alias,,,the same GADM unit under the name records use +se-lan-alias,SE-LAN-SWE.21_1,SE,Västra Götaland,alias,,,the same GADM unit under the name records use +se-lan-alias,SE-LAN-SWE.3_1,SE,Gävleborg,alias,,,the same GADM unit under the name records use +se-lan-alias,SE-LAN-SWE.4_1,SE,Gotland,alias,,,the same GADM unit under the name records use +se-lan-alias,SE-LAN-SWE.5_1,SE,Halland,alias,,,the same GADM unit under the name records use +se-lan-alias,SE-LAN-SWE.6_1,SE,Jämtland,alias,,,the same GADM unit under the name records use +se-lan-alias,SE-LAN-SWE.7_1,SE,Jönköping,alias,,,the same GADM unit under the name records use +se-lan-alias,SE-LAN-SWE.8_1,SE,Kalmar,alias,,,the same GADM unit under the name records use +se-lan-alias,SE-LAN-SWE.9_1,SE,Kronoberg,alias,,,the same GADM unit under the name records use +se-landskap,SE-LS-Blekinge,SE,Blekinge,parallel,,,landskap (province); extent not yet sourced +se-landskap,SE-LS-Bohuslan,SE,Bohuslän,parallel,,,landskap (province); extent not yet sourced +se-landskap,SE-LS-Dalarna,SE,Dalarna,parallel,,,landskap (province); extent not yet sourced +se-landskap,SE-LS-Dalsland,SE,Dalsland,parallel,,,landskap (province); extent not yet sourced +se-landskap,SE-LS-Gotland,SE,Gotland,parallel,,,landskap (province); extent not yet sourced +se-landskap,SE-LS-Gastrikland,SE,Gästrikland,parallel,,,landskap (province); extent not yet sourced +se-landskap,SE-LS-Halland,SE,Halland,parallel,,,landskap (province); extent not yet sourced +se-landskap,SE-LS-Halsingland,SE,Hälsingland,parallel,,,landskap (province); extent not yet sourced +se-landskap,SE-LS-Harjedalen,SE,Härjedalen,parallel,,,landskap (province); extent not yet sourced +se-landskap,SE-LS-Jamtland,SE,Jämtland,parallel,,,landskap (province); extent not yet sourced +se-landskap,SE-LS-Lappland,SE,Lappland,parallel,,,landskap (province); extent not yet sourced +se-landskap,SE-LS-Medelpad,SE,Medelpad,parallel,,,landskap (province); extent not yet sourced +se-landskap,SE-LS-Norrbotten,SE,Norrbotten,parallel,,,landskap (province); extent not yet sourced +se-landskap,SE-LS-Narke,SE,Närke,parallel,,,landskap (province); extent not yet sourced +se-landskap,SE-LS-Skane,SE,Skåne,parallel,,,landskap (province); extent not yet sourced +se-landskap,SE-LS-Smaland,SE,Småland,parallel,,,landskap (province); extent not yet sourced +se-landskap,SE-LS-Sodermanland,SE,Södermanland,parallel,,,landskap (province); extent not yet sourced +se-landskap,SE-LS-Uppland,SE,Uppland,parallel,,,landskap (province); extent not yet sourced +se-landskap,SE-LS-Varmland,SE,Värmland,parallel,,,landskap (province); extent not yet sourced +se-landskap,SE-LS-Vasterbotten,SE,Västerbotten,parallel,,,landskap (province); extent not yet sourced +se-landskap,SE-LS-Vastergotland,SE,Västergötland,parallel,,,landskap (province); extent not yet sourced +se-landskap,SE-LS-Vastmanland,SE,Västmanland,parallel,,,landskap (province); extent not yet sourced +se-landskap,SE-LS-Angermanland,SE,Ångermanland,parallel,,,landskap (province); extent not yet sourced +se-landskap,SE-LS-Oland,SE,Öland,parallel,,,landskap (province); extent not yet sourced +se-landskap,SE-LS-Ostergotland,SE,Östergötland,parallel,,,landskap (province); extent not yet sourced +se-lappmark,SE-LP-Lule,SE,Lule lappmark,parallel,,,lappmark; extent not yet sourced +se-lappmark,SE-LP-Lycksele,SE,Lycksele lappmark,parallel,,,lappmark; extent not yet sourced +se-lappmark,SE-LP-Pite,SE,Pite lappmark,parallel,,,lappmark; extent not yet sourced +se-lappmark,SE-LP-Torne,SE,Torne lappmark,parallel,,,lappmark; extent not yet sourced +se-lappmark,SE-LP-Asele,SE,Åsele lappmark,parallel,,,lappmark; extent not yet sourced +gb-vice-county,GB-VC,GB,Watsonian vice-county,parallel,,,"botanical recording unit, boundaries frozen at 1852; extent not yet sourced" +gb-vice-county,IE-VC,IE,Watsonian vice-county,parallel,,,"botanical recording unit, boundaries frozen at 1852; extent not yet sourced" diff --git a/tests/testthat/test-local-altdiv.R b/tests/testthat/test-local-altdiv.R new file mode 100644 index 0000000..27f7e08 --- /dev/null +++ b/tests/testthat/test-local-altdiv.R @@ -0,0 +1,75 @@ +context("alternative and superseded sub-national divisions") + +# Built from curation shipped with the package; nothing is downloaded and nothing is +# derived from another component, so this needs no backbone. + +dir <- file.path(tempdir(), "gnrs-altdiv-cache") +unlink(dir, recursive = TRUE) +dir.create(dir, recursive = TRUE, showWarnings = FALSE) +gnrs_build_altdiv(dir = dir, quiet = TRUE) + +test_that("the component builds and reports what it knows", { + expect_true(gnrs_is_built("altdiv", dir)) + a <- gnrs_altdiv(dir) + expect_true(all(c("units", "names", "extent") %in% names(a))) + expect_false(anyDuplicated(a$units$entity_key) > 0) + expect_true(all(a$extent$entity_key %in% a$units$entity_key)) + expect_true(all(a$names$entity_key %in% a$units$entity_key)) + # a unit has an extent exactly when its key appears in the extent table + expect_equal(sort(a$units$entity_key[a$units$extent_known]), sort(unique(a$extent$entity_key))) +}) + +test_that("a division that IS a GADM unit is not diverted to another system", { + # nothing here belongs to another division system, and no alias is registered for + # these countries: Norwegian counties are covered only where a reform superseded them + m <- gnrs_altdiv_match(c("NO", "US", "GB"), c("Akershus", "California", "Greater London"), dir = dir) + expect_true(all(is.na(m$entity_key))) + # a bare lan name IS registered, as an alias of that same lan: the GNRS reference + # names these units inconsistently ("Norrbotten" but "Vastmanlands lan"), so the bare + # name has to be recognised. It carries the lan's own extent, and the resolver takes + # an exact GADM match first in any case. + m <- gnrs_altdiv_match("SE", "Stockholm", dir = dir) + expect_equal(m$kind, "alias") + expect_true(m$extent_known) + expect_equal(gnrs_altdiv_extent(m$entity_key, dir), "SWE.15_1") +}) + +test_that("parallel systems are recognised but carry no extent yet", { + m <- gnrs_altdiv_match(c("SE", "SE", "SE"), c("Uppland", "Småland", "Lule lappmark"), dir = dir) + expect_equal(m$system, c("se-landskap", "se-landskap", "se-lappmark")) + expect_equal(m$kind, rep("parallel", 3)) + expect_false(any(m$extent_known)) + expect_equal(gnrs_altdiv_extent(m$entity_key[1], dir), character(0)) +}) + +test_that("vice-counties are matched by the way records write them", { + m <- gnrs_altdiv_match(rep("GB", 3), c("VC57 Derbyshire", "VC1 West Cornwall", "VC 9 Dorset"), dir = dir) + expect_equal(unique(m$system), "gb-vice-county") + # a county that is not a vice-county is left alone + expect_true(is.na(gnrs_altdiv_match("GB", "Greater London", dir = dir)$entity_key)) +}) + +test_that("a lan under the name records use resolves to that same lan", { + m <- gnrs_altdiv_match(c("SE", "SE"), c("Norrbottens län", "Norrbotten län"), dir = dir) + expect_equal(m$kind, c("alias", "alias")) + expect_true(all(m$extent_known)) + expect_equal(gnrs_altdiv_extent(m$entity_key[1], dir), "SWE.10_1") +}) + +test_that("superseded counties carry their extent and their period", { + m <- gnrs_altdiv_match(rep("NO", 3), rep("Viken", 3), + dates = c("2021-06-01", "2025-06-01", NA), dir = dir) + expect_equal(unique(m$entity_key), "NO-VIKEN") + expect_true(all(m$extent_known)) + expect_setequal(gnrs_altdiv_extent("NO-VIKEN", dir), c("NOR.1_1", "NOR.4_1", "NOR.2_1")) + # Viken existed 2020-01-01 to 2023-12-31; with no date there is nothing to check + expect_equal(m$in_period, c(TRUE, FALSE, NA)) + # Innlandet was not dissolved in 2024 + expect_true(gnrs_altdiv_match("NO", "Innlandet", dates = "2025-06-01", dir = dir)$in_period) +}) + +test_that("extents name GADM units that exist", { + a <- gnrs_altdiv(dir) + expect_true(all(grepl("^[A-Z]{3}[.][0-9]+(_[0-9]+)?$", a$extent$gid))) + expect_true(all(a$extent$level %in% c(1L, 2L))) +}) diff --git a/tests/testthat/test-local-history.R b/tests/testthat/test-local-history.R index 4ef0f5d..00266cb 100644 --- a/tests/testthat/test-local-history.R +++ b/tests/testthat/test-local-history.R @@ -10,7 +10,8 @@ gnrs_test_cshapes(dir) gnrs_build_history(dir = dir, quiet = TRUE) test_that("nothing derived from CShapes ships with the package", { - shipped <- list.files(dirname(gnrs_extdata("history_codes.csv")), pattern = "[.]csv$") + # the history component's own files; other components ship theirs alongside + shipped <- list.files(dirname(gnrs_extdata("history_codes.csv")), pattern = "^history_.*[.]csv$") expect_true(file.exists(file.path(dirname(gnrs_extdata("history_codes.csv")), "SOURCES.md"))) expect_setequal(shipped, c("history_codes.csv", "history_current_entities.csv", "history_curated_entities.csv", "history_curated_lineage.csv", diff --git a/tests/testthat/test-local-resolve.R b/tests/testthat/test-local-resolve.R index 4405e50..384e904 100644 --- a/tests/testthat/test-local-resolve.R +++ b/tests/testthat/test-local-resolve.R @@ -20,6 +20,8 @@ test_that("the output has the web service's columns, in its order", { "match_method_county_parish", "match_score_country", "match_score_state_province", "match_score_county_parish", "threshold_fuzzy", "overall_score", "poldiv_submitted", "poldiv_matched", "match_status", "user_id", + # the service's own columns end here; the components append theirs + "alt_division", "alt_division_system", "alt_division_level", "alt_division_extent_known", # history = "all" (the default) appends the historical-division columns "entity_key", "is_historical", "entity_valid_from", "entity_valid_to", "successors", "subnational_resolved_in", "subnational_status", "date_check" @@ -200,18 +202,19 @@ test_that("a missing backbone is reported rather than erroring", { test_that("status and citations describe what was built", { s <- suppressMessages(GNRS_local_status(dir)) - expect_equal(s$source, c("gnrs", "gadm", "geonames", "history", "cshapes", "points")) + expect_equal(s$source, c("gnrs", "gadm", "geonames", "history", "altdiv", "cshapes", "points")) # the history component is built on first use of GNRS_local() (history = "all"), from # the CShapes copy in the cache: CShapes is a component of its own, since nothing # derived from it ships with the package - expect_equal(s$built, c(TRUE, FALSE, TRUE, TRUE, TRUE, FALSE)) + expect_equal(s$built, c(TRUE, FALSE, TRUE, TRUE, TRUE, TRUE, FALSE)) expect_equal(s$version[1], "database test (2024-01-01), code test") cit <- GNRS_local_citations(dir, quiet = TRUE) - expect_equal(cit$what, c("method", "software", "source", "source", "source", "source")) + expect_equal(cit$what, c("method", "software", "source", "source", "source", "source", "source")) expect_true(all(grepl("2024-01-01", cit$citation[3:4]))) expect_match(cit$citation[5], "CShapes 2.0") # CShapes is CC BY-NC-SA 4.0: attribution is a condition of use, so it is cited in full - expect_match(cit$citation[6], "Mapping the International System") + expect_match(cit$citation[6], "Alternative and superseded sub-national divisions") + expect_match(cit$citation[7], "Mapping the International System") bib <- tempfile(fileext = ".bib") GNRS_local_citations(dir, bibtex_file = bib, quiet = TRUE) expect_true(any(grepl("^@article", readLines(bib)))) From b8f5467913a2bcaad471d3c00b39977650a36c90 Mon Sep 17 00:00:00 2001 From: Brian Maitner Date: Thu, 24 Sep 2026 12:52:17 -0400 Subject: [PATCH 7/7] fighting with copilot nitpicks --- R/GNRS_local.R | 46 ++++++++++++++++++++--------- R/local_altdiv.R | 7 ++++- R/local_build.R | 10 +++++-- R/local_history_resolve.R | 12 +++++++- R/local_resolve.R | 2 +- data-raw/altdiv.R | 8 +++-- man/GNRS_local.Rd | 18 ++++++++--- man/GNRS_local_build.Rd | 5 +++- tests/testthat/test-local-altdiv.R | 13 ++++++++ tests/testthat/test-local-build.R | 8 +++++ tests/testthat/test-local-history.R | 12 ++++++++ 11 files changed, 115 insertions(+), 26 deletions(-) diff --git a/R/GNRS_local.R b/R/GNRS_local.R index 3ae3ae8..1d988ac 100644 --- a/R/GNRS_local.R +++ b/R/GNRS_local.R @@ -39,7 +39,9 @@ #' which are read from the \code{cshapes} package when it is installed and #' otherwise downloaded from the publisher (about 60 MB) when #' \code{build_missing} allows building; with \code{history = "current"} -#' nothing beyond the ordinary components is needed. +#' nothing beyond the ordinary components is needed. When the component +#' cannot be prepared (a package not installed, a download declined), the +#' call says so and resolves current divisions only. #' @param tolerance_years With \code{history = "at_date"}, how many years #' either side of a former country's existence a record date may fall. A #' single non-negative number. @@ -50,9 +52,17 @@ #' current countries descending from a matched former country), #' \code{subnational_resolved_in} and \code{subnational_status} (a state or #' county given under a former country is looked up within its successors; -#' "unverifiable" if none contains it), and \code{date_check}. Scores are numeric rather than the character -#' strings the web service returns; identifiers are character, as the web -#' service returns them; empty values are "". +#' "unverifiable" if none contains it), and \code{date_check}. Whatever +#' \code{history} is, four further columns report a state or county that is +#' an alternative or superseded division rather than one the service knows +#' (a Swedish landskap, a Watsonian vice-county, a Norwegian county from +#' before the 2020 reform): \code{alt_division} (its name), +#' \code{alt_division_system}, \code{alt_division_level} and +#' \code{alt_division_extent_known} (whether the GADM units it covers are +#' recorded, so that a coordinate could be checked against it); "" or NA +#' for a row that resolved ordinarily. Scores are numeric rather than the +#' character strings the web service returns; identifiers are character, as +#' the web service returns them; empty values are "". #' @note \strong{This is a new implementation and should be treated as beta.} #' It is a port of the SQL the web service runs, resolving against the #' service's own reference tables, so identifiers, standard names and codes @@ -140,24 +150,32 @@ GNRS_local <- function(political_division_dataframe, # 4.0 and the package is MIT). With the cshapes package installed that downloads # nothing, so it happens on first use as it always did; without it CShapes has to be # downloaded, which follows build_missing like every other download. + # When it cannot be prepared (a package missing, or a download declined), the + # call goes on with current divisions only, and says so, rather than returning + # nothing: the default build prepares the ordinary components only. if (history != "current" && !gnrs_is_built("history", dir)) { + ready <- FALSE need <- c("sf", "countrycode")[!vapply(c("sf", "countrycode"), requireNamespace, logical(1), quietly = TRUE)] if (length(need)) { message("history = \"", history, "\" needs the ", paste(need, collapse = " and "), - " package", if (length(need) > 1) "s" else "", ". Install ", - if (length(need) > 1) "them" else "it", ", or call again with history = \"current\".") - return(invisible(NULL)) - } - if (!gnrs_is_built("cshapes", dir)) { - if (requireNamespace("cshapes", quietly = TRUE)) { + " package", if (length(need) > 1) "s" else "", ", which ", + if (length(need) > 1) "are" else "is", " not installed.") + } else if (!gnrs_is_built("cshapes", dir) && !requireNamespace("cshapes", quietly = TRUE) && + !gnrs_require_sources("cshapes", dir = dir, build_missing = build_missing, quiet = quiet)) { + message("The CShapes data that history = \"", history, "\" needs was not built.") + } else { + if (!gnrs_is_built("cshapes", dir)) { if (!quiet) message("Building the CShapes component from the cshapes package (no download) ...") gnrs_build_cshapes(dir = dir, quiet = TRUE) - } else if (!gnrs_require_sources("cshapes", dir = dir, build_missing = build_missing, quiet = quiet)) { - return(invisible(NULL)) } + if (!quiet) message("Building the history component (no download) ...") + gnrs_build_history(dir = dir, quiet = TRUE) + ready <- TRUE + } + if (!ready) { + message("Resolving against current political divisions only (history = \"current\").") + history <- "current" } - if (!quiet) message("Building the history component (no download) ...") - gnrs_build_history(dir = dir, quiet = TRUE) } if (!alternate_names && gnrs_is_built("geonames", dir)) { # Built but not wanted: the name table on disk includes the GeoNames diff --git a/R/local_altdiv.R b/R/local_altdiv.R index 2870cd9..1ff4fb0 100644 --- a/R/local_altdiv.R +++ b/R/local_altdiv.R @@ -30,6 +30,7 @@ gnrs_altdiv_path <- function(table, dir = gnrs_cache_dir()) { #' @keywords internal #' @noRd gnrs_build_altdiv <- function(dir = gnrs_cache_dir(create = TRUE), quiet = FALSE) { + if (!dir.exists(dir)) dir.create(dir, recursive = TRUE, showWarnings = FALSE) rd <- function(f) utils::read.csv(gnrs_extdata(f), stringsAsFactors = FALSE, encoding = "UTF-8", na.strings = "") units <- rd("altdiv_units.csv") @@ -82,9 +83,12 @@ gnrs_build_altdiv <- function(dir = gnrs_cache_dir(create = TRUE), quiet = FALSE #' @keywords internal #' @noRd gnrs_altdiv <- function(dir = gnrs_cache_dir()) { - if (!is.null(gnrs_env$altdiv)) return(gnrs_env$altdiv) paths <- gnrs_altdiv_path(c("units", "names", "extent"), dir) if (!all(file.exists(paths))) return(NULL) + # the cache is for this directory and these files: a call with another dir, + # or after a rebuild, reads afresh + stamp <- paste(normalizePath(dir, winslash = "/"), paste(file.mtime(paths), collapse = "|")) + if (!is.null(gnrs_env$altdiv) && identical(gnrs_env$altdiv_stamp, stamp)) return(gnrs_env$altdiv) rd <- function(p) as.data.frame(nanoparquet::read_parquet(p)) a <- list(units = rd(paths[1]), names = rd(paths[2]), extent = rd(paths[3])) a$units$valid_from <- as.Date(a$units$valid_from) @@ -101,6 +105,7 @@ gnrs_altdiv <- function(dir = gnrs_cache_dir()) { a$exact <- a$names$match == "exact" a$key_exact <- paste(a$country_of[a$exact], a$names$lower[a$exact], sep = "\u001f") gnrs_env$altdiv <- a + gnrs_env$altdiv_stamp <- stamp a } diff --git a/R/local_build.R b/R/local_build.R index 3da23e3..e1ced9f 100644 --- a/R/local_build.R +++ b/R/local_build.R @@ -6,7 +6,7 @@ #' is kept in the standard user cache directory, and can be removed again with #' \code{GNRS_local_remove()}. #' -#' Two components are fetched by default, and four more can be added. +#' Two components are fetched by default, and five more can be added. #' \code{"gnrs"} is the web service's own #' reference tables of countries, states/provinces and counties/parishes, #' fetched through its API in a few small requests: every political division it @@ -69,6 +69,9 @@ #' and, for \code{GNRS_local()}'s historical modes, \code{"cshapes"} (the #' CShapes 2.0 boundaries of former countries, from the \code{cshapes} #' package when it is installed, otherwise a 60 MB download) and +#' \code{"altdiv"} (alternative and superseded sub-national divisions, from +#' curation shipped with the package: nothing is downloaded, and +#' \code{GNRS_local()} builds it on first use) and #' \code{"history"} (the historical entities, names and lineage, assembled #' from tables shipped with the package and from CShapes, which it builds if #' it is missing). The other components are layered on or filtered to the @@ -118,7 +121,10 @@ GNRS_local_build <- function(sources = c("gnrs", "geonames"), return(invisible(NULL)) } - if (!"gnrs" %in% sources && !gnrs_is_built("gnrs", dir)) { + # CShapes and the alternative divisions stand alone; everything else is + # layered on or filtered to the service's tables + dependent <- setdiff(sources, c("cshapes", "altdiv")) + if (length(dependent) && !"gnrs" %in% sources && !gnrs_is_built("gnrs", dir)) { if (!quiet) { message("The other components are layered on the service's reference tables, so 'gnrs' is built first.") } diff --git a/R/local_history_resolve.R b/R/local_history_resolve.R index 124f2cd..9ead466 100644 --- a/R/local_history_resolve.R +++ b/R/local_history_resolve.R @@ -312,8 +312,10 @@ gnrs_resolve_history <- function(u, m, dates, bb_current, dir, threshold, histor state_province_verbatim = u$state_province_verbatim[i], county_parish_verbatim = u$county_parish_verbatim[i], stringsAsFactors = FALSE) })) + # successors the current backbone lacks are dropped before, not after, the + # emptiness test + if (!is.null(cand)) cand <- cand[!is.na(cand$country_verbatim), , drop = FALSE] if (!is.null(cand) && nrow(cand)) { - cand <- cand[!is.na(cand$country_verbatim), , drop = FALSE] rs <- gnrs_resolve(cand[, c("country_verbatim", "state_province_verbatim", "county_parish_verbatim")], bb_current, threshold = threshold) rs$row <- cand$row @@ -341,6 +343,14 @@ gnrs_resolve_history <- function(u, m, dates, bb_current, dir, threshold, histor r_all$poldiv_submitted[rs$row] <- lvl_sub r_all$poldiv_matched[rs$row] <- lvl_mat r_all$match_status[rs$row] <- ifelse(lvl_sub == lvl_mat, "full match", "partial match") + # ... as were the lowest matched identifier and the overall score, which + # combines the historical country's score with the successor's divisions' + r_all$geonameid[rs$row] <- ifelse(is.na(rs$county_parish_id), rs$state_province_id, rs$county_parish_id) + sc <- r_all$match_score_country[rs$row] + ss <- rs$match_score_state_province + sk <- rs$match_score_county_parish + overall <- ifelse(is.na(sk), (sc + ss) / 2, (sc + ss + sk) / 3) + r_all$overall_score[rs$row] <- gnrs_numeric2(overall) } } unres <- sub_rows[is.na(r_all$subnational_status[sub_rows])] diff --git a/R/local_resolve.R b/R/local_resolve.R index 22c4211..00947a6 100644 --- a/R/local_resolve.R +++ b/R/local_resolve.R @@ -54,7 +54,7 @@ gnrs_resolve <- function(u, bb, threshold = 0.5) { u$alt_division <- na_chr u$alt_division_system <- na_chr u$alt_division_level <- na_chr - u$alt_division_extent_known <- NA + u$alt_division_extent_known <- rep(NA, nrow(u)) if (n == 0) { return(gnrs_summarize(u, bb)) diff --git a/data-raw/altdiv.R b/data-raw/altdiv.R index 60cd8b3..13179b4 100644 --- a/data-raw/altdiv.R +++ b/data-raw/altdiv.R @@ -38,8 +38,12 @@ # --------------------------------------------------------------------------- suppressMessages({library(data.table); library(nanoparquet)}) -OUT <- file.path("C:/Users/bmaitner/Desktop/current_projects/RGNRS", "inst", "extdata") -GADM <- "C:/Users/bmaitner/Desktop/current_projects/garden_variety_traits/data/services_cache/gadmindex-units.gz.parquet" +# Run from the package root. The GADM unit index (RGVS's gadmindex-units +# parquet) is read from wherever GNRS_GADM_INDEX points. +if (!file.exists("DESCRIPTION")) stop("Run this script from the package root.") +OUT <- file.path("inst", "extdata") +GADM <- Sys.getenv("GNRS_GADM_INDEX", unset = NA) +if (is.na(GADM)) stop("Set GNRS_GADM_INDEX to the path of the GADM unit index parquet.") dir.create(OUT, recursive = TRUE, showWarnings = FALSE) D <- function(x) as.Date(x) units <- list(); names_ <- list(); extent <- list() diff --git a/man/GNRS_local.Rd b/man/GNRS_local.Rd index dbc32af..20c4912 100644 --- a/man/GNRS_local.Rd +++ b/man/GNRS_local.Rd @@ -55,7 +55,9 @@ tables shipped with the package plus the CShapes historical boundaries, which are read from the \code{cshapes} package when it is installed and otherwise downloaded from the publisher (about 60 MB) when \code{build_missing} allows building; with \code{history = "current"} -nothing beyond the ordinary components is needed.} +nothing beyond the ordinary components is needed. When the component +cannot be prepared (a package not installed, a download declined), the +call says so and resolves current divisions only.} \item{tolerance_years}{With \code{history = "at_date"}, how many years either side of a former country's existence a record date may fall. A @@ -69,9 +71,17 @@ A data.frame with the same columns as \code{GNRS()}, one row per current countries descending from a matched former country), \code{subnational_resolved_in} and \code{subnational_status} (a state or county given under a former country is looked up within its successors; - "unverifiable" if none contains it), and \code{date_check}. Scores are numeric rather than the character - strings the web service returns; identifiers are character, as the web - service returns them; empty values are "". + "unverifiable" if none contains it), and \code{date_check}. Whatever + \code{history} is, four further columns report a state or county that is + an alternative or superseded division rather than one the service knows + (a Swedish landskap, a Watsonian vice-county, a Norwegian county from + before the 2020 reform): \code{alt_division} (its name), + \code{alt_division_system}, \code{alt_division_level} and + \code{alt_division_extent_known} (whether the GADM units it covers are + recorded, so that a coordinate could be checked against it); "" or NA + for a row that resolved ordinarily. Scores are numeric rather than the + character strings the web service returns; identifiers are character, as + the web service returns them; empty values are "". } \description{ Resolves country, state/province and county/parish names against a locally diff --git a/man/GNRS_local_build.Rd b/man/GNRS_local_build.Rd index a55435f..20e2d9c 100644 --- a/man/GNRS_local_build.Rd +++ b/man/GNRS_local_build.Rd @@ -19,6 +19,9 @@ GNRS_local_build( and, for \code{GNRS_local()}'s historical modes, \code{"cshapes"} (the CShapes 2.0 boundaries of former countries, from the \code{cshapes} package when it is installed, otherwise a 60 MB download) and +\code{"altdiv"} (alternative and superseded sub-national divisions, from +curation shipped with the package: nothing is downloaded, and +\code{GNRS_local()} builds it on first use) and \code{"history"} (the historical entities, names and lineage, assembled from tables shipped with the package and from CShapes, which it builds if it is missing). The other components are layered on or filtered to the @@ -49,7 +52,7 @@ is kept in the standard user cache directory, and can be removed again with \code{GNRS_local_remove()}. } \details{ -Two components are fetched by default, and four more can be added. +Two components are fetched by default, and five more can be added. \code{"gnrs"} is the web service's own reference tables of countries, states/provinces and counties/parishes, fetched through its API in a few small requests: every political division it diff --git a/tests/testthat/test-local-altdiv.R b/tests/testthat/test-local-altdiv.R index 27f7e08..a0a4520 100644 --- a/tests/testthat/test-local-altdiv.R +++ b/tests/testthat/test-local-altdiv.R @@ -73,3 +73,16 @@ test_that("extents name GADM units that exist", { expect_true(all(grepl("^[A-Z]{3}[.][0-9]+(_[0-9]+)?$", a$extent$gid))) expect_true(all(a$extent$level %in% c(1L, 2L))) }) + +test_that("the session cache is for one directory, and the build creates the directory", { + a <- file.path(tempdir(), "gnrs-altdiv-a", "nested") + b <- file.path(tempdir(), "gnrs-altdiv-b") + unlink(c(dirname(a), b), recursive = TRUE) + expect_false(dir.exists(a)) + gnrs_build_altdiv(dir = a, quiet = TRUE) + expect_true(gnrs_is_built("altdiv", a)) + expect_false(is.null(gnrs_altdiv(a))) + # a directory without the component gets nothing, not a's tables + expect_null(gnrs_altdiv(b)) + expect_false(is.null(gnrs_altdiv(a))) +}) diff --git a/tests/testthat/test-local-build.R b/tests/testthat/test-local-build.R index cf17039..31a0c45 100644 --- a/tests/testthat/test-local-build.R +++ b/tests/testthat/test-local-build.R @@ -94,3 +94,11 @@ test_that("reading the alternate names keeps only what the SQL keeps", { expect_equal(alt$name, c("Estados Unidos", "United States")) expect_equal(alt$geonameid, c(6252001L, 6252001L)) }) + +test_that("a standalone component builds without the service's tables", { + fresh <- file.path(tempdir(), "gnrs-standalone") + unlink(fresh, recursive = TRUE) + expect_silent(GNRS_local_build("altdiv", dir = fresh, quiet = TRUE)) + expect_true(gnrs_is_built("altdiv", fresh)) + expect_false(gnrs_is_built("gnrs", fresh)) +}) diff --git a/tests/testthat/test-local-history.R b/tests/testthat/test-local-history.R index 00266cb..e8b5909 100644 --- a/tests/testthat/test-local-history.R +++ b/tests/testthat/test-local-history.R @@ -175,3 +175,15 @@ test_that("the history arguments come after quiet, so positional callers still w expect_equal(r$country, "Mexico") expect_equal(names(formals(GNRS_local))[6], "quiet") }) + +test_that("a state resolved within a successor carries the summary of that resolution", { + # the Territory of Hawaii was absorbed into the United States, which the + # synthetic reference has, so a state given under it resolves there + r <- gnrs_test_resolve(dir, "Territory of Hawaii", "Arizona") + expect_equal(r$entity_key, "CSH4") + expect_equal(r$subnational_status, "resolved in successor") + expect_equal(r$state_province, "Arizona") + expect_equal(r$geonameid, r$state_province_id) + expect_true(is.finite(r$overall_score)) + expect_equal(r$overall_score, round((r$match_score_country + r$match_score_state_province) / 2, 2)) +})