Merge pull request #213 from R-ArcGIS/rasterfn

Add raster function support for `arc_raster()`

NEWS.md

@@ -6,6 +6,9 @@
 
 ## New features
 
+- `arc_raster()` gains an argument `raster_fn` which takes a character scalar and performs a raster function server side before returning results
+- `list_service_raster_fns()` is a new helper function to list available raster functions for an `ImageServer`
+
 ## Breaking changes 
 
 # arcgislayers 0.3.0

R/arc-raster.R

@@ -12,6 +12,8 @@
 #' @param bbox_crs the CRS of the values passed to `xmin`, `xmax`, `ymin`, and `ymax`.
 #'  If not specified, uses the CRS of `x`.
 #' @param format default `"tiff"`. Must be one of "jpgpng", "png", "png8", "png24", "jpg", "bmp", "gif", "tiff", "png32", "bip", "bsq", "lerc".
+#' @param ... additional key value pairs to be passed to [`httr2::req_body_form()`].
+#' @param raster_fn a scalar string with the name of the service raster function. See [`list_service_raster_fns()`] for available raster functions.
 #' @param width default `NULL`. Cannot exceed `x[["maxImageWidth"]]`.
 #' @param height default `NULL`. Cannot exceed `x[["maxImageHeight"]]`.
 #' @param token default `arc_token()` authorization token.
@@ -29,8 +31,8 @@
 #' arc_raster(
 #'   landsat,
 #'   xmin = -71,
-#'   ymin = 43,
 #'   xmax = -67,
+#'   ymin = 43,
 #'   ymax = 47.5,
 #'   bbox_crs = 4326,
 #'   width = 100,
@@ -54,7 +56,22 @@ arc_raster <- function(
     width = NULL,
     height = NULL,
     format = "tiff",
+    ...,
+    raster_fn = NULL,
     token = arc_token()) {
+  check_string(raster_fn, allow_null = TRUE)
+  if (!is.null(raster_fn)) {
+    if (!raster_fn %in% list_service_raster_fns(x)[["name"]]) {
+      cli::cli_abort(
+        c(
+          "{.arg raster_fn} value of {.val {raster_fn}} is not known",
+          i = "Use {.fn list_service_raster_fns} to see available raster functions"
+        )
+      )
+    } else {
+      raster_fn <- jsonify::to_json(list(rasterFunction = raster_fn), unbox = TRUE)
+    }
+  }
   # validate and extract CRS object
   out_sr <- validate_crs(crs)[["spatialReference"]][["wkid"]]
 
@@ -74,6 +91,8 @@ arc_raster <- function(
     format = format,
     size = paste0(c(width, height), collapse = ","),
     outSR = out_sr,
+    ...,
+    renderingRule = raster_fn,
     f = "json"
   )
 

R/arc-select.R

@@ -623,6 +623,12 @@ validate_page_size <- function(
 # Protocol Buffer helpers ------------------------------------------------
 
 supports_pbf <- function(x, arg = rlang::caller_arg(x), call = rlang::caller_call()) {
+  check_inherits_any(
+    x,
+    class = c("FeatureLayer", "Table", "ImageServer"),
+    arg = arg,
+    call = call
+  )
   # verify that x is an layer
   # FIXME: This check makes arc_select error on ImageServer inputs
   check_inherits_any(

R/raster-fns.R

@@ -0,0 +1,19 @@
+#' List Available Raster Funcitons
+#'
+#' This function returns the `rasterFunctionInfos` field of the `ImageServer`'s metadata
+#' as a `data.frame`. If the field does not exist then an error is emitted.
+#'
+#' @inheritParams arcgisutils::infer_esri_type
+#' @param x an `ImageServer`.
+#' @returns a data.frame of the available raster functions.
+#' @examples
+#' # example code
+#'
+list_service_raster_fns <- function(x, arg = rlang::caller_arg(x), call = rlang::caller_call()) {
+  check_inherits_any(x, "ImageServer")
+
+  if (!x$allowRasterFunction) {
+    cli::cli_abort("{.arg arg} does not support raster functions")
+  }
+  data_frame(x$rasterFunctionInfos)
+}

tests/testthat/test-raster-fns.R

@@ -0,0 +1,30 @@
+test_that("use raster functions", {
+  furl <- "https://di-usfsdata.img.arcgis.com/arcgis/rest/services/FIA_BIGMAP_2018_Species_Aboveground_Biomass/ImageServer"
+
+  x <- arc_open(furl)
+  expect_no_error({
+    suppressWarnings({
+      balsams <- arc_raster(
+        x,
+        xmin = -71,
+        xmax = -67,
+        ymin = 43,
+        ymax = 47.5,
+        bbox_crs = 4326,
+        width = 100,
+        height = 100,
+        raster_fn = "SPCD_0012_Abies_balsamea"
+      )
+    })
+  })
+})
+
+test_that("list service raster functions", {
+  furl <- "https://di-usfsdata.img.arcgis.com/arcgis/rest/services/FIA_BIGMAP_2018_Species_Aboveground_Biomass/ImageServer"
+
+  x <- arc_open(furl)
+  raster_fns <- list_service_raster_fns(x)
+  expect_identical(names(raster_fns), names(raster_fns))
+  expect_s3_class(raster_fns, "data.frame")
+  expect_s3_class(raster_fns, "tbl")
+})