Merge pull request #42 from R-ArcGIS/rbind

`rbind_results()` helper function

DESCRIPTION

@@ -33,6 +33,9 @@ Imports:
     utils
 Suggests: 
     arcgisbinding,
+    collapse (>= 2.0.0),
+    data.table,
+    vctrs,
     testthat (>= 3.0.0)
 LinkingTo: 
     Rcpp

NAMESPACE

@@ -55,6 +55,7 @@ export(is_date)
 export(obj_check_token)
 export(parse_esri_json)
 export(ptype_tbl)
+export(rbind_results)
 export(refresh_token)
 export(remote_ptype_tbl)
 export(set_arc_token)

NEWS.md

@@ -1,5 +1,6 @@
 # arcgisutils (development version)
 
+- `rbind_results()` is a new helper function that combines a list of results as efficiently as possible.
 - `arc_base_req()` gains two new arguments `path` and `query` which allows you to add query parameters and paths to the generated base request
 - `arc_self_meta()` is a new function to provide access to the [`/self`](https://developers.arcgis.com/rest/users-groups-and-items/portal-self.htm) endpoint. Closes [#32](https://github.com/R-ArcGIS/arcgisutils/issues/32)
 - Null geometries are parsed into empty Geometry Collections using `sf::st_geometrycollection()` Fixed [#168](https://github.com/R-ArcGIS/arcgislayers/issues/168)

R/arc-token.R

@@ -111,7 +111,7 @@ set_arc_token <- function(token, ...) {
 #' @rdname token
 #' @export
 unset_arc_token <- function(token = NULL) {
-  check_character(token)
+  check_character(token, allow_null = TRUE)
   if (is.null(token)) {
     token <- "ARCGIS_TOKEN"
     rlang::env_unbind(token_env, token)

R/rbind-results.R

@@ -0,0 +1,90 @@
+#' Combine multiple data.frames
+#'
+#' A general function that takes a list of `data.frame`s and returns a single
+#' and combines them into a single object. It will use the fastest method
+#' available. In order this is [`collapse::rowbind()`], [`data.table::rbindlist()`],
+#' [`vctrs::list_unchop()`], then `do.call(rbind.data.frame, x)`.
+#'
+#' If all items in the list are `data.frame`s, then the result will be a `data.frame`.
+#' If all elements are an `sf` object, then the result will be an `sf` object.
+#' If the items are mixed, the result will be a `data.frame`.
+#'
+#' If any items are `NULL`, then an attribute `null_elements` will be attached
+#' to the result. The attribute is an integer vector of the indices that
+#' were `NULL`.
+#'
+#' @param x a list where each element is a `data.frame` or `NULL`.
+#' @param .ptype currently unused. Reserved for a future release.
+#' @export
+#' @returns see details.
+#' @inheritParams parse_esri_json
+#' @examples
+#'
+#' x <- head(iris)
+#' res <- rbind_results(list(x, NULL, x))
+#' attr(res, "null_elements")
+rbind_results <- function(
+    x,
+    call = rlang::current_env(),
+    .ptype = data.frame()
+) {
+
+  # use for loop for side effects
+  # check that each element is a data.frame
+  for (item in x) check_data_frame(
+    item,
+    allow_null = TRUE,
+    call = call,
+    arg = rlang::caller_arg(x)
+  )
+
+  # check if all results are sf, if so, we must return sf
+  return_sf <- all(vapply(x, inherits_or_null, logical(1), class = "sf"))
+
+  # identify which results are missing
+  missing_elements <- vapply(x, is.null, logical(1))
+  are_missing <- which(missing_elements)
+
+  if (all(missing_elements)) {
+    # return empty data.frame() if all missing
+    # FIXME should we take a ptype here? to
+    return(data.frame())
+  }
+
+  if (rlang::is_installed("collapse", version = "2.0.0")) {
+    x <- collapse::rowbind(x)
+  } else if (rlang::is_installed("data.table")) {
+    x <- data.table::rbindlist(x)
+    data.table::setDF(x)
+  } else if (rlang::is_installed("vctrs")) {
+    # vctrs::vec_rbind() doesn't handle NULL
+    x <- vctrs::list_unchop(x, error_call = call)
+  } else {
+    x <- do.call(rbind.data.frame, x)
+  }
+
+  # cast to sf if not already (the case with collapse)
+  if (return_sf && !rlang::inherits_any(x, "sf")) {
+    x <- sf::st_as_sf(x)
+  }
+
+  if (length(are_missing) > 0) {
+    attr(x, "null_elements") <- are_missing
+  }
+
+  x
+}
+
+#' Check if an object is NULL or inherits a class
+#'
+#' Uses [`rlang::inherits_any()`] for the class check.
+#' @keywords internal
+#' @noRd
+inherits_or_null <- function(x, class) {
+  if (is.null(x)) {
+    return(TRUE)
+  } else {
+    rlang::inherits_any(x, class)
+  }
+}
+

R/self.R

@@ -19,7 +19,7 @@
 #' @inheritParams arc_base_req
 #' @export
 #' @examples
-#' \donttest {
+#' \dontrun{
 #' set_arc_token(auth_code())
 #' self <- arc_self_meta()
 #' names(self)

_pkgdown.yml

@@ -17,7 +17,7 @@ reference:
 - title: Authorization
   contents:
   - auth_code
-  - arc_selc_meta
+  - arc_self_meta
 - title: Geometry
   contents:
   - determine_dims
@@ -36,6 +36,7 @@ reference:
 - title: Utilities
   contents:
   - compact
+  - rbind_results
 - title: Requests
   contents:
   - fetch_layer_metadata

tests/testthat/test-rbind-results.R

@@ -0,0 +1,45 @@
+test_that("rbind sf objects", {
+  nc <- sf::st_read(system.file("shape/nc.shp", package = "sf"))
+  x <- list(nc, nc, NULL, nc)
+
+  res <- rbind_results(x)
+
+  # should be an sf object
+  expect_true(inherits(res, "sf"))
+  # should have 1 missing element
+  expect_identical(attr(res, "null_elements"), 3L)
+})
+
+test_that("rbind mixed results", {
+  nc <- sf::st_read(system.file("shape/nc.shp", package = "sf"))
+  items <- list(as.data.frame(nc), nc)
+
+  res <- rbind_results(items)
+  expect_true(rlang::inherits_only(res, "data.frame"))
+})
+
+test_that("rbind data.frames", {
+  res <- rbind_results(list(iris, NULL, iris))
+  expect_true(rlang::inherits_only(res, "data.frame"))
+})
+
+test_that("rbind NULL & list(NULL)", {
+
+  # should return empty df
+  res <- rbind_results(NULL)
+  expect_identical(res, data.frame())
+
+  # one null
+  res <- rbind_results(list(NULL))
+  expect_identical(res, data.frame())
+
+  # multiple
+  res <- rbind_results(list(NULL, NULL))
+  expect_identical(res, data.frame())
+})
+
+test_that("rbind errors on non-df objects", {
+  expect_error(rbind_results(list(iris, NULL, "a")))
+})
+
+