downloadSSURGO: add support for STATSGO downloads

NEWS.md

@@ -3,6 +3,7 @@
 and in concatenation of reason string when `wide_reason=TRUE`
  - `createSSURGO()` now creates indices for foreign keys and other columns important data analysis, dramatically improving the performance of standard soilDB queries on SQLite sources.
  - `createSSURGO()` now works properly on STATSGO datasets for individual states or CONUS. Previously tabular data would be transferred but spatial data were not.
+ - `downloadSSURGO()` gains `db` argument which gives ability to download STATSGO by state or all of US from Web Soil Survey. Thanks to Meghan Krueger for suggestion.
  - `get_SDA_property()`: weighted average/dominant component numeric methods now returns `mukey` in first column position; for parity with other `get_SDA*` methods recently updated/already doing this, making it easier to use these columns for raster attribute tables via `terra::set.levels()`
 
 # soilDB 2.7.10 (2023-11-16)

R/createSSURGO.R

@@ -9,10 +9,14 @@
 #' @param destdir Directory to download ZIP files into. Default `tempdir()`.
 #' @param exdir Directory to extract ZIP archives into. May be a directory that does not yet exist. Each ZIP file will extract to a folder labeled with `areasymbol` in this directory. Default: `destdir`
 #' @param include_template Include the (possibly state-specific) MS Access template database? Default: `FALSE`
+#' @param db Either `"SSURGO"` (default; detailed soil map) or `"STATSGO"` (general soil map).
 #' @param extract Logical. Extract ZIP files to `exdir`? Default: `TRUE`
 #' @param remove_zip Logical. Remove ZIP files after extracting? Default: `FALSE` 
 #' @param overwrite Logical. Overwrite by re-extracting if directory already exists? Default: `FALSE`
 #' @param quiet Logical. Passed to `curl::curl_download()`.
+#' @details
+#' When `db="STATSGO"` the `WHERE` argument is not supported. Allowed `areasymbols` include `"US"` and two-letter state codes e.g. `"WY"` for the Wyoming general soils map.
+#' 
 #' @export
 #' 
 #' @details Pipe-delimited TXT files are found in _/tabular/_ folder extracted from a SSURGO ZIP. The files are named for tables in the SSURGO schema. There is no header / the files do not have column names. See the _Soil Data Access Tables and Columns Report_: \url{https://sdmdataaccess.nrcs.usda.gov/documents/TablesAndColumnsReport.pdf} for details on tables, column names and metadata including the default sequence of columns used in TXT files. The function returns a `try-error` if the `WHERE`/`areasymbols` arguments result in
@@ -25,11 +29,22 @@ downloadSSURGO <- function(WHERE = NULL,
                            destdir = tempdir(), 
                            exdir = destdir, 
                            include_template = FALSE,
+                           db = c('SSURGO', 'STATSGO'),
                            extract = TRUE, 
                            remove_zip = FALSE,
                            overwrite = FALSE,
                            quiet = FALSE) {
 
+  db <- match.arg(toupper(db), c('SSURGO', 'STATSGO'))
+
+  if (!is.null(WHERE) && db == "STATSGO") {
+    stop('custom WHERE clause not supported with db="STATSGO"', call. = FALSE)
+  }
+
+  if (!is.null(areasymbols) && db == "STATSGO") {
+    WHERE <- areasymbols
+  }
+
   if (is.null(WHERE) && is.null(areasymbols)) {
     stop('must specify either `WHERE` or `areasymbols` argument', call. = FALSE)
   }
@@ -45,7 +60,7 @@ downloadSSURGO <- function(WHERE = NULL,
   }
 
   # make WSS download URLs from areasymbol, template, date
-  urls <- .make_WSS_download_url(WHERE, include_template = include_template)
+  urls <- .make_WSS_download_url(WHERE, include_template = include_template, db = db)
 
   if (inherits(urls, 'try-error')) {
     message(urls[1])
@@ -65,7 +80,7 @@ downloadSSURGO <- function(WHERE = NULL,
   }
 
   paths <- list.files(destdir, pattern = "\\.zip$", full.names = TRUE)
-  paths2 <- paths[grep(".*wss_SSA_(.*)_.*", paths)]
+  paths2 <- paths[grep(".*wss_(SSA|gsmsoil)_(.*)_.*", paths)]
 
   if  (extract) {
     if (!quiet) {

R/get_SSURGO_utils.R

@@ -6,40 +6,52 @@
 #'
 #' @return a vector of URLs to Web Soil Survey ZIP files
 #' @noRd
-.make_WSS_download_url <- function(WHERE = NULL, include_template = FALSE) {
+.make_WSS_download_url <- function(WHERE = NULL, include_template = FALSE, db = c('SSURGO', 'STATSGO')) {
 
-  # use SDA to get areasymbol and last updated date to build WSS cache urls
-  q <- "SELECT areasymbol, saverest FROM sacatalog WHERE areasymbol != 'US'"
-  q2 <- ifelse(!is.null(WHERE), paste0(q, " AND (", WHERE, ")"), q)
-  sacatalog <- suppressMessages(SDA_query(q2))
+  db <- match.arg(toupper(db), c('SSURGO', 'STATSGO'))
 
-  if (inherits(sacatalog, 'try-error') || is.null(sacatalog)) {
-    return(try(stop("Query of Soil Survey Area Catalog (", 
-                    WHERE, ") failed to return any data", call. = FALSE), silent = TRUE))
+  if (db == "STATSGO") {
+    q <- "SELECT areasymbol, saverest FROM sacatalog WHERE areasymbol = 'US'"
+    sacatalog <- suppressMessages(SDA_query(q))
+    res <- paste0(
+      "https://websoilsurvey.sc.egov.usda.gov/DSD/Download/Cache/STATSGO2/wss_gsmsoil_",
+      WHERE, "_[", as.Date(sacatalog$saverest, format = "%m/%d/%Y %H:%M:%S"), "].zip"
+    )
+    unique(res)
+  } else {
+    # use SDA to get areasymbol and last updated date to build WSS cache urls
+    q <- "SELECT areasymbol, saverest FROM sacatalog WHERE areasymbol != 'US'"
+    q2 <- ifelse(!is.null(WHERE), paste0(q, " AND (", WHERE, ")"), q)
+    sacatalog <- suppressMessages(SDA_query(q2))
+
+    if (inherits(sacatalog, 'try-error') || is.null(sacatalog)) {
+      return(try(stop("Query of Soil Survey Area Catalog (", 
+                      WHERE, ") failed to return any data", call. = FALSE), silent = TRUE))
+    }
+    areasymbol <- sacatalog$areasymbol
+    saverest <- sacatalog$saverest
+
+    statecode <- substr(areasymbol, 0, 2)
+
+    # handle custom (state-specific) template DBs
+    # TODO: NPS urls cannot be derived from areasymbol alone
+    # NB: no (current) usage of "NPS" template
+    # TODO: authoritative source of release dates of templates?
+    statecode[!statecode %in% c('AK','CT','FL','GA','HI',
+                                'ID','IN','IA','ME','MI',
+                                'MN','MT','NE','NJ','NC',
+                                'OH','OR','PA','SD','UT',
+                                'VT','WA','WV','WI','WY',
+                                'HI','NPS')] <- "US"
+    res <- paste0(
+      "https://websoilsurvey.sc.egov.usda.gov/DSD/Download/Cache/SSA/wss_SSA_",
+      areasymbol, ifelse(rep(include_template, length(areasymbol)), 
+                         paste0("_soildb_", statecode, "_2003"), ""), "_[",
+      as.Date(saverest, format = "%m/%d/%Y %H:%M:%S"), "].zip"
+    )
+
+    unique(res)
   }
-
-  areasymbol <- sacatalog$areasymbol
-  saverest <- sacatalog$saverest
-  statecode <- substr(areasymbol, 0, 2)
-
-  # handle custom (state-specific) template DBs
-  # TODO: NPS urls cannot be derived from areasymbol alone
-  # NB: no (current) usage of "NPS" template
-  # TODO: authoritative source of release dates of templates?
-  statecode[!statecode %in% c('AK','CT','FL','GA','HI',
-                              'ID','IN','IA','ME','MI',
-                              'MN','MT','NE','NJ','NC',
-                              'OH','OR','PA','SD','UT',
-                              'VT','WA','WV','WI','WY',
-                              'HI','NPS')] <- "US"
-  res <- paste0(
-    "https://websoilsurvey.sc.egov.usda.gov/DSD/Download/Cache/SSA/wss_SSA_",
-    areasymbol, ifelse(rep(include_template, length(areasymbol)), 
-                       paste0("_soildb_", statecode, "_2003"), ""), "_[",
-    as.Date(saverest, format = "%m/%d/%Y %H:%M:%S"), "].zip"
-  )
-
-  unique(res)
 }