Shift centroid, add_bbox_buffer to sf (Fixes #18) (Fixes #17)

.github/workflows/run-examples.yaml

@@ -8,7 +8,7 @@ on:
       - '*'
       - '!gh-pages'
 
-name: R-CMD-check-Ubuntu-release
+name: run-examples
 
 jobs:
   run-examples:

DESCRIPTION

@@ -29,7 +29,8 @@ Imports:
     utils,
     gdalUtilities,
     sf,
-    rlang
+    rlang,
+    units
 RoxygenNote: 7.1.1
 Suggests: 
     testthat,

NAMESPACE

@@ -1,8 +1,13 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method(add_bbox_buffer,Raster)
+S3method(add_bbox_buffer,sf)
+S3method(get_tiles,Raster)
 S3method(get_tiles,list)
 S3method(get_tiles,sf)
 S3method(get_tiles,terrainr_bounding_box)
+S3method(set_bbox_side_length,Raster)
+S3method(set_bbox_side_length,sf)
 export(add_bbox_buffer)
 export(calc_haversine_distance)
 export(combine_overlays)
@@ -11,7 +16,6 @@ export(deg_to_rad)
 export(export_bounding_box)
 export(export_coord_pair)
 export(georeference_overlay)
-export(get_bbox_centroid)
 export(get_tiles)
 export(hit_national_map_api)
 export(merge_rasters)

NEWS.md

@@ -1,12 +1,19 @@
 # terrainr 0.2.1.9000
 * Breaking changes:
+    * `terrainr_*` classes have been effectively removed and are no longer 
+      exported. Functions which previously expected these objects now generally 
+      accept `sf` and `Raster` class objects instead. Functions which previously
+      returned these objects now generally return `sf` objects instead.
     * The list returned by `get_tiles` now uses the service names provided by
       the user, not the endpoint names. This means that 
       `get_tiles(..., services = "elevation")` will now use the name `elevation`
       instead of `3DEPElevation`, and remain standard across versions (#12).
     * `get_bbox` and `get_coordinate_bbox` have been removed. Functions that 
       used to expect `terrainr_bounding_box` objects now accept objects of class
       `sf` or `raster`. 
+    * `add_bbox_buffer` loses the `divisible` argument. For precise control over
+      side length, use `set_bbox_side_length` (which should be more accurate, if
+      slightly more conservative, than the `divisible` system ever was).
 * Improvements and bug fixes:
     * `calc_haversine_distance` gains an argument `coord_units` allowing it to 
       handle coordinates in radians as well as degrees.

R/add_bbox_buffer.R

@@ -10,82 +10,183 @@
 #' [set_bbox_side_length] is a thin wrapper around [add_bbox_buffer] which sets
 #' all sides of the bounding box to (approximately) a specified length.
 #'
-#' @param bbox The original bounding box to add a buffer around. If not already
-#' a \code{\link{terrainr_bounding_box}} object, will be converted.
+#' @param data The original data to add a buffer around.
 #' @param distance The distance to add to the buffer.
 #' @param distance_unit The units of the distance to add to the buffer, passed
-#' to \code{\link{convert_distance}}.
-#' @param divisible Numeric: Extend the top right and bottom left corners so
-#' that each side is divisible by \code{divisible}. Leave set to \code{NULL} to
-#' not extend. This argument is in the same units as \code{distance_unit}.
+#' to [units::as_units].
+#' @param error_crs Logical: Should this function error if `data` has no CRS?
+#' If `TRUE`, function errors; if `FALSE`, function quietly assumes EPSG:4326.
+#' If `NULL`, the default, function assumes EPSG:4326 with a warning.
 #'
-#' @return A [terrainr_bounding_box] object.
+#' @return An `sfc` object (from [sf::st_as_sfc]).
 #'
 #' @family utilities
 NULL
 
 #' @rdname addbuff
 #' @examples
-#' add_bbox_buffer(
-#'   list(
-#'     c(lat = 44.04905, lng = -74.01188),
-#'     c(lat = 44.17609, lng = -73.83493)
-#'   ),
-#'   10
-#' )
+#'
+#' df <- data.frame(
+#'   lat = c(44.04905, 44.17609),
+#'   lng = c(-74.01188, -73.83493)
+#'   )
+#'
+#' df_sf <- sf::st_as_sf(df, coords = c("lng", "lat"))
+#' df_sf <- sf::st_set_crs(df_sf, 4326)
+#'
+#' add_bbox_buffer(df_sf, 10)
+#'
 #' @export
 #' @md
-add_bbox_buffer <- function(bbox,
+add_bbox_buffer <- function(data,
                             distance,
                             distance_unit = "meters",
-                            divisible = NULL) {
-  if (!methods::is(bbox, "terrainr_bounding_box")) {
-    bbox <- terrainr::terrainr_bounding_box(bbox[[1]], bbox[[2]])
-  }
+                            error_crs = NULL) {
 
-  centroid <- terrainr::get_bbox_centroid(bbox)
-  corner_distance <- terrainr::calc_haversine_distance(
-    centroid,
-    bbox@bl
-  )
-  distance <- terrainr::convert_distance(distance, distance_unit)
-  add_distance <- corner_distance + distance
-  bl <- terrainr::point_from_distance(centroid, add_distance, 225)
-  tr <- terrainr::point_from_distance(centroid, add_distance, 45)
+  UseMethod("add_bbox_buffer")
 
-  if (!is.null(divisible)) {
-    tl <- c(tr@lat, bl@lng)
-    divisible <- terrainr::convert_distance(divisible, distance_unit)
+}
 
-    x <- ceiling(terrainr::calc_haversine_distance(tl, tr) / divisible)
-    tr <- terrainr::point_from_distance(tl, divisible * x, 90)
+#' @rdname addbuff
+#' @export
+add_bbox_buffer.sf <- function(data,
+                               distance,
+                               distance_unit = "meters",
+                               error_crs = NULL) {
 
-    y <- ceiling(terrainr::calc_haversine_distance(tl, tr) / divisible)
-    bl <- terrainr::point_from_distance(tl, divisible * y, 180)
+  if (is.na(sf::st_crs(data)$input)) {
+    if (is.null(error_crs)) {
+      warning("No CRS associated with input data. Assuming EPSG:4326.\n")
+    } else if (error_crs) {
+      stop("No CRS associated with input data.")
+    }
+    data <- sf::st_set_crs(data, 4326)
   }
 
-  return(terrainr::terrainr_bounding_box(bl, tr))
+  units(distance) <- units::as_units(distance_unit)
+
+  bbox <- sf::st_bbox(data)
+  bbox_sfc <- sf::st_as_sfc(bbox)
+  units(distance) <- distance_unit
+  bbox <- tryCatch({
+    # force an error before the warning if it'll be a problem
+    ignored <- units::as_units("degree")
+    ignored + distance
+    # If distance will error, we're already in the second method now.
+    # If it'll only warn, return the sf version
+    sf::st_buffer(bbox_sfc, distance)
+  },
+  error = function(e) {
+    centroid <- get_centroid(lat = c(bbox[["ymin"]], bbox[["ymax"]]),
+                             lng = c(bbox[["xmin"]], bbox[["xmax"]]))
+    corner_distance <- calc_haversine_distance(
+      centroid,
+      c(lng = bbox[["xmin"]], lat = bbox[["ymin"]]),
+      )
+    units(corner_distance) <- units::as_units("meter")
+    # This forces add_distance into meters since corner_distance is first
+    add_distance <- corner_distance + distance
+    # Now drop units for trig to not give warnings
+    units(add_distance) <- units::as_units(NULL)
+    bl <- point_from_distance(centroid, add_distance, 225)
+    tr <- point_from_distance(centroid, add_distance, 45)
+    output <- stats::setNames(
+      c(bl@lng, bl@lat, tr@lng, tr@lat),
+      c("xmin", "ymin", "xmax", "ymax")
+      )
+    class(output) <- "bbox"
+    sf::st_as_sfc(output)
+    })
+
+  return(bbox)
+}
+
+#' @rdname addbuff
+#' @export
+add_bbox_buffer.Raster <- function(data,
+                                   distance,
+                                   distance_unit = "meters",
+                                   error_crs = NULL) {
+
+  bbox <- raster::extent(data)
+  data_sf <- data.frame(
+    lat = c(bbox@ymin, bbox@ymax),
+    lng = c(bbox@xmin, bbox@xmax)
+  )
+  data_sf <- sf::st_as_sf(data_sf, coords = c("lng", "lat"))
+  data_sf <- sf::st_set_crs(data_sf, sf::st_crs(data))
+  add_bbox_buffer(data_sf,
+                  distance = distance,
+                  distance_unit = distance_unit,
+                  error_crs = error_crs)
+
 }
 
 #' @rdname addbuff
 #' @examples
-#' set_bbox_side_length(
-#'   list(
-#'     c(lat = 44.04905, lng = -74.01188),
-#'     c(lat = 44.17609, lng = -73.83493)
-#'   ),
-#'   4000
-#' )
+#'
+#' df <- data.frame(
+#'   lat = c(44.04905, 44.17609),
+#'   lng = c(-74.01188, -73.83493)
+#'   )
+#'
+#' df_sf <- sf::st_as_sf(df, coords = c("lng", "lat"))
+#' df_sf <- sf::st_set_crs(df_sf, 4326)
+#'
+#' set_bbox_side_length(df_sf, 4000)
+#'
 #' @export
-set_bbox_side_length <- function(bbox,
+set_bbox_side_length <- function(data,
                                  distance,
-                                 distance_unit = "meters") {
-  center <- terrainr::export_coord_pair(terrainr::get_bbox_centroid(bbox))
-  terrainr::add_bbox_buffer(
-    list(tr = c(lat = center[["lat"]], lng = center[["lng"]]),
-         bl = c(lat = center[["lat"]] - 0.000001,
-                lng = center[["lng"]] - 0.000001)),
+                                 distance_unit = "meters",
+                                 error_crs = NULL) {
+  UseMethod("set_bbox_side_length")
+}
+
+#' @rdname addbuff
+#' @export
+set_bbox_side_length.sf <- function(data,
+                                    distance,
+                                    distance_unit = "meters",
+                                    error_crs = NULL) {
+  bbox <- sf::st_bbox(data)
+  center <- get_centroid(lat = c(bbox[["ymin"]], bbox[["ymax"]]),
+                         lng = c(bbox[["xmin"]], bbox[["xmax"]]))
+  data_sf <- data.frame(
+    lat = c(center[["lat"]], center[["lat"]] - 0.000001),
+    lng = c(center[["lng"]], center[["lng"]] - 0.000001)
+  )
+
+  data_sf <- sf::st_as_sf(data_sf, coords = c("lng", "lat"))
+  data_sf <- sf::st_set_crs(data_sf, sf::st_crs(data))
+
+  add_bbox_buffer(
+    data_sf,
     distance = sqrt((distance^2) * 2) / 2,
-    distance_unit = distance_unit
+    distance_unit = distance_unit,
+    error_crs = error_crs
+  )
+
+}
+
+#' @rdname addbuff
+#' @export
+set_bbox_side_length.Raster <- function(data,
+                                   distance,
+                                   distance_unit = "meters",
+                                   error_crs = NULL) {
+
+  bbox <- raster::extent(data)
+  data_sf <- data.frame(
+    lat = c(bbox@ymin, bbox@ymax),
+    lng = c(bbox@xmin, bbox@xmax)
+  )
+  data_sf <- sf::st_as_sf(data_sf, coords = c("lng", "lat"))
+  data_sf <- sf::st_set_crs(data_sf, sf::st_crs(data))
+  set_bbox_side_length(
+    data_sf,
+    distance = distance,
+    distance_unit = distance_unit,
+    error_crs = error_crs
   )
 }

R/get_tiles.R

@@ -123,7 +123,36 @@ get_tiles.sf <- function(data,
 
 }
 
-get_tiles.raster <- function(data,
+get_tiles.sfc <- function(data,
+                          output_prefix = tempfile(),
+                          side_length = NULL,
+                          resolution = 1,
+                          services = "elevation",
+                          verbose = FALSE,
+                          georeference = TRUE,
+                          ...) {
+
+  data <- sf::st_bbox(data)
+  bl <- c("lng" = data[["xmin"]], "lat" = data[["ymin"]])
+  tr <- c("lng" = data[["xmax"]], "lat" = data[["ymax"]])
+
+  get_tiles_internal(
+    bl = bl,
+    tr = tr,
+    output_prefix = output_prefix,
+    side_length = side_length,
+    resolution = resolution,
+    services = services,
+    verbose = verbose,
+    georeference = georeference,
+    ...
+  )
+
+}
+
+#' @rdname get_tiles
+#' @export
+get_tiles.Raster <- function(data,
                              output_prefix = tempfile(),
                              side_length = NULL,
                              resolution = 1,