Migrate to sf-based map data (#79)

* `usmapdata` was updated to produce `sf`-based objects in version 0.2.0. * These changes update `usmap` to make use of these changes by using the temporary `as_sf` parameter in the `usmapdata` calls. * Once the migration is complete, another update will be released that removes these parameters as the new default behavior will be the `sf`-based objects. * `usmap_transform()` has also been updated to transform inputs to match the new `sf`-based map data * Updated README examples to use new `sf`-based data #### Notes * Plotting the raw data can be done using `ggplot2::geom_sf()` rather than `ggplot2::geom_point()`. * There is no need to supply `x` and `y` coordinates to the aesthetic mappings. resolves #31
pdil · Jan 15, 2024 · 11b81f3 · 11b81f3
2 parents 3c57ece + c9ac2c8
commit 11b81f3
Show file tree

Hide file tree

Showing 20 changed files with 356 additions and 361 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -16,7 +16,7 @@ URL: https://usmap.dev
 BugReports: https://github.com/pdil/usmap/issues
 Imports:
     rlang,
-    usmapdata (>= 0.1.2)
+    usmapdata (>= 0.2.0)
 Suggests:
     covr,
     ggplot2,

diff --git a/NEWS.md b/NEWS.md
@@ -1,7 +1,14 @@
 # usmap 0.6.4.9999
 
-### Bug Fixes
-* Fix `sf` warning message in `usmap_crs()`.
+### Improvements
+* Migrate to new `usmapdata 0.2.0` `sf`-based map data files.
+  * Map data produced by `us_map()` is now returned as an `sf` object instead of a standard data frame.
+  * Allows for further flexibility in manipulation, easier plotting, and reduced file sizes.
+  * There should be no visible changes to existing `usmap` functionality.
+  * If something doesn't look right, please [open an issue](https://github.com/pdil/usmap/issues).
+* In accordance with the `sf` change mentioned above, the output of `usmap_transform()` has changed.
+  * The output data frame now replaces the `lat`/`lon` columns with a single `geometry` column with the transformed points and can be plotted using `ggplot2::geom_sf()`.
+  * Review the included examples and `advanced-mapping` vignette for more details.
 
 # usmap 0.6.4
 Released Monday, December 11, 2023.

diff --git a/R/fips.R b/R/fips.R
@@ -52,14 +52,14 @@
 #' @export
 fips <- function(state, county = c()) {
   if (missing(state) && missing(county)) {
-    return(usmapdata::fips_data()$fips)
+    return(usmapdata::fips_data(as_sf = TRUE)$fips)
   }
 
   state_ <- tolower(state)
   county_ <- tolower(county)
 
   if (length(county_) == 0) {
-    df <- usmapdata::fips_data()
+    df <- usmapdata::fips_data(as_sf = TRUE)
     abbr <- tolower(df$abbr)
     full <- tolower(df$full)
     fips2 <- c(df$fips, df$fips)
@@ -72,7 +72,7 @@ fips <- function(state, county = c()) {
       stop("`county` parameter cannot be used with multiple states.")
     }
 
-    df <- usmapdata::fips_data("counties")
+    df <- usmapdata::fips_data("counties", as_sf = TRUE)
     name <- tolower(df$county)
     state_abbr <- tolower(df$abbr)
     state_full <- tolower(df$full)
@@ -170,10 +170,10 @@ fips_info.character <- function(fips, sortAndRemoveDuplicates = FALSE) {
 #' @keywords internal
 get_fips_info <- function(fips, sortAndRemoveDuplicates) {
   if (all(nchar(fips) == 2)) {
-    df <- usmapdata::fips_data()
+    df <- usmapdata::fips_data(as_sf = TRUE)
     columns <- c("abbr", "fips", "full")
   } else if (all(nchar(fips) == 5)) {
-    df <- usmapdata::fips_data("counties")
+    df <- usmapdata::fips_data("counties", as_sf = TRUE)
     columns <- c("full", "abbr", "county", "fips")
   }
 

diff --git a/R/join-data.R b/R/join-data.R
@@ -71,9 +71,8 @@ map_with_data <- function(data,
   # Remove columns in data that are already in map_df
   data$abbr <- NULL
   data$full <- NULL
-  data$piece <- NULL
-  data$order <- NULL
   data$county <- NULL
+  data$geom <- NULL
   #
 
   padding <- ifelse(region_type == "state", 2, 5)
@@ -85,9 +84,9 @@ map_with_data <- function(data,
   result <- result[, c(setdiff(names(result), names(data)), names(data))]
 
   if (region_type == "state") {
-    result <- result[order(result$full, result$piece, result$order), ]
+    result <- result[order(result$full), ]
   } else {
-    result <- result[order(result$full, result$county, result$piece, result$order), ]
+    result <- result[order(result$full, result$county), ]
   }
 
   result

diff --git a/R/plot-map.R b/R/plot-map.R
@@ -75,7 +75,7 @@ plot_usmap <- function(regions = c("states", "state", "counties", "county"),
   .data <- ggplot2::.data
 
   # parse parameters
-  regions_ <- match.arg(regions)
+  regions <- match.arg(regions)
   geom_args <- list(...)
 
   # set geom_polygon defaults
@@ -97,27 +97,23 @@ plot_usmap <- function(regions = c("states", "state", "counties", "county"),
 
   # create polygon layer
   if (nrow(data) == 0) {
-    map_df <- usmap::us_map(regions = regions_, include = include, exclude = exclude)
-    geom_args[["mapping"]] <- ggplot2::aes(x = .data$x, y = .data$y, group = .data$group)
+    map_df <- usmap::us_map(regions = regions, include = include, exclude = exclude)
+    geom_args[["mapping"]] <- ggplot2::aes()
   } else {
     map_df <- usmap::map_with_data(data, values = values, include = include, exclude = exclude)
-    geom_args[["mapping"]] <- ggplot2::aes(
-      x = .data$x,
-      y = .data$y,
-      group = .data$group,
-      fill = .data[[values]]
-    )
+
+    if (!is.null(map_df$county)) regions <- "counties"
+    geom_args[["mapping"]] <- ggplot2::aes(fill = .data[[values]])
   }
 
-  polygon_layer <- do.call(ggplot2::geom_polygon, geom_args)
+  polygon_layer <- do.call(ggplot2::geom_sf, geom_args)
 
   # create label layer
   if (labels) {
-    if (regions_ == "state") regions__ <- "states"
-    else if (regions_ == "county") regions__ <- "counties"
-    else regions__ <- regions_
+    if (regions == "state") regions <- "states"
+    else if (regions == "county") regions <- "counties"
 
-    centroid_labels <- usmapdata::centroid_labels(regions__)
+    centroid_labels <- usmapdata::centroid_labels(regions, as_sf = TRUE)
 
     if (length(include) > 0) {
       centroid_labels <- centroid_labels[
@@ -136,24 +132,24 @@ plot_usmap <- function(regions = c("states", "state", "counties", "county"),
       ), ]
     }
 
-    if (regions_ == "county" || regions_ == "counties") {
-      label_layer <- ggplot2::geom_text(
+    if (regions == "county" || regions == "counties") {
+      label_layer <- ggplot2::geom_sf_text(
         data = centroid_labels,
-        ggplot2::aes(x = .data$x, y = .data$y, label = sub(" County", "", .data$county)),
+        ggplot2::aes(label = sub(" County", "", .data$county)),
         color = label_color
       )
     } else {
-      label_layer <- ggplot2::geom_text(
+      label_layer <- ggplot2::geom_sf_text(
         data = centroid_labels,
-        ggplot2::aes(x = .data$x, y = .data$y, label = .data$abbr), color = label_color
+        ggplot2::aes(label = .data$abbr), color = label_color
       )
     }
   } else {
     label_layer <- ggplot2::geom_blank()
   }
 
   # construct final plot
-  ggplot2::ggplot(data = map_df) + polygon_layer + label_layer + ggplot2::coord_equal() + theme
+  ggplot2::ggplot(data = map_df) + polygon_layer + label_layer + theme
 }
 
 #' Convenient theme map

diff --git a/R/transform.R b/R/transform.R
@@ -21,7 +21,7 @@
 #'   input data frame with the Albers Equal Area projection applied. The
 #'   transformed columns will be appended to the data frame so that all
 #'   original columns should remain intact.
-#'
+
 #' @examples
 #' data <- data.frame(
 #'   lon = c(-74.01, -95.36, -118.24, -87.65, -134.42, -157.86),
@@ -35,9 +35,9 @@
 #' # Plot transformed data on map
 #' library(ggplot2)
 #'
-#' plot_usmap() + geom_point(
+#' plot_usmap() + geom_sf(
 #'   data = transformed_data,
-#'   aes(x = x, y = y, size = pop),
+#'   aes(size = pop),
 #'   color = "red", alpha = 0.5
 #' )
 #'
@@ -46,19 +46,6 @@
 usmap_transform <- function(data,
                             input_names = c("lon", "lat"),
                             output_names = c("x", "y")) {
-
-  # check for sf
-  if (!requireNamespace("sf", quietly = TRUE)) {
-    stop("`sf` must be installed to use `usmap_transform`.
-         Use: install.packages(\"sf\") and try again.")
-  }
-
-  # check for sp
-  if (!requireNamespace("sp", quietly = TRUE)) {
-    stop("`sp` must be installed to use `usmap_transform`.
-         Use: install.packages(\"sp\") and try again.")
-  }
-
   UseMethod("usmap_transform", data)
 }
 
@@ -93,92 +80,62 @@ usmap_transform.data.frame <- function(data,
     output_names <- as.character(output_names)
   }
 
-  # create SpatialPointsDataFrame
-  longlat <- sp::CRS(SRS_string = "EPSG:4326") # long/lat coordinates
-
-  spdf <- sp::SpatialPointsDataFrame(
-    coords = data[, c(input_names[1], input_names[2])],
-    data = data,
-    proj4string = longlat
-  )
-
-  # transform to canonical projection
-  transformed <- sp::spTransform(spdf, usmap_crs())
+  # Convert data to sf
+  data_sf <- sf::st_as_sf(data, coords = input_names)
+  sf::st_crs(data_sf) <- sf::st_crs(4326) # long/lat CRS
 
-  # transform Alaska points
+  # Transform to canonical projection
+  transformed <- sf::st_transform(data_sf, usmap_crs())
+  sf::st_agr(transformed) <- "constant"
 
-  ak_bbox <- sp::bbox(
-    matrix(
+  # Transform Alaska points
+  ak_bbox <- sf::st_as_sfc(
+    sf::st_bbox(
       c(
-        -4377000, # min transformed longitude
-        -1519000, # max transformed longitude
-        1466000,  # min transformed latitude
-        3914000   # max transformed latitude
-      ), ncol = 2
+        xmin = -4377000,
+        xmax = -1519000,
+        ymin = 1466000,
+        ymax = 3914000
+      ),
+      crs = usmap_crs()
     )
   )
+  alaska <- sf::st_intersection(transformed, ak_bbox)
 
-  alaska <- transformed[
-    transformed@coords[, 1] >= ak_bbox[1, 1] &
-      transformed@coords[, 1] <= ak_bbox[1, 2] &
-      transformed@coords[, 2] >= ak_bbox[2, 1] &
-      transformed@coords[, 2] <= ak_bbox[2, 2],
-  ]
-
-  if (length(alaska) > 0) {
-    alaska <- sp::elide(
-      alaska,
-      rotate = -50,
-      scale = max(apply(ak_bbox, 1, diff)) / 2.3,
-      bb = ak_bbox
-    )
-    alaska <- sp::elide(alaska, shift = c(-1298669, -3018809))
-    sp::proj4string(alaska) <- usmap_crs()
-    names(alaska) <- names(transformed)
+  if (nrow(alaska) > 0) {
+    sf::st_geometry(alaska) <- sf::st_geometry(alaska) * usmapdata:::transform2D(-50, 1 / 2)
+    sf::st_geometry(alaska) <- sf::st_geometry(alaska) + c(3e5, -2e6)
+    sf::st_crs(alaska) <- usmap_crs()
   }
 
-  # transform Hawaii points
-
-  hi_bbox <- sp::bbox(
-    matrix(
+  # Transform Hawaii points
+  hi_bbox <- sf::st_as_sfc(
+    sf::st_bbox(
       c(
-        -5750000, # min transformed longitude
-        -5450000, # max transformed longitude
-        -1050000, # min transformed latitude
-        -441000   # max transformed latitude
-      ), ncol = 2
+        xmin = -5750000,
+        xmax = -5450000,
+        ymin = -1050000,
+        ymax = -441000
+      ),
+      crs = usmap_crs()
     )
   )
+  hawaii <- sf::st_intersection(transformed, hi_bbox)
 
-  hawaii <- transformed[
-    transformed@coords[, 1] >= hi_bbox[1, 1] &
-      transformed@coords[, 1] <= hi_bbox[1, 2] &
-      transformed@coords[, 2] >= hi_bbox[2, 1] &
-      transformed@coords[, 2] <= hi_bbox[2, 2],
-  ]
-
-  if (length(hawaii) > 0) {
-    hawaii <- sp::elide(
-      hawaii,
-      rotate = -35,
-      bb = hi_bbox
-    )
-    hawaii <- sp::elide(hawaii, shift = c(5400000, -1400000))
-    sp::proj4string(hawaii) <- usmap_crs()
-    names(hawaii) <- names(transformed)
+  if (nrow(hawaii) > 0) {
+    sf::st_geometry(hawaii) <- sf::st_geometry(hawaii) * usmapdata:::transform2D(-35)
+    sf::st_geometry(hawaii) <- sf::st_geometry(hawaii) + c(3.6e6, 1.8e6)
+    sf::st_crs(hawaii) <- usmap_crs()
   }
 
-  # combine all points
-  combined <- rbind(transformed, alaska, hawaii)
-
-  result <- as.data.frame(
-    combined[!duplicated(combined@data, fromLast = TRUE), ]
-  )
-  row.names(result) <- NULL
+  # Re-combine all points
+  transformed_excl_ak <- sf::st_difference(transformed, ak_bbox)
+  sf::st_agr(transformed_excl_ak) <- "constant"
 
-  colnames(result) <- c(colnames(data), output_names)
+  transformed_excl_ak_hi <- sf::st_difference(transformed_excl_ak, hi_bbox)
+  sf::st_agr(transformed_excl_ak_hi) <- "constant"
 
-  result
+  rbind(transformed_excl_ak_hi, alaska, hawaii)
 }
 
 #' usmap coordinate reference system
@@ -191,16 +148,5 @@ usmap_transform.data.frame <- function(data,
 #'
 #' @export
 usmap_crs <- function() {
-  if (!requireNamespace("sf", quietly = TRUE)) {
-    stop("`sf` must be installed to use `usmap_crs`.
-         Use: install.packages(\"sf\") and try again.")
-  }
-
-  if (!requireNamespace("sp", quietly = TRUE)) {
-    stop("`sp` must be installed to use `usmap_crs`.
-         Use: install.packages(\"sp\") and try again.")
-  }
-
-  sp::CRS(paste("+proj=laea +lat_0=45 +lon_0=-100 +x_0=0 +y_0=0",
-                "+a=6370997 +b=6370997 +units=m +no_defs"))
+  sf::st_crs(9311)
 }
diff --git a/R/usmap.R b/R/usmap.R
@@ -96,11 +96,5 @@
 us_map <- function(regions = c("states", "state", "counties", "county"),
                    include = c(),
                    exclude = c()) {
-  # check for usmapdata
-  if (!requireNamespace("usmapdata", quietly = TRUE)) {
-    stop("`usmapdata` must be installed to use `plot_usmap`.
-         Use: install.packages(\"usmapdata\") and try again.")
-  }
-
-  usmapdata::us_map(regions = regions, include = include, exclude = exclude)
+  usmapdata::us_map(regions = regions, include = include, exclude = exclude, as_sf = TRUE)
 }