points_elided_sf()

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 <bob@rud.is>
 Description: Creating a composite projection for states and counties of the United States

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)

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
+
+}

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.
+}