Add bc_bbox

DESCRIPTION

@@ -41,3 +41,5 @@ Additional_repositories: https://bcgov.github.io/drat
 LazyData: true
 Roxygen: list(markdown = TRUE)
 RoxygenNote: 6.1.0
+Encoding: UTF-8
+

NAMESPACE

@@ -10,6 +10,7 @@ S3method(transform_bc_albers,sfc)
 export(airzones)
 export(available_layers)
 export(bc_area)
+export(bc_bbox)
 export(bc_bound)
 export(bc_bound_hres)
 export(bc_cities)

NEWS.md

@@ -2,6 +2,7 @@
 * Added `bc_neighbours()` function to call layers containing adjacent jurisdictions.
 * Ensured the `geometry` column in all layers is consistently named `"geometry"` (Thanks @boshek)
 * Moving sf package to Depends to take advantage of sf print methods.
+* Added `bc_bbox()` to get a bounding box for British Columbia (#40).
 
 # bcmaps v0.17.1
 * Fixed an issue where `self_union()` would fail due to a change in the `raster` package (30cef3438)

R/utils.R

@@ -397,3 +397,38 @@ bec_colours <- function() {
 #' @export
 bec_colors <- bec_colours
 
+#' Get an extent/bounding box for British Columbia
+#'
+#' @param class `"sf"`, `"sp"`, or `"raster"`
+#' @param crs coordinate reference system: integer with the EPSG code,
+#' or character with proj4string. Default `3005` (BC Albers).
+#'
+#' @return an object denoting a bouding box of British Columbia,
+#' of the corresponding class specified in `class`. The coordinates will be
+#' in lat-long WGS84 (epsg:4326).
+#' @export
+#'
+#' @examples
+#' bc_bbox("sf")
+#' bc_bbox("sp")
+#' bc_bbox("raster")
+bc_bbox <- function(class = c("sf", "sp", "raster"), crs = 3005) {
+  class <- match.arg(class)
+
+  if (class == "raster" && !requireNamespace("raster")) {
+    stop("raster package required to make an object of class Extent")
+  }
+
+  sf_bbox <- sf::st_bbox(sf::st_transform(bc_bound(), crs))
+
+  raw_bbox <- unclass(sf_bbox)
+  attr(raw_bbox, "crs") <- NULL
+
+  switch(class,
+         sf = sf_bbox,
+         sp = structure(unname(raw_bbox), .Dim = c(2L, 2L),
+                        .Dimnames = list(c("x", "y"), c("min", "max"))),
+         raster = raster::extent(unname(raw_bbox[c("xmin", "xmax", "ymin", "ymax")]))
+  )
+
+}

tests/testthat/test-get_big_data.R

@@ -32,7 +32,7 @@ test_that("get_big_data works with latest release", {
 test_that("get_big_data fails when file doesn't exist", {
   skip_if_not_installed("bcmaps.rdata")
   skip_on_cran()
-  expect_error(get_big_data("test", "sf", "0.1.0"), "No assets matching filename test.rds in 0.1.0 release")
+  expect_error(get_big_data("test", "sf", "0.1.0", force = TRUE, ask = FALSE), "No assets matching filename test.rds in 0.1.0 release")
 })
 
 test_that("check_write_to_data_dir works", {

tests/testthat/test-utils.R

@@ -0,0 +1,40 @@
+context("test-utils")
+
+Extent_to_vec <- function(x) {
+  ret <- vapply(slotNames(x), function(y) slot(x, y), FUN.VALUE = numeric(1))
+  ret[c("xmin", "ymin", "xmax", "ymax")]
+}
+
+sp_bbox_to_vec <- function(x) {
+  c(
+    xmin = x["x", "min"],
+    ymin = x["y", "min"],
+    xmax = x["x", "max"],
+    ymax = x["y", "max"]
+  )
+}
+
+sf_bbox_to_vec <- function(x) {
+  ret <- as.numeric(x)
+  names(ret) <- names(x)
+  ret[c("xmin", "ymin", "xmax", "ymax")]
+}
+
+test_that("bc_bbox works with all classes", {
+  sf_out <- sf_bbox_to_vec(bc_bbox())
+  expect_equal(bc_bbox(), sf::st_bbox(bc_bound()))
+  expect_equal(sp_bbox_to_vec(bc_bbox("sp")), sf_out)
+  expect_equal(Extent_to_vec(bc_bbox("raster")), sf_out)
+})
+
+test_that("bc_bbox works with all classes and numeric crs", {
+  sf_out <- sf_bbox_to_vec(bc_bbox(crs = 4326))
+  expect_equal(sp_bbox_to_vec(bc_bbox("sp", crs = 4326)), sf_out)
+  expect_equal(Extent_to_vec(bc_bbox("raster", crs = 4326)), sf_out)
+})
+
+test_that("bc_bbox works with all classes and character crs", {
+  sf_out <- sf_bbox_to_vec(bc_bbox(crs = "+init=epsg:3857"))
+  expect_equal(sp_bbox_to_vec(bc_bbox("sp", crs = "+init=epsg:3857")), sf_out)
+  expect_equal(Extent_to_vec(bc_bbox("raster", crs = "+init=epsg:3857")), sf_out)
+})