From e5c1b03f0d70e00de672bba05505eb86acb65093 Mon Sep 17 00:00:00 2001 From: Andrew Gene Brown Date: Wed, 2 Oct 2024 12:14:52 -0700 Subject: [PATCH 01/17] get_SDA_pmgroupname: fix bug in dominant component aggregation in mapunits dominated my miscellaneous areas --- R/get_SDA_pmgroupname.R | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/R/get_SDA_pmgroupname.R b/R/get_SDA_pmgroupname.R index 5ea5c08a..aff94c14 100644 --- a/R/get_SDA_pmgroupname.R +++ b/R/get_SDA_pmgroupname.R @@ -158,11 +158,10 @@ get_SDA_pmgroupname <- function(areasymbols = NULL, if (method %in% c("DOMINANT COMPONENT", "DOMINANT CONDITION")) { dcq <- sprintf("SELECT c1.cokey FROM component AS c1 - INNER JOIN mapunit AS mu1 ON c1.mukey = mu1.mukey AND c1.mukey = mapunit.mukey %s ORDER BY c1.comppct_r DESC, c1.cokey ", + INNER JOIN mapunit AS mu1 ON c1.mukey = mu1.mukey AND c1.mukey = mapunit.mukey %s + ORDER BY c1.comppct_r DESC, c1.cokey ", ifelse(miscellaneous_areas, "", " AND NOT c1.compkind = 'Miscellaneous area'")) - comp_selection <- sprintf("AND component.cokey = (%s)", .LIMIT_N( - "SELECT c1.cokey FROM component AS c1 - INNER JOIN mapunit AS mu1 ON c1.mukey = mu1.mukey AND c1.mukey = mapunit.mukey ORDER BY c1.comppct_r DESC, c1.cokey ", n = 1, sqlite = !is.null(dsn))) + comp_selection <- sprintf("AND component.cokey = (%s)", .LIMIT_N(dcq, n = 1, sqlite = !is.null(dsn))) } else { comp_selection <- "" } From c8eb1ca4785fa24b8ad8e345c011bfa9376aa704 Mon Sep 17 00:00:00 2001 From: Andrew Gene Brown Date: Wed, 2 Oct 2024 12:26:47 -0700 Subject: [PATCH 02/17] get_SDA_pmgroupname: add test MUKEY with dominant component miscellaneous area --- tests/testthat/test-get_SDA_pmgroupname.R | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) diff --git a/tests/testthat/test-get_SDA_pmgroupname.R b/tests/testthat/test-get_SDA_pmgroupname.R index 1d5f7288..56a9ed1d 100644 --- a/tests/testthat/test-get_SDA_pmgroupname.R +++ b/tests/testthat/test-get_SDA_pmgroupname.R @@ -1,4 +1,5 @@ test_that("get_SDA_pmgroupname works", { + skip_if_offline() skip_on_cran() @@ -11,19 +12,19 @@ test_that("get_SDA_pmgroupname works", { res <- get_SDA_pmgroupname(mukeys = c(462409, 2462630), simplify = FALSE, method = "dominant condition") # default is miscellaneous_areas=FALSE expect_null(res) - res <- get_SDA_pmgroupname(mukeys = c(462409, 2462630), simplify = FALSE, miscellaneous_areas = TRUE, method = "dominant condition") + res <- get_SDA_pmgroupname(mukeys = c(462409, 2462630, 465186), simplify = FALSE, miscellaneous_areas = TRUE, method = "dominant condition") skip_if(is.null(res)) - expect_equal(nrow(res), 2) + expect_equal(nrow(res), 3) - res <- get_SDA_pmgroupname(mukeys = c(461994, 461995), simplify = FALSE, method = "none") + res <- get_SDA_pmgroupname(mukeys = c(461994, 461995, 465186), simplify = FALSE, method = "none") skip_if(is.null(res)) - expect_equal(nrow(res), 7) + expect_equal(nrow(res), 8) - res <- get_SDA_pmgroupname(mukeys = c(461994, 461995), simplify = FALSE, method = "none", miscellaneous_areas = TRUE) + res <- get_SDA_pmgroupname(mukeys = c(461994, 461995, 465186), simplify = FALSE, method = "none", miscellaneous_areas = TRUE) skip_if(is.null(res)) - expect_equal(nrow(res), 11) + expect_equal(nrow(res), 14) - res <- get_SDA_pmgroupname(mukeys = c(461994, 461995), simplify = FALSE, method = "dominant condition") + res <- get_SDA_pmgroupname(mukeys = c(461994, 461995, 465186), simplify = FALSE, method = "dominant condition") skip_if(is.null(res)) - expect_equal(nrow(res), 2) + expect_equal(nrow(res), 3) }) From 882c8d7f2b79171f574f9ed3a56114fb9a35e3e5 Mon Sep 17 00:00:00 2001 From: Andrew Gene Brown Date: Wed, 2 Oct 2024 12:28:57 -0700 Subject: [PATCH 03/17] get_SDA_pmgroupname: always use LEFT join for `copmgrp` --- R/get_SDA_pmgroupname.R | 2 +- tests/testthat/test-get_SDA_pmgroupname.R | 5 +++-- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/R/get_SDA_pmgroupname.R b/R/get_SDA_pmgroupname.R index aff94c14..e814b66e 100644 --- a/R/get_SDA_pmgroupname.R +++ b/R/get_SDA_pmgroupname.R @@ -177,7 +177,7 @@ get_SDA_pmgroupname <- function(areasymbols = NULL, pm_selection <- "" } - misc_area_join_type <- ifelse(miscellaneous_areas, "LEFT", "INNER") + misc_area_join_type <- "LEFT" # ifelse(miscellaneous_areas, "LEFT", "INNER") q <- sprintf( paste0("SELECT DISTINCT mapunit.mukey, diff --git a/tests/testthat/test-get_SDA_pmgroupname.R b/tests/testthat/test-get_SDA_pmgroupname.R index 56a9ed1d..4c9f4d94 100644 --- a/tests/testthat/test-get_SDA_pmgroupname.R +++ b/tests/testthat/test-get_SDA_pmgroupname.R @@ -9,8 +9,9 @@ test_that("get_SDA_pmgroupname works", { expect_equal(nrow(res), length(unique(res$mukey))) # some misc areas have geomorph populated (e.g. "Mixed alluvial land", but others, like "Water" are NULL) - res <- get_SDA_pmgroupname(mukeys = c(462409, 2462630), simplify = FALSE, method = "dominant condition") # default is miscellaneous_areas=FALSE - expect_null(res) + res <- get_SDA_pmgroupname(mukeys = c(462409, 2462630, 465186), simplify = FALSE, method = "dominant condition") # default is miscellaneous_areas=FALSE + skip_if(is.null(res)) + expect_equal(nrow(res), 3) res <- get_SDA_pmgroupname(mukeys = c(462409, 2462630, 465186), simplify = FALSE, miscellaneous_areas = TRUE, method = "dominant condition") skip_if(is.null(res)) From 081ea9bbb77a9f4562f03107671c2ba4c4e41406 Mon Sep 17 00:00:00 2001 From: Andrew Gene Brown Date: Wed, 2 Oct 2024 12:34:59 -0700 Subject: [PATCH 04/17] get_SDA_pmgroupname: docs --- R/get_SDA_pmgroupname.R | 12 ++++++------ man/get_SDA_pmgroupname.Rd | 12 ++++++------ 2 files changed, 12 insertions(+), 12 deletions(-) diff --git a/R/get_SDA_pmgroupname.R b/R/get_SDA_pmgroupname.R index e814b66e..9213225a 100644 --- a/R/get_SDA_pmgroupname.R +++ b/R/get_SDA_pmgroupname.R @@ -6,12 +6,12 @@ #' #'@details Default `method` is `"Dominant Component"` to get the dominant component (highest percentage). Use `"Dominant Condition"` or dominant parent material condition (similar conditions aggregated across components). Use `"None"` for no aggregation (one record per component). #' -#' @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 `copmgrp` tables, used in lieu of `mukeys` or `areasymbols` -#' @param method One of: `"Dominant Component"`, `"Dominant Condition"`, `"None"` -#' @param simplify logical; group into generalized parent material groups? Default `TRUE` -#' @param miscellaneous_areas Include miscellaneous areas (non-soil components) in results? Default: `FALSE`. +#' @param areasymbols _character_. Vector of soil survey area symbols +#' @param mukeys _integer_. Vector of map unit keys +#' @param WHERE _character_. SQL WHERE clause specified in terms of fields in `legend`, `mapunit`, `component`, or `copmgrp` tables, used in lieu of `mukeys` or `areasymbols` +#' @param method _character_. One of: `"Dominant Component"`, `"Dominant Condition"`, `"None"` +#' @param simplify _logical_. Group into generalized parent material groups? Default `TRUE` +#' @param miscellaneous_areas _logical_. Include miscellaneous areas (non-soil components) in results? Default: `FALSE`. #' @param query_string Default: `FALSE`; if `TRUE` return a character string containing query that would be sent to SDA via `SDA_query` #' @param dsn Path to local SQLite database or a DBIConnection object. If `NULL` (default) use Soil Data Access API via `SDA_query()`. #' @author Jason Nemecek, Chad Ferguson, Andrew Brown diff --git a/man/get_SDA_pmgroupname.Rd b/man/get_SDA_pmgroupname.Rd index 2d67f44b..323755ad 100644 --- a/man/get_SDA_pmgroupname.Rd +++ b/man/get_SDA_pmgroupname.Rd @@ -16,17 +16,17 @@ get_SDA_pmgroupname( ) } \arguments{ -\item{areasymbols}{vector of soil survey area symbols} +\item{areasymbols}{\emph{character}. Vector of soil survey area symbols} -\item{mukeys}{vector of map unit keys} +\item{mukeys}{\emph{integer}. Vector of map unit keys} -\item{WHERE}{character containing SQL WHERE clause specified in terms of fields in \code{legend}, \code{mapunit}, \code{component}, or \code{copmgrp} tables, used in lieu of \code{mukeys} or \code{areasymbols}} +\item{WHERE}{\emph{character}. SQL WHERE clause specified in terms of fields in \code{legend}, \code{mapunit}, \code{component}, or \code{copmgrp} tables, used in lieu of \code{mukeys} or \code{areasymbols}} -\item{method}{One of: \code{"Dominant Component"}, \code{"Dominant Condition"}, \code{"None"}} +\item{method}{\emph{character}. One of: \code{"Dominant Component"}, \code{"Dominant Condition"}, \code{"None"}} -\item{simplify}{logical; group into generalized parent material groups? Default \code{TRUE}} +\item{simplify}{\emph{logical}. Group into generalized parent material groups? Default \code{TRUE}} -\item{miscellaneous_areas}{Include miscellaneous areas (non-soil components) in results? Default: \code{FALSE}.} +\item{miscellaneous_areas}{\emph{logical}. Include miscellaneous areas (non-soil components) in results? Default: \code{FALSE}.} \item{query_string}{Default: \code{FALSE}; if \code{TRUE} return a character string containing query that would be sent to SDA via \code{SDA_query}} From b62f6ff94ba79482a05c5a19cb5f774cf27219ba Mon Sep 17 00:00:00 2001 From: Andrew Gene Brown Date: Wed, 2 Oct 2024 13:18:14 -0700 Subject: [PATCH 05/17] whitespace --- R/get_SDA_pmgroupname.R | 2 +- man/get_SDA_pmgroupname.Rd | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/get_SDA_pmgroupname.R b/R/get_SDA_pmgroupname.R index 9213225a..ec6c43f2 100644 --- a/R/get_SDA_pmgroupname.R +++ b/R/get_SDA_pmgroupname.R @@ -11,7 +11,7 @@ #' @param WHERE _character_. SQL WHERE clause specified in terms of fields in `legend`, `mapunit`, `component`, or `copmgrp` tables, used in lieu of `mukeys` or `areasymbols` #' @param method _character_. One of: `"Dominant Component"`, `"Dominant Condition"`, `"None"` #' @param simplify _logical_. Group into generalized parent material groups? Default `TRUE` -#' @param miscellaneous_areas _logical_. Include miscellaneous areas (non-soil components) in results? Default: `FALSE`. +#' @param miscellaneous_areas _logical_. Include miscellaneous areas (non-soil components) in results? Default: `FALSE`. #' @param query_string Default: `FALSE`; if `TRUE` return a character string containing query that would be sent to SDA via `SDA_query` #' @param dsn Path to local SQLite database or a DBIConnection object. If `NULL` (default) use Soil Data Access API via `SDA_query()`. #' @author Jason Nemecek, Chad Ferguson, Andrew Brown diff --git a/man/get_SDA_pmgroupname.Rd b/man/get_SDA_pmgroupname.Rd index 323755ad..6331ea50 100644 --- a/man/get_SDA_pmgroupname.Rd +++ b/man/get_SDA_pmgroupname.Rd @@ -26,7 +26,7 @@ get_SDA_pmgroupname( \item{simplify}{\emph{logical}. Group into generalized parent material groups? Default \code{TRUE}} -\item{miscellaneous_areas}{\emph{logical}. Include miscellaneous areas (non-soil components) in results? Default: \code{FALSE}.} +\item{miscellaneous_areas}{\emph{logical}. Include miscellaneous areas (non-soil components) in results? Default: \code{FALSE}.} \item{query_string}{Default: \code{FALSE}; if \code{TRUE} return a character string containing query that would be sent to SDA via \code{SDA_query}} From 2acbbfed3743887fdca6c079be6309a3a0aea15e Mon Sep 17 00:00:00 2001 From: Andrew Gene Brown Date: Wed, 2 Oct 2024 13:18:43 -0700 Subject: [PATCH 06/17] get_SDA_hydric: add `miscellaneous_areas` argument (default `TRUE`) --- R/get_SDA_hydric.R | 123 ++++++++++++++++++++++-------------------- man/get_SDA_hydric.Rd | 5 +- 2 files changed, 70 insertions(+), 58 deletions(-) diff --git a/R/get_SDA_hydric.R b/R/get_SDA_hydric.R index 0d0787de..a1f4239e 100644 --- a/R/get_SDA_hydric.R +++ b/R/get_SDA_hydric.R @@ -21,74 +21,83 @@ #' @param mukeys vector of map unit keys #' @param WHERE character containing SQL WHERE clause specified in terms of fields in `legend`, `mapunit`, or `component` tables, used in lieu of `mukeys` or `areasymbols` #' @param method One of: `"Mapunit"`, `"Dominant Component"`, `"Dominant Condition"`, `"None"` -#' @param query_string Default: `FALSE`; if `TRUE` return a character string containing query that would be sent to SDA via `SDA_query` +#' @param miscellaneous_areas _logical_. Include miscellaneous areas (non-soil components) in results? Default: `TRUE`. +#' @param query_string Default: `FALSE`; if `TRUE` return a character string containing query that would be sent to SDA via `SDA_query()` #' @param dsn Path to local SQLite database or a DBIConnection object. If `NULL` (default) use Soil Data Access API via `SDA_query()`. #' @author Jason Nemecek, Chad Ferguson, Andrew Brown #' @return a data.frame #' @export -get_SDA_hydric <- function(areasymbols = NULL, mukeys = NULL, WHERE = NULL, method = "MAPUNIT", query_string = FALSE, dsn = NULL) { +get_SDA_hydric <- function(areasymbols = NULL, mukeys = NULL, WHERE = NULL, method = "MAPUNIT", miscellaneous_areas = TRUE, query_string = FALSE, dsn = NULL) { - method <- match.arg(toupper(method), c("MAPUNIT", "DOMINANT COMPONENT", "DOMINANT CONDITION", "NONE")) + method <- match.arg(toupper(method), c("MAPUNIT", "DOMINANT COMPONENT", "DOMINANT CONDITION", "NONE")) - if (is.null(mukeys) && is.null(areasymbols) && is.null(WHERE)) { - stop("Please specify one of the following arguments: mukeys, areasymbols, WHERE", call. = FALSE) - } + if (is.null(mukeys) && is.null(areasymbols) && is.null(WHERE)) { + stop("Please specify one of the following arguments: mukeys, areasymbols, WHERE", call. = FALSE) + } - if (!is.null(mukeys)) { - WHERE <- paste("mapunit.mukey IN", format_SQL_in_statement(as.integer(mukeys))) - } else if (!is.null(areasymbols)) { - WHERE <- paste("legend.areasymbol IN", format_SQL_in_statement(areasymbols)) - } - .h0 <- function(w) .LIMIT_N(paste("SELECT ISNULL(SUM(comppct_r), 0) FROM mapunit AS mu INNER JOIN component AS c ON c.mukey = mu.mukey AND mapunit.mukey = mu.mukey", w), n = 1, sqlite = !is.null(dsn)) + if (!is.null(mukeys)) { + WHERE <- paste("mapunit.mukey IN", format_SQL_in_statement(as.integer(mukeys))) + } else if (!is.null(areasymbols)) { + WHERE <- paste("legend.areasymbol IN", format_SQL_in_statement(areasymbols)) + } + + .h0 <- function(w) .LIMIT_N(paste(sprintf("SELECT ISNULL(SUM(comppct_r), 0) + FROM mapunit AS mu + INNER JOIN component AS c ON c.mukey = mu.mukey AND mapunit.mukey = mu.mukey %s", + ifelse(miscellaneous_areas, "", " AND NOT c.compkind = 'Miscellaneous area'")), w), + n = 1, sqlite = !is.null(dsn)) - q <- paste0("SELECT mapunit.mukey, areasymbol, musym, mapunit.muname, - (", .h0(""), ") AS total_comppct, - (", .h0("AND majcompflag = 'Yes'"), ") AS count_maj_comp, - (", .h0("AND hydricrating = 'Yes'"), ") AS all_hydric, - (", .h0("AND majcompflag = 'Yes' AND hydricrating = 'Yes'"), ") AS hydric_majors, - (", .h0("AND majcompflag = 'Yes' AND hydricrating != 'Yes'"), ") AS maj_not_hydric, - (", .h0("AND majcompflag != 'Yes' AND hydricrating = 'Yes'"), ") AS hydric_inclusions, - (", .h0("AND hydricrating != 'Yes'"), ") AS all_not_hydric, - (", .h0("AND hydricrating IS NULL"), ") AS hydric_null - INTO #main_query - FROM legend - INNER JOIN mapunit ON mapunit.lkey = legend.lkey AND ", WHERE, " - SELECT mukey, areasymbol, musym, muname, - total_comppct AS total_comppct, - hydric_majors AS hydric_majors, - hydric_inclusions AS hydric_inclusions, - CASE WHEN total_comppct = all_not_hydric + hydric_null THEN 'Nonhydric' - WHEN total_comppct = all_hydric THEN 'Hydric' - WHEN hydric_majors + hydric_inclusions >= total_comppct / 2 THEN 'Predominantly Hydric' - WHEN hydric_majors > 0 THEN 'Partially Hydric' - WHEN hydric_majors + hydric_inclusions < total_comppct / 2 THEN 'Predominantly Nonhydric' - ELSE 'Error' END AS HYDRIC_RATING - FROM #main_query") - # TODO: refactor out the temp table and CASE WHEN for HYDRIC_RATING calculated in R + q <- paste0("SELECT mapunit.mukey, areasymbol, musym, mapunit.muname, + (", .h0(""), ") AS total_comppct, + (", .h0("AND majcompflag = 'Yes'"), ") AS count_maj_comp, + (", .h0("AND hydricrating = 'Yes'"), ") AS all_hydric, + (", .h0("AND majcompflag = 'Yes' AND hydricrating = 'Yes'"), ") AS hydric_majors, + (", .h0("AND majcompflag = 'Yes' AND hydricrating != 'Yes'"), ") AS maj_not_hydric, + (", .h0("AND majcompflag != 'Yes' AND hydricrating = 'Yes'"), ") AS hydric_inclusions, + (", .h0("AND hydricrating != 'Yes'"), ") AS all_not_hydric, + (", .h0("AND hydricrating IS NULL"), ") AS hydric_null + INTO #main_query + FROM legend + INNER JOIN mapunit ON mapunit.lkey = legend.lkey AND ", WHERE, " + SELECT mukey, areasymbol, musym, muname, + total_comppct AS total_comppct, + hydric_majors AS hydric_majors, + hydric_inclusions AS hydric_inclusions, + CASE WHEN total_comppct = all_not_hydric + hydric_null THEN 'Nonhydric' + WHEN total_comppct = all_hydric THEN 'Hydric' + WHEN hydric_majors + hydric_inclusions >= total_comppct / 2 THEN 'Predominantly Hydric' + WHEN hydric_majors > 0 THEN 'Partially Hydric' + WHEN hydric_majors + hydric_inclusions < total_comppct / 2 THEN 'Predominantly Nonhydric' + ELSE 'Error' END AS HYDRIC_RATING + FROM #main_query") + # TODO: refactor out the temp table and CASE WHEN for HYDRIC_RATING calculated in R - comp_selection <- "" - hyd_selection <- "" - if (method != "MAPUNIT") { - if (method %in% c("DOMINANT COMPONENT", "DOMINANT CONDITION")) { - comp_selection <- sprintf("AND component.cokey = (%s)", .LIMIT_N("SELECT c1.cokey FROM component AS c1 - INNER JOIN mapunit AS mu1 ON c1.mukey = mu1.mukey AND c1.mukey = mapunit.mukey - ORDER BY c1.comppct_r DESC, c1.cokey", n = 1, sqlite = !is.null(dsn))) - } + comp_selection <- "" + hyd_selection <- "" + + if (method != "MAPUNIT") { + if (method %in% c("DOMINANT COMPONENT", "DOMINANT CONDITION")) { + comp_selection <- sprintf("AND component.cokey = (%s)", .LIMIT_N(sprintf("SELECT c1.cokey FROM component AS c1 + INNER JOIN mapunit AS mu1 ON c1.mukey = mu1.mukey AND c1.mukey = mapunit.mukey %s + ORDER BY c1.comppct_r DESC, c1.cokey", ifelse(miscellaneous_areas, "", " AND NOT c1.compkind = 'Miscellaneous area'")), + n = 1, sqlite = !is.null(dsn))) + } - if (method == "DOMINANT CONDITION") { - hyd_selection <- sprintf("AND hydricrating = (%s)", .LIMIT_N("SELECT hydricrating FROM mapunit AS mu - INNER JOIN component AS c ON c.mukey = mu.mukey AND mapunit.mukey = mu.mukey - GROUP BY hydricrating, comppct_r - ORDER BY SUM(comppct_r) OVER (PARTITION BY hydricrating) DESC", n = 1, sqlite = !is.null(dsn))) - } + if (method == "DOMINANT CONDITION") { + hyd_selection <- sprintf("AND hydricrating = (%s)", .LIMIT_N(sprintf("SELECT hydricrating FROM mapunit AS mu + INNER JOIN component AS c ON c.mukey = mu.mukey AND mapunit.mukey = mu.mukey %s + GROUP BY hydricrating, comppct_r + ORDER BY SUM(comppct_r) OVER (PARTITION BY hydricrating) DESC", ifelse(miscellaneous_areas, "", " AND NOT c.compkind = 'Miscellaneous area'")), + n = 1, sqlite = !is.null(dsn))) + } - q <- sprintf(paste0("SELECT areasymbol, musym, muname, mapunit.mukey, ", - ifelse(method == "DOMINANT CONDITION", "", "cokey, compname, compkind, comppct_r, majcompflag, "), - "hydricrating - FROM legend - INNER JOIN mapunit ON mapunit.lkey = legend.lkey - INNER JOIN component ON component.mukey = mapunit.mukey %s %s - WHERE %s"), comp_selection, hyd_selection, WHERE) + q <- sprintf(paste0("SELECT areasymbol, musym, muname, mapunit.mukey, ", + ifelse(method == "DOMINANT CONDITION", "", "cokey, compname, compkind, comppct_r, majcompflag, "), + "hydricrating + FROM legend + INNER JOIN mapunit ON mapunit.lkey = legend.lkey + INNER JOIN component ON component.mukey = mapunit.mukey %s %s %s + WHERE %s"), comp_selection, hyd_selection, ifelse(miscellaneous_areas, "", " AND NOT component.compkind = 'Miscellaneous area'"), WHERE) } if (!is.null(dsn)) { diff --git a/man/get_SDA_hydric.Rd b/man/get_SDA_hydric.Rd index 0c8e30a0..2f232a07 100644 --- a/man/get_SDA_hydric.Rd +++ b/man/get_SDA_hydric.Rd @@ -9,6 +9,7 @@ get_SDA_hydric( mukeys = NULL, WHERE = NULL, method = "MAPUNIT", + miscellaneous_areas = TRUE, query_string = FALSE, dsn = NULL ) @@ -22,7 +23,9 @@ get_SDA_hydric( \item{method}{One of: \code{"Mapunit"}, \code{"Dominant Component"}, \code{"Dominant Condition"}, \code{"None"}} -\item{query_string}{Default: \code{FALSE}; if \code{TRUE} return a character string containing query that would be sent to SDA via \code{SDA_query}} +\item{miscellaneous_areas}{\emph{logical}. Include miscellaneous areas (non-soil components) in results? Default: \code{TRUE}.} + +\item{query_string}{Default: \code{FALSE}; if \code{TRUE} return a character string containing query that would be sent to SDA via \code{SDA_query()}} \item{dsn}{Path to local SQLite database or a DBIConnection object. If \code{NULL} (default) use Soil Data Access API via \code{SDA_query()}.} } From 8033e2186cbf07ada4cf1d5e746dddc7ea17329e Mon Sep 17 00:00:00 2001 From: Andrew Gene Brown Date: Wed, 2 Oct 2024 14:25:47 -0700 Subject: [PATCH 07/17] get_SDA_hydric: add `include_minors` argument --- R/get_SDA_hydric.R | 40 ++++++++++++++++++++++++++++------------ man/get_SDA_hydric.Rd | 3 +++ 2 files changed, 31 insertions(+), 12 deletions(-) diff --git a/R/get_SDA_hydric.R b/R/get_SDA_hydric.R index a1f4239e..64acdf20 100644 --- a/R/get_SDA_hydric.R +++ b/R/get_SDA_hydric.R @@ -21,14 +21,22 @@ #' @param mukeys vector of map unit keys #' @param WHERE character containing SQL WHERE clause specified in terms of fields in `legend`, `mapunit`, or `component` tables, used in lieu of `mukeys` or `areasymbols` #' @param method One of: `"Mapunit"`, `"Dominant Component"`, `"Dominant Condition"`, `"None"` +#' @param include_minors logical. Include minor components? Default: `TRUE`. #' @param miscellaneous_areas _logical_. Include miscellaneous areas (non-soil components) in results? Default: `TRUE`. #' @param query_string Default: `FALSE`; if `TRUE` return a character string containing query that would be sent to SDA via `SDA_query()` #' @param dsn Path to local SQLite database or a DBIConnection object. If `NULL` (default) use Soil Data Access API via `SDA_query()`. #' @author Jason Nemecek, Chad Ferguson, Andrew Brown #' @return a data.frame #' @export -get_SDA_hydric <- function(areasymbols = NULL, mukeys = NULL, WHERE = NULL, method = "MAPUNIT", miscellaneous_areas = TRUE, query_string = FALSE, dsn = NULL) { - +get_SDA_hydric <- function(areasymbols = NULL, + mukeys = NULL, + WHERE = NULL, + method = "MAPUNIT", + include_minors = TRUE, + miscellaneous_areas = TRUE, + query_string = FALSE, + dsn = NULL) { + method <- match.arg(toupper(method), c("MAPUNIT", "DOMINANT COMPONENT", "DOMINANT CONDITION", "NONE")) if (is.null(mukeys) && is.null(areasymbols) && is.null(WHERE)) { @@ -43,8 +51,9 @@ get_SDA_hydric <- function(areasymbols = NULL, mukeys = NULL, WHERE = NULL, meth .h0 <- function(w) .LIMIT_N(paste(sprintf("SELECT ISNULL(SUM(comppct_r), 0) FROM mapunit AS mu - INNER JOIN component AS c ON c.mukey = mu.mukey AND mapunit.mukey = mu.mukey %s", - ifelse(miscellaneous_areas, "", " AND NOT c.compkind = 'Miscellaneous area'")), w), + INNER JOIN component AS c ON c.mukey = mu.mukey AND mapunit.mukey = mu.mukey %s %s", + ifelse(miscellaneous_areas, "", " AND NOT c.compkind = 'Miscellaneous area'"), + ifelse(include_minors, "", " AND c.majcompflag = 'Yes'")), w), n = 1, sqlite = !is.null(dsn)) q <- paste0("SELECT mapunit.mukey, areasymbol, musym, mapunit.muname, @@ -78,26 +87,33 @@ get_SDA_hydric <- function(areasymbols = NULL, mukeys = NULL, WHERE = NULL, meth if (method != "MAPUNIT") { if (method %in% c("DOMINANT COMPONENT", "DOMINANT CONDITION")) { comp_selection <- sprintf("AND component.cokey = (%s)", .LIMIT_N(sprintf("SELECT c1.cokey FROM component AS c1 - INNER JOIN mapunit AS mu1 ON c1.mukey = mu1.mukey AND c1.mukey = mapunit.mukey %s - ORDER BY c1.comppct_r DESC, c1.cokey", ifelse(miscellaneous_areas, "", " AND NOT c1.compkind = 'Miscellaneous area'")), + INNER JOIN mapunit AS mu1 ON c1.mukey = mu1.mukey AND c1.mukey = mapunit.mukey %s %s + ORDER BY c1.comppct_r DESC, c1.cokey", ifelse(miscellaneous_areas, "", " AND NOT c1.compkind = 'Miscellaneous area'"), + ifelse(include_minors, "", " AND c1.majcompflag = 'Yes'")), n = 1, sqlite = !is.null(dsn))) } if (method == "DOMINANT CONDITION") { hyd_selection <- sprintf("AND hydricrating = (%s)", .LIMIT_N(sprintf("SELECT hydricrating FROM mapunit AS mu - INNER JOIN component AS c ON c.mukey = mu.mukey AND mapunit.mukey = mu.mukey %s GROUP BY hydricrating, comppct_r - ORDER BY SUM(comppct_r) OVER (PARTITION BY hydricrating) DESC", ifelse(miscellaneous_areas, "", " AND NOT c.compkind = 'Miscellaneous area'")), + ORDER BY SUM(comppct_r) OVER (PARTITION BY hydricrating) DESC", + ifelse(miscellaneous_areas, "", " AND NOT c.compkind = 'Miscellaneous area'"), + ifelse(include_minors, "", " AND c.majcompflag = 'Yes'")), n = 1, sqlite = !is.null(dsn))) } q <- sprintf(paste0("SELECT areasymbol, musym, muname, mapunit.mukey, ", ifelse(method == "DOMINANT CONDITION", "", "cokey, compname, compkind, comppct_r, majcompflag, "), "hydricrating - FROM legend - INNER JOIN mapunit ON mapunit.lkey = legend.lkey - INNER JOIN component ON component.mukey = mapunit.mukey %s %s %s - WHERE %s"), comp_selection, hyd_selection, ifelse(miscellaneous_areas, "", " AND NOT component.compkind = 'Miscellaneous area'"), WHERE) + FROM legend + INNER JOIN mapunit ON mapunit.lkey = legend.lkey + INNER JOIN component ON component.mukey = mapunit.mukey %s %s %s %s + WHERE %s"), + comp_selection, + hyd_selection, + ifelse(miscellaneous_areas, "", " AND NOT component.compkind = 'Miscellaneous area'"), + ifelse(include_minors, "", " AND component.majcompflag = 'Yes'"), + WHERE) } if (!is.null(dsn)) { diff --git a/man/get_SDA_hydric.Rd b/man/get_SDA_hydric.Rd index 2f232a07..3bc9116b 100644 --- a/man/get_SDA_hydric.Rd +++ b/man/get_SDA_hydric.Rd @@ -9,6 +9,7 @@ get_SDA_hydric( mukeys = NULL, WHERE = NULL, method = "MAPUNIT", + include_minors = TRUE, miscellaneous_areas = TRUE, query_string = FALSE, dsn = NULL @@ -23,6 +24,8 @@ get_SDA_hydric( \item{method}{One of: \code{"Mapunit"}, \code{"Dominant Component"}, \code{"Dominant Condition"}, \code{"None"}} +\item{include_minors}{logical. Include minor components? Default: \code{TRUE}.} + \item{miscellaneous_areas}{\emph{logical}. Include miscellaneous areas (non-soil components) in results? Default: \code{TRUE}.} \item{query_string}{Default: \code{FALSE}; if \code{TRUE} return a character string containing query that would be sent to SDA via \code{SDA_query()}} From 9ed9c2e55740dccfba02fd5cf9d1de2ae15d2e24 Mon Sep 17 00:00:00 2001 From: Andrew Gene Brown Date: Wed, 2 Oct 2024 14:49:43 -0700 Subject: [PATCH 08/17] get_SDA_interpretation: add miscellaneous areas and include_minors arguments --- R/get_SDA_interpretation.R | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/R/get_SDA_interpretation.R b/R/get_SDA_interpretation.R index 4154b1b8..cd51314b 100644 --- a/R/get_SDA_interpretation.R +++ b/R/get_SDA_interpretation.R @@ -684,6 +684,8 @@ get_SDA_interpretation <- function(rulename, areasymbols = NULL, mukeys = NULL, WHERE = NULL, + miscellaneous_areas = FALSE, + include_minors = TRUE, query_string = FALSE, not_rated_value = NA_real_, wide_reason = FALSE, @@ -694,6 +696,8 @@ get_SDA_interpretation <- function(rulename, areasymbols = areasymbols, mukeys = mukeys, WHERE = WHERE, + miscellaneous_areas = miscellaneous_areas, + include_minors = include_minors, sqlite = !is.null(dsn) ) @@ -746,7 +750,7 @@ get_SDA_interpretation <- function(rulename, modifier = modifier)) } -.constructInterpQuery <- function(method, interp, areasymbols = NULL, mukeys = NULL, WHERE = NULL, sqlite = FALSE) { +.constructInterpQuery <- function(method, interp, areasymbols = NULL, mukeys = NULL, WHERE = NULL, miscellaneous_areas = FALSE, include_minors = TRUE, sqlite = FALSE) { if (is.null(mukeys) && is.null(areasymbols) && is.null(WHERE)) { stop("Please specify one of the following arguments: mukeys, areasymbols, WHERE", call. = FALSE) @@ -762,10 +766,10 @@ get_SDA_interpretation <- function(rulename, agg_method <- .interpretationAggMethod(method) areasymbols <- soilDB::format_SQL_in_statement(areasymbols) switch(agg_method$method, - "DOMINANT COMPONENT" = .interpretation_aggregation(interp, WHERE, dominant = TRUE, sqlite = sqlite), - "DOMINANT CONDITION" = .interpretation_by_condition(interp, WHERE, dominant = TRUE, sqlite = sqlite), - "WEIGHTED AVERAGE" = .interpretation_weighted_average(interp, WHERE, sqlite = sqlite), - "NONE" = .interpretation_aggregation(interp, WHERE, sqlite = sqlite) + "DOMINANT COMPONENT" = .interpretation_aggregation(interp, WHERE, dominant = TRUE, miscellaneous_areas = miscellaneous_areas, include_minors = include_minors, sqlite = sqlite), + "DOMINANT CONDITION" = .interpretation_by_condition(interp, WHERE, dominant = TRUE, miscellaneous_areas = miscellaneous_areas, include_minors = include_minors, sqlite = sqlite), + "WEIGHTED AVERAGE" = .interpretation_weighted_average(interp, WHERE, miscellaneous_areas = miscellaneous_areas, include_minors = include_minors, sqlite = sqlite), + "NONE" = .interpretation_aggregation(interp, WHERE, miscellaneous_areas = miscellaneous_areas, include_minors = include_minors, sqlite = sqlite) ) } From da4c36296c3a8215979707da550f27c0b71807f0 Mon Sep 17 00:00:00 2001 From: Andrew Gene Brown Date: Wed, 2 Oct 2024 14:52:23 -0700 Subject: [PATCH 09/17] get_SDA_interpretation: add miscellaneous_areas to "dominant component" and "none" methods --- R/get_SDA_interpretation.R | 35 ++++++++++++++++++++--------------- 1 file changed, 20 insertions(+), 15 deletions(-) diff --git a/R/get_SDA_interpretation.R b/R/get_SDA_interpretation.R index cd51314b..19513841 100644 --- a/R/get_SDA_interpretation.R +++ b/R/get_SDA_interpretation.R @@ -788,19 +788,19 @@ get_SDA_interpretation <- function(rulename, INNER JOIN mapunit ON mapunit.lkey = legend.lkey AND %s INNER JOIN component ON component.mukey = mapunit.mukey %s ORDER BY mapunit.mukey, areasymbol, musym, muname", - paste0(sapply(interp, function(x) sprintf(" + paste0(sapply(interp, function(x) sprintf(" (%s) AS [rating_%s], (%s) AS [total_comppct_%s], (%s) AS [class_%s], (SELECT %s FROM mapunit AS mu INNER JOIN component AS c ON c.mukey = mu.mukey AND c.compkind != 'miscellaneous area' AND c.cokey = component.cokey INNER JOIN cointerp ON c.cokey = cointerp.cokey AND mapunit.mukey = mu.mukey AND ruledepth != 0 AND mrulename LIKE '%s') AS [reason_%s]", - .q1(x), .cleanRuleColumnName(x), - .q2(x), .cleanRuleColumnName(x), - .q3(x), .cleanRuleColumnName(x), - aggfun, x, .cleanRuleColumnName(x))), collapse = ", "), where_clause, - ifelse(dominant, paste0("AND component.cokey = (", .LIMIT_N("SELECT c1.cokey FROM component AS c1 INNER JOIN mapunit AS mu ON c1.mukey = mu.mukey AND c1.mukey = mapunit.mukey ORDER BY c1.comppct_r DESC, c1.cokey", n = 1, sqlite = sqlite), ")", ""))) + .q1(x), .cleanRuleColumnName(x), + .q2(x), .cleanRuleColumnName(x), + .q3(x), .cleanRuleColumnName(x), + aggfun, x, .cleanRuleColumnName(x))), collapse = ", "), where_clause, + ifelse(dominant, paste0("AND component.cokey = (", .LIMIT_N("SELECT c1.cokey FROM component AS c1 INNER JOIN mapunit AS mu ON c1.mukey = mu.mukey AND c1.mukey = mapunit.mukey ORDER BY c1.comppct_r DESC, c1.cokey", n = 1, sqlite = sqlite), ")", ""))) } -.interpretation_aggregation <- function(interp, where_clause, dominant = FALSE, sqlite = FALSE) { +.interpretation_aggregation <- function(interp, where_clause, dominant = FALSE, miscellaneous_areas = FALSE, include_minors = TRUE, sqlite = FALSE) { aggfun <- "STRING_AGG(CONCAT(rulename, ' \"', interphrc, '\" (', interphr, ')'), '; ')" if (sqlite) aggfun <- "(GROUP_CONCAT(rulename || ' \"' || interphrc || '\" (' || interphr || ')', '; ') || '; ')" sprintf("SELECT mapunit.mukey, component.cokey, areasymbol, musym, muname, compname, compkind, comppct_r, majcompflag, @@ -809,20 +809,25 @@ get_SDA_interpretation <- function(rulename, INNER JOIN mapunit ON mapunit.lkey = legend.lkey AND %s INNER JOIN component ON component.mukey = mapunit.mukey %s", paste0(sapply(interp, function(x) sprintf(" - (SELECT interphr FROM component AS c0 INNER JOIN cointerp ON c0.cokey = cointerp.cokey AND component.cokey = c0.cokey AND ruledepth = 0 AND mrulename LIKE '%s') as [rating_%s], - (SELECT interphrc FROM component AS c1 INNER JOIN cointerp ON c1.cokey = cointerp.cokey AND c1.cokey = component.cokey AND ruledepth = 0 AND mrulename LIKE '%s') as [class_%s], - (SELECT %s FROM mapunit AS mu INNER JOIN component AS c ON c.mukey = mu.mukey AND c.compkind != 'miscellaneous area' AND c.cokey = component.cokey AND mu.mukey = mapunit.mukey INNER JOIN cointerp ON c.cokey = cointerp.cokey AND ruledepth != 0 AND mrulename = '%s') as [reason_%s]", + (SELECT interphr FROM component AS c0 + INNER JOIN cointerp ON c0.cokey = cointerp.cokey AND component.cokey = c0.cokey AND ruledepth = 0 AND mrulename LIKE '%s') as [rating_%s], + (SELECT interphrc FROM component AS c1 + INNER JOIN cointerp ON c1.cokey = cointerp.cokey AND c1.cokey = component.cokey AND ruledepth = 0 AND mrulename LIKE '%s') as [class_%s], + (SELECT %s FROM mapunit AS mu + INNER JOIN component AS c ON c.mukey = mu.mukey %s AND c.cokey = component.cokey AND mu.mukey = mapunit.mukey + INNER JOIN cointerp ON c.cokey = cointerp.cokey AND ruledepth != 0 AND mrulename = '%s') as [reason_%s]", x, .cleanRuleColumnName(x), x, .cleanRuleColumnName(x), - aggfun, + aggfun, ifelse(miscellaneous_areas, "", "AND c.compkind != 'miscellaneous area'"), x, .cleanRuleColumnName(x))), collapse = ", "), where_clause, - ifelse(dominant, sprintf("AND component.cokey = (%s)", .LIMIT_N("SELECT c1.cokey FROM component AS c1 - INNER JOIN mapunit AS mu ON c1.mukey = mu.mukey AND c1.mukey = mapunit.mukey - ORDER BY c1.comppct_r DESC, c1.cokey", n = 1, sqlite = sqlite)), "")) + ifelse(dominant, sprintf("AND component.cokey = (%s)", .LIMIT_N(sprintf("SELECT c1.cokey FROM component AS c1 + INNER JOIN mapunit AS mu ON c1.mukey = mu.mukey AND c1.mukey = mapunit.mukey %s + ORDER BY c1.comppct_r DESC, c1.cokey", ifelse(miscellaneous_areas, "", "AND c1.compkind != 'miscellaneous area'")), + n = 1, sqlite = sqlite)), "")) } -.interpretation_weighted_average <- function(interp, where_clause, sqlite = FALSE) { +.interpretation_weighted_average <- function(interp, where_clause, miscellaneous_areas = FALSE, include_minors = TRUE, sqlite = FALSE) { stopifnot(!sqlite) sprintf("SELECT mapunit.mukey, areasymbol, musym, muname, %s From 1319c0e5ff104182d25fd93ac1477cbc62891f44 Mon Sep 17 00:00:00 2001 From: Andrew Gene Brown Date: Wed, 2 Oct 2024 15:56:36 -0700 Subject: [PATCH 10/17] get_SDA_interpretation: implement miscellaneous_areas argument for method = "dominant condition" - also fix for aggregate component percentage of dominant condition (ratings were correctly determined) --- R/get_SDA_interpretation.R | 43 +++++++++++++++++++++++++++----------- 1 file changed, 31 insertions(+), 12 deletions(-) diff --git a/R/get_SDA_interpretation.R b/R/get_SDA_interpretation.R index 19513841..ea1837af 100644 --- a/R/get_SDA_interpretation.R +++ b/R/get_SDA_interpretation.R @@ -775,29 +775,48 @@ get_SDA_interpretation <- function(rulename, .cleanRuleColumnName <- function(x) gsub("[^A-Za-z0-9]", "", gsub(">", "GT", gsub("<", "LT", gsub("=", "EQ", x, fixed = TRUE), fixed = TRUE), fixed = TRUE)) -.interpretation_by_condition <- function(interp, where_clause, dominant = TRUE, sqlite = FALSE) { +.interpretation_by_condition <- function(interp, where_clause, dominant = TRUE, miscellaneous_areas = FALSE, include_minors = TRUE, sqlite = FALSE) { aggfun <- "STRING_AGG(CONCAT(rulename, ' \"', interphrc, '\" (', interphr, ')'), '; ')" if (sqlite) aggfun <- "(GROUP_CONCAT(rulename || ' \"' || interphrc || '\" (' || interphr || ')', '; ') || '; ')" - .q0 <- function(q, x) .LIMIT_N(sprintf(q, x), n = 1, sqlite = sqlite) - .q1 <- function(x) .q0("SELECT ROUND (AVG(interphr) OVER (PARTITION BY interphrc), 2) FROM mapunit AS mu INNER JOIN component AS c ON c.mukey = mu.mukey INNER JOIN cointerp ON c.cokey = cointerp.cokey AND mapunit.mukey = mu.mukey AND ruledepth = 0 AND mrulename LIKE '%s' GROUP BY interphrc, interphr ORDER BY SUM (comppct_r) DESC", x) - .q2 <- function(x) .q0("SELECT SUM(comppct_r) FROM mapunit AS mu INNER JOIN component AS c ON c.mukey = mu.mukey INNER JOIN cointerp ON c.cokey = cointerp.cokey AND mapunit.mukey = mu.mukey AND ruledepth = 0 AND mrulename LIKE '%s' GROUP BY interphrc, comppct_r ORDER BY SUM(comppct_r) OVER (PARTITION BY interphrc) DESC", x) - .q3 <- function(x) .q0("SELECT interphrc FROM mapunit AS mu INNER JOIN component AS c ON c.mukey = mu.mukey INNER JOIN cointerp ON c.cokey = cointerp.cokey AND mapunit.mukey = mu.mukey AND ruledepth = 0 AND mrulename LIKE '%s' GROUP BY interphrc, comppct_r ORDER BY SUM(comppct_r) OVER (PARTITION BY interphrc) DESC", x) + .q0 <- function(q, x) .LIMIT_N(sprintf(q, ifelse(miscellaneous_areas, "", "AND c.compkind != 'miscellaneous area'"), x), + n = 1, sqlite = sqlite) + .q1 <- function(x) .q0("SELECT ROUND (AVG(interphr) OVER (PARTITION BY interphrc), 2) FROM mapunit AS mu + INNER JOIN component AS c ON c.mukey = mu.mukey AND mapunit.mukey = mu.mukey %s + LEFT JOIN cointerp ON c.cokey = cointerp.cokey AND ruledepth = 0 AND mrulename LIKE '%s' + GROUP BY interphrc, interphr + ORDER BY SUM (comppct_r) DESC", x) + .q2 <- function(x) .q0("SELECT SUM(comppct_r) AS sum_comppct_r FROM mapunit AS mu + INNER JOIN component AS c ON c.mukey = mu.mukey AND mapunit.mukey = mu.mukey %s + LEFT JOIN cointerp ON c.cokey = cointerp.cokey AND ruledepth = 0 AND mrulename LIKE '%s' + GROUP BY interphrc + ORDER BY sum_comppct_r DESC", x) + .q3 <- function(x) .q0("SELECT interphrc FROM mapunit AS mu + INNER JOIN component AS c ON c.mukey = mu.mukey AND mapunit.mukey = mu.mukey %s + LEFT JOIN cointerp ON c.cokey = cointerp.cokey AND ruledepth = 0 AND mrulename LIKE '%s' + GROUP BY interphrc, comppct_r + ORDER BY SUM(comppct_r) OVER (PARTITION BY interphrc) DESC", x) sprintf("SELECT mapunit.mukey, areasymbol, musym, muname, %s FROM legend INNER JOIN mapunit ON mapunit.lkey = legend.lkey AND %s - INNER JOIN component ON component.mukey = mapunit.mukey %s + INNER JOIN component ON component.mukey = mapunit.mukey %s %s ORDER BY mapunit.mukey, areasymbol, musym, muname", paste0(sapply(interp, function(x) sprintf(" (%s) AS [rating_%s], (%s) AS [total_comppct_%s], (%s) AS [class_%s], - (SELECT %s FROM mapunit AS mu INNER JOIN component AS c ON c.mukey = mu.mukey AND c.compkind != 'miscellaneous area' AND c.cokey = component.cokey INNER JOIN cointerp ON c.cokey = cointerp.cokey AND mapunit.mukey = mu.mukey AND ruledepth != 0 AND mrulename LIKE '%s') AS [reason_%s]", - .q1(x), .cleanRuleColumnName(x), - .q2(x), .cleanRuleColumnName(x), - .q3(x), .cleanRuleColumnName(x), - aggfun, x, .cleanRuleColumnName(x))), collapse = ", "), where_clause, - ifelse(dominant, paste0("AND component.cokey = (", .LIMIT_N("SELECT c1.cokey FROM component AS c1 INNER JOIN mapunit AS mu ON c1.mukey = mu.mukey AND c1.mukey = mapunit.mukey ORDER BY c1.comppct_r DESC, c1.cokey", n = 1, sqlite = sqlite), ")", ""))) + (SELECT %s FROM mapunit AS mu + INNER JOIN component AS c ON c.mukey = mu.mukey %s AND c.cokey = component.cokey + INNER JOIN cointerp ON c.cokey = cointerp.cokey AND mapunit.mukey = mu.mukey AND ruledepth != 0 AND mrulename LIKE '%s') AS [reason_%s]", + .q1(x), .cleanRuleColumnName(x), + .q2(x), .cleanRuleColumnName(x), + .q3(x), .cleanRuleColumnName(x), + aggfun, ifelse(miscellaneous_areas, "", "AND c.compkind != 'miscellaneous area'"), + x, .cleanRuleColumnName(x))), collapse = ", "), where_clause, ifelse(miscellaneous_areas, "", "AND component.compkind != 'miscellaneous area'"), + ifelse(dominant, paste0("AND component.cokey = (", .LIMIT_N(sprintf("SELECT c1.cokey FROM component AS c1 + INNER JOIN mapunit AS mu ON c1.mukey = mu.mukey AND c1.mukey = mapunit.mukey %s + ORDER BY c1.comppct_r DESC, c1.cokey", ifelse(miscellaneous_areas, "", "AND c1.compkind != 'miscellaneous area'")), + n = 1, sqlite = sqlite), ")", ""))) } .interpretation_aggregation <- function(interp, where_clause, dominant = FALSE, miscellaneous_areas = FALSE, include_minors = TRUE, sqlite = FALSE) { From 9f87a7b7028455db0068593235e76d4584bc741c Mon Sep 17 00:00:00 2001 From: Andrew Gene Brown Date: Wed, 2 Oct 2024 16:21:53 -0700 Subject: [PATCH 11/17] get_SDA_interpretation: implement miscellaneous_areas for method="weighted average" --- R/get_SDA_interpretation.R | 27 +++++++++++++++++---------- man/get_SDA_interpretation.Rd | 6 ++++++ 2 files changed, 23 insertions(+), 10 deletions(-) diff --git a/R/get_SDA_interpretation.R b/R/get_SDA_interpretation.R index ea1837af..84dfc60c 100644 --- a/R/get_SDA_interpretation.R +++ b/R/get_SDA_interpretation.R @@ -11,6 +11,8 @@ #' @param mukeys vector of map unit keys #' @param WHERE character containing SQL WHERE clause specified in terms of fields in `legend`, `mapunit`, or `component` tables, used in lieu of `mukeys` or `areasymbols` #' @param query_string Default: `FALSE`; if `TRUE` return a character string containing query that would be sent to SDA via `SDA_query` +#' @param include_minors logical. Include minor components? Default: `TRUE`. +#' @param miscellaneous_areas _logical_. Include miscellaneous areas (non-soil components) in results? Default: `TRUE`. #' @param not_rated_value used where rating class is "Not Rated". Default: `NA_real_` #' @param wide_reason Default: `FALSE`; if `TRUE` apply post-processing to all columns with prefix `"reason_"` to create additional columns for sub-rule ratings. #' @param dsn Path to local SQLite database or a DBIConnection object. If `NULL` (default) use Soil Data Access API via `SDA_query()`. @@ -684,8 +686,8 @@ get_SDA_interpretation <- function(rulename, areasymbols = NULL, mukeys = NULL, WHERE = NULL, - miscellaneous_areas = FALSE, include_minors = TRUE, + miscellaneous_areas = FALSE, query_string = FALSE, not_rated_value = NA_real_, wide_reason = FALSE, @@ -853,7 +855,7 @@ get_SDA_interpretation <- function(rulename, INTO #main FROM legend INNER JOIN mapunit ON mapunit.lkey = legend.lkey AND %s - INNER JOIN component ON component.mukey = mapunit.mukey + INNER JOIN component ON component.mukey = mapunit.mukey %s GROUP BY areasymbol, musym, muname, mapunit.mukey SELECT areasymbol, musym, muname, mukey, %s, @@ -864,30 +866,35 @@ get_SDA_interpretation <- function(rulename, paste0(sapply(interp, function(x) sprintf("(SELECT TOP 1 CASE WHEN ruledesign = 1 THEN 'limitation' WHEN ruledesign = 2 THEN 'suitability' END FROM mapunit AS mu - INNER JOIN component AS c ON c.mukey = mu.mukey - INNER JOIN cointerp ON c.cokey = cointerp.cokey AND mapunit.mukey = mu.mukey AND ruledepth = 0 AND mrulename LIKE '%s' + INNER JOIN component AS c ON c.mukey = mu.mukey AND mapunit.mukey = mu.mukey %s + INNER JOIN cointerp ON c.cokey = cointerp.cokey AND ruledepth = 0 AND mrulename LIKE '%s' GROUP BY mu.mukey, ruledesign) AS [design_%s], ROUND ((SELECT SUM (interphr * comppct_r) FROM mapunit AS mu - INNER JOIN component AS c ON c.mukey = mu.mukey - INNER JOIN cointerp ON c.cokey = cointerp.cokey AND mapunit.mukey = mu.mukey AND ruledepth = 0 AND mrulename LIKE '%s' + INNER JOIN component AS c ON c.mukey = mu.mukey AND mapunit.mukey = mu.mukey %s + INNER JOIN cointerp ON c.cokey = cointerp.cokey AND ruledepth = 0 AND mrulename LIKE '%s' GROUP BY mu.mukey),2) AS [rating_%s], ROUND ((SELECT SUM (comppct_r) FROM mapunit AS mu - INNER JOIN component AS c ON c.mukey = mu.mukey - INNER JOIN cointerp ON c.cokey = cointerp.cokey AND mapunit.mukey = mu.mukey AND ruledepth = 0 AND mrulename LIKE '%s' + INNER JOIN component AS c ON c.mukey = mu.mukey AND mapunit.mukey = mu.mukey %s + INNER JOIN cointerp ON c.cokey = cointerp.cokey AND ruledepth = 0 AND mrulename LIKE '%s' AND (interphr) IS NOT NULL GROUP BY mu.mukey),2) AS [sum_com_%s], (SELECT STRING_AGG(CONCAT(interphrc, ' (', interphr, ')'), '; ') FROM mapunit AS mu - INNER JOIN component AS c ON c.mukey = mu.mukey AND compkind != 'miscellaneous area' - INNER JOIN cointerp ON c.cokey = cointerp.cokey AND mapunit.mukey = mu.mukey + INNER JOIN component AS c ON c.mukey = mu.mukey AND mapunit.mukey = mu.mukey %s + INNER JOIN cointerp ON c.cokey = cointerp.cokey AND ruledepth != 0 AND mrulename LIKE '%s' GROUP BY mu.mukey) AS [reason_%s]", + ifelse(miscellaneous_areas, "", "AND c.compkind != 'miscellaneous area'"), x, .cleanRuleColumnName(x), + ifelse(miscellaneous_areas, "", "AND c.compkind != 'miscellaneous area'"), x, .cleanRuleColumnName(x), + ifelse(miscellaneous_areas, "", "AND c.compkind != 'miscellaneous area'"), x, .cleanRuleColumnName(x), + ifelse(miscellaneous_areas, "", "AND c.compkind != 'miscellaneous area'"), x, .cleanRuleColumnName(x))), collapse = ", "), where_clause, + ifelse(miscellaneous_areas, "", "AND compkind != 'miscellaneous area'"), paste0(sapply(interp, function(x) sprintf("ISNULL(ROUND(([rating_%s] / [sum_com_%s]),2), 99) AS [rating_%s]", .cleanRuleColumnName(x), .cleanRuleColumnName(x), .cleanRuleColumnName(x))), diff --git a/man/get_SDA_interpretation.Rd b/man/get_SDA_interpretation.Rd index dbb61611..7de162cf 100644 --- a/man/get_SDA_interpretation.Rd +++ b/man/get_SDA_interpretation.Rd @@ -10,6 +10,8 @@ get_SDA_interpretation( areasymbols = NULL, mukeys = NULL, WHERE = NULL, + include_minors = TRUE, + miscellaneous_areas = FALSE, query_string = FALSE, not_rated_value = NA_real_, wide_reason = FALSE, @@ -27,6 +29,10 @@ get_SDA_interpretation( \item{WHERE}{character containing SQL WHERE clause specified in terms of fields in \code{legend}, \code{mapunit}, or \code{component} tables, used in lieu of \code{mukeys} or \code{areasymbols}} +\item{include_minors}{logical. Include minor components? Default: \code{TRUE}.} + +\item{miscellaneous_areas}{\emph{logical}. Include miscellaneous areas (non-soil components) in results? Default: \code{TRUE}.} + \item{query_string}{Default: \code{FALSE}; if \code{TRUE} return a character string containing query that would be sent to SDA via \code{SDA_query}} \item{not_rated_value}{used where rating class is "Not Rated". Default: \code{NA_real_}} From 75fe013a152bf7e52fe78bda471465c9a711191f Mon Sep 17 00:00:00 2001 From: Andrew Gene Brown Date: Wed, 2 Oct 2024 16:41:09 -0700 Subject: [PATCH 12/17] get_SDA_pmgroupname: implement `include_minors` (default TRUE) --- R/get_SDA_pmgroupname.R | 18 ++++++++++++------ man/get_SDA_pmgroupname.Rd | 3 +++ 2 files changed, 15 insertions(+), 6 deletions(-) diff --git a/R/get_SDA_pmgroupname.R b/R/get_SDA_pmgroupname.R index ec6c43f2..b5f482c4 100644 --- a/R/get_SDA_pmgroupname.R +++ b/R/get_SDA_pmgroupname.R @@ -11,6 +11,7 @@ #' @param WHERE _character_. SQL WHERE clause specified in terms of fields in `legend`, `mapunit`, `component`, or `copmgrp` tables, used in lieu of `mukeys` or `areasymbols` #' @param method _character_. One of: `"Dominant Component"`, `"Dominant Condition"`, `"None"` #' @param simplify _logical_. Group into generalized parent material groups? Default `TRUE` +#' @param include_minors logical. Include minor components? Default: `TRUE`. #' @param miscellaneous_areas _logical_. Include miscellaneous areas (non-soil components) in results? Default: `FALSE`. #' @param query_string Default: `FALSE`; if `TRUE` return a character string containing query that would be sent to SDA via `SDA_query` #' @param dsn Path to local SQLite database or a DBIConnection object. If `NULL` (default) use Soil Data Access API via `SDA_query()`. @@ -22,6 +23,7 @@ get_SDA_pmgroupname <- function(areasymbols = NULL, WHERE = NULL, method = "DOMINANT COMPONENT", simplify = TRUE, + include_minors = TRUE, miscellaneous_areas = FALSE, query_string = FALSE, dsn = NULL) { @@ -158,9 +160,10 @@ get_SDA_pmgroupname <- function(areasymbols = NULL, if (method %in% c("DOMINANT COMPONENT", "DOMINANT CONDITION")) { dcq <- sprintf("SELECT c1.cokey FROM component AS c1 - INNER JOIN mapunit AS mu1 ON c1.mukey = mu1.mukey AND c1.mukey = mapunit.mukey %s + INNER JOIN mapunit AS mu1 ON c1.mukey = mu1.mukey AND c1.mukey = mapunit.mukey %s %s ORDER BY c1.comppct_r DESC, c1.cokey ", - ifelse(miscellaneous_areas, "", " AND NOT c1.compkind = 'Miscellaneous area'")) + ifelse(include_minors, "", " AND c1.majcompflag = 'Yes'"), + ifelse(miscellaneous_areas, "", " AND NOT c1.compkind = 'Miscellaneous area'")) comp_selection <- sprintf("AND component.cokey = (%s)", .LIMIT_N(dcq, n = 1, sqlite = !is.null(dsn))) } else { comp_selection <- "" @@ -168,9 +171,10 @@ get_SDA_pmgroupname <- function(areasymbols = NULL, if (method == "DOMINANT CONDITION") { dcq <- sprintf("SELECT pmgroupname FROM mapunit AS mu - INNER JOIN component AS c1 ON c1.mukey = mapunit.mukey AND mapunit.mukey = mu.mukey - INNER JOIN copmgrp ON copmgrp.cokey = component.cokey %s + INNER JOIN component AS c1 ON c1.mukey = mapunit.mukey AND mapunit.mukey = mu.mukey %s %s + INNER JOIN copmgrp ON copmgrp.cokey = component.cokey GROUP BY pmgroupname, comppct_r ORDER BY SUM(comppct_r) OVER (PARTITION BY pmgroupname) DESC", + ifelse(include_minors, "", " AND c1.majcompflag = 'Yes'"), ifelse(miscellaneous_areas, "", " AND NOT c1.compkind = 'Miscellaneous area'")) pm_selection <- sprintf("AND pmgroupname = (%s)", .LIMIT_N(dcq, n = 1, sqlite = !is.null(dsn))) } else { @@ -188,11 +192,13 @@ get_SDA_pmgroupname <- function(areasymbols = NULL, "%s FROM legend INNER JOIN mapunit ON mapunit.lkey = legend.lkey AND %s - %s JOIN component ON component.mukey = mapunit.mukey %s %s + %s JOIN component ON component.mukey = mapunit.mukey %s %s %s %s JOIN copmgrp ON copmgrp.cokey = component.cokey %s"), case_pmgroupname, WHERE, - misc_area_join_type, comp_selection, ifelse(miscellaneous_areas, "", " AND NOT component.compkind = 'Miscellaneous area'"), + misc_area_join_type, comp_selection, + ifelse(include_minors, "", " AND component.majcompflag = 'Yes'"), + ifelse(miscellaneous_areas, "", " AND NOT component.compkind = 'Miscellaneous area'"), misc_area_join_type, pm_selection ) diff --git a/man/get_SDA_pmgroupname.Rd b/man/get_SDA_pmgroupname.Rd index 6331ea50..5365b909 100644 --- a/man/get_SDA_pmgroupname.Rd +++ b/man/get_SDA_pmgroupname.Rd @@ -10,6 +10,7 @@ get_SDA_pmgroupname( WHERE = NULL, method = "DOMINANT COMPONENT", simplify = TRUE, + include_minors = TRUE, miscellaneous_areas = FALSE, query_string = FALSE, dsn = NULL @@ -26,6 +27,8 @@ get_SDA_pmgroupname( \item{simplify}{\emph{logical}. Group into generalized parent material groups? Default \code{TRUE}} +\item{include_minors}{logical. Include minor components? Default: \code{TRUE}.} + \item{miscellaneous_areas}{\emph{logical}. Include miscellaneous areas (non-soil components) in results? Default: \code{FALSE}.} \item{query_string}{Default: \code{FALSE}; if \code{TRUE} return a character string containing query that would be sent to SDA via \code{SDA_query}} From 5862d65a7d4fcdce6bf37d7fd41e778eefa323b9 Mon Sep 17 00:00:00 2001 From: Andrew Gene Brown Date: Wed, 2 Oct 2024 17:05:41 -0700 Subject: [PATCH 13/17] get_SDA_pmgroupname: test include_minors --- tests/testthat/test-get_SDA_pmgroupname.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-get_SDA_pmgroupname.R b/tests/testthat/test-get_SDA_pmgroupname.R index 4c9f4d94..7dcbff57 100644 --- a/tests/testthat/test-get_SDA_pmgroupname.R +++ b/tests/testthat/test-get_SDA_pmgroupname.R @@ -17,9 +17,9 @@ test_that("get_SDA_pmgroupname works", { skip_if(is.null(res)) expect_equal(nrow(res), 3) - res <- get_SDA_pmgroupname(mukeys = c(461994, 461995, 465186), simplify = FALSE, method = "none") + res <- get_SDA_pmgroupname(mukeys = c(461994, 461995, 465186), simplify = FALSE, method = "none", miscellaneous_areas = TRUE, include_minors = FALSE) skip_if(is.null(res)) - expect_equal(nrow(res), 8) + expect_equal(nrow(res), 5) res <- get_SDA_pmgroupname(mukeys = c(461994, 461995, 465186), simplify = FALSE, method = "none", miscellaneous_areas = TRUE) skip_if(is.null(res)) From e8248a44a66c2f235b45ec61122810e55784449b Mon Sep 17 00:00:00 2001 From: Andrew Gene Brown Date: Fri, 4 Oct 2024 15:52:28 -0700 Subject: [PATCH 14/17] remove misc_area_join_type --- R/get_SDA_cosurfmorph.R | 2 -- R/get_SDA_pmgroupname.R | 9 ++++----- 2 files changed, 4 insertions(+), 7 deletions(-) diff --git a/R/get_SDA_cosurfmorph.R b/R/get_SDA_cosurfmorph.R index 53936bb5..7eec8bca 100644 --- a/R/get_SDA_cosurfmorph.R +++ b/R/get_SDA_cosurfmorph.R @@ -111,8 +111,6 @@ get_SDA_cosurfmorph <- function(table = c("cosurfmorphgc", "cosurfmorphhpp", "co # excludes custom calculated columns (e.g. surfaceshape concatenated from across/down) vars_default <- vars[!grepl("surfaceshape", vars)] - misc_area_join_type <- ifelse(miscellaneous_areas, "LEFT", "INNER") - misc_area_filter <- ifelse(miscellaneous_areas, "LEFT", "INNER") q <- paste0("SELECT a.[BYVARNAME] AS [BYVARNAME], ", .SELECT_STATEMENT0(vars), ", total diff --git a/R/get_SDA_pmgroupname.R b/R/get_SDA_pmgroupname.R index b5f482c4..1b4787fb 100644 --- a/R/get_SDA_pmgroupname.R +++ b/R/get_SDA_pmgroupname.R @@ -181,7 +181,6 @@ get_SDA_pmgroupname <- function(areasymbols = NULL, pm_selection <- "" } - misc_area_join_type <- "LEFT" # ifelse(miscellaneous_areas, "LEFT", "INNER") q <- sprintf( paste0("SELECT DISTINCT mapunit.mukey, @@ -192,14 +191,14 @@ get_SDA_pmgroupname <- function(areasymbols = NULL, "%s FROM legend INNER JOIN mapunit ON mapunit.lkey = legend.lkey AND %s - %s JOIN component ON component.mukey = mapunit.mukey %s %s %s - %s JOIN copmgrp ON copmgrp.cokey = component.cokey %s"), + LEFT JOIN component ON component.mukey = mapunit.mukey %s %s %s + LEFT JOIN copmgrp ON copmgrp.cokey = component.cokey %s"), case_pmgroupname, WHERE, - misc_area_join_type, comp_selection, + comp_selection, ifelse(include_minors, "", " AND component.majcompflag = 'Yes'"), ifelse(miscellaneous_areas, "", " AND NOT component.compkind = 'Miscellaneous area'"), - misc_area_join_type, pm_selection + pm_selection ) if (query_string) { From 924f13925741f3c8de57406e830e066e2751f9d8 Mon Sep 17 00:00:00 2001 From: Andrew Gene Brown Date: Fri, 4 Oct 2024 16:57:43 -0700 Subject: [PATCH 15/17] get_SDA_cosurfmorph updates --- R/get_SDA_cosurfmorph.R | 84 ++++++++++++++--------- man/get_SDA_cosurfmorph.Rd | 15 +++- tests/testthat/test-get_SDA_cosurfmorph.R | 6 ++ 3 files changed, 68 insertions(+), 37 deletions(-) diff --git a/R/get_SDA_cosurfmorph.R b/R/get_SDA_cosurfmorph.R index 7eec8bca..f0084a03 100644 --- a/R/get_SDA_cosurfmorph.R +++ b/R/get_SDA_cosurfmorph.R @@ -7,11 +7,14 @@ #' Get Geomorphic/Surface Morphometry Data from Soil Data Access or a local SSURGO data source and summarize by counts and proportions ("probabilities"). #' #' @param table Target table to summarize. Default: `"cosurfmorphgc"` (3D Geomorphic Component). Alternate choices include `cosurfmorphhpp` (2D Hillslope Position), `cosurfmorphss` (Surface Shape), and `cosurfmorphmr` (Microrelief). -#' @param by Grouping variable. Default: `"compname"` +#' @param by Grouping variable. Default: `"mapunit.mukey"` #' @param areasymbols A vector of soil survey area symbols (e.g. `'CA067'`) #' @param mukeys A vector of map unit keys (e.g. `466627`) #' @param WHERE WHERE clause added to SQL query. For example: `areasymbol = 'CA067'` -#' @param miscellaneous_areas Include miscellaneous areas (non-soil components) in results? Default: `FALSE`. +#' @param method _character_. One of: `"ByGroup"`, `"None"` +#' @param include_minors logical. Include minor components? Default: `TRUE`. +#' @param miscellaneous_areas logical. Include miscellaneous areas (non-soil components) in results? Default: `FALSE`. +#' @param representative_only logical. Include only representative Component Parent Material Groups? Default: `TRUE`. #' @param db Either `'SSURGO'` (default) or `'STATSGO'`. If `'SSURGO'` is specified `areasymbol = 'US'` records are excluded. If `'STATSGO'` only `areasymbol = 'US'` records are included. #' @param dsn Path to local SSURGO database SQLite database. Default `NULL` uses Soil Data Access. #' @param query_string Return query instead of sending to Soil Data Access / local database. Default: `FALSE`. @@ -46,11 +49,14 @@ #' get_SDA_cosurfmorph('cosurfmorphmr', WHERE = "areasymbol = 'CA630'") #' } get_SDA_cosurfmorph <- function(table = c("cosurfmorphgc", "cosurfmorphhpp", "cosurfmorphss", "cosurfmorphmr"), - by = "compname", + by = "mapunit.mukey", areasymbols = NULL, mukeys = NULL, WHERE = NULL, + method = c("bygroup", "none"), + include_minors = TRUE, miscellaneous_areas = FALSE, + representative_only = TRUE, db = c('SSURGO', 'STATSGO'), dsn = NULL, query_string = FALSE) { @@ -58,6 +64,8 @@ get_SDA_cosurfmorph <- function(table = c("cosurfmorphgc", "cosurfmorphhpp", "co if (is.null(mukeys) && is.null(areasymbols) && is.null(WHERE)) { stop("Please specify one of the following arguments: mukeys, areasymbols, WHERE", call. = FALSE) } + + method <- match.arg(toupper(method), c("BYGROUP", "NONE")) if (!is.null(mukeys)) { WHERE <- paste("mapunit.mukey IN", format_SQL_in_statement(as.integer(mukeys))) @@ -67,7 +75,7 @@ get_SDA_cosurfmorph <- function(table = c("cosurfmorphgc", "cosurfmorphhpp", "co db <- match.arg(toupper(db), choices = c('SSURGO', 'STATSGO')) table <- match.arg(tolower(table), choices = c("cosurfmorphgc", "cosurfmorphhpp", "cosurfmorphss", "cosurfmorphmr")) - statsgo_filter <- switch(db, SSURGO = "!=", STATSGO = "=") + statsgo_filter <- switch(db, SSURGO = "legend.areasymbol != 'US'", STATSGO = "legend.areasymbol == 'US'", "1=1") vars <- switch(table, "cosurfmorphgc" = c("geomposmntn", "geomposhill", "geomposflats", "geompostrce"), @@ -76,6 +84,7 @@ get_SDA_cosurfmorph <- function(table = c("cosurfmorphgc", "cosurfmorphhpp", "co # NOTE: surfaceshape is calculated CONCAT(shapeacross, '/', shapedown) "cosurfmorphmr" = "geomicrorelief") + # TODO: weight probabilities by component percentage? needs refactor .SELECT_STATEMENT0 <- function(v) { paste0(paste0(v, ", ", paste0(v, "_n"), ", ", paste0(paste0("round(", v, "_n / total, 2) AS p_", v)), collapse = ", ")) } @@ -95,15 +104,11 @@ get_SDA_cosurfmorph <- function(table = c("cosurfmorphgc", "cosurfmorphhpp", "co res } - .JOIN_TABLE <- function(x) { - sprintf("LEFT JOIN %s ON cogeomordesc.cogeomdkey = %s.cogeomdkey", x, x) - } - .NULL_FILTER <- function(v, miscellaneous_areas = FALSE) { if (miscellaneous_areas) return("1=1") paste0(paste0(v, collapse = " IS NOT NULL OR "), " IS NOT NULL") } - + .ORDER_COLUMNS <- function(v) { paste0(paste0(paste0("p_", v), collapse = " DESC, "), " DESC") } @@ -111,7 +116,8 @@ get_SDA_cosurfmorph <- function(table = c("cosurfmorphgc", "cosurfmorphhpp", "co # excludes custom calculated columns (e.g. surfaceshape concatenated from across/down) vars_default <- vars[!grepl("surfaceshape", vars)] - q <- paste0("SELECT a.[BYVARNAME] AS [BYVARNAME], + if (method == "BYGROUP") { + q <- paste0("SELECT a.[BYVARNAME] AS [BYVARNAME], ", .SELECT_STATEMENT0(vars), ", total FROM ( @@ -119,52 +125,62 @@ get_SDA_cosurfmorph <- function(table = c("cosurfmorphgc", "cosurfmorphhpp", "co ", .SELECT_STATEMENT1(vars_default), " FROM legend INNER JOIN mapunit ON mapunit.lkey = legend.lkey - INNER JOIN component ON mapunit.mukey = component.mukey + INNER JOIN component ON mapunit.mukey = component.mukey ", + ifelse(include_minors, "", "AND majcompflag = 'Yes'") ," ", ifelse(miscellaneous_areas, "", " AND NOT component.compkind = 'Miscellaneous area'")," LEFT JOIN cogeomordesc ON component.cokey = cogeomordesc.cokey - ", .JOIN_TABLE(table), " - WHERE legend.areasymbol ", statsgo_filter, " 'US' + ", ifelse(representative_only, "AND rvindicator = 'Yes'", ""), " + ", sprintf("INNER JOIN %s ON cogeomordesc.cogeomdkey = %s.cogeomdkey", table, table), " + WHERE ", statsgo_filter, " AND (", .NULL_FILTER(vars_default, miscellaneous_areas), ") AND ", WHERE, " GROUP BY [BYVAR], ", paste0(vars_default, collapse = ", "), " ) AS a JOIN (SELECT [BYVAR] AS BYVAR, CAST(count([BYVAR]) AS numeric) AS total FROM legend INNER JOIN mapunit ON mapunit.lkey = legend.lkey - INNER JOIN component ON mapunit.mukey = component.mukey + INNER JOIN component ON mapunit.mukey = component.mukey ", + ifelse(include_minors,"", "AND majcompflag = 'Yes'") ," ", ifelse(miscellaneous_areas, "", " AND NOT component.compkind = 'Miscellaneous area'")," LEFT JOIN cogeomordesc ON component.cokey = cogeomordesc.cokey - ", .JOIN_TABLE(table), " - WHERE legend.areasymbol != 'US' + ", ifelse(representative_only, "AND rvindicator = 'Yes'", ""), + sprintf("LEFT JOIN %s ON cogeomordesc.cogeomdkey = %s.cogeomdkey", table, table), " + WHERE ", statsgo_filter, " AND (", .NULL_FILTER(vars_default, miscellaneous_areas), ") AND ", WHERE, " GROUP BY [BYVAR]) AS b ON a.BYVAR = b.BYVAR ORDER BY [BYVARNAME], ", .ORDER_COLUMNS(vars_default)) - + + } else if (method == "NONE") { + + if (!missing(by)) { + message("NOTE: `by` argument is ignored when method='none'") + } + + q <- paste0("SELECT mapunit.mukey, component.cokey, compname, compkind, comppct_r, majcompflag, cogeomordesc.rvindicator,", + paste0(vars, collapse = ", "), " + FROM legend + INNER JOIN mapunit ON mapunit.lkey = legend.lkey + INNER JOIN component ON mapunit.mukey = component.mukey ", + ifelse(include_minors, "", "AND majcompflag = 'Yes'") ," + ", ifelse(miscellaneous_areas, "", " AND NOT component.compkind = 'Miscellaneous area'")," + LEFT JOIN cogeomordesc ON component.cokey = cogeomordesc.cokey + ", sprintf("LEFT JOIN %s ON cogeomordesc.cogeomdkey = %s.cogeomdkey", table, table), " + WHERE ", statsgo_filter, " + AND (", .NULL_FILTER(vars_default, miscellaneous_areas), ") + AND ", WHERE, "") + } + # insert grouping variable byname <- gsub("(.*\\.)?(.*)", "\\2", by) qsub <- gsub("[BYVARNAME]", byname, gsub("[BYVAR]", by, q, fixed = TRUE), fixed = TRUE) + if (query_string) { return(qsub) } - if (!is.null(dsn)) { - # if dsn is specified - if (inherits(dsn, 'DBIConnection')) { - # allow existing connections (don't close them) - res <- DBI::dbGetQuery(dsn, qsub) - } else { - # otherwise create a connection - if (requireNamespace("RSQLite")) { - con <- dbConnect(RSQLite::SQLite(), dsn) - res <- dbGetQuery(con, qsub) - RSQLite::dbDisconnect(con) - } else stop("package 'RSQLite' is required to query a local data source (`dsn`)", call. = FALSE) - } - } else { - # otherwise query from SDA - res <- SDA_query(qsub) - } + + res <- SDA_query(qsub, dsn = dsn) res } diff --git a/man/get_SDA_cosurfmorph.Rd b/man/get_SDA_cosurfmorph.Rd index 8d1d846e..d70fd128 100644 --- a/man/get_SDA_cosurfmorph.Rd +++ b/man/get_SDA_cosurfmorph.Rd @@ -6,11 +6,14 @@ \usage{ get_SDA_cosurfmorph( table = c("cosurfmorphgc", "cosurfmorphhpp", "cosurfmorphss", "cosurfmorphmr"), - by = "compname", + by = "mapunit.mukey", areasymbols = NULL, mukeys = NULL, WHERE = NULL, + method = c("bygroup", "none"), + include_minors = TRUE, miscellaneous_areas = FALSE, + representative_only = TRUE, db = c("SSURGO", "STATSGO"), dsn = NULL, query_string = FALSE @@ -19,7 +22,7 @@ get_SDA_cosurfmorph( \arguments{ \item{table}{Target table to summarize. Default: \code{"cosurfmorphgc"} (3D Geomorphic Component). Alternate choices include \code{cosurfmorphhpp} (2D Hillslope Position), \code{cosurfmorphss} (Surface Shape), and \code{cosurfmorphmr} (Microrelief).} -\item{by}{Grouping variable. Default: \code{"compname"}} +\item{by}{Grouping variable. Default: \code{"mapunit.mukey"}} \item{areasymbols}{A vector of soil survey area symbols (e.g. \code{'CA067'})} @@ -27,7 +30,13 @@ get_SDA_cosurfmorph( \item{WHERE}{WHERE clause added to SQL query. For example: \code{areasymbol = 'CA067'}} -\item{miscellaneous_areas}{Include miscellaneous areas (non-soil components) in results? Default: \code{FALSE}.} +\item{method}{\emph{character}. One of: \code{"ByGroup"}, \code{"None"}} + +\item{include_minors}{logical. Include minor components? Default: \code{TRUE}.} + +\item{miscellaneous_areas}{logical. Include miscellaneous areas (non-soil components) in results? Default: \code{FALSE}.} + +\item{representative_only}{logical. Include only representative Component Parent Material Groups? Default: \code{TRUE}.} \item{db}{Either \code{'SSURGO'} (default) or \code{'STATSGO'}. If \code{'SSURGO'} is specified \code{areasymbol = 'US'} records are excluded. If \code{'STATSGO'} only \code{areasymbol = 'US'} records are included.} diff --git a/tests/testthat/test-get_SDA_cosurfmorph.R b/tests/testthat/test-get_SDA_cosurfmorph.R index c9526f60..852ff2e2 100644 --- a/tests/testthat/test-get_SDA_cosurfmorph.R +++ b/tests/testthat/test-get_SDA_cosurfmorph.R @@ -23,4 +23,10 @@ test_that("get_SDA_cosurfmorph works", { x <- get_SDA_cosurfmorph(WHERE = "areasymbol = 'CA630'", table = 'cosurfmorphss') skip_if(is.null(x)) expect_true(inherits(x, 'data.frame')) + + x <- get_SDA_cosurfmorph(mukeys = 465186, + by = "mapunit.mukey", + miscellaneous_areas = TRUE, + include_minors = FALSE, + method = "none") }) From 9b062d4a630c9fc278c5cebccb8669e662c0630a Mon Sep 17 00:00:00 2001 From: Andrew Gene Brown Date: Fri, 4 Oct 2024 17:10:38 -0700 Subject: [PATCH 16/17] get_SDA_interpretation: fix default `miscellaneous_areas` argument (should be `TRUE`) --- R/get_SDA_interpretation.R | 2 +- man/get_SDA_interpretation.Rd | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/get_SDA_interpretation.R b/R/get_SDA_interpretation.R index 84dfc60c..9a511c8d 100644 --- a/R/get_SDA_interpretation.R +++ b/R/get_SDA_interpretation.R @@ -687,7 +687,7 @@ get_SDA_interpretation <- function(rulename, mukeys = NULL, WHERE = NULL, include_minors = TRUE, - miscellaneous_areas = FALSE, + miscellaneous_areas = TRUE, query_string = FALSE, not_rated_value = NA_real_, wide_reason = FALSE, diff --git a/man/get_SDA_interpretation.Rd b/man/get_SDA_interpretation.Rd index 7de162cf..10e5c00d 100644 --- a/man/get_SDA_interpretation.Rd +++ b/man/get_SDA_interpretation.Rd @@ -11,7 +11,7 @@ get_SDA_interpretation( mukeys = NULL, WHERE = NULL, include_minors = TRUE, - miscellaneous_areas = FALSE, + miscellaneous_areas = TRUE, query_string = FALSE, not_rated_value = NA_real_, wide_reason = FALSE, From bd675ee843e457a06f45be7d75f3d4ce66a8e732 Mon Sep 17 00:00:00 2001 From: Andrew Gene Brown Date: Fri, 4 Oct 2024 17:22:46 -0700 Subject: [PATCH 17/17] get_SDA_hydric: fix dominant condition --- R/get_SDA_hydric.R | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/R/get_SDA_hydric.R b/R/get_SDA_hydric.R index 64acdf20..e87143f6 100644 --- a/R/get_SDA_hydric.R +++ b/R/get_SDA_hydric.R @@ -94,12 +94,14 @@ get_SDA_hydric <- function(areasymbols = NULL, } if (method == "DOMINANT CONDITION") { - hyd_selection <- sprintf("AND hydricrating = (%s)", .LIMIT_N(sprintf("SELECT hydricrating FROM mapunit AS mu - GROUP BY hydricrating, comppct_r - ORDER BY SUM(comppct_r) OVER (PARTITION BY hydricrating) DESC", - ifelse(miscellaneous_areas, "", " AND NOT c.compkind = 'Miscellaneous area'"), - ifelse(include_minors, "", " AND c.majcompflag = 'Yes'")), - n = 1, sqlite = !is.null(dsn))) + hyd_selection <- sprintf("AND hydricrating = (%s)", + .LIMIT_N(sprintf("SELECT hydricrating FROM mapunit AS mu + INNER JOIN component ON component.mukey = mapunit.mukey %s %s + GROUP BY hydricrating, comppct_r + ORDER BY SUM(comppct_r) OVER (PARTITION BY hydricrating) DESC", + ifelse(miscellaneous_areas, "", " AND NOT component.compkind = 'Miscellaneous area'"), + ifelse(include_minors, "", " AND component.majcompflag = 'Yes'")), + n = 1, sqlite = !is.null(dsn))) } q <- sprintf(paste0("SELECT areasymbol, musym, muname, mapunit.mukey, ",