diff --git a/R/SDA-spatial.R b/R/SDA-spatial.R index 4509edde..db74d1a9 100644 --- a/R/SDA-spatial.R +++ b/R/SDA-spatial.R @@ -46,7 +46,7 @@ processSDA_WKT <- function(d, g='geom', crs = 4326, p4s = NULL, as_sf = TRUE) { # STATSGO features require AND CLIPAREASYMBOL = 'US' to avoid state areasymbol copy # select the right query for SSURGO / STATSGO geometry filters submitted to SDA -.SDA_geometrySelector <- function(db, method, geomAcres = TRUE) { +.SDA_geometrySelector <- function(db, what, method, geomAcres = TRUE) { db_table <- switch(db, SSURGO = "mupolygon", STATSGO = "gsmmupolygon", @@ -77,6 +77,14 @@ processSDA_WKT <- function(d, g='geom', crs = 4326, p4s = NULL, as_sf = TRUE) { id_column, geom_sql, id_column, db_table, db_column, clip_sql, id_column, ifelse(geomAcres, area_ac_sql, "") ) + + # handle non-polygon results + if (db == "SSURGO" && what %in% c("mupoint", "muline", "featpoint", "featline")) { + res <- gsub("mupolygon", what, res) + if (what %in% c("featpoint", "featline")) { + res <- gsub("mukey", "featkey", res) + } + } return(res) } @@ -331,9 +339,9 @@ SDA_spatialQuery <- function(geom, what <- "mupolygon" } - # sanity checks - if (!what %in% c('mukey', 'mupolygon', 'areasymbol', 'sapolygon')) { - stop("query type (argument `what`) must be either 'mukey' / 'areasymbol' (tabular result) OR 'mupolygon' / 'sapolygon' (geometry result)", call. = FALSE) + # determine if requested data type is allowed + if (!what %in% c('mukey', 'mupolygon', 'mupoint', 'muline', 'featpoint', 'featline', 'areasymbol', 'sapolygon')) { + stop("query type (argument `what`) must be either 'mukey' / 'areasymbol' (tabular result) OR 'mupolygon', 'mupoint', 'muline', 'featpoint', 'featline', 'sapolygon' (geometry result)", call. = FALSE) } # areasymbol is allowed with db = "SSURGO" (default) and db = "SAPOLYGON" @@ -363,20 +371,24 @@ SDA_spatialQuery <- function(geom, wkt <- wk::wk_collection(wk::as_wkt(geom)) # returning geom + mukey or geom + areasymbol - if (what %in% c('mupolygon', 'sapolygon')) { + if (what %in% c("mupolygon", "sapolygon", "mupoint", "muline", "featpoint", "featline")) { + if (what %in% c("mupoint", "muline", "featpoint", "featline")) { + geomAcres <- FALSE + } + # return intersection + area if (geomIntersection) { # select the appropriate query - .template <- .SDA_geometrySelector(db = db, method = 'intersection', geomAcres = geomAcres) + .template <- .SDA_geometrySelector(db = db, what = what, method = 'intersection', geomAcres = geomAcres) q <- sprintf(.template, as.character(wkt), as.character(wkt)) } else { # return overlapping # select the appropriate query - .template <- .SDA_geometrySelector(db = db, method = 'overlap', geomAcres = geomAcres) + .template <- .SDA_geometrySelector(db = db, what = what, method = 'overlap', geomAcres = geomAcres) q <- sprintf(.template, as.character(wkt)) } @@ -388,7 +400,7 @@ SDA_spatialQuery <- function(geom, # note that row-order / number of rows in results may not match geom res <- suppressMessages(SDA_query(q)) - if (inherits(res, 'try-error')) { + if (is.null(res) || inherits(res, 'try-error')) { return(res) } @@ -397,58 +409,40 @@ SDA_spatialQuery <- function(geom, # sf -> terra res <- terra::vect(res) } - } - - if (what == 'mukey') { - if (db == "SSURGO") { - q <- sprintf("SELECT mukey, muname - FROM mapunit - WHERE mukey IN ( - SELECT DISTINCT mukey from SDA_Get_Mukey_from_intersection_with_WktWgs84('%s') + + } else { + + if (what == 'mukey') { + if (db == "SSURGO") { + q <- sprintf("SELECT mukey, muname + FROM mapunit + WHERE mukey IN ( + SELECT DISTINCT mukey from SDA_Get_Mukey_from_intersection_with_WktWgs84('%s') + )", wkt) + } else if (db == "STATSGO") { + q <- sprintf("SELECT DISTINCT P.mukey, mapunit.muname + FROM gsmmupolygon AS P + INNER JOIN mapunit ON mapunit.mukey = P.mukey + WHERE mupolygongeo.STIntersects(geometry::STGeomFromText('%s', 4326)) = 1 + AND CLIPAREASYMBOL = 'US'", wkt) + } else { + stop("query type 'mukey' for 'SAPOLYGON' is not supported", call. = FALSE) + } + + } else if (what == 'areasymbol') { + # SSURGO only + q <- sprintf("SELECT areasymbol + FROM sapolygon + WHERE sapolygonkey IN ( + SELECT DISTINCT sapolygonkey from SDA_Get_Sapolygonkey_from_intersection_with_WktWgs84('%s') )", wkt) - } else if (db == "STATSGO") { - q <- sprintf("SELECT DISTINCT P.mukey, mapunit.muname - FROM gsmmupolygon AS P - INNER JOIN mapunit ON mapunit.mukey = P.mukey - WHERE mupolygongeo.STIntersects(geometry::STGeomFromText('%s', 4326) ) = 1 - AND CLIPAREASYMBOL = 'US'", wkt) - } else { - stop("query type 'mukey' for 'SAPOLYGON' is not supported", call. = FALSE) - } - - if (query_string) { - return(q) } - - # single query for all of the features - # note that row-order / number of rows in results may not match geom - res <- suppressMessages(SDA_query(q)) - if (inherits(res, 'try-error')) { - return(res) - } - } - - # SSURGO only - if (what == 'areasymbol') { - q <- sprintf("SELECT areasymbol - FROM sapolygon - WHERE sapolygonkey IN ( - SELECT DISTINCT sapolygonkey from SDA_Get_Sapolygonkey_from_intersection_with_WktWgs84('%s') - )", wkt) - if (query_string) { return(q) } - - # single query for all of the features - # note that row-order / number of rows in results may not match geom - res <- suppressMessages(SDA_query(q)) - if (inherits(res, 'try-error')) { - return(res) - } + res <- suppressMessages(SDA_query(q)) } - res }