Implement usmapdata 1.0.0 changes (#51)

* Added support for Puerto Rico in map creation and transform support
functions.
* `us_map()` defaults to excluding Puerto Rico, but this can be changed
by setting the `USMAP_EXCLUDE_PR = FALSE` environment variable.
* Removed `as_sf` parameter, no longer in use anyway.
* Add check results to `release` workflow artifacts with a link in the
PR body template.
* Updated all shapefiles (2021-2024) to include PR.

closes #48 
closes #49

Author: pdil

.lintr

@@ -1,5 +1,4 @@
 linters: linters_with_defaults(
-  cyclocomp_linter = NULL,
   line_length_linter(120),
   object_name_linter(c("camelCase", "snake_case", "symbols"))
  )

DESCRIPTION

@@ -22,7 +22,8 @@ Suggests:
     covr,
     dplyr,
     spelling,
-    testthat (>= 3.0.0)
+    testthat (>= 3.0.0),
+    withr
 Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.3.2
 Config/testthat/edition: 3

NEWS.md

@@ -1,5 +1,21 @@
 # [unreleased]
 
+### New Features
+* Puerto Rico has been added!
+  * Finally, after years of procrastinating, Puerto Rico has finally been added to the map, see [Issue #48](https://github.com/pdil/usmapdata/issues/48).
+  * All included map files have been retroactively updated to include Puerto Rico, so any valid value of `data_year` will include Puerto Rico if desired.
+  * `us_map()` and `fips_data()` both return Puerto Rico in their data sets and it can be included or excluded just like any state (using FIPS, full name, abbreviation, etc.).
+  * Special thanks [@dcaud](https://github.com/dcaud) who started this work [years ago](https://github.com/pdil/usmap/pull/34).
+
+### Enhancements
+* `include` now takes precedence over `exclude` in `us_map()`.
+  * Any items that are in both the `include` and `exclude` vectors will be _included_.
+
+### Removed
+* The `as_sf` parameter has been completely removed from `us_map()`, `centroid_labels()`, and `fips_data()`.
+  * It was no longer used by `usmap` nor did it have any effect if set.
+  * Any existing code that sets it can safely delete it from `usmapdata` function calls.
+
 # usmapdata 0.6.0
 Released Saturday, June 14, 2025.
 
@@ -51,7 +67,6 @@ Released Sunday, February 4, 2024.
 This update continues the `sf` migration by setting the `as_sf` parameter to default to the behavior of `TRUE`. This parameter no longer has any effect, as explained below. The next phase will involve updating `usmap` to no longer make use of this parameter, in which case it can be completely removed.
 
 ### Removed
-
 * The `as_sf` parameter is now deprecated and no longer has any effect.
   * As part of this removal, the default behavior for `us_map()`, `centroid_labels()`, and `fips_data()` is equivalent to `as_sf = TRUE` which is to return their data as an `sf` object (see `0.2.0` release notes for more details).
   * This parameter will be completely removed in a future version but continues to exist for compatibility reasons.

R/create-us-map.R

@@ -1,12 +1,11 @@
-
 #' Internal map creation tools
 #'
 #' @description
 #' `create_us_map()` creates the modified shapefiles used by the
 #' \link[usmap]{usmap} package.
 #'
 #' `ea_crs()` returns the US National Atlas Equal Area coordinate reference system
-#' (CRS) used by this package and `usmap`.
+#' (CRS) used by this package and \link[usmap]{usmap}.
 #'
 #' `transform2D()` computes a two dimensional affine transformation matrix
 #' for the provided rotation angle and scale factor.
@@ -15,6 +14,8 @@
 #'
 #' `transform_hawaii()` applies the appropriate transform for the Hawaii polygons.
 #'
+#' `transform_puerto_rico()` applies the appropriate transform for the Puerto Rico polygons.
+#'
 #' `compute_centroids()` computes the modified centroids for each state or
 #' county polygon using a center-of-mass technique on the largest polygon in
 #' the region.
@@ -23,6 +24,8 @@
 #'
 #' `hawaii_bbox()` returns the bounding box of Hawaii pre-transformation.
 #'
+#' `puerto_rico_bbox()` returns the bounding box of Puerto Rico pre-transformation.
+#'
 #' @note
 #' Using these functions externally is not recommended since they make certain
 #' undocumented assumptions that may not work with all inputs.
@@ -71,10 +74,14 @@ create_us_map <- function(
   # FIPS code for Hawaii = 15
   hawaii <- transform_hawaii(us_ea[us_ea$STATEFP == "15", ])
 
+  # FIPS code for Puerto Rico = 72
+  puerto_rico <- transform_puerto_rico(us_ea[us_ea$STATEFP == "72", ])
+
   # keep only US states (i.e. remove territories, minor outlying islands, etc.)
-  # also remove Alaska (02) and Hawaii (15) so that we can add in shifted one
-  us_ea <- us_ea[!us_ea$STATEFP %in% c(as.character(57:80), "02", "15"), ]
-  us_ea <- rbind(us_ea, alaska, hawaii)
+  # also remove Alaska (02), Hawaii (15), Puerto Rico (72) so that we can add in
+  # shifted versions
+  us_ea <- us_ea[!us_ea$STATEFP %in% c(as.character(57:80), "02", "15", "72"), ]
+  us_ea <- rbind(us_ea, alaska, hawaii, puerto_rico)
 
   # delete unused columns
   cols <- c()
@@ -161,6 +168,16 @@ transform_hawaii <- function(hawaii) {
   hawaii
 }
 
+#' @rdname create_us_map
+#' @keywords internal
+transform_puerto_rico <- function(puerto_rico) {
+  sf::st_geometry(puerto_rico) <- sf::st_geometry(puerto_rico) * transform2D(15, 2)
+  sf::st_geometry(puerto_rico) <- sf::st_geometry(puerto_rico) + c(-4.5e6, 4e6)
+  sf::st_crs(puerto_rico) <- ea_crs()
+
+  puerto_rico
+}
+
 #' @rdname create_us_map
 #' @keywords internal
 compute_centroids <- function(polygons, iterations = 3, initial_width_step = 10) {
@@ -264,3 +281,19 @@ hawaii_bbox <- function() {
     )
   )
 }
+
+#' @rdname create_us_map
+#' @keywords internal
+puerto_rico_bbox <- function() {
+  sf::st_as_sfc(
+    sf::st_bbox(
+      c(
+        xmin = 3300000,
+        xmax = 3700000,
+        ymin = -2400000,
+        ymax = -2200000
+      ),
+      crs = ea_crs()
+    )
+  )
+}

R/fips-data.R

@@ -2,7 +2,7 @@
 #'
 #' @inheritParams us_map
 #'
-#' @return An data frame of FIPS codes of the desired \code{regions}.
+#' @return An data frame of FIPS codes of the desired `regions`.
 #'
 #' @examples
 #' str(fips_data())
@@ -13,7 +13,6 @@
 #' @export
 fips_data <- function(
   regions = c("states", "state", "counties", "county"),
-  as_sf = TRUE,
   data_year = NULL
 ) {
   regions <- match.arg(regions)

R/us-map.R

@@ -1,30 +1,28 @@
 #' Retrieve US map data
 #'
 #' @param regions The region breakdown for the map, can be one of
-#'   (\code{"states"}, \code{"state"}, \code{"counties"}, \code{"county"}).
-#'   The default is \code{"states"}.
-#' @param include The regions to include in the resulting map. If \code{regions} is
-#'  \code{"states"}/\code{"state"}, the value can be either a state name, abbreviation or FIPS code.
+#'   (`"states"`, `"state"`, `"counties"`, `"county"`).
+#'   The default is `"states"`.
+#' @param include The regions to include in the resulting map. If `regions` is
+#'  `"states"`/`"state"`, the value can be either a state name, abbreviation or FIPS code.
 #'  For counties, the FIPS must be provided as there can be multiple counties with the
 #'  same name. If states are provided in the county map, only counties in the included states
 #'  will be returned.
-#' @param exclude The regions to exclude in the resulting map. If \code{regions} is
-#'  \code{"states"}/\code{"state"}, the value can be either a state name, abbreviation or FIPS code.
+#' @param exclude The regions to exclude in the resulting map. If `regions` is
+#'  `"states"`/`"state"`, the value can be either a state name, abbreviation or FIPS code.
 #'  For counties, the FIPS must be provided as there can be multiple counties with the
-#'  same name. The regions listed in the \code{include} parameter are applied first and the
-#'  \code{exclude} regions are then removed from the resulting map. Any excluded regions
-#'  not present in the included regions will be ignored.
-#' @param as_sf Defunct, this parameter no longer has any effect and will be removed in
-#'  the future.
+#'  same name. The regions listed in the `include` parameter take precedence over
+#'  regions listed in `exclude`. If both parameters include the same region(s) they
+#'  will be included in the map.
 #' @param data_year The year for which to obtain map data.
-#' If the value is \code{NULL}, the most recent year's data is used. If the
-#' provided year is not found from the available map data sets, the next most
-#' recent year's data is used. This can be used if an older data set is being
-#' plotted on the US map so that the data matches the map more accurately.
-#' Therefore, the provided value should match the year of the plotted data set.
-#' The default is \code{NULL}, i.e. the most recent available year is used.
+#'  If the value is `NULL`, the most recent year's data is used. If the
+#'  provided year is not found from the available map data sets, the next most
+#'  recent year's data is used. This can be used if an older data set is being
+#'  plotted on the US map so that the data matches the map more accurately.
+#'  Therefore, the provided value should match the year of the plotted data set.
+#'  The default is `NULL`, i.e. the most recent available year is used.
 #'
-#' @return An `sf` data frame of US map coordinates divided by the desired \code{regions}.
+#' @return An `sf` data frame of US map coordinates divided by the desired `regions`.
 #'
 #' @examples
 #' str(us_map())
@@ -41,7 +39,6 @@ us_map <- function(
   regions = c("states", "state", "counties", "county"),
   include = c(),
   exclude = c(),
-  as_sf = TRUE,
   data_year = NULL
 ) {
   regions <- match.arg(regions)
@@ -53,20 +50,25 @@ us_map <- function(
   file_path <- system.file("extdata", map_year, file_name, package = "usmapdata")
   df <- sf::read_sf(file_path, as_tibble = FALSE)
 
-  if (length(include) > 0) {
-    df <- df[df$full %in% include |
-               df$abbr %in% include |
-               df$fips %in% include |
-               substr(df$fips, 1, 2) %in% include, ]
-  }
+  # remove excluded items that are in `include`
+  exclude <- setdiff(exclude, include)
 
+  # remove excludes
   if (length(exclude) > 0) {
     df <- df[!(df$full %in% exclude |
                  df$abbr %in% exclude |
                  df$fips %in% exclude |
                  substr(df$fips, 1, 2) %in% exclude), ]
   }
 
+  # remove non-includes
+  if (length(include) > 0) {
+    df <- df[df$full %in% include |
+               df$abbr %in% include |
+               df$fips %in% include |
+               substr(df$fips, 1, 2) %in% include, ]
+  }
+
   df[order(df$abbr), ]
 }
 
@@ -75,12 +77,11 @@ us_map <- function(
 #' @inheritParams us_map
 #'
 #' @return An `sf` data frame of state or county centroid labels and positions
-#'   relative to the coordinates returned by the \code{us_map} function.
+#'   relative to the coordinates returned by the \link{us_map} function.
 #'
 #' @export
 centroid_labels <- function(
   regions = c("states", "state", "counties", "county"),
-  as_sf = TRUE,
   data_year = NULL
 ) {
   regions <- match.arg(regions)
@@ -109,8 +110,8 @@ available_map_years <- function() {
 
 #' Select appropriate map data year from available years
 #'
-#' @param data_year The year for which to obtain \code{usmap} data.
-#' If the value is \code{NULL}, the most recent year is returned. If the
+#' @param data_year The year for which to obtain \link{us_map} data.
+#' If the value is `NULL`, the most recent year is returned. If the
 #' provided year is not found from the available map data sets, the next most
 #' recent available year is returned.
 #'

R/usmapdata-package.R

@@ -9,14 +9,14 @@
 #' @section Map data frames:
 #' Alaska and Hawaii have been manually moved to a new location so that
 #' their new coordinates place them to the bottom-left corner of
-#' the map. These maps can be accessed by using the \code{\link{us_map}} function.
+#' the map. These maps can be accessed by using the \link{us_map} function.
 #'
 #' The function provides the ability to retrieve maps with either
-#' state borders or county borders using the \code{regions} parameter
+#' state borders or county borders using the `regions` parameter
 #' for convenience.
 #'
 #' States (or counties) can be included such that all other states (or counties)
-#' are excluded using the \code{include} parameter.
+#' are excluded using the `include` parameter.
 #'
 #' @author Paolo Di Lorenzo \cr
 #' \itemize{

data-raw/scripts/config.ini

@@ -4,4 +4,3 @@ cert = www2-census-gov-chain.pem
 current_year = 2024
 entities = state,county
 res = 20m
-

data-raw/test-harness/test-harness.R

@@ -0,0 +1,79 @@
+# Test harness script to verify map creation functions work as intended.
+
+# Run from within usmapdata.Rproj
+devtools::load_all(getwd()) # load local developer build of usmapdata
+
+usmapdata:::create_us_map(
+  type = "counties",
+  input_file = "data-raw/shapefiles/2024/cb_2024_us_county_20m.shp",
+  output_dir = "data-raw/test-harness",
+  output_file = "us_counties.gpkg"
+)
+
+file_path <- system.file("data-raw/test-harness/us_counties.gpkg", package = "usmapdata")
+df <- sf::read_sf(file_path, as_tibble = FALSE)
+
+ggplot2::ggplot(data = df[df$abbr == "PR", ]) +
+  ggplot2::geom_sf(color = "black", fill = "white")
+
+perform_transform <- function(data, ...) {
+  data <- sf::st_as_sf(as.data.frame(data), coords = c("lon", "lat"))
+  data_sf <- sf::st_as_sf(data, ...)
+
+  if (is.na(sf::st_crs(data_sf))) {
+    crs <- list(...)[["crs"]]
+    if (is.null(crs)) crs <- sf::st_crs(4326)
+    sf::st_crs(data_sf) <- crs
+  }
+
+  # Transform to canonical projection
+  transformed <- sf::st_transform(data_sf, usmap::usmap_crs())
+  sf::st_agr(transformed) <- "constant"
+
+  # Transform Alaska points
+  ak_bbox <- usmapdata:::alaska_bbox()
+  alaska <- sf::st_intersection(transformed, ak_bbox)
+  alaska <- usmapdata:::transform_alaska(alaska)
+
+  # Transform Hawaii points
+  hi_bbox <- usmapdata:::hawaii_bbox()
+  hawaii <- sf::st_intersection(transformed, hi_bbox)
+  hawaii <- usmapdata:::transform_hawaii(hawaii)
+
+  # Transform Hawaii points
+  pr_bbox <- usmapdata:::puerto_rico_bbox()
+  puerto_rico <- sf::st_intersection(transformed, pr_bbox)
+  puerto_rico <- usmapdata:::transform_puerto_rico(puerto_rico)
+
+  # Re-combine all points
+  transformed_excl_ak <- sf::st_difference(transformed, ak_bbox)
+  sf::st_agr(transformed_excl_ak) <- "constant"
+
+  transformed_excl_ak_hi <- sf::st_difference(transformed_excl_ak, hi_bbox)
+  sf::st_agr(transformed_excl_ak_hi) <- "constant"
+
+  transformed_excl_ak_hi_pr <- sf::st_difference(transformed_excl_ak_hi, pr_bbox)
+  sf::st_agr(transformed_excl_ak_hi_pr) <- "constant"
+
+  rbind(transformed_excl_ak_hi_pr, alaska, hawaii, puerto_rico)
+}
+
+data <- data.frame(
+  lon = c(-74.01, -95.36, -118.24, -87.65, -134.42, -157.86, -66.104),
+  lat = c(40.71, 29.76, 34.05, 41.85, 58.30, 21.31, 18.466),
+  pop = c(8398748, 2325502, 3990456, 2705994, 32113, 347397, 347052)
+)
+
+transformed_data <- perform_transform(data)
+
+library(ggplot2)
+ggplot(data = df) +
+  geom_sf(color = "black", fill = "white") +
+  geom_sf(
+    data = transformed_data,
+    aes(size = pop),
+    color = "red", alpha = 0.5
+  ) + usmap:::theme_map()
+
+# delete map files
+unlink(Sys.glob("data-raw/test-harness/*.gpkg"))