various bugfixes

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: slga
 Type: Package
 Title: Data access tools for the Soil and Landscape Grid of Australia
-Version: 0.5.0
+Version: 0.6.0
 Date: 2018-11-30
 Authors@R: c(
     person("Lauren", "O'Brien", email = "[email protected]", role = c('aut', 'cre')),

NEWS.md

@@ -1,6 +1,14 @@
+# slga 0.6.0
+
+  * S3 methods for validating aoi (internal only). Covered: numeric vector, raster, rasterExtent, sf, sfc.
+  * Bugfix for tempfile names.
+  * Bugfix for bounding box.
+  * Better crs checking.
+  * Outputs in GDA94 like they should have been already.
+
 # slga 0.5.0
 
-  * data type fixes for lscape, more efficient download method
+  * data type fixes for lscape, more efficient download method.
   * Added `metadata_soils()` and `metadata_lscape()` to provide access to service metadata in XML or JSON format.
 
 # slga 0.4.0
@@ -13,18 +21,17 @@
 
 # slga 0.3.0
 
-  * Updated README.md
-  * Added travis and codecov
+  * Updated README.md.
+  * Added travis and codecov.
 
 # slga 0.2.0
 
   * Retrieval functionality wrapped in `get_slga_data()` to get raster values and confidence intervals in one object. For more complex requests involving multiple depth ranges, attributes, products or combinations thereof, use this with a map-style function e.g. `base::lapply()` or `purrr::map()`.
   * Added product/attribute availability checking.
   * Now using easier to remember names for products.
-  * Added unit tests
-  * Added vignette
+  * Added unit tests.
+  * Added vignette.
 
 # slga 0.1.0
 
-  * basic functionality - ability to extract a single raster subset using a
-bounding box.
+  * basic functionality - ability to extract a single raster subset using a bounding box.

R/get_data.R

@@ -70,7 +70,8 @@ get_soils_raster <- function(product   = NULL,
   # write final product to working directory if directed
   if(write_out == TRUE) {
     out_dest <- file.path(getwd(), paste0(out_name, '.tif'))
-    raster::writeRaster(r, out_dest, datatype = 'FLT4S', NAflag = -9999, overwrite = TRUE)
+    raster::writeRaster(r, out_dest, datatype = 'FLT4S',
+                        NAflag = -9999, overwrite = TRUE)
     raster::raster(out_dest)
   } else {
     r

R/helpers.R

@@ -16,11 +16,9 @@
 #' @keywords internal
 #' @importFrom sf st_bbox st_crs st_point st_sfc st_transform
 #'
-transform_bb <- function(bbox = NULL, crs = 4326) {
-  ll <- sf::st_point(c(bbox[1], bbox[2]))
-  ur <- sf::st_point(c(bbox[3], bbox[4]))
-  pts <- sf::st_sfc(ll, ur, crs = sf::st_crs(bbox))
-  new <- sf::st_transform(pts, crs)
+transform_bb <- function(bbox = NULL, crs = 4283) {
+  box <- sf::st_as_sfc(bbox, crs = sf::st_crs(bbox))
+  new <- sf::st_transform(box, crs)
   sf::st_bbox(new)
 }
 
@@ -104,67 +102,114 @@ align_aoi <- function(aoi = NULL, product = NULL, snap = "out")
   aoi
 }
 
-#' Validate AOI
+#' Convert AOI
 #'
-#' Checks that an area of interest is of appropriate projection, size, and
-#' extent.
+#' Converts an AOI from a variety of possible input types to an `sf` style bbox.
 #'
-#' @param aoi length 4 numeric vector, `raster` object, or `sf` object.
-#' @param product Character, one of the options from column 'Short_Name' in
-#'   \code{\link[slga:slga_product_info]{slga_product_info}}.
+#' @param aoi Numeric; bounding coordinates or an `sf` or `raster` object from
+#'   which they can be derived.
+#' @return `sf` bbox object with same crs as input.
 #' @keywords internal
+#' @rdname convert_aoi
 #' @importFrom raster extent
-#' @importFrom sf st_crs st_as_sfc st_intersects
+#' @importFrom sf st_bbox st_crs st_as_sfc st_intersects
 #' @importFrom utils data
 #'
-validate_aoi <- function(aoi = NULL, product = NULL) {
+convert_aoi <- function(aoi = NULL) {
+  UseMethod('convert_aoi')
+}
+
+#' @rdname convert_aoi
+#' @inherit convert_aoi return
+#' @method convert_aoi numeric
+#'
+convert_aoi.numeric <- function(aoi = NULL) {
+    # dumb check for malformed vectors
+    if(aoi[3] <= aoi[1]) {
+      stop('Please check that AOI coordinates are ordered correctly
+           - xmin, ymin, xmax, ymax.')
+    }
 
-  # 1. for simple bounding vector, convert to sf style bbox
-  if(all(length(aoi) == 4, inherits(aoi, 'numeric'))) {
     aoi <- structure(aoi, names = c("xmin", "ymin", "xmax", "ymax"),
-                     class = "bbox", crs = sf::st_crs(4326))
-    message("Assuming AOI coordinates are in EPSG:4326 and ordered correctly.")
+                     class = "bbox", crs = sf::st_crs(4283))
+    message("Assuming AOI coordinates are in EPSG:4283 and ordered correctly.")
+    aoi
   }
 
-  # 2. Do the same for rasters
-  if(inherits(aoi, 'Raster')) {
+#' @rdname convert_aoi
+#' @inherit convert_aoi return
+#' @method convert_aoi Raster
+#'
+convert_aoi.Raster <- function(aoi = NULL) {
+
     aoi_crs <- sf::st_crs(aoi@crs@projargs)
     aoi <- raster::extent(aoi)
-    # low-dependency conversion to sf-style bbox pinched from sf/bbox.r
-    aoi <- c(attr(aoi, 'xmin'), attr(aoi, 'ymin'),
-             attr(aoi, 'xmax'), attr(aoi, 'ymax'))
-    aoi <- structure(aoi, names = c("xmin", "ymin", "xmax", "ymax"),
-                     class = "bbox", crs = aoi_crs)
-  }
-  # and bare extent objects jic but have to assume 4326 here
-  if(inherits(aoi, 'Extent')) {
-    aoi <- c(attr(aoi, 'xmin'), attr(aoi, 'ymin'),
-             attr(aoi, 'xmax'), attr(aoi, 'ymax'))
-    aoi <- structure(aoi, names = c("xmin", "ymin", "xmax", "ymax"),
-                     class = "bbox", crs = sf::st_crs(4326))
-    message("Assuming AOI coordinates are in EPSG:4326.")
+    sf::st_bbox(aoi, crs = aoi_crs)
+}
+
+#' @rdname convert_aoi
+#' @inherit convert_aoi return
+#' @method convert_aoi Extent
+#'
+convert_aoi.Extent <- function(aoi = NULL) {
+    message("Assuming AOI coordinates are in EPSG:4283.")
+    sf::st_bbox(aoi, crs = sf::st_crs(4283))
   }
-  # note that EPSG code may be lost for some projections eg EPSG:3577
 
-  # 3. Now assuming sf objects are all that is left here
-  ext <- if(inherits(aoi, c('sf', 'sfc'))) {
-    sf::st_bbox(aoi)
+#' @rdname convert_aoi
+#' @inherit convert_aoi return
+#' @method convert_aoi sf
+#'
+convert_aoi.sf <- function(aoi = NULL) {
+  aoi <- sf::st_as_sfc(sf::st_bbox(aoi), crs = sf::st_crs(aoi))
+  sf::st_bbox(aoi)
+}
+
+#' @rdname convert_aoi
+#' @inherit convert_aoi return
+#' @method convert_aoi sfc
+#'
+convert_aoi.sfc <- function(aoi = NULL) {
+  aoi <- sf::st_as_sfc(sf::st_bbox(aoi), crs = sf::st_crs(aoi))
+  sf::st_bbox(aoi)
+}
+
+#' Validate AOI
+#'
+#' Checks that an area of interest is of appropriate projection, size, and
+#' extent.
+#'
+#' @param aoi Numeric; bounding coordinates or an `sf` or `raster` object from
+#'   which they can be derived.
+#' @param product Character, one of the options from column 'Short_Name' in
+#'   \code{\link[slga:slga_product_info]{slga_product_info}}.
+#' @keywords internal
+#' @importFrom raster extent
+#' @importFrom sf st_crs st_as_sfc st_intersects
+#' @importFrom utils data
+#'
+validate_aoi <- function(aoi = NULL, product = NULL) {
+
+  ext <- if(!inherits(aoi, 'bbox')) {
+    convert_aoi(aoi)
   } else {
     aoi
   }
 
-  # check crs, convert if not 4326
+  # check crs, transform if not in 4283
   ext <- if(is.na(attr(ext, 'crs')$epsg)) {
-    if(grepl('+proj=lonlat|+datum=WGS84',
-             attr(ext, 'crs')$proj4string) == FALSE) {
-      message('Transforming AOI coordinates to EPSG:4326')
-      transform_bb(ext, 4326)
+    crs_bits <- sort(unlist(strsplit(attr(ext, 'crs')$proj4string, ' ')))
+    gda94_bits <- sort(unlist(strsplit(
+      '+proj=longlat +ellps=GRS80 +towgs84=0,0,0,0,0,0,0 +no_defs', ' ')))
+    if(!identical(crs_bits, gda94_bits)) {
+      message('Transforming aoi coordinates to EPSG:4283')
+      transform_bb(ext, 4283)
     } else {
       ext
     }
-    } else if(attr(ext, 'crs')$epsg != 4326) {
-    message('Transforming aoi coordinates to EPSG:4326')
-    transform_bb(ext, 4326)
+    } else if(attr(ext, 'crs')$epsg != 4283) {
+    message('Transforming aoi coordinates to EPSG:4283')
+    transform_bb(ext, 4283)
   } else {
     ext
   }
@@ -175,7 +220,7 @@ validate_aoi <- function(aoi = NULL, product = NULL) {
   prd <- slga_product_info[which(slga_product_info$Short_Name == product), ]
   prd <- c(prd[['xmin']], prd[['ymin']], prd[['xmax']], prd[['ymax']])
   prd_aoi <- structure(prd, names = c("xmin", "ymin", "xmax", "ymax"),
-              class = "bbox", crs =  sf::st_crs(4326))
+              class = "bbox", crs =  sf::st_crs(4283))
   # cast both extents to sfc and check intersect
   # note slightly dodgy as unprojected
   ol <- suppressMessages(

tests/testthat/test_helpers.R

@@ -3,7 +3,7 @@ context('helpers')
 test_that(
   'transform_bb functions as expected',
   c(
-    # function is only called when its clear that data is not already in 4326
+    # function is only called when its clear that data is not already in 4283
     # see helpers.R lines 144-157
     # testing on King Island in UTM
     # this is fun b/c King Island is right on a UTM boundary
@@ -14,10 +14,10 @@ test_that(
                      class = "bbox", crs = sf::st_crs(28355)),
     val1 <- slga:::transform_bb(aoi1),
     expect_is(val1, 'bbox'),
-    expect_equal(attr(val1, 'crs')$epsg, 4326),
-    expect_equivalent(val1[1], 143.75),
-    expect_equivalent(val1[2], -40.17),
-    expect_equivalent(val1[3], 144.18),
+    expect_equal(attr(val1, 'crs')$epsg, 4283),
+    expect_equivalent(val1[1], 143.7221117),
+    expect_equivalent(val1[2], -40.1699999),
+    expect_equivalent(val1[3], 144.204006),
     expect_equivalent(val1[4], -39.57),
     # now test in 3577
     aoi2 <- structure(c(1021763.636335253,  -4374038.1744254353,
@@ -26,11 +26,11 @@ test_that(
                      class = "bbox", crs = sf::st_crs(3577)),
     val2 <- slga:::transform_bb(aoi2),
     expect_is(val2, 'bbox'),
-    expect_equal(attr(val2, 'crs')$epsg, 4326),
+    expect_equal(attr(val2, 'crs')$epsg, 4283),
     expect_equivalent(val2[1], 143.75),
-    expect_equivalent(val2[2], -40.17),
+    expect_equivalent(val2[2], -40.1966433),
     expect_equivalent(val2[3], 144.18),
-    expect_equivalent(val2[4], -39.57)
+    expect_equivalent(val2[4], -39.543595)
     # val1 and val2 aren't 1000% equal but that's ok, they're pretty damn close
   )
 )
@@ -40,13 +40,13 @@ test_that(
   c(
     aoi <- structure(c(143.75, -40.17, 144.18, -39.57),
                       names = c("xmin", "ymin", "xmax", "ymax"),
-                      class = "bbox", crs = sf::st_crs(4326)),
+                      class = "bbox", crs = sf::st_crs(4283)),
     val1 <- slga:::align_aoi(aoi, 'NAT'),
     val2 <- slga:::align_aoi(aoi, 'TAS'),
     expect_is(val1, 'bbox'),
-    expect_equal(attr(val1, 'crs')$epsg, 4326),
+    expect_equal(attr(val1, 'crs')$epsg, 4283),
     expect_is(val2, 'bbox'),
-    expect_equal(attr(val2, 'crs')$epsg, 4326),
+    expect_equal(attr(val2, 'crs')$epsg, 4283),
     expect_equivalent(val1[1], 143.749583),
     expect_equivalent(val1[2], -40.1704166),
     expect_equivalent(val1[3], 144.180416),
@@ -79,29 +79,29 @@ test_that(
   c(
     aoi <- structure(c(143.75, -40.17, 144.18, -39.57),
                      names = c("xmin", "ymin", "xmax", "ymax"),
-                     class = "bbox", crs = sf::st_crs(4326)),
+                     class = "bbox", crs = sf::st_crs(4283)),
     val1 <- slga:::validate_aoi(aoi, 'NAT'),
     val2 <- slga:::validate_aoi(aoi, 'TAS'),
     expect_is(val1, 'bbox'),
-    expect_equal(attr(val1, 'crs')$epsg, 4326),
+    expect_equal(attr(val1, 'crs')$epsg, 4283),
     expect_is(val2, 'bbox'),
-    expect_equal(attr(val2, 'crs')$epsg, 4326),
+    expect_equal(attr(val2, 'crs')$epsg, 4283),
     expect_error(slga:::validate_aoi(aoi, 'SA')),
     aoi_simple <- c(143.75, -40.17, 144.18, -39.57),
     val3 <- slga:::validate_aoi(aoi_simple, 'NAT'),
     expect_equal(val1, val3),
-    aoi_raster <- raster::extent(sf::st_sf(sf::st_as_sfc(val1), 4326)),
+    aoi_raster <- raster::extent(sf::st_sf(sf::st_as_sfc(val1), 4283)),
     val4 <- slga:::validate_aoi(aoi_raster, 'NAT'),
     expect_equal(val1, val4),
     library(raster),
     data('ki_surface_clay'),
     val5 <- slga:::validate_aoi(ki_surface_clay, 'NAT'),
     val6 <- slga:::validate_aoi(raster::extent(ki_surface_clay), 'NAT'),
-    expect_equal(val5, val6),
+    expect_equivalent(val5, val6),
     expect_error(slga:::validate_aoi('1', 'NAT')),
-    val7 <- sf::st_as_sfc(aoi, crs = 4326),
+    val7 <- sf::st_as_sfc(aoi, crs = 4283),
     expect_equal(slga:::validate_aoi(val7, 'NAT'), val1),
-    val8 <- st_bbox(sf::st_transform(sf::st_as_sfc(aoi, crs = 4326), 28356)),
+    val8 <- st_bbox(sf::st_transform(sf::st_as_sfc(aoi, crs = 4283), 28356)),
     val9 <- val8,
     attr(val9, 'crs')$epsg <- NA,
     expect_equal(slga:::validate_aoi(val8, 'NAT'), slga:::validate_aoi(val9, 'NAT')),