Merge branch 'master' into sda-chorizon1

.github/workflows/R-CMD-check.yml

@@ -34,7 +34,7 @@ jobs:
       GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
 
     steps:
-      - uses: actions/checkout@v3
+      - uses: actions/checkout@v4
 
       - name: Get branch name (push)
         if: github.event_name != 'pull_request'
@@ -73,7 +73,7 @@ jobs:
         shell: Rscript {0}
 
       - name: Install terra off r-universe (devel+Windows only)
-        if: matrix.config.r == 'devel' || runner.os == 'Windows'
+        if: matrix.config.r == 'devel' #|| runner.os == 'Windows'
         run: install.packages('terra', repos = 'https://rspatial.r-universe.dev')
         shell: Rscript {0}
 

CITATION.cff

@@ -37,7 +37,7 @@ preferred-citation:
   - family-names: Brown
     given-names: Andrew
     email: [email protected]
-  notes: R package version 2.8.1
+  notes: R package version 2.8.2
   url: https://CRAN.R-project.org/package=soilDB
   year: '2024'
 repository: https://CRAN.R-project.org/package=soilDB
@@ -272,6 +272,22 @@ references:
   - family-names: Falcon
     given-names: Seth
   year: '2024'
+- type: software
+  title: duckdb
+  abstract: 'duckdb: DBI Package for the DuckDB Database Management System'
+  notes: Suggests
+  url: https://r.duckdb.org/
+  repository: https://CRAN.R-project.org/package=duckdb
+  authors:
+  - family-names: Mühleisen
+    given-names: Hannes
+    email: [email protected]
+    orcid: https://orcid.org/0000-0001-8552-0029
+  - family-names: Raasveldt
+    given-names: Mark
+    email: [email protected]
+    orcid: https://orcid.org/0000-0001-5005-6844
+  year: '2024'
 - type: software
   title: sf
   abstract: 'sf: Simple Features for R'

DESCRIPTION

@@ -13,7 +13,7 @@ License: GPL (>= 3)
 LazyLoad: yes
 Depends: R (>= 3.5.0)
 Imports: grDevices, graphics, stats, utils, methods, aqp (>= 2.0.2), data.table, DBI, curl
-Suggests: jsonlite, xml2, httr, rvest, odbc, RSQLite, sf, wk, terra, raster, knitr, rmarkdown, testthat
+Suggests: jsonlite, xml2, httr, rvest, odbc, RSQLite, duckdb, sf, wk, terra, raster, knitr, rmarkdown, testthat
 Repository: CRAN
 URL: https://ncss-tech.github.io/soilDB/, https://ncss-tech.github.io/AQP/
 BugReports: https://github.com/ncss-tech/soilDB/issues

R/SDA_query.R

@@ -42,21 +42,22 @@ format_SQL_in_statement <- function(x) {
 
 #' Query Soil Data Access
 #'
-#' @param q A valid T-SQL query surrounded by double quotes
+#' @param q character. A valid T-SQL query surrounded by double quotes.
+#' @param dsn character. Default: `NULL` uses Soil Data Access remote data source via REST API. Alternately, `dsn` may be a file path to an SQLite database using the SSURGO schema, or a `DBIConnection` that has already been created.
 #'
-#' @description Submit a query to the Soil Data Access (SDA) REST/JSON web-service and return the results as a data.frame. There is a 100,000 record limit and 32Mb JSON serializer limit, per query. Queries should contain a WHERE statement or JOIN condition to limit the number of rows affected / returned. Consider wrapping calls to \code{SDA_query} in a function that can iterate over logical chunks (e.g. areasymbol, mukey, cokey, etc.). The function \code{makeChunks} can help with such iteration.
+#' @description Submit a query to the Soil Data Access (SDA) REST/JSON web-service and return the results as a data.frame. There is a 100,000 record and 32Mb JSON serialization limit per query. Queries should contain a WHERE clause or JOIN condition to limit the number of rows affected / returned. Consider wrapping calls to `SDA_query()` in a function that can iterate over logical chunks (e.g. areasymbol, mukey, cokey, etc.). The function `makeChunks()` can help with such iteration. All usages of `SDA_query()` should handle the possibility of a `try-error` result in case the web service connection is down or if an invalid query is passed to the endpoint.
 #'
 #' @details The SDA website can be found at \url{https://sdmdataaccess.nrcs.usda.gov} and query examples can be found at \url{https://sdmdataaccess.nrcs.usda.gov/QueryHelp.aspx}. A library of query examples can be found at \url{https://nasis.sc.egov.usda.gov/NasisReportsWebSite/limsreport.aspx?report_name=SDA-SQL_Library_Home}.
 #'
 #' SSURGO (detailed soil survey) and STATSGO (generalized soil survey) data are stored together within SDA. This means that queries that don't specify an area symbol may result in a mixture of SSURGO and STATSGO records. See the examples below and the \href{http://ncss-tech.github.io/AQP/soilDB/SDA-tutorial.html}{SDA Tutorial} for details.
 #'
 #' @note This function requires the `httr`, `jsonlite`, and `xml2` packages
-#' @return a data.frame result (\code{NULL} if empty, try-error on error)
-#' @author D.E. Beaudette
-#' @seealso \code{\link{SDA_spatialQuery}}
+#' @return A data.frame result for queries that return a single table. A list of data.frame for queries that return multiple tables. `NULL` if result is empty, and `try-error` on error.
+#' @author D.E. Beaudette, A.G Brown
+#' @seealso [SDA_spatialQuery()]
 #' @keywords manip
 #' @export
-#' @examplesIf curl::has_internet() && requireNamespace("wk")
+#' @examplesIf curl::has_internet() && requireNamespace("wk", quietly = TRUE)
 #' @examples
 #' \donttest{
 #'   ## get SSURGO export date for all soil survey areas in California
@@ -104,7 +105,33 @@ format_SQL_in_statement <- function(x) {
 #'    x <- SDA_query(q)
 #'    str(x)
 #' }
-SDA_query <- function(q) {
+SDA_query <- function(q, dsn = NULL) {
+  if (is.null(dsn)) {
+    res <- .SDA_query(q)
+    if (inherits(res, 'try-error')) {
+      message(res)
+    }
+    return(invisible(res))
+  } else {
+    if (inherits(dsn, 'DBIConnection')) {
+      return(DBI::dbGetQuery(dsn, q))
+    } else if (file.exists(dsn)) {
+      if (requireNamespace("RSQLite")) {
+        con <- try(RSQLite::dbConnect(RSQLite::SQLite(), dsn))
+        on.exit(DBI::dbDisconnect(con), add = TRUE)
+        if (!inherits(con, 'try-error')) {
+          return(RSQLite::dbGetQuery(con, q))
+        } else {
+          return(invisible(con))
+        }
+      }
+    } else {
+      stop("Invalid data source name: ", dsn, call. = FALSE)
+    }
+  }
+}
+
+.SDA_query <- function(q) {
 
   # check for required packages
   if (!requireNamespace('httr', quietly = TRUE))
@@ -125,13 +152,26 @@ SDA_query <- function(q) {
   }
 
   # submit request
-  r <- try(httr::POST(url = "https://sdmdataaccess.sc.egov.usda.gov/tabular/post.rest",
-                  body = list(query = q,
-                              format = "json+columnname+metadata"),
-                  encode = "form"), silent = TRUE)
-
+  r <- try(httr::POST(
+    url = "https://sdmdataaccess.sc.egov.usda.gov/tabular/post.rest",
+    body = list(query = q,
+                format = "json+columnname+metadata"),
+    encode = "form"
+  ), silent = TRUE)
+
+  # check response content type
+  h <- r$all_headers
+  if (!is.null(h)) {
+    if (length(h) == 0 || !h[[1]]$headers$`content-type` %in% 
+                            c("application/json; charset=utf-8", # data response
+                              "text/xml; charset=utf-8") # error response
+       )  {
+      r <- try(stop("Soil Data Access POST REST API is not currently available, please try again later.", call. = FALSE), silent = TRUE)
+    }
+  }
+
   if (inherits(r, 'try-error')) {
-    message("Soil Data Access POST request failed, returning try-error\n\n", r)
+    message("Soil Data Access POST request failed, returning try-error.\n\n", r)
     return(invisible(r))
   }
 
@@ -153,9 +193,9 @@ SDA_query <- function(q) {
         error.msg <- "Unable to parse error message from XML response"
       }
 
-      ## message about bad result (previously error/warning)
-      message(error.msg)
-
+      ## inject specific message into a try-error result
+      request.status <- try(stop(paste0(attr(request.status, 'condition')$message, "\n",
+                                        error.msg), call. = FALSE), silent = TRUE)
     }
 
     # return the error object so calling function/user can handle it
@@ -211,7 +251,7 @@ SDA_query <- function(q) {
 }
 
 
-## See https://github.com/ncss-tech/soilDB/pull/191 for a list of possibly data types
+## See https://github.com/ncss-tech/soilDB/pull/191 for a list of possible data types
 
 # note: empty strings and 'NA' are converted into <NA>
 # convert the raw results from SDA into a proper data.frame
@@ -280,7 +320,6 @@ SDA_query <- function(q) {
 
   ## TODO further error checking?
 
-  # done
   return(df)
 }
 

R/SoilDataViewer.R

@@ -5,7 +5,7 @@
 #' @param notratedcolor Used to add 'Not rated' color entries where applicable. Default: `"#FFFFFF00"` (transparent white).
 #' @param simplify Return a data.frame when `WHERE` is length 1? Return a list with 1 element per legend when `WHERE` is length > `1`? Default: `TRUE`
 #'
-#' @return A list with a data.frame element for each element of `where` containing `"attributekey"`, `"attributename"`, `"attributetype"`, `"attributetablename"`, `"attributecolumnname"`, `"attributedescription"`, `"nasisrulename"`, `"label"`, `"order"`, `"value"`, `"lower_value"`, `"upper_value"`,`"red"`, `"green"`, `"blue"` and `"hex"` columns.
+#' @return A list with a data.frame element for each element of `WHERE` containing `"attributekey"`, `"attributename"`, `"attributetype"`, `"attributetablename"`, `"attributecolumnname"`, `"attributedescription"`, `"nasisrulename"`, `"label"`, `"order"`, `"value"`, `"lower_value"`, `"upper_value"`,`"red"`, `"green"`, `"blue"` and `"hex"` columns.
 #' @export
 #'
 #' @importFrom grDevices rgb