Add arc_read() (#108)

DESCRIPTION

@@ -40,7 +40,8 @@ Suggests:
  dplyr,
  rmarkdown,
  testthat (>= 3.0.0),
- tidyselect
+ tidyselect,
+ vctrs
 Config/testthat/edition: 3
 Remotes: 
  R-ArcGIS/arcgisutils

NAMESPACE

@@ -12,6 +12,7 @@ export(add_features)
 export(add_item)
 export(arc_open)
 export(arc_raster)
+export(arc_read)
 export(arc_select)
 export(clear_query)
 export(create_feature_server)

NEWS.md

@@ -1,5 +1,6 @@
 # arcgislayers 0.1.0 (unreleased)
 
+- Add `arc_read()` with support for `name_repair` argument using `{vctrs}` (#108)
 - Add `get_layer_estimates()` to retrieve estimate info such as the number of features and the extent of the layer
 - Add `truncate_layer()` to support truncate and append workflow
 - Add support for opening `MapServers` <https://github.com/R-ArcGIS/arcgislayers/pull/83>

R/arc-read.R

@@ -0,0 +1,152 @@
+#' Read a ArcGIS FeatureLayer, Table, or ImageServer
+#'
+#' [arc_read()] combines the functionality of [arc_open()] with [arc_select()]
+#' or [arc_raster()] to read an ArcGIS FeatureLayer, Table, or ImageServer to a
+#' `sf` object or object of class `SpatRaster`. Optionally set, check, or modify
+#' names for the returned data frame or sf object using the `col_names` and
+#' `name_repair` parameters.
+#'
+#' @inheritParams arc_open
+#' @param col_names Default `NULL`. If `TRUE`, use the default column names for
+#' the feature. If `col_names` is a character vector with the same length as
+#' the number of columns in the layer, the default names are replaced with the
+#' new names. If the length of `col_names` is one less than the length of the
+#' default column names, the existing sf column name is retained. If
+#' `col_names` is the string `"alias"`, names are set to match the available
+#' alias names for the layer.
+#' @param col_select,fields Default `NULL`. A character vector of the field
+#' names to be returned. By default, all fields are returned. `fields` is
+#' ignored if `col_select` is supplied.
+#' @param n_max Defaults to 10000 or an option set with
+#' `options("arcgislayers.n_max" = <max records>)`. Maximum number of records
+#' to return.
+#' @inheritParams arc_select
+#' @inheritParams arc_raster
+#' @param name_repair Default `"unique"`. See [vctrs::vec_as_names()] for
+#' details. If `name_repair = NULL`, names are set directly.
+#' @param ... Additional arguments passed to [arc_select()] if URL is a
+#' "FeatureLayer" or "Table" or [arc_raster()] if URL is an "ImageLayer".
+#' @examples
+#' if (interactive()) {
+#' url <- "https://sampleserver6.arcgisonline.com/arcgis/rest/services/Census/MapServer/3"
+#'
+#' arc_read(url)
+#'
+#' arc_read(url, name_repair = tolower)
+#'
+#' url <- "https://sampleserver6.arcgisonline.com/arcgis/rest/services/EmergencyFacilities/FeatureServer/0"
+#'
+#' arc_read(url, col_names = "alias")
+#'
+#' img_url <- "https://landsat2.arcgis.com/arcgis/rest/services/Landsat/MS/ImageServer"
+#'
+#' arc_read(
+#' img_url,
+#' width = 1000, height = 1000,
+#' xmin = -71, ymin = 43,
+#' xmax = -67, ymax = 47.5,
+#' bbox_crs = 4326
+#' )
+#' }
+#' @export
+arc_read <- function(
+ url,
+ col_names = TRUE,
+ col_select = NULL,
+ n_max = getOption("arcgislayers.n_max", default = 10000),
+ name_repair = "unique",
+ crs = NULL,
+ ...,
+ fields = NULL,
+ token = Sys.getenv("ARCGIS_TOKEN")
+) {
+ service <- arc_open(url = url, token = token)
+
+ crs <- crs %||% sf::st_crs(service)
+
+ if (!obj_is_layer(service)) {
+ layer <- arc_raster(
+ x = service,
+ ...,
+ crs = crs,
+ token = token
+ )
+
+ return(layer)
+ }
+
+ layer <- arc_select(
+ x = service,
+ fields = col_select %||% fields,
+ crs = crs,
+ n_max = n_max,
+ token = token,
+ ...
+ )
+
+ set_layer_names(
+ layer,
+ col_names = col_names,
+ name_repair = name_repair,
+ alias = service[["fields"]][["alias"]]
+ )
+}
+
+#' Set names for layer or table
+#'
+#' @noRd
+set_layer_names <- function(x,
+ col_names = NULL,
+ name_repair = NULL,
+ alias = NULL,
+ call = rlang::caller_env()) {
+ layer_nm <- names(x)
+
+ # Use existing names by default
+ nm <- layer_nm
+ sf_column_nm <- attr(x, "sf_column")
+
+ if (is.character(col_names)) {
+ # Assign alias values as name if col_names = "alias"
+ if (identical(col_names, "alias")) {
+ col_names <- alias
+ }
+
+ nm <- col_names
+ }
+
+ nm_len <- length(nm)
+
+ if (rlang::is_false(col_names)) {
+ # Use X1, X2, etc. as names if col_names is FALSE
+ nm <- paste0("X", seq(to = nm_len))
+ }
+
+ # If x is a sf object and sf column is not in names, check to ensure names
+ # work with geometry column
+ if (inherits(x, "sf") && sf_column_nm != nm[[nm_len]]) {
+ layer_nm_len <- length(layer_nm)
+ if (length(nm) == layer_nm_len) {
+ # If same number of names as layer columns, use last name for geometry
+ x <- sf::st_set_geometry(x, nm[[length(layer_nm)]])
+ } else if (length(nm) == (layer_nm_len - 1)) {
+ # If same number of names as layer columns, use existing geometry name
+ nm <- c(nm, sf_column_nm)
+ }
+ }
+
+ if (!is.null(name_repair)) {
+ rlang::check_installed("vctrs", call = call)
+ nm <- vctrs::vec_as_names(
+ names = nm,
+ repair = name_repair,
+ repair_arg = "name_repair",
+ call = call
+ )
+ }
+
+ rlang::set_names(
+ x,
+ nm = nm
+ )
+}

R/arc-select.R

@@ -272,6 +272,11 @@ obj_check_layer <- function(x,
  )
 }
 
+#' @noRd
+obj_is_layer <- function(x) {
+ rlang::inherits_any(x, c("FeatureLayer", "Table"))
+}
+
 #' Check if an object inherits from a set of classes
 #'
 #' [check_inherits_any()] wraps [rlang::inherits_any()] to error if an object

tests/testthat/test-arc_read.R

@@ -0,0 +1,51 @@
+test_that("arc_read(): FeatureServer can be read", {
+
+ furl <- "https://services.arcgis.com/P3ePLMYs2RVChkJx/ArcGIS/rest/services/USA_Counties_Generalized_Boundaries/FeatureServer/0"
+
+ layer <- arc_read(furl)
+
+ # if any errors occur above here the test will fail
+ expect_true(TRUE)
+})
+
+
+test_that("arc_read(): ImageServer can be read", {
+
+ img_url <- "https://landsat2.arcgis.com/arcgis/rest/services/Landsat/MS/ImageServer"
+
+ res <- arc_read(
+ img_url,
+ xmin = -71,
+ ymin = 43,
+ xmax = -67,
+ ymax = 47.5,
+ crs = 4326,
+ height = 100,
+ width = 100
+ )
+
+ expect_s4_class(res, "SpatRaster")
+ expect_equal(attr(class(res), "package"), "terra")
+
+})
+
+
+test_that("arc_read(): name_repair works", {
+
+ furl <- "https://services.arcgis.com/P3ePLMYs2RVChkJx/ArcGIS/rest/services/USA_Counties_Generalized_Boundaries/FeatureServer/0"
+
+ col_select <- c("NAME", "FIPS")
+
+ layer <- arc_read(furl, col_select = col_select, name_repair = tolower)
+
+ expect_named(layer, c("name", "fips", "geometry"))
+
+ layer <- arc_read(furl, col_select = col_select, col_names = c("Name", "FIPS Code"))
+
+ expect_named(layer, c("Name", "FIPS Code", "geometry"))
+
+ expect_error(
+ arc_read(furl, col_select = col_select, col_names = c("Name", "Name"), name_repair = "check_unique")
+ )
+
+})