diff --git a/DESCRIPTION b/DESCRIPTION index 81d2025..bcaba00 100644 --- a/DESCRIPTION +++ b/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 = "obrlsoilau@gmail.com", role = c('aut', 'cre')), diff --git a/NEWS.md b/NEWS.md index a17b347..fe5a7a0 100644 --- a/NEWS.md +++ b/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. diff --git a/R/get_data.R b/R/get_data.R index 4fc6b10..2f20c00 100644 --- a/R/get_data.R +++ b/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 diff --git a/R/helpers.R b/R/helpers.R index 611f491..937bdf8 100644 --- a/R/helpers.R +++ b/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( diff --git a/data/ki_surface_clay.rda b/data/ki_surface_clay.rda index 25fea43..3ab8607 100644 Binary files a/data/ki_surface_clay.rda and b/data/ki_surface_clay.rda differ diff --git a/man/convert_aoi.Rd b/man/convert_aoi.Rd new file mode 100644 index 0000000..1f761d4 --- /dev/null +++ b/man/convert_aoi.Rd @@ -0,0 +1,34 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/helpers.R +\name{convert_aoi} +\alias{convert_aoi} +\alias{convert_aoi.numeric} +\alias{convert_aoi.Raster} +\alias{convert_aoi.Extent} +\alias{convert_aoi.sf} +\alias{convert_aoi.sfc} +\title{Convert AOI} +\usage{ +convert_aoi(aoi = NULL) + +\method{convert_aoi}{numeric}(aoi = NULL) + +\method{convert_aoi}{Raster}(aoi = NULL) + +\method{convert_aoi}{Extent}(aoi = NULL) + +\method{convert_aoi}{sf}(aoi = NULL) + +\method{convert_aoi}{sfc}(aoi = NULL) +} +\arguments{ +\item{aoi}{Numeric; bounding coordinates or an `sf` or `raster` object from +which they can be derived.} +} +\value{ +`sf` bbox object with same crs as input. +} +\description{ +Converts an AOI from a variety of possible input types to an `sf` style bbox. +} +\keyword{internal} diff --git a/man/transform_bb.Rd b/man/transform_bb.Rd index 4aa0dbc..6c0fa21 100644 --- a/man/transform_bb.Rd +++ b/man/transform_bb.Rd @@ -4,7 +4,7 @@ \alias{transform_bb} \title{transform a bounding box} \usage{ -transform_bb(bbox = NULL, crs = 4326) +transform_bb(bbox = NULL, crs = 4283) } \arguments{ \item{bbox}{Object of class 'bbox' generated by diff --git a/man/validate_aoi.Rd b/man/validate_aoi.Rd index 0b9d682..b788fd0 100644 --- a/man/validate_aoi.Rd +++ b/man/validate_aoi.Rd @@ -7,7 +7,8 @@ validate_aoi(aoi = NULL, product = NULL) } \arguments{ -\item{aoi}{length 4 numeric vector, `raster` object, or `sf` object.} +\item{aoi}{Numeric; bounding coordinates or an `sf` or `raster` object from +which they can be derived.} \item{product}{Character, one of the options from column 'Short_Name' in \code{\link[slga:slga_product_info]{slga_product_info}}.} diff --git a/tests/testthat/test_helpers.R b/tests/testthat/test_helpers.R index 70799cd..61145eb 100644 --- a/tests/testthat/test_helpers.R +++ b/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')),