diff --git a/DESCRIPTION b/DESCRIPTION index a4455cf..37acbfb 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Package: albersusa Type: Package Title: Tools, Shapefiles & Data to Work with an 'AlbersUSA' Composite Projection -Version: 0.4.0 -Date: 2019-12-09 +Version: 0.4.1 +Date: 2020-03-03 Author: Bob Rudis (bob@rud.is) Maintainer: Bob Rudis Description: Creating a composite projection for states and counties of the United States diff --git a/NAMESPACE b/NAMESPACE index 55591f6..86291c7 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -3,6 +3,7 @@ export(counties_composite) export(counties_sf) export(points_elided) +export(points_elided_sf) export(us_aeqd_proj) export(us_eqdc_proj) export(us_laea_proj) diff --git a/R/points-elided-sf.R b/R/points-elided-sf.R new file mode 100644 index 0000000..662809f --- /dev/null +++ b/R/points-elided-sf.R @@ -0,0 +1,55 @@ +#' Shift points around Alaska and Hawaii to the elided area +#' +#' This function will take an {sf} object or a data frame of coordinates +#' and shift the points around Alaska and Hawaii to the elided area from this package, +#' leaving the other points intact. +#' +#' @param {sfin} An object of SpatialPoints class or a data frame with x (`lon`) and y (`lat`) +#' @return An elided version of the original {sf} class +#' @export +points_elided_sf <- function(sfin) { + + sfin <- points + orig_crs <- st_crs(sfin) + + # convert it to Albers equal area + sfin <- st_transform(sfin, st_crs("+proj=laea +lat_0=45 +lon_0=-100 +x_0=0 +y_0=0 +a=6370997 +b=6370997 +units=m +no_defs")) + + ak_poly <- readRDS(system.file("extdata/alaska-sf-poly.rds", package="albersusa")) + ak_bb <- readRDS(system.file("extdata/alaska_bb.rda", package="albersusa")) + + hi_poly <- readRDS(system.file("extdata/hawaii-sf-poly.rds", package="albersusa")) + hi_bb <- readRDS(system.file("extdata/hawaii_bb.rda", package="albersusa")) + + ak_idx <- which(lengths(st_intersects(sfin, ak_poly)) != 0) + hi_idx <- which(lengths(st_intersects(sfin, hi_poly)) != 0) + + tmp_ak <- sfin[ak_idx,] + tmp_hi <- sfin[hi_idx,] + tmp_in <- sfin[-c(ak_idx, hi_idx),] + + if (nrow(tmp_ak)) { + tmp_ak <- as(tmp_ak, "Spatial") + tmp_ak <- maptools::elide(tmp_ak, scale = max(apply(ak_bb, 1, diff)) / 2.3, rotate = -50, bb = ak_bb) + tmp_ak <- maptools::elide(tmp_ak, shift = c(-1298669, -3018809)) + tmp_ak <- st_set_crs(as(tmp_ak, "sf"), st_crs("+proj=laea +lat_0=45 +lon_0=-100 +x_0=0 +y_0=0 +a=6370997 +b=6370997 +units=m +no_defs")) + } else { + tmp_ak <- NULL + } + + if (nrow(tmp_hi)) { + tmp_hi <- as(tmp_hi, "Spatial") + tmp_hi <- maptools::elide(tmp_hi, rotate = -35, bb = hi_bb) + tmp_hi <- maptools::elide(tmp_hi, shift = c(5400000, -1400000)) + tmp_hi <- st_set_crs(as(tmp_hi, "sf"), st_crs("+proj=laea +lat_0=45 +lon_0=-100 +x_0=0 +y_0=0 +a=6370997 +b=6370997 +units=m +no_defs")) + } else { + tmp_hi <- NULL + } + + if (nrow(tmp_in) == 0) tmp_in <- NULL + + out <- rbind(tmp_ak, tmp_hi, tmp_in) + + out + +} diff --git a/inst/extdata/alaska-sf-poly.rds b/inst/extdata/alaska-sf-poly.rds new file mode 100644 index 0000000..bd5aa8e Binary files /dev/null and b/inst/extdata/alaska-sf-poly.rds differ diff --git a/inst/extdata/hawaii-sf-poly.rds b/inst/extdata/hawaii-sf-poly.rds new file mode 100644 index 0000000..f891734 Binary files /dev/null and b/inst/extdata/hawaii-sf-poly.rds differ diff --git a/man/points_elided_sf.Rd b/man/points_elided_sf.Rd new file mode 100644 index 0000000..6ef09e5 --- /dev/null +++ b/man/points_elided_sf.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/points-elided-sf.R +\name{points_elided_sf} +\alias{points_elided_sf} +\title{Shift points around Alaska and Hawaii to the elided area} +\usage{ +points_elided_sf(sfin) +} +\arguments{ +\item{{sfin}}{An object of SpatialPoints class or a data frame with x (`lon`) and y (`lat`)} +} +\value{ +An elided version of the original {sf} class +} +\description{ +This function will take an {sf} object or a data frame of coordinates +and shift the points around Alaska and Hawaii to the elided area from this package, +leaving the other points intact. +}