diff --git a/NEWS.md b/NEWS.md index 400003d..569f39f 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,13 +1,17 @@ # arcgislayers (development version) -## Breaking changes +## New features -- `dplyr` methods for `collect()`, `select()`, and `filter()` have been removed. +- 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. +## Breaking changes + +- `dplyr` methods for `collect()`, `select()`, and `filter()` have been removed. + # arcgislayers 0.3.1 ## Bug fixes diff --git a/R/arc-select.R b/R/arc-select.R index 640ddee..f279ab2 100644 --- a/R/arc-select.R +++ b/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 diff --git a/R/utils-spatial-filter.R b/R/utils-spatial-filter.R index 260ebdc..fbf251b 100644 --- a/R/utils-spatial-filter.R +++ b/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") +} diff --git a/man/spatial_filter.Rd b/man/spatial_filter.Rd index b133307..8578c2b 100644 --- a/man/spatial_filter.Rd +++ b/man/spatial_filter.Rd @@ -57,9 +57,8 @@ If an \code{sfc} object is provided it will be transformed to the layers spatial reference. If the \code{sfc} is missing a CRS (or is an \code{sfg} object) it is assumed to use the same spatial reference as the FeatureLayer. If the \code{sfc} object has multiple features, the features are unioned with -\code{\link[sf:geos_combine]{sf::st_union()}}. If an \code{sfc} object has \code{MULTIPOLYGON} geometry, the features -are unioned before being cast to \code{POLYGON} geometry with \code{\link[sf:st_cast]{sf::st_cast()}}. All -geometries are checked for validity before conversion. +\code{\link[sf:geos_combine]{sf::st_union()}}. If an \code{sfc} object has \code{MULTIPOLYGON} geometry, the +features are cast to \code{POLYGON} geometry and only the first element is used. } \examples{ prepare_spatial_filter(sf::st_point(c(0, 5)), 4326, "intersects") diff --git a/tests/testthat/test-arc_select.R b/tests/testthat/test-arc_select.R index a84783d..a35371d 100644 --- a/tests/testthat/test-arc_select.R +++ b/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 + ) + ) +})