From 954de27d488299b82cc721a852d47a01196280d6 Mon Sep 17 00:00:00 2001 From: Andrew Gene Brown Date: Thu, 16 May 2024 21:51:28 -0700 Subject: [PATCH 1/2] SDA_query: handle API failures with more grace - HTML or any other content type than JSON (data) or XML (error message) indicates the service is temporarily down --- R/SDA_query.R | 25 +++++++++++++++++++------ 1 file changed, 19 insertions(+), 6 deletions(-) diff --git a/R/SDA_query.R b/R/SDA_query.R index dcf423bd..ee740f0a 100644 --- a/R/SDA_query.R +++ b/R/SDA_query.R @@ -125,13 +125,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)) } From de8ab7ab614eefee745bfee7b1eefaae56d7e77b Mon Sep 17 00:00:00 2001 From: Andrew Gene Brown Date: Tue, 28 May 2024 12:19:20 -0700 Subject: [PATCH 2/2] Use `SDA_query()` wrapper function to emit more interpretable error messages --- R/SDA_query.R | 50 +++++++++++++++----- R/SSURGO_query.R | 32 ------------- R/fetchSDA_spatial.R | 2 +- R/get_SDA_coecoclass.R | 14 ++---- R/get_SDA_hydric.R | 16 +------ R/get_SDA_interpretation.R | 15 ++---- R/get_SDA_metrics.R | 2 +- R/get_SDA_muaggatt.R | 15 ++---- R/get_SDA_pmgroupname.R | 17 ++----- R/get_SDA_property.R | 19 ++------ R/get_SSURGO_utils.R | 4 +- R/get_component_from_SDA.R | 92 +++++++++++++++++++++++++++--------- R/get_cosoilmoist_from_SDA.R | 9 ++-- man/SDA_query.Rd | 16 ++++--- 14 files changed, 145 insertions(+), 158 deletions(-) delete mode 100644 R/SSURGO_query.R diff --git a/R/SDA_query.R b/R/SDA_query.R index ee740f0a..6ee5c846 100644 --- a/R/SDA_query.R +++ b/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)) @@ -166,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 @@ -224,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 # convert the raw results from SDA into a proper data.frame @@ -293,7 +320,6 @@ SDA_query <- function(q) { ## TODO further error checking? - # done return(df) } diff --git a/R/SSURGO_query.R b/R/SSURGO_query.R deleted file mode 100644 index 24878b94..00000000 --- a/R/SSURGO_query.R +++ /dev/null @@ -1,32 +0,0 @@ -#' Query arbitrary data sources that use the SSURGO data model -#' -#' This is a simple wrapper function allowing queries to be passed to a variety of database drivers. It is assumed the database generally follows the SSURGO schema, regardless of the driver being used. -#' -#' @param x An SQL query. If `dsn` is NULL `x` is in T-SQL dialect. If `dsn` is a _character_ (file path), the SQLite dialect is used. If `dsn` is a `DBIConnection`, any SQL dialect compatible with the DBI source can be used. -#' @param dsn Default: `NULL` uses Soil Data Access remote data source via REST API. Alternately `dsn` may be a _character_ file path to an SQLite database, or a `DBIConnection` that has already been created. -#' -#' @details No processing of the query string is performed by this function, so all values of `x` must be adjusted according to the value of `dsn`. -#' -#' @return A _data.frame_, or _try-error_ on error -#' @noRd -.SSURGO_query <- function(x, dsn = NULL) { - if (is.null(dsn)) { - return(SDA_query(x)) - } else { - if (inherits(dsn, 'DBIConnection')) { - return(DBI::dbGetQuery(con, x)) - } 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, x)) - } else { - return(invisible(con)) - } - } - } else { - stop("Invalid data source name: ", dsn, call. = FALSE) - } - } -} diff --git a/R/fetchSDA_spatial.R b/R/fetchSDA_spatial.R index 76afac0f..34aff35c 100644 --- a/R/fetchSDA_spatial.R +++ b/R/fetchSDA_spatial.R @@ -339,7 +339,7 @@ fetchSDA_spatial <- function(x, } t1 <- Sys.time() - sp.res.sub <- try(suppressMessages(soilDB::SDA_query(q))) + sp.res.sub <- try(suppressMessages(SDA_query(q))) if (inherits(sp.res.sub, 'try-error')) { message("Bad chunk encountered. Querying each individually...") diff --git a/R/get_SDA_coecoclass.R b/R/get_SDA_coecoclass.R index ed9307f2..d2c0b12f 100644 --- a/R/get_SDA_coecoclass.R +++ b/R/get_SDA_coecoclass.R @@ -96,15 +96,7 @@ get_SDA_coecoclass <- function(method = "None", if (query_string) return(q) - if (is.null(dsn)) { - res <- suppressMessages(SDA_query(q)) - } else { - if (!inherits(dsn, 'DBIConnection')) { - dsn <- dbConnect(RSQLite::SQLite(), dsn) - on.exit(DBI::dbDisconnect(dsn), add = TRUE) - } - res <- dbGetQuery(dsn, q) - } + res <- SDA_query(q) if (length(res) == 0) { message('query returned no results') @@ -161,7 +153,7 @@ get_SDA_coecoclass <- function(method = "None", mukey <- NULL; .N <- NULL; .SD <- NULL; .GRP <- NULL; if (!is.null(areasymbols)) { - res0 <- .SSURGO_query(paste0( + res0 <- SDA_query(paste0( "SELECT DISTINCT mukey, nationalmusym, muname FROM mapunit INNER JOIN legend ON legend.lkey = mapunit.lkey WHERE areasymbol IN ", format_SQL_in_statement(areasymbols) @@ -172,7 +164,7 @@ get_SDA_coecoclass <- function(method = "None", idx <- makeChunks(mukeys, 1000) l <- split(mukeys, idx) res0 <- do.call('rbind', lapply(l, function(x) { - .SSURGO_query(paste0( + SDA_query(paste0( "SELECT DISTINCT mukey, nationalmusym, muname FROM mapunit INNER JOIN legend ON legend.lkey = mapunit.lkey WHERE mukey IN ", format_SQL_in_statement(x), "" diff --git a/R/get_SDA_hydric.R b/R/get_SDA_hydric.R index b07ccea9..0d0787de 100644 --- a/R/get_SDA_hydric.R +++ b/R/get_SDA_hydric.R @@ -100,21 +100,7 @@ get_SDA_hydric <- function(areasymbols = NULL, mukeys = NULL, WHERE = NULL, meth } # execute query - if (is.null(dsn)) { - res <- suppressMessages(SDA_query(q)) - } else { - if (!inherits(dsn, 'DBIConnection')) { - dsn <- RSQLite::dbConnect(RSQLite::SQLite(), dsn) - on.exit(DBI::dbDisconnect(dsn), add = TRUE) - } - res <- dbGetQuery(dsn, q) - } - - # stop if bad - if (inherits(res, 'try-error')) { - warnings() - stop(attr(res, 'condition')) - } + res <- SDA_query(q, dsn = dsn) return(res) } diff --git a/R/get_SDA_interpretation.R b/R/get_SDA_interpretation.R index 3499454f..4154b1b8 100644 --- a/R/get_SDA_interpretation.R +++ b/R/get_SDA_interpretation.R @@ -700,20 +700,11 @@ get_SDA_interpretation <- function(rulename, if (query_string) return(q) # execute query - if (is.null(dsn)) { - res <- suppressMessages(SDA_query(q)) - } else { - if (!inherits(dsn, 'DBIConnection')) { - dsn <- dbConnect(RSQLite::SQLite(), dsn) - on.exit(DBI::dbDisconnect(dsn), add = TRUE) - } - res <- dbGetQuery(dsn, q) - } + res <- SDA_query(q, dsn = dsn) - # stop if bad + # return if bad if (inherits(res, 'try-error')) { - warnings() - stop(attr(res, 'condition')) + return(res) } # check rating column values diff --git a/R/get_SDA_metrics.R b/R/get_SDA_metrics.R index d8839770..32c3317c 100644 --- a/R/get_SDA_metrics.R +++ b/R/get_SDA_metrics.R @@ -58,5 +58,5 @@ get_SDA_metrics <- function(query_name, query_frequency, query_year, state = NUL format_SQL_in_statement(query_frequency), format_SQL_in_statement(query_year), format_SQL_in_statement(state)) - SDA_query(q) + SDA_query(q, dsn = NULL) } diff --git a/R/get_SDA_muaggatt.R b/R/get_SDA_muaggatt.R index e3212194..9b1227b9 100644 --- a/R/get_SDA_muaggatt.R +++ b/R/get_SDA_muaggatt.R @@ -36,20 +36,11 @@ get_SDA_muaggatt <- function(areasymbols = NULL, mukeys = NULL, WHERE = NULL, qu } # execute query - if (is.null(dsn)) { - res <- suppressMessages(SDA_query(q)) - } else { - if (!inherits(dsn, 'DBIConnection')) { - dsn <- dbConnect(RSQLite::SQLite(), dsn) - on.exit(DBI::dbDisconnect(dsn), add = TRUE) - } - res <- dbGetQuery(dsn, q) - } + res <- SDA_query(q, dsn = dsn) - # stop if bad + # return if bad if (inherits(res, 'try-error')) { - warnings() - stop(attr(res, 'condition')) + return(res) } # remove duplicated mukey column diff --git a/R/get_SDA_pmgroupname.R b/R/get_SDA_pmgroupname.R index 13b585ab..5ea5c08a 100644 --- a/R/get_SDA_pmgroupname.R +++ b/R/get_SDA_pmgroupname.R @@ -202,20 +202,11 @@ get_SDA_pmgroupname <- function(areasymbols = NULL, } # execute query - if (is.null(dsn)) { - res <- suppressMessages(SDA_query(q)) - } else { - if (!inherits(dsn, 'DBIConnection')) { - dsn <- dbConnect(RSQLite::SQLite(), dsn) - on.exit(DBI::dbDisconnect(dsn), add = TRUE) - } - res <- dbGetQuery(dsn, q) - } - - # stop if bad + res <- SDA_query(q, dsn = dsn) + + # return if bad if (inherits(res, 'try-error')) { - warnings() - stop(attr(res, 'condition')) + return(res) } return(res) diff --git a/R/get_SDA_property.R b/R/get_SDA_property.R index 4ed9c3c9..fb9632ec 100644 --- a/R/get_SDA_property.R +++ b/R/get_SDA_property.R @@ -149,20 +149,11 @@ get_SDA_property <- if (query_string) return(q) # execute query - if (is.null(dsn)) { - res <- suppressMessages(SDA_query(q)) - } else { - if (!inherits(dsn, 'DBIConnection')) { - dsn <- dbConnect(RSQLite::SQLite(), dsn) - on.exit(DBI::dbDisconnect(dsn), add = TRUE) - } - res <- dbGetQuery(dsn, q) - } - - # stop if bad + res <- SDA_query(q, dsn = dsn) + + # return if bad if (inherits(res, 'try-error')) { - warnings() - stop(attr(res, 'condition')) + return(res) } return(res) @@ -326,7 +317,7 @@ get_SDA_property <- method <- toupper(method) if (method == "NONE") { - # dput(colnames(suppressMessages(SDA_query("SELECT TOP 1 * FROM chorizon")))) # without cokey + # dput(colnames(SDA_query("SELECT TOP 1 * FROM chorizon"))) # without cokey is_hz <- agg_property %in% .valid_chorizon_columns() } diff --git a/R/get_SSURGO_utils.R b/R/get_SSURGO_utils.R index 4be76cdf..a2a9dd78 100644 --- a/R/get_SSURGO_utils.R +++ b/R/get_SSURGO_utils.R @@ -12,7 +12,7 @@ if (db == "STATSGO") { q <- "SELECT areasymbol, saverest FROM sacatalog WHERE areasymbol = 'US'" - sacatalog <- suppressMessages(SDA_query(q)) + sacatalog <- SDA_query(q, dsn = NULL) 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" @@ -22,7 +22,7 @@ # 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)) + sacatalog <- SDA_query(q2, dsn = NULL) if (inherits(sacatalog, 'try-error') || is.null(sacatalog)) { return(try(stop("Query of Soil Survey Area Catalog (", diff --git a/R/get_component_from_SDA.R b/R/get_component_from_SDA.R index 36269489..11c5d9f0 100644 --- a/R/get_component_from_SDA.R +++ b/R/get_component_from_SDA.R @@ -57,7 +57,12 @@ get_component_from_SDA <- function(WHERE = NULL, duplicates = FALSE, childs = TR # exec query d.component <- SDA_query(q.component) - + + # return if bad + if (inherits(d.component, 'try-error')) { + return(invisible(d.component)) + } + # empty result set should short circuit (no error, just message) if(length(d.component) == 0) return(d.component) @@ -124,7 +129,15 @@ get_component_from_SDA <- function(WHERE = NULL, duplicates = FALSE, childs = TR # exec query d.pm <- SDA_query(q.pm) + if (inherits(d.pm, 'try-error')) { + return(invisible(d.pm)) + } + d.cogmd <- SDA_query(q.lf) + if (inherits(d.cogmd, 'try-error')) { + return(invisible(d.cogmd)) + } + d.cosrf <- .get_cosurffrags_from_SDA(unique(d.component$cokey), nullFragsAreZero = nullFragsAreZero) d.cm <- uncode(.get_comonth_from_SDA(d.component$cokey)) @@ -246,6 +259,11 @@ get_component_from_SDA <- function(WHERE = NULL, duplicates = FALSE, childs = TR ") df <- SDA_query(q) + + if (inherits(df, 'try-error')) { + return(invisible(df)) + } + vars <- c("flodfreqcl", "floddurcl", "pondfreqcl", "ponddurcl") df[vars] <- lapply(df[vars], trimws) @@ -409,7 +427,11 @@ get_component_from_SDA <- function(WHERE = NULL, duplicates = FALSE, childs = TR ") d <- SDA_query(q) - + + if (inherits(d, 'try-error')) { + return(invisible(d)) + } + if (is.null(d)) { d <- data.frame( cokey = cokey[1], @@ -484,12 +506,16 @@ get_cointerp_from_SDA <- function(WHERE = NULL, mrulename = NULL, duplicates = F ) d.cointerp <- SDA_query(q.cointerp) - + + if (inherits(d.cointerp, 'try-error')) { + return(invisible(d.cointerp)) + } + # recode metadata domains d.cointerp <- uncode(d.cointerp) - + return(d.cointerp) - } +} #' @export #' @rdname fetchSDA @@ -550,13 +576,18 @@ get_lmuaoverlap_from_SDA <- function(WHERE = NULL, droplevels = TRUE, stringsAsF # exec query d <- SDA_query(q) - - d$musym = as.character(d$musym) - - # recode metadata domains - d <- uncode(d, droplevels = droplevels) - - # done + + if (inherits(d, 'try-error')) { + return(invisible(d)) + } + + if (!is.null(d)) { + d$musym <- as.character(d$musym) + + # recode metadata domains + d <- uncode(d, droplevels = droplevels) + } + return(d) } @@ -600,14 +631,16 @@ get_mapunit_from_SDA <- function(WHERE = NULL, # exec query d.mapunit <- SDA_query(q.mapunit) - - if (!inherits(d.mapunit, 'try-error')) { + + if (inherits(d.mapunit, 'try-error')) { + return(invisible(d.mapunit)) + } + + if (!is.null(d.mapunit)) { d.mapunit$musym = as.character(d.mapunit$musym) # recode metadata domains d.mapunit <- uncode(d.mapunit, droplevels = droplevels) - } else { - d.mapunit <- NULL } # done @@ -675,7 +708,11 @@ get_chorizon_from_SDA <- function(WHERE = NULL, duplicates = FALSE, # exec query d.chorizon <- SDA_query(q.chorizon) - + + if (inherits(d.chorizon, 'try-error')) { + return(invisible(d.chorizon)) + } + ## TODO: might be nice to abstract this into a new function # hacks to make R CMD check --as-cran happy: metadata <- NULL @@ -806,7 +843,11 @@ get_chorizon_from_SDA <- function(WHERE = NULL, duplicates = FALSE, ") d.chfrags <- SDA_query(q.chfrags) - + + if (inherits(d.chfrags, 'try-error')) { + return(invisible(d.chfrags)) + } + # r.rf.data.v2 nullFragsAreZero = TRUE idx <- !names(d.chfrags) %in% "chkey" if (nullFragsAreZero == TRUE) { @@ -848,19 +889,17 @@ get_chorizon_from_SDA <- function(WHERE = NULL, duplicates = FALSE, .get_diagnostics_from_SDA <- function(target_cokeys) { # query SDA to get corresponding codiagfeatures q <- paste0('SELECT * FROM codiagfeatures WHERE cokey IN ', format_SQL_in_statement(target_cokeys), ";") - return(SDA_query(q)) + SDA_query(q) } .get_restrictions_from_SDA <- function(target_cokeys) { # query SDA to get corresponding corestrictions q <- paste0('SELECT * FROM corestrictions WHERE cokey IN ', format_SQL_in_statement(target_cokeys), ";") - return(SDA_query(q)) + SDA_query(q) } - - #' @title Get SSURGO/STATSGO2 Mapunit Data from Soil Data Access #' #' @description Functions to download and flatten commonly used tables and from Soil Data @@ -930,6 +969,10 @@ fetchSDA <- function(WHERE = NULL, duplicates = FALSE, childs = TRUE, droplevels = droplevels, nullFragsAreZero = TRUE ) + if (inherits(f.component, 'try-error')) { + return(invisible(f.component)) + } + if (is.null(f.component)) { stop("WHERE clause returned no components.", call. = FALSE) } @@ -963,7 +1006,10 @@ fetchSDA <- function(WHERE = NULL, duplicates = FALSE, childs = TRUE, assign('component.hz.problems', value=bad.ids, envir=get_soilDB_env()) } - + if (inherits(f.chorizon, 'try-error')) { + return(invisible(f.chorizon)) + } + # upgrade to SoilProfilecollection depths(f.chorizon) <- cokey ~ hzdept_r + hzdepb_r diff --git a/R/get_cosoilmoist_from_SDA.R b/R/get_cosoilmoist_from_SDA.R index 9a431483..7838da79 100644 --- a/R/get_cosoilmoist_from_SDA.R +++ b/R/get_cosoilmoist_from_SDA.R @@ -39,13 +39,16 @@ get_cosoilmoist_from_SDA <- function(WHERE = NULL, duplicates = FALSE, impute = # exec query d.cosoilmoist <- SDA_query(q.cosoilmoist) - + + if (inherits(d.cosoilmoist, 'try-error')) { + return(invisible(d.cosoilmoist)) + } + # set factor levels according to metadata domains d.cosoilmoist <- uncode(d.cosoilmoist) # prep dataset: rename columns, impute empty values, stringsAsFactors d.cosoilmoist <- .cosoilmoist_prep(d.cosoilmoist, impute = impute) - # done return(d.cosoilmoist) - } +} diff --git a/man/SDA_query.Rd b/man/SDA_query.Rd index a7f1bc1c..ed442caa 100644 --- a/man/SDA_query.Rd +++ b/man/SDA_query.Rd @@ -4,16 +4,18 @@ \alias{SDA_query} \title{Query Soil Data Access} \usage{ -SDA_query(q) +SDA_query(q, dsn = NULL) } \arguments{ -\item{q}{A valid T-SQL query surrounded by double quotes} +\item{q}{character. A valid T-SQL query surrounded by double quotes.} + +\item{dsn}{character. Default: \code{NULL} uses Soil Data Access remote data source via REST API. Alternately, \code{dsn} may be a file path to an SQLite database using the SSURGO schema, or a \code{DBIConnection} that has already been created.} } \value{ -a data.frame result (\code{NULL} if empty, try-error on error) +A data.frame result for queries that return a single table. A list of data.frame for queries that return multiple tables. \code{NULL} if result is empty, and \code{try-error} on error. } \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. +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 \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. All usages of \code{SDA_query()} should handle the possibility of a \code{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}. @@ -24,7 +26,7 @@ SSURGO (detailed soil survey) and STATSGO (generalized soil survey) data are sto This function requires the \code{httr}, \code{jsonlite}, and \code{xml2} packages } \examples{ -\dontshow{if (curl::has_internet() && requireNamespace("wk")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +\dontshow{if (curl::has_internet() && requireNamespace("wk", quietly = TRUE)) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} \dontshow{\}) # examplesIf} \donttest{ ## get SSURGO export date for all soil survey areas in California @@ -74,9 +76,9 @@ This function requires the \code{httr}, \code{jsonlite}, and \code{xml2} package } } \seealso{ -\code{\link{SDA_spatialQuery}} +\code{\link[=SDA_spatialQuery]{SDA_spatialQuery()}} } \author{ -D.E. Beaudette +D.E. Beaudette, A.G Brown } \keyword{manip}