Add ability to change default map exclude with env var

Author: pdil

NEWS.md

@@ -1,5 +1,17 @@
 # [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).
+  * By default, it is not shown. It can be shown by setting `include = "PR"` (or using any combination of `include`/`exclude` parameters that results in `PR` being shown).
+  * The default can be changed to show `PR` by setting the environment variable `USMAP_EXCLUDE_PR = FALSE`.
+  * 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.
+  * 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.

R/aaa.R

@@ -0,0 +1,3 @@
+#' Internal package environment for usmapdata.
+#' @keywords internal
+.pkg_env <- new.env(parent = emptyenv())

R/create-us-map.R

@@ -5,7 +5,7 @@
 #' \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.

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())

R/us-map.R

@@ -1,28 +1,30 @@
 #' 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.
+#'  same name. The regions listed in the `include` parameter are applied first and the
+#'  `exclude` regions are then removed from the resulting map. Any excluded regions
+#'  not present in the included regions will be ignored. The default value is "PR".
+#'  The default can be set to be an empty vector by setting the environment variable
+#'  `USMAP_EXCLUDE_PR = FALSE`.
 #' @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
+#' 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 \code{NULL}, i.e. the most recent available year is used.
+#' 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())
@@ -38,7 +40,7 @@
 us_map <- function(
   regions = c("states", "state", "counties", "county"),
   include = c(),
-  exclude = c(),
+  exclude = .pkg_env$usmap_default_exclude(),
   data_year = NULL
 ) {
   regions <- match.arg(regions)
@@ -50,20 +52,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), ]
 }
 
@@ -72,7 +79,7 @@ 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(
@@ -105,8 +112,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.
 #'
@@ -140,3 +147,11 @@ select_map_year <- function(data_year) {
     data_year
   }
 }
+
+#' @keywords internal
+.pkg_env$usmap_default_exclude <- function() {
+  if (Sys.getenv("USMAP_EXCLUDE_PR", unset = TRUE))
+    c("PR")
+  else
+    c()
+}

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/test-harness/test-harness.R

@@ -4,14 +4,76 @@
 devtools::load_all(getwd()) # load local developer build of usmapdata
 
 usmapdata:::create_us_map(
-  type = "states",
-  input_file = "data-raw/shapefiles/2024/cb_2024_us_state_20m.shp",
+  type = "counties",
+  input_file = "data-raw/shapefiles/2024/cb_2024_us_county_20m.shp",
   output_dir = "data-raw/test-harness",
-  output_file = "us_states.gpkg"
+  output_file = "us_counties.gpkg"
 )
 
-file_path <- system.file("data-raw/test-harness/us_states.gpkg", package = "usmapdata")
+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) +
+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"))