series/taxaExtent: support soilDB.return_Spatial option/as_Spatial ar…

…gument like other spatial fns

 - curl imported now, don't need requireNamespace

R/seriesExtent.R

@@ -3,9 +3,10 @@
 #' @description This function downloads a generalized representations of a soil series extent from SoilWeb, derived from the current SSURGO snapshot. Data can be returned as vector outlines (`sf` object) or gridded representation of area proportion falling within 800m cells (`SpatRaster` object). Gridded series extent data are only available in CONUS. Vector representations are returned with a GCS/WGS84 coordinate reference system and raster representations are returned with an Albers Equal Area / NAD83 coordinate reference system (`EPSG:5070`).
 #' 
 #' @param s a soil series name, case-insensitive
-#' @param type series extent representation, 'vector': results in an `sf` object and 'raster' results in a `SpatRaster` object
+#' @param type series extent representation, `'vector'`: results in an `sf` object and `'raster'` results in a `SpatRaster` object
 #' @param timeout time that we are willing to wait for a response, in seconds
-#' 
+#' @param as_Spatial Return sp (`SpatialPolygonsDataFrame`) / raster (`RasterLayer`) classes? Default: `FALSE`.
+#' @return An R spatial object, class depending on `type` and `as_Spatial` arguments
 #' @references \url{https://casoilresource.lawr.ucdavis.edu/see/}
 #' @author D.E. Beaudette
 #' 
@@ -49,10 +50,8 @@
 #' }
 #' }
 #' 
-seriesExtent <- function(s, type = c('vector', 'raster'), timeout = 60) {
-
-  if (!requireNamespace("curl")) 
-    stop("package curl is required to download series extent data", call. = FALSE)
+seriesExtent <- function(s, type = c('vector', 'raster'), timeout = 60, 
+                         as_Spatial = getOption('soilDB.return_Spatial', default = FALSE)) {
 
   # download timeout should be longer than default (13 seconds) 
   h <- .soilDB_curl_handle(timeout = timeout)
@@ -67,15 +66,15 @@ seriesExtent <- function(s, type = c('vector', 'raster'), timeout = 60) {
   # ch: this is a shared curl handle with options set
   res <- switch(
     type,
-    vector = {.vector_extent(s, ch = h)},
-    raster = {.raster_extent(s, ch = h)}
+    vector = {.vector_extent(s, ch = h, as_Spatial = as_Spatial)},
+    raster = {.raster_extent(s, ch = h, as_Spatial = as_Spatial)}
   )
 
   return(res)
 }
 
 # 2022-08-15: converted from download.file() -> curl::curl_download() due to SSL errors
-.vector_extent <- function(s, ch) {
+.vector_extent <- function(s, ch, as_Spatial) {
 
   if (!requireNamespace("sf")) 
     stop("package sf is required to return vector series extent grids", call. = FALSE)
@@ -109,12 +108,16 @@ seriesExtent <- function(s, type = c('vector', 'raster'), timeout = 60) {
   # reset row names in attribute data to series name
   rownames(x) <- as.character(x$series)
 
+  if (as_Spatial) {
+    x <- sf::as_Spatial(x)
+  }
+
   # GCS WGS84
   return(x)
 }
 
 # 2022-08-15: converted from download.file() -> curl::curl_download() due to SSL errors
-.raster_extent <- function(s, ch) {
+.raster_extent <- function(s, ch, as_Spatial) {
 
   if (!requireNamespace("terra")) 
     stop("package terra is required to return raster series extent grids", call. = FALSE)
@@ -157,6 +160,14 @@ seriesExtent <- function(s, type = c('vector', 'raster'), timeout = 60) {
   # make CRS explicit
   terra::crs(x) <- 'EPSG:5070'
 
+  if (as_Spatial) {
+    if (requireNamespace("raster", quietly = TRUE)) {
+      x <- raster::raster(x) 
+    } else {
+      stop("Package `raster` is required to return raster data as a RasterLayer object with soilDB.return_Spatial=TRUE")
+    }
+  }
+
   return(x)
 }
 

R/taxaExtent.R

@@ -5,26 +5,28 @@
 #' 
 #' @param x single taxon label (e.g. `haploxeralfs`) or formative element (e.g. `pale`), case-insensitive
 #' 
-#' @param level the taxonomic level within the top 4 tiers of Soil Taxonomy, one of \code{c('order', 'suborder', 'greatgroup', 'subgroup')}
+#' @param level the taxonomic level within the top 4 tiers of Soil Taxonomy, one of `'order'`, `'suborder'`, `'greatgroup'`, `'subgroup'`
 #' 
 #' @param formativeElement logical, search using formative elements instead of taxon label
 #' 
 #' @param timeout time that we are willing to wait for a response, in seconds
 #' 
-#' @return a `SpatRaster` object
+#' @param as_Spatial Return raster (`RasterLayer`) classes? Default: `FALSE`.
+#' 
+#' @return a `SpatRaster` object (or `RasterLayer` when `as_Spatial=TRUE`)
 #' 
 #' @author D.E. Beaudette and A.G. Brown
 #' 
 #' @details See the [Geographic Extent of Soil Taxa](https://ncss-tech.github.io/AQP/soilDB/taxa-extent.html) tutorial for more detailed examples.
 #' 
 #' ## Taxon Queries
 #' 
-#' Taxon labels can be conveniently extracted from the "ST_unique_list" sample data, provided by the [SoilTaxonomy package](https://github.com/ncss-tech/SoilTaxonomy).
+#' Taxon labels can be conveniently extracted from the `"ST_unique_list"` sample data, provided by the [SoilTaxonomy package](https://github.com/ncss-tech/SoilTaxonomy).
 #' 
 #' ## Formative Element Queries
 #' 
 #' ### Greatgroup:
-#' The following labels are used to access taxa containing the following formative elements (in parenthesis).
+#' The following labels are used to access taxa containing the following formative elements (in parentheses)
 #' 
 #' * acr: (acro/acr) extreme weathering
 #' * alb: (alb) presence of an albic horizon
@@ -201,7 +203,9 @@
 #' 
 #' }
 #' @export
-taxaExtent <- function(x, level = c('order', 'suborder', 'greatgroup', 'subgroup'), formativeElement = FALSE, timeout = 60) {
+taxaExtent <- function(x, level = c('order', 'suborder', 'greatgroup', 'subgroup'),
+                       formativeElement = FALSE, timeout = 60,
+                       as_Spatial = getOption('soilDB.return_Spatial', default = FALSE)) {
 
   ## sanity checks
 
@@ -213,10 +217,10 @@ taxaExtent <- function(x, level = c('order', 'suborder', 'greatgroup', 'subgroup
 
   # main branch
   # formative element query
-  if(formativeElement) {
+  if (formativeElement) {
 
     # formative elements are only available at the greatgroup / subgroup for now
-    if(level %in% c('order', 'suborder')) {
+    if (level %in% c('order', 'suborder')) {
       stop('formative element queries are only supported for greatgroup and subgroup taxa', call. = FALSE)
     }
 
@@ -240,8 +244,8 @@ taxaExtent <- function(x, level = c('order', 'suborder', 'greatgroup', 'subgroup
   } else {
     # taxon query
 
-    # encode taxa name: spaces -> underscores
-    x <- gsub(pattern=' ', replacement='_', x = tolower(x), fixed = TRUE)
+    # encode taxon name: spaces -> underscores
+    x <- gsub(pattern = ' ', replacement = '_', x = tolower(x), fixed = TRUE)
 
     # convert taxa level to path
     subdir <- switch(
@@ -264,8 +268,6 @@ taxaExtent <- function(x, level = c('order', 'suborder', 'greatgroup', 'subgroup
 
   }
 
-
-
   # init temp files
   tf <- tempfile(fileext = '.tif')
 
@@ -280,7 +282,7 @@ taxaExtent <- function(x, level = c('order', 'suborder', 'greatgroup', 'subgroup
   )
 
   # trap errors
-  if(inherits(res, 'error')){
+  if (inherits(res, 'error')) {
     message('no data returned')
     return(NULL)
   }
@@ -296,11 +298,19 @@ taxaExtent <- function(x, level = c('order', 'suborder', 'greatgroup', 'subgroup
 
   # transfer layer name
   # conversion of '_' -> ' ' only meaningful in taxon query
-  names(r) <- gsub(pattern='_', replacement=' ', x = x, fixed = TRUE)
+  names(r) <- gsub(pattern = '_', replacement = ' ', x = x, fixed = TRUE)
 
   # make CRS explicit
   terra::crs(r) <- 'EPSG:5070'
 
+  if (as_Spatial) {
+    if (requireNamespace("raster", quietly = TRUE)) {
+      r <- raster::raster(r) 
+    } else {
+      stop("Package `raster` is required to return raster data as a RasterLayer object with as_Spatial=TRUE")
+    }
+  }
+
   return(r)
 
 }