From 691af67fbc9c5c31bd57e5a2394f4dc68e679025 Mon Sep 17 00:00:00 2001 From: "Andrew G. Brown" Date: Mon, 18 Sep 2023 16:24:23 -0700 Subject: [PATCH 1/5] get_SDA_coecoclass: add `method="all"` to produce aggregated mapunit level compositional summaries - "ESPOLYGON" style with soils aggregated within ecological site --- DESCRIPTION | 2 +- NEWS.md | 8 ++ R/get_SDA_coecoclass.R | 171 +++++++++++++++++++++++++++++++++++++- man/get_SDA_coecoclass.Rd | 6 +- 4 files changed, 180 insertions(+), 7 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 777f26b9..04c7f5aa 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: soilDB Type: Package Title: Soil Database Interface -Version: 2.7.9 +Version: 2.7.9.9000 Authors@R: c(person(given="Dylan", family="Beaudette", role = c("aut"), email = "dylan.beaudette@usda.gov"), person(given="Jay", family="Skovlin", role = c("aut")), person(given="Stephen", family="Roecker", role = c("aut")), diff --git a/NEWS.md b/NEWS.md index b7fe9f21..97d3b438 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,11 @@ +# soilDB 2.7.9.9000 (2023-09-18) + + - `get_SDA_coecoclass()` gains `method="all"` for aggregating information about ecological sites and related components. The method performs a condition-based aggregation for each ecological site condition in the map unit, producing a "wide" data.frame result with as many columns as needed to portray all site conditions. + + - `fetchSDA_spatial()` gains `geom.src="mlrapolygon"` for obtaining Major Land Resource Area (MLRA) polygon boundaries. When using this geometry source `x` is a vector of `MLRARSYM` (MLRA Symbols). + + - The geometry source is the MLRA Geographic Database v5.2 (2022) which is not (yet) part of Soil Data Access. Instead of SDA, GDAL utilities are used to read a zipped ESRI Shapefile from a remote URL: . Therefore, most additional `fetchSDA_spatial()` arguments are _not_ currently supported for the MLRA geometry source. In the future a `mlrapolygon` table may be added to SDA (analogous to `mupolygon` and `sapolygon`), and the function will be updated accordingly at that time. + # soilDB 2.7.9 (2023-09-01) ## Bug Fixes diff --git a/R/get_SDA_coecoclass.R b/R/get_SDA_coecoclass.R index ec0d5302..fd30630f 100644 --- a/R/get_SDA_coecoclass.R +++ b/R/get_SDA_coecoclass.R @@ -1,10 +1,11 @@ #' Get mapunit ecological sites from Soil Data Access #' -#' @details When `method="Dominant Condition"` an additional field `ecoclasspct_r` is returned in the result with the sum of `comppct_r` that have the dominant condition `ecoclassid`. The component with the greatest `comppct_r` is returned for the `component` and `coecosite` level information. +#' @details When `method="Dominant Condition"` an additional field `ecoclasspct_r` is returned in the result +#' with the sum of `comppct_r` that have the dominant condition `ecoclassid`. The component with the greatest +#' `comppct_r` is returned for the `component` and `coecosite` level information. #' #' Note that if there are multiple `coecoclasskey` per `ecoclassid` there may be more than one record per component. -#' -#' @param method aggregation method. One of: "Dominant Component", "Dominant Condition", "None". If "None" is selected one row will be returned per component, otherwise one row will be returned per map unit. +#' @param method aggregation method. One of: `"Dominant Component"`, `"Dominant Condition"`, `"All"` or `"None"` (default). If `method="all"` multiple numbered columns represent site composition within each map unit e.g. `site1...`, `site2...`. If `method="none"` is selected one row will be returned per _component_; in all other cases one row will be returned per _map unit_. #' @param areasymbols vector of soil survey area symbols #' @param mukeys vector of map unit keys #' @param WHERE character containing SQL WHERE clause specified in terms of fields in `legend`, `mapunit`, `component` or `coecosite` tables, used in lieu of `mukeys` or `areasymbols` @@ -25,7 +26,26 @@ get_SDA_coecoclass <- function(method = "None", miscellaneous_areas = TRUE, include_minors = TRUE, dsn = NULL) { - method <- match.arg(toupper(method), c('NONE', "DOMINANT COMPONENT", "DOMINANT CONDITION")) + method <- match.arg(toupper(method), c("NONE", "ALL", "DOMINANT COMPONENT", "DOMINANT CONDITION")) + + if (method == "ALL") { + if (!is.null(WHERE)) { + stop("`method='all'` does not support custom `WHERE` clause", call. = FALSE) + } + + if (isTRUE(query_string)) { + stop("`method='all'` does not support custom `query_string=TRUE`", call. = FALSE) + } + + return(.get_SDA_coecoclass_agg(areasymbols = areasymbols, + mukeys = mukeys, + ecoclasstypename = ecoclasstypename, + ecoclassref = ecoclassref, + not_rated_value = not_rated_value, + miscellaneous_areas = miscellaneous_areas, + include_minors = include_minors, + dsn = dsn)) + } if (!is.null(ecoclassref)) { ecoclassref_in <- soilDB::format_SQL_in_statement(ecoclassref) @@ -122,3 +142,146 @@ get_SDA_coecoclass <- function(method = "None", res2 } +.get_SDA_coecoclass_agg <- function(areasymbols = NULL, + mukeys = NULL, + ecoclasstypename = NULL, + ecoclassref = "Ecological Site Description Database", + not_rated_value = "Not assigned", + miscellaneous_areas = TRUE, + include_minors = TRUE, + dsn = NULL, + threshold = 0) { + + comppct_r <- NULL; condpct_r <- NULL; compname <- NULL; ecoclasstypename <- NULL + areasymbol <- NULL; compnames <- NULL; unassigned <- NULL; + mukey <- NULL; .N <- NULL; .SD <- NULL; .GRP <- NULL; + + if (!is.null(areasymbols)) { + res0 <- do.call('rbind', lapply(areasymbols, function(x) { + soilDB::SDA_query(paste0( + "SELECT DISTINCT mukey, nationalmusym, muname FROM mapunit + INNER JOIN legend ON legend.lkey = mapunit.lkey + WHERE areasymbol = '", x, "'" + )) + })) + idx <- soilDB::makeChunks(res0$mukey, 1000) + l <- split(res0$mukey, idx) + } else { + idx <- soilDB::makeChunks(mukeys, 1000) + l <- split(mukeys, idx) + res0 <- do.call('rbind', lapply(l, function(x) { + soilDB::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), "" + )) + })) + idx <- soilDB::makeChunks(res0$mukey, 1000) + l <- split(res0$mukey, idx) + } + + res1 <- do.call('rbind', lapply(l, function(x) { + soilDB::get_SDA_coecoclass(mukeys = x, + ecoclasstypename = ecoclasstypename, + ecoclassref = ecoclassref, + not_rated_value = not_rated_value, + miscellaneous_areas = miscellaneous_areas, + include_minors = include_minors, + dsn = dsn) + })) + + res1 <- data.table::data.table(res1)[, .SD[order(comppct_r, decreasing = TRUE), ], by = "mukey"] + res2 <- data.table::data.table(subset(res1, areasymbol != "US")) + + # remove FSG etc. some components have no ES assigned, but have other eco class + idx <- !res2$ecoclassref %in% c(not_rated_value, "Not assigned", "Ecological Site Description Database") & + !res2$ecoclasstypename %in% c(not_rated_value, "Not assigned", "NRCS Rangeland Site", "NRCS Forestland Site") + res2$ecoclassid[idx] <- not_rated_value + res2$ecoclassref[idx] <- not_rated_value + res2$ecoclassname[idx] <- not_rated_value + res2$ecoclasstypename[idx] <- not_rated_value + + res3 <- res2[, list( + condpct_r = sum(comppct_r, na.rm = TRUE), + compnames = paste0(compname[ecoclasstypename %in% c("NRCS Rangeland Site", + "NRCS Forestland Site")], + collapse = ", "), + unassigned = paste0(compname[!ecoclasstypename %in% c("NRCS Rangeland Site", + "NRCS Forestland Site")], + collapse = ", ") + ), by = c("mukey", "ecoclassid", "ecoclassname")][, rbind( + .SD[, 1:4], + data.frame( + ecoclassid = not_rated_value, + ecoclassname = not_rated_value, + condpct_r = 100 - sum(condpct_r[nchar(compnames) > 0], na.rm = TRUE), + compnames = paste0(unassigned[nchar(unassigned) > 0 & !unassigned %in% compnames], + collapse = ",") + ) + ), by = c("mukey")][order(mukey, -condpct_r), ] + res3 <- res3[nchar(res3$compnames) > 0,] + + # could do up to max_sites, but generally cut to some minimum condition percentage `threshold` + max_sites <- max(res3[, .N, by = "mukey"]$N) + res3 <- res3[res3$condpct_r >= threshold, ] + max_sites_pruned <- max(res3[, .N, by = "mukey"]$N) + res3$condpct_r <- as.integer(res3$condpct_r) + + if (max_sites > max_sites_pruned) { + message("maximum number of sites per mukey: ", max_sites) + message("using maximum number of sites above threshold (", + threshold, "%) per mukey: ", max_sites_pruned) + } + + .coecoclass_long_to_wide <- function(x, group) { + res <- data.frame(grpid = group) + for (i in 1:max_sites_pruned) { + if (i > nrow(x)) { + d <- data.frame( + siten = NA_character_, + sitenname = NA_character_, + sitencompname = NA_character_, + sitenpct_r = NA_integer_, + sitenlink = NA_character_ + ) + } else { + d <- data.frame( + siten = ifelse(isTRUE(is.na(x$ecoclassid[i])), not_rated_value, x$ecoclassid[i]), + sitenname = ifelse(isTRUE(is.na(x$ecoclassname[i])), not_rated_value, x$ecoclassname[i]), + sitencompname = ifelse(isTRUE(is.na(x$compnames[i])), NA_character_, x$compnames[i]), + sitenpct_r = ifelse(isTRUE(is.na(x$condpct_r[i])), 0, x$condpct_r[i]), + sitenlink = ifelse( + isTRUE(x$ecoclassid[i] == not_rated_value | is.na(x$ecoclassid[i])), + NA_character_, + paste0( + "https://edit.jornada.nmsu.edu/catalogs/esd/", + substr(x$ecoclassid[i], 2, 5), + "/", + x$ecoclassid[i] + ) + ) + ) + # sitenpdf = ifelse(isTRUE(x$ecoclassid[i] == "Not assigned"), NA_character_, + # paste0( + # "https://edit.jornada.nmsu.edu/services/descriptions/esd/", + # substr(x$ecoclassid[i], 2, 5), "/", x$ecoclassid[i], ".pdf" + # ))) + } + colnames(d) <- c( + paste0("site", i), paste0("site", i, "name"), paste0("site", i, "compname"), + paste0("site", i, "pct_r"), paste0("site", i, "link") + ) + res <- cbind(res, d) + } + res + } + + res <- merge(data.table::data.table(res0), res3, + by = "mukey", all.x = TRUE)[, + .coecoclass_long_to_wide(.SD, .GRP), + by = c("mukey", "muname", "nationalmusym"), ] + + res$grpid <- NULL + res +} + diff --git a/man/get_SDA_coecoclass.Rd b/man/get_SDA_coecoclass.Rd index 9d941789..815bbc57 100644 --- a/man/get_SDA_coecoclass.Rd +++ b/man/get_SDA_coecoclass.Rd @@ -19,7 +19,7 @@ get_SDA_coecoclass( ) } \arguments{ -\item{method}{aggregation method. One of: "Dominant Component", "Dominant Condition", "None". If "None" is selected one row will be returned per component, otherwise one row will be returned per map unit.} +\item{method}{aggregation method. One of: \code{"Dominant Component"}, \code{"Dominant Condition"}, \code{"All"} or \code{"None"} (default). If \code{method="all"} multiple numbered columns represent site composition within each map unit e.g. \code{site1...}, \code{site2...}. If \code{method="none"} is selected one row will be returned per \emph{component}; in all other cases one row will be returned per \emph{map unit}.} \item{areasymbols}{vector of soil survey area symbols} @@ -45,7 +45,9 @@ get_SDA_coecoclass( Get mapunit ecological sites from Soil Data Access } \details{ -When \code{method="Dominant Condition"} an additional field \code{ecoclasspct_r} is returned in the result with the sum of \code{comppct_r} that have the dominant condition \code{ecoclassid}. The component with the greatest \code{comppct_r} is returned for the \code{component} and \code{coecosite} level information. +When \code{method="Dominant Condition"} an additional field \code{ecoclasspct_r} is returned in the result +with the sum of \code{comppct_r} that have the dominant condition \code{ecoclassid}. The component with the greatest +\code{comppct_r} is returned for the \code{component} and \code{coecosite} level information. Note that if there are multiple \code{coecoclasskey} per \code{ecoclassid} there may be more than one record per component. } From 4bf72799733f6896116a78ee58f382fd957e30c7 Mon Sep 17 00:00:00 2001 From: "Andrew G. Brown" Date: Mon, 18 Sep 2023 16:40:12 -0700 Subject: [PATCH 2/5] news --- NEWS.md | 4 ---- 1 file changed, 4 deletions(-) diff --git a/NEWS.md b/NEWS.md index 97d3b438..d3659b69 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,10 +2,6 @@ - `get_SDA_coecoclass()` gains `method="all"` for aggregating information about ecological sites and related components. The method performs a condition-based aggregation for each ecological site condition in the map unit, producing a "wide" data.frame result with as many columns as needed to portray all site conditions. - - `fetchSDA_spatial()` gains `geom.src="mlrapolygon"` for obtaining Major Land Resource Area (MLRA) polygon boundaries. When using this geometry source `x` is a vector of `MLRARSYM` (MLRA Symbols). - - - The geometry source is the MLRA Geographic Database v5.2 (2022) which is not (yet) part of Soil Data Access. Instead of SDA, GDAL utilities are used to read a zipped ESRI Shapefile from a remote URL: . Therefore, most additional `fetchSDA_spatial()` arguments are _not_ currently supported for the MLRA geometry source. In the future a `mlrapolygon` table may be added to SDA (analogous to `mupolygon` and `sapolygon`), and the function will be updated accordingly at that time. - # soilDB 2.7.9 (2023-09-01) ## Bug Fixes From d7b3eae462c6f82345f98588071477f649ad0c5b Mon Sep 17 00:00:00 2001 From: "Andrew G. Brown" Date: Fri, 27 Oct 2023 17:03:46 -0700 Subject: [PATCH 3/5] doc update --- R/get_SDA_coecoclass.R | 13 +++++++++---- man/get_SDA_coecoclass.Rd | 3 +++ 2 files changed, 12 insertions(+), 4 deletions(-) diff --git a/R/get_SDA_coecoclass.R b/R/get_SDA_coecoclass.R index fd30630f..9c54f041 100644 --- a/R/get_SDA_coecoclass.R +++ b/R/get_SDA_coecoclass.R @@ -13,8 +13,9 @@ #' @param ecoclasstypename If `NULL` no constraint on `ecoclasstypename` is used in the query. #' @param ecoclassref Default: `"Ecological Site Description Database"`. If `NULL` no constraint on `ecoclassref` is used in the query. #' @param not_rated_value Default: `"Not assigned"` -#' @param include_minors logical. Include minor components? Default: `TRUE`. #' @param miscellaneous_areas logical. Include miscellaneous areas (non-soil components)? +#' @param include_minors logical. Include minor components? Default: `TRUE`. +#' @param threshold integer. Default: `0`. Minimum component percentage (RV) for inclusion. Used only for `method="all"`. #' @param dsn Path to local SQLite database or a DBIConnection object. If `NULL` (default) use Soil Data Access API via `SDA_query()`. #' @export get_SDA_coecoclass <- function(method = "None", @@ -25,16 +26,18 @@ get_SDA_coecoclass <- function(method = "None", not_rated_value = "Not assigned", miscellaneous_areas = TRUE, include_minors = TRUE, + threshold = 0, dsn = NULL) { + method <- match.arg(toupper(method), c("NONE", "ALL", "DOMINANT COMPONENT", "DOMINANT CONDITION")) if (method == "ALL") { if (!is.null(WHERE)) { - stop("`method='all'` does not support custom `WHERE` clause", call. = FALSE) + stop("`method='all'` does not support custom `WHERE` clauses", call. = FALSE) } if (isTRUE(query_string)) { - stop("`method='all'` does not support custom `query_string=TRUE`", call. = FALSE) + stop("`method='all'` does not support `query_string=TRUE`", call. = FALSE) } return(.get_SDA_coecoclass_agg(areasymbols = areasymbols, @@ -44,6 +47,7 @@ get_SDA_coecoclass <- function(method = "None", not_rated_value = not_rated_value, miscellaneous_areas = miscellaneous_areas, include_minors = include_minors, + threshold = threshold, dsn = dsn)) } @@ -142,7 +146,7 @@ get_SDA_coecoclass <- function(method = "None", res2 } -.get_SDA_coecoclass_agg <- function(areasymbols = NULL, +get_SDA_coecoclass_agg <- function(areasymbols = NULL, mukeys = NULL, ecoclasstypename = NULL, ecoclassref = "Ecological Site Description Database", @@ -182,6 +186,7 @@ get_SDA_coecoclass <- function(method = "None", res1 <- do.call('rbind', lapply(l, function(x) { soilDB::get_SDA_coecoclass(mukeys = x, + method = "None", ecoclasstypename = ecoclasstypename, ecoclassref = ecoclassref, not_rated_value = not_rated_value, diff --git a/man/get_SDA_coecoclass.Rd b/man/get_SDA_coecoclass.Rd index 815bbc57..7dd0e0d9 100644 --- a/man/get_SDA_coecoclass.Rd +++ b/man/get_SDA_coecoclass.Rd @@ -15,6 +15,7 @@ get_SDA_coecoclass( not_rated_value = "Not assigned", miscellaneous_areas = TRUE, include_minors = TRUE, + threshold = 0, dsn = NULL ) } @@ -39,6 +40,8 @@ get_SDA_coecoclass( \item{include_minors}{logical. Include minor components? Default: \code{TRUE}.} +\item{threshold}{integer. Default: \code{0}. Minimum component percentage (RV) for inclusion. Used only for \code{method="all"}.} + \item{dsn}{Path to local SQLite database or a DBIConnection object. If \code{NULL} (default) use Soil Data Access API via \code{SDA_query()}.} } \description{ From 818e07a4bc7e259304ae9d236441f21aaf60f30e Mon Sep 17 00:00:00 2001 From: "Andrew G. Brown" Date: Fri, 27 Oct 2023 17:03:56 -0700 Subject: [PATCH 4/5] add ssurgo query wrapper function --- R/SSURGO_query.R | 31 +++++++++++++++++++++++++++++++ 1 file changed, 31 insertions(+) create mode 100644 R/SSURGO_query.R diff --git a/R/SSURGO_query.R b/R/SSURGO_query.R new file mode 100644 index 00000000..2ce06457 --- /dev/null +++ b/R/SSURGO_query.R @@ -0,0 +1,31 @@ +#' 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)) + if (!inherits(con, 'try-error')) { + return(RSQLite::dbGetQuery(con, x)) + } else { + return(invisible(con)) + } + } + } else { + stop("Invalid data source name: ", dsn, call. = FALSE) + } + } +} From ccc356af092750b68431e15a8f76620a2537d081 Mon Sep 17 00:00:00 2001 From: "Andrew G. Brown" Date: Fri, 27 Oct 2023 17:05:24 -0700 Subject: [PATCH 5/5] add SQLite support: use .SSURGO_query internally instead of SDA_query --- R/SSURGO_query.R | 1 + R/get_SDA_coecoclass.R | 48 +++++++++++++++++++++++---------------- man/get_SDA_coecoclass.Rd | 2 +- 3 files changed, 30 insertions(+), 21 deletions(-) diff --git a/R/SSURGO_query.R b/R/SSURGO_query.R index 2ce06457..24878b94 100644 --- a/R/SSURGO_query.R +++ b/R/SSURGO_query.R @@ -18,6 +18,7 @@ } 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 { diff --git a/R/get_SDA_coecoclass.R b/R/get_SDA_coecoclass.R index 9c54f041..1769dd11 100644 --- a/R/get_SDA_coecoclass.R +++ b/R/get_SDA_coecoclass.R @@ -15,7 +15,7 @@ #' @param not_rated_value Default: `"Not assigned"` #' @param miscellaneous_areas logical. Include miscellaneous areas (non-soil components)? #' @param include_minors logical. Include minor components? Default: `TRUE`. -#' @param threshold integer. Default: `0`. Minimum component percentage (RV) for inclusion. Used only for `method="all"`. +#' @param threshold integer. Default: `0`. Minimum combined component percentage (RV) for inclusion of a mapunit's ecological site in wide-format tabular sumamry. Used only for `method="all"`. #' @param dsn Path to local SQLite database or a DBIConnection object. If `NULL` (default) use Soil Data Access API via `SDA_query()`. #' @export get_SDA_coecoclass <- function(method = "None", @@ -146,7 +146,7 @@ get_SDA_coecoclass <- function(method = "None", res2 } -get_SDA_coecoclass_agg <- function(areasymbols = NULL, +.get_SDA_coecoclass_agg <- function(areasymbols = NULL, mukeys = NULL, ecoclasstypename = NULL, ecoclassref = "Ecological Site Description Database", @@ -162,37 +162,39 @@ get_SDA_coecoclass_agg <- function(areasymbols = NULL, if (!is.null(areasymbols)) { res0 <- do.call('rbind', lapply(areasymbols, function(x) { - soilDB::SDA_query(paste0( + .SSURGO_query(paste0( "SELECT DISTINCT mukey, nationalmusym, muname FROM mapunit INNER JOIN legend ON legend.lkey = mapunit.lkey WHERE areasymbol = '", x, "'" )) })) - idx <- soilDB::makeChunks(res0$mukey, 1000) + idx <- makeChunks(res0$mukey, 1000) l <- split(res0$mukey, idx) } else { - idx <- soilDB::makeChunks(mukeys, 1000) + idx <- makeChunks(mukeys, 1000) l <- split(mukeys, idx) res0 <- do.call('rbind', lapply(l, function(x) { - soilDB::SDA_query(paste0( + .SSURGO_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), "" )) })) - idx <- soilDB::makeChunks(res0$mukey, 1000) + idx <- makeChunks(res0$mukey, 1000) l <- split(res0$mukey, idx) } res1 <- do.call('rbind', lapply(l, function(x) { - soilDB::get_SDA_coecoclass(mukeys = x, - method = "None", - ecoclasstypename = ecoclasstypename, - ecoclassref = ecoclassref, - not_rated_value = not_rated_value, - miscellaneous_areas = miscellaneous_areas, - include_minors = include_minors, - dsn = dsn) + get_SDA_coecoclass( + mukeys = x, + method = "None", + ecoclasstypename = ecoclasstypename, + ecoclassref = ecoclassref, + not_rated_value = not_rated_value, + miscellaneous_areas = miscellaneous_areas, + include_minors = include_minors, + dsn = dsn + ) })) res1 <- data.table::data.table(res1)[, .SD[order(comppct_r, decreasing = TRUE), ], by = "mukey"] @@ -201,6 +203,7 @@ get_SDA_coecoclass_agg <- function(areasymbols = NULL, # remove FSG etc. some components have no ES assigned, but have other eco class idx <- !res2$ecoclassref %in% c(not_rated_value, "Not assigned", "Ecological Site Description Database") & !res2$ecoclasstypename %in% c(not_rated_value, "Not assigned", "NRCS Rangeland Site", "NRCS Forestland Site") + res2$ecoclassid[idx] <- not_rated_value res2$ecoclassref[idx] <- not_rated_value res2$ecoclassname[idx] <- not_rated_value @@ -227,9 +230,9 @@ get_SDA_coecoclass_agg <- function(areasymbols = NULL, res3 <- res3[nchar(res3$compnames) > 0,] # could do up to max_sites, but generally cut to some minimum condition percentage `threshold` - max_sites <- max(res3[, .N, by = "mukey"]$N) + max_sites <- suppressWarnings(max(res3[, .N, by = "mukey"]$N)) res3 <- res3[res3$condpct_r >= threshold, ] - max_sites_pruned <- max(res3[, .N, by = "mukey"]$N) + max_sites_pruned <- suppressWarnings(max(res3[, .N, by = "mukey"]$N)) res3$condpct_r <- as.integer(res3$condpct_r) if (max_sites > max_sites_pruned) { @@ -238,9 +241,15 @@ get_SDA_coecoclass_agg <- function(areasymbols = NULL, threshold, "%) per mukey: ", max_sites_pruned) } + if (!is.finite(max_sites_pruned)) { + sdx <- 1 + } else { + sdx <- seq(max_sites_pruned) + } + .coecoclass_long_to_wide <- function(x, group) { res <- data.frame(grpid = group) - for (i in 1:max_sites_pruned) { + for (i in sdx) { if (i > nrow(x)) { d <- data.frame( siten = NA_character_, @@ -281,8 +290,7 @@ get_SDA_coecoclass_agg <- function(areasymbols = NULL, res } - res <- merge(data.table::data.table(res0), res3, - by = "mukey", all.x = TRUE)[, + res <- merge(data.table::data.table(res0), res3, by = "mukey", all.x = TRUE)[, .coecoclass_long_to_wide(.SD, .GRP), by = c("mukey", "muname", "nationalmusym"), ] diff --git a/man/get_SDA_coecoclass.Rd b/man/get_SDA_coecoclass.Rd index 7dd0e0d9..8a7c758a 100644 --- a/man/get_SDA_coecoclass.Rd +++ b/man/get_SDA_coecoclass.Rd @@ -40,7 +40,7 @@ get_SDA_coecoclass( \item{include_minors}{logical. Include minor components? Default: \code{TRUE}.} -\item{threshold}{integer. Default: \code{0}. Minimum component percentage (RV) for inclusion. Used only for \code{method="all"}.} +\item{threshold}{integer. Default: \code{0}. Minimum combined component percentage (RV) for inclusion of a mapunit's ecological site in wide-format tabular sumamry. Used only for \code{method="all"}.} \item{dsn}{Path to local SQLite database or a DBIConnection object. If \code{NULL} (default) use Soil Data Access API via \code{SDA_query()}.} }