Merge pull request #346 from ncss-tech/SDA_spatialQuery-features

SDA_spatialQuery: implement `what` `'mupoint'`, `'muline'`, `'featpoint'`, `'featline'`

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
 }