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

@@ -86,17 +86,6 @@ arc_select <- function(
   check_string(where, allow_null = TRUE, allow_empty = FALSE)
   check_character(fields, allow_null = TRUE)
 
-
-  check_number_whole(as.integer(page_size), min = 1, allow_null = TRUE)
-  check_number_whole(
-    as.integer(page_size),
-    # bug in the standalone checks
-    # needs to be a double and cannot be used with
-    # max at the same time which is why it is brought into two calls
-    max = as.double(x[["maxRecordCount"]]),
-    allow_null = TRUE
-  )
-
   # extract the query object
   query <- attr(x, "query")
 
@@ -216,7 +205,7 @@ collect_layer <- function(
   # get existing parameters
 
   # determine_format() chooses between pbf and json
-  out_f <- determine_format(x)
+  out_f <- determine_format(x, call = error_call)
 
   query_params <- validate_params(
     query,
@@ -600,35 +589,24 @@ validate_page_size <- function(
     page_size = NULL,
     max_records = NULL,
     error_call = rlang::caller_env()) {
-  # if page_size is null, use max records (default)
-  page_size <- page_size %||% max_records
-
-  # coerce to integer
-  page_size <- as.integer(page_size)
-
-  if (!is.numeric(page_size) && !length(page_size) == 0) {
-    cli::cli_abort(
-      "{.arg page_size} must be a numeric scalar,
-      not {.obj_type_friendly {page_size}}",
-      call = error_call
-    )
+  if (is.numeric(page_size)) {
+    # coerce to integer if page_size is numeric
+    page_size <- as.integer(page_size)
   }
 
-  page_size_len <- length(page_size)
-
-  if (!rlang::has_length(page_size, 1)) {
-    cli::cli_abort(
-      "{.arg page_size} must be length 1, not {page_size_len}",
-      call = error_call
-    )
-  }
+  check_number_whole(page_size, min = 1, allow_null = TRUE, call = error_call)
+  check_number_whole(
+    page_size,
+    # bug in the standalone checks
+    # needs to be a double and cannot be used with
+    # max at the same time which is why it is brought into two calls
+    max = as.double(max_records),
+    allow_null = TRUE,
+    call = error_call
+  )
 
-  if (page_size < 1) {
-    cli::cli_abort(
-      "{.arg page_size} must be a positive integer.",
-      call = error_call
-    )
-  }
+  # if page_size is null, use max records (default)
+  page_size <- page_size %||% max_records
 
   if (is.numeric(max_records) && (page_size > max_records)) {
     cli::cli_abort(
@@ -645,8 +623,20 @@ 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
-  obj_check_layer(x, arg, call)
+  # FIXME: This check makes arc_select error on ImageServer inputs
+  check_inherits_any(
+    x,
+    class = c("FeatureLayer", "Table", "ImageServer"),
+    arg = arg,
+    call = call
+  )
 
   # extract supported query formats
   query_formats_raw <- x[["supportedQueryFormats"]]

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")
+})