Merge pull request #186 from elipousson/prepare-spatial-filter-revisions

Fix #166 with improvements to `filter_geom` handling by `arc_select()`

NEWS.md

@@ -1,13 +1,17 @@
 # arcgislayers (development version)
 
-## Breaking changes
+## New features
 
-- `dplyr` methods for `collect()`, `select()`, and `filter()` have been removed. <https://github.com/R-ArcGIS/arcgislayers/issues/111> <https://github.com/R-ArcGIS/arcgislayers/issues/224> <https://github.com/R-ArcGIS/arcgislayers/issues/218>
+- Improve handling of `filter_geom` by `arc_select()` by warning if applying `sf::st_union()` to the filter does not generate a length 1 sfc, or if `filter_geom` is supplied when accessing a Table, or if `filter_geom` is empty (@elipousson, #166)
 
 ## Bug fixes
 
 - `arc_select()` includes argument name in error message when `...` contains non-string values. <https://github.com/R-ArcGIS/arcgislayers/issues/226>
 
+## Breaking changes
+
+- `dplyr` methods for `collect()`, `select()`, and `filter()` have been removed. <https://github.com/R-ArcGIS/arcgislayers/issues/111> <https://github.com/R-ArcGIS/arcgislayers/issues/224> <https://github.com/R-ArcGIS/arcgislayers/issues/218>
+
 # arcgislayers 0.3.1
 
 ## Bug fixes

R/arc-select.R

@@ -126,7 +126,7 @@ arc_select <- function(
   query[["returnGeometry"]] <- geometry
 
   # handle filter geometry if not missing
-  if (!is.null(filter_geom)) {
+  if (!is.null(filter_geom) && inherits(x, "FeatureLayer")) {
     spatial_filter <- prepare_spatial_filter(
       filter_geom,
       crs = crs,
@@ -135,6 +135,14 @@ arc_select <- function(
 
     # append spatial filter fields to the query
     query <- c(query, spatial_filter)
+  } else if (!is.null(filter_geom)) {
+    # warn if filter_geom is supplied but object is not a FeatureLayer
+    cli::cli_warn(
+      "{.arg filter_geom} is ignored when {.arg x} is
+      {.obj_simple_type {.cls {class(x)}}}."
+    )
+
+    filter_geom <- NULL
   }
 
   # handle SR if not missing

R/utils-spatial-filter.R

@@ -20,9 +20,8 @@
 #'  reference. If the `sfc` is missing a CRS (or is an `sfg` object) it is
 #'  assumed to use the same spatial reference as the FeatureLayer. If the `sfc`
 #'  object has multiple features, the features are unioned with
-#'  [sf::st_union()]. If an `sfc` object has `MULTIPOLYGON` geometry, the features
-#'  are unioned before being cast to `POLYGON` geometry with [sf::st_cast()]. All
-#'  geometries are checked for validity before conversion.
+#'  [sf::st_union()]. If an `sfc` object has `MULTIPOLYGON` geometry, the
+#'  features are cast to `POLYGON` geometry and only the first element is used.
 #'
 #' @returns [prepare_spatial_filter()] returns a named list with the
 #'   `geometryType`, `geometry` (as Esri JSON), and spatial relation predicate.
@@ -44,15 +43,16 @@ prepare_spatial_filter <- function(
     call = error_call
   )
 
-  # NOTE: CRS cannot be missing
-  if (inherits(filter_geom, "bbox")) {
-    filter_geom <- sf::st_as_sfc(filter_geom)
-  } else if (any(!sf::st_is_valid(filter_geom))) {
-    filter_geom <- sf::st_make_valid(filter_geom)
+  if (is_sfc(filter_geom) && rlang::is_empty(filter_geom)) {
+    cli::cli_warn(
+      "{.arg filter_geom} contains no features and can't be used for query."
+    )
+
+    return(NULL)
   }
 
   # FIXME: Unsure how to handle sfg inputs w/o checking CRS
-  if (inherits(filter_geom, "sfg")) {
+  if (is_sfg(filter_geom)) {
     filter_crs <- crs
   } else {
     filter_crs <- sf::st_crs(filter_geom)
@@ -62,38 +62,59 @@ prepare_spatial_filter <- function(
     }
   }
 
-  # if an sfc_multipolygon we union and cast to polygon
-  # related issue: https://github.com/R-ArcGIS/arcgislayers/issues/4
-  if (inherits(filter_geom, "sfc_MULTIPOLYGON")) {
-    cli::cli_inform(
-      c(
-        "!" = "{.arg filter_geom} cannot be a {.val MULTIPOLYGON} geometry.",
-        "i" = "Using {.fn sf::st_union} and {.fn sf::st_cast} to create a
-        {.val POLYGON} for {.arg filter_geom}."
-      ),
-      call = error_call
-    )
+  filter_sfg <- filter_geom_as_sfg(filter_geom, error_call = error_call)
+
+  list(
+    geometryType = arcgisutils::determine_esri_geo_type(filter_sfg, call = error_call),
+    geometry = arcgisutils::as_esri_geometry(filter_sfg, crs = filter_crs, call = error_call),
+    spatialRel = match_spatial_rel(predicate, error_call = error_call)
+    # TODO is `inSR` needed if the CRS is specified in the geometry???
+  )
+}
+
+#' Convert input filter_geom to a sfg object
+#' @noRd
+filter_geom_as_sfg <- function(
+    filter_geom,
+    error_call = rlang::caller_env()
+) {
+  # NOTE: CRS cannot be missing
+  if (inherits(filter_geom, "bbox")) {
+    filter_geom <- sf::st_as_sfc(filter_geom)
+  } else if (any(!sf::st_is_valid(filter_geom))) {
+    filter_geom <- sf::st_make_valid(filter_geom)
+  }
+
+  # union multi-element sfc inputs (e.g. convert multiple POLYGON features to a
+  # single MULTIPOLYGON feature)
+  if (is_sfc(filter_geom) && length(filter_geom) > 1) {
     filter_geom <- sf::st_union(filter_geom)
+  }
+
+  # if an sfc_multipolygon we union and cast to polygon - see related issues:
+  # https://github.com/R-ArcGIS/arcgislayers/issues/4
+  # https://github.com/R-ArcGIS/arcgislayers/issues/166
+  if (rlang::inherits_any(filter_geom, c("sfc_MULTIPOLYGON", "MULTIPOLYGON"))) {
     filter_geom <- sf::st_cast(filter_geom, to = "POLYGON")
-  } else if (inherits(filter_geom, "MULTIPOLYGON")) {
-    filter_geom <- sf::st_cast(filter_geom, "POLYGON")
+  }
+
+  # return any sfg object
+  if (is_sfg(filter_geom)) {
+    return(filter_geom)
   }
 
   # if its an sfc object it must be length one
-  if (inherits(filter_geom, "sfc")) {
-    if (length(filter_geom) > 1) {
-      filter_geom <- sf::st_union(filter_geom)
-    }
-    # extract the sfg object which is used to write Esri json
-    filter_geom <- filter_geom[[1]]
+  geom_length <- length(filter_geom)
+
+  if (geom_length > 1) {
+    cli::cli_warn(
+      c("{.arg filter_geom} contains {geom_length} elements.",
+        "i" = "Using geometry from first element only.")
+    )
   }
 
-  list(
-    geometryType = arcgisutils::determine_esri_geo_type(filter_geom),
-    geometry = arcgisutils::as_esri_geometry(filter_geom, crs = filter_crs),
-    spatialRel = match_spatial_rel(predicate, error_call = error_call)
-    # TODO is `inSR` needed if the CRS is specified in the geometry???
-  )
+  # extract the sfg object which is used to write Esri json
+  filter_geom[[1]]
 }
 
 #' @description
@@ -148,3 +169,15 @@ match_spatial_rel <- function(predicate, error_call = rlang::caller_env()) {
 
   esri_predicates[grepl(predicate, esri_predicates, ignore.case = TRUE)]
 }
+
+#' Is x a sfc object?
+#' @noRd
+is_sfc <- function(x) {
+  rlang::inherits_any(x, "sfc")
+}
+
+#' Is x a sfg object?
+#' @noRd
+is_sfg <- function(x) {
+  rlang::inherits_any(x, "sfg")
+}

tests/testthat/test-arc_select.R

@@ -63,3 +63,99 @@ test_that("arc_select(): respects `...`", {
     )
   )
 })
+
+test_that("arc_select(): supports multiple filter_geom input types", {
+  nc <- sf::read_sf(system.file("shape/nc.shp", package="sf"))
+
+  furl <- "https://services.arcgis.com/P3ePLMYs2RVChkJx/ArcGIS/rest/services/USA_State_Boundaries/FeatureServer/0"
+
+  flayer <- arc_open(furl)
+
+  # allow bbox input for filter_geom
+  bbox_res <- arc_select(
+    flayer,
+    filter_geom = sf::st_bbox(nc),
+    fields = "STATE_NAME"
+  )
+
+  expect_identical(
+    bbox_res[["STATE_NAME"]],
+    c("Georgia", "Kentucky", "North Carolina", "South Carolina",
+      "Tennessee", "Virginia")
+  )
+
+  # allow sfc input for filter_geom
+  sfc_res <- suppressWarnings(
+    arc_select(
+      flayer,
+      filter_geom = nc$geometry,
+      fields = "STATE_NAME"
+    )
+  )
+
+  expect_identical(
+    sfc_res[["STATE_NAME"]],
+    c("North Carolina", "Virginia")
+  )
+
+  furl <- "https://services.arcgis.com/P3ePLMYs2RVChkJx/ArcGIS/rest/services/USA_Counties/FeatureServer/0"
+
+  flayer <- arc_open(furl)
+
+  # allow sfg input for filter_geom
+  sfg_res <- arc_select(
+    flayer,
+    filter_geom = nc$geometry[1],
+    fields = "STATE_NAME"
+  )
+
+  expect_identical(
+    unique(sfg_res[["STATE_NAME"]]),
+    c("North Carolina", "Tennessee", "Virginia")
+  )
+
+  # allow multiple POINTs as input for filter_geom
+  points_res <- arc_select(
+    flayer,
+    filter_geom = sf::st_sample(nc, size = 10),
+    fields = "STATE_NAME"
+  )
+
+  expect_identical(
+    unique(points_res[["STATE_NAME"]]),
+    "North Carolina"
+  )
+})
+
+test_that("arc_select(): warns for Table layers and provides message for MULTIPOLYGON input", {
+  nc <- sf::read_sf(system.file("shape/nc.shp", package="sf"))
+
+  turl <- "https://services2.arcgis.com/j80Jz20at6Bi0thr/ArcGIS/rest/services/List_of_Providers/FeatureServer/27"
+
+  tlayer <- arc_open(turl)
+
+  # warn on table URLs
+  expect_warning(
+    arc_select(
+      tlayer,
+      filter_geom = nc$geometry
+    )
+  )
+})
+
+
+test_that("arc_select(): errors for invalid filter_geom inputs", {
+  nc <- sf::read_sf(system.file("shape/nc.shp", package="sf"))
+
+  furl <- "https://services.arcgis.com/P3ePLMYs2RVChkJx/ArcGIS/rest/services/USA_Counties/FeatureServer/0"
+
+  flayer <- arc_open(furl)
+
+  # error on sf input
+  expect_error(
+    arc_select(
+      flayer,
+      filter_geom = nc
+    )
+  )
+})