Add scales + helpers for working w/ drawingInfo from FeatureLayer objects

[elipousson]

I'm interested in seeing a function in {arcgislayers} (or some other package in the growing R-ArcGIS-verse) to support the translation of rendering specification from FeatureLayers to ggplot2 (or other R native mapping syntax). A vice-versa workflow of translating a ggplot2 scale into a rendering specification for a FeatureLayer could also be helpful but the first option is where I'm starting.

Here is a reprex showing how this could work with a discrete scale:

symbol_color_as_hex <- function(x) {
  vapply(
    x,
    function(x) {
      grDevices::rgb(
        x[[1]],
        x[[2]],
        x[[3]],
        maxColorValue = 255
      )
    },
    NA_character_
  )
}

symbol_color <- function(x) {
  colors <- lapply(x[["symbol"]], \(x) {
    x[["color"]]
  })
  
  symbol_color_as_hex(colors)
}


symbol_outline_color <- function(x) {
  colors <- lapply(x[["symbol"]], \(x) {
      x[["outline"]][["color"]]
    })
  
  symbol_color_as_hex(colors)
}

#' Create a discrete scale based on the drawingInfo of an ArcGIS FeatureLayer
#
scale_discrete_arcgis <- function(x,
                                  ...,
                                  field = NULL,
                                  aesthetics = c("fill", "colour"),
                                  breaks = waiver(),
                                  na.value = "grey50",
                                  na.translate = FALSE) {
  rlang::check_installed("ggplot2")

  if (rlang::has_name(x, "drawingInfo")) {
    x <- x[["drawingInfo"]][["renderer"]]
  }

  field <- field %||% c(
    x[["field1"]], x[["field2"]], x[["field3"]]
  )[[1]]

  value_info <- x[["uniqueValueInfos"]]
  value_nm <- value_info[["value"]]
  
  fill_scale <- NULL
  color_scale <- NULL

  if ("fill" %in% aesthetics) {
    fill_values <- rlang::set_names(
      symbol_color(value_info),
      value_nm
    )

    fill_scale <- ggplot2::scale_discrete_manual(
      ...,
      values = fill_values,
      aesthetics = "fill",
      breaks = breaks,
      na.value = na.value,
      na.translate = na.translate
    )
  }

  if (any(c("color", "colour") %in% aesthetics)) {
    color_values <- rlang::set_names(
      symbol_outline_color(value_info),
      value_nm
    )

    color_scale <- ggplot2::scale_discrete_manual(
      ...,
      values = color_values,
      aesthetics = "colour",
      breaks = breaks,
      na.value = na.value,
      na.translate = na.translate
    )
  }

  list(
    fill_scale,
    color_scale
  ) 
}

library(arcgislayers)
library(ggplot2)
library(rlang) # for %||%

url <- "https://geodata.baltimorecity.gov/egis/rest/services/Housing/dmxBoundaries3/MapServer/40"

layer <- arc_open(url = url)

data <- arc_select(layer)

ggplot() +
  geom_sf(
    data = data,
    aes(fill = MVA, color = MVA),
    alpha = 0.8
  ) +
  scale_discrete_arcgis(layer) +
  theme_void()

^{Created on 2023-12-12 with reprex v2.0.2}

Additional examples or specifications on different types of scales and how they may map onto ggplot2 aesthetics would be helpful to better define the scope for this set of features. The handling of scales by the {rdeck} package is one point of inspiration for translation between a ggplot2 style specification and a non-ggplot2 context.

Another inspiration is the community edition of the SLYR QGIS plugin provides a Python library for reading ESRI .style database files and vector .lyr files into QGIS. I'm not certain but it seems likely that the specs for ESRI lyr files may be relevant.

The documentation on drawingInfo and renderer in the Web Map Specification is the other relevant reference.

[elipousson]

Realized belatedly that this issue could be combined with #106 or vice-versa.

[JosiahParry]

I quite like this idea. I have 0 familiarity with creating new scales and geoms with ggplot2 so it would be on you to do!

This example is quite compelling. However, I think this should rather be a geom than a scale. In your example the scale is specific to the field MVA which is derscribed by layer$drawingInfo$renderer$field1 if you rpovide a different field you get an error.

In the case of multiple fields being symbolized how would this work?

Could there be multiple functions? Ones for extracting a scale type for a specific field like yours above? What about a geom_feature_layer() that can be used to visualize the layer with all of its styles?

What about an interface for specifying the drawing info? arcgisutils::as_layer_definition provides it as null. Renderers are documented at https://developers.arcgis.com/documentation/common-data-types/renderer-objects.htm

Drawing info documented at https://developers.arcgis.com/documentation/common-data-types/drawinginfo.htm

[elipousson]

I think you're likely right about this being more appropriate as a geom_ than a scale function alone. Something with a scale="auto" with the option to enable or disable getting the scale from the layer renderer vs. providing it yourself. I'll look for a few examples among any ggplot2 extension packages with similar goals for guidance on the appropriate interface.

Since this feature relies on accessing both the layer metadata and the data itself, could there be some way of getting both of those in a single object? Maybe it could be an option for arc_read() where the metadata is stashed as an additional attribute of the sf data frame? Or an option for arc_open() where the data is also included in the output? Neither option is ideal but it feels a little cumbersome to pass both the data and metadata separately to get this feature working.

I'll open a separate issue for arcgisutils for reading and writing "renderer" objects. Any color handling utility functions could also be added there.

This isn't a super high priority for me (and based on your roadmap, I expect it isn't at the top of your list either) so I'll you can likely expect slow and intermittent progress on this one.

[JosiahParry]

Neither option is ideal but it feels a little cumbersome to pass both the data and metadata separately to get this feature working.

I definitely think providing both the connection object and the data used for it is the best approach and the least complicated. This is required for add_features() and update_features(). It is also similar to providing anthe connection as the first argument and another object as a section similar to get_layers() and arc_select(). We can check to see that the field names and types between the sf object and the symbology of the FeatureLayer are the same which is what is done in add_features() and update_features()

[elipousson]

I ran across a more complex renderer and worked up a more involved example with some helper functions.

library(tidyverse)
library(arcgislayers)

list_unique_value_symbols <- function(renderer, as_data_frame = TRUE) {
  unique_value_info <- list_unique_value_info(renderer)
  unique_value_info |> 
    pull(symbol) |> 
    purrr::map(
      \(x) {
        tibble::tibble(
          type = x[["type"]],
          style = x[["style"]],
          # FIXME: Missing outline color handling
          color = list(x[["color"]]),
          hex = symbol_color_as_hex(list(x[["color"]])),
          width = x[["width"]]
        )
      }
    ) |> 
    list_rbind()
}

symbol_color_as_hex <- function(x) {
  vapply(
    x,
    function(x) {
      grDevices::rgb(
        x[[1]],
        x[[2]],
        x[[3]],
        maxColorValue = x[[4]]
      )
    },
    NA_character_
  )
}

symbol_color <- function(x) {
  colors <- lapply(x[["symbol"]], \(x) {
    x[["color"]]
  })
  
  symbol_color_as_hex(colors)
}

symbol_outline_color <- function(x) {
  colors <- lapply(x[["symbol"]], \(x) {
    x[["outline"]][["color"]]
  })
  
  symbol_color_as_hex(colors)
}

pull_layer_renderer <- function(layer) {
  layer[["drawingInfo"]][["renderer"]]
}

list_renderer_fields <- function(renderer) {
  renderer_fields <- vctrs::list_drop_empty(
    renderer[c("field1", "field2", "field3")]
  )
  
  as.character(renderer_fields)
}

list_unique_value_info <- function(renderer,
                                   too_few = "align_start") {
  stopifnot(
    renderer[["type"]] == "uniqueValue"
  )
  
  value_info <- renderer[["uniqueValueInfos"]]
  
  value_info |> 
    tidyr::separate_wider_delim(
      cols = value,
      names = list_renderer_fields(renderer),
      delim = ",",
      too_few = too_few
    )
}

url <- "https://hydro.nationalmap.gov/arcgis/rest/services/nhd/MapServer/6"

layer <- arc_open(url)

renderer <- layer |> 
  pull_layer_renderer()

unique_values <- list_cbind(
  list(
    list_unique_value_info(renderer),
    list_unique_value_symbols(renderer)
  )
) |> 
  # TODO: Figure out how to match variable type 
  mutate(
    fcode = as.integer(FCODE),
    ftype = as.integer(FTYPE)
  )
  

nc <- sf::read_sf(system.file("shape/nc.shp", package="sf"))

county <- nc[5, ]

data <- arc_select(layer, filter_geom = sf::st_bbox(county))
#> Iterating ■■■■■■■■■                         25% | ETA:  6s
#> Iterating ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■  100% | ETA:  0s

data <- data |> 
  left_join(
    unique_values
  )
#> Joining with `by = join_by(ftype, fcode)`

ggplot() +
  geom_sf(
    data = county,
    fill = NA,
    color = "black",
    linewidth = 0.75
  ) +
  geom_sf(
    data = data,
    aes(color = hex)
  ) +
  scale_color_identity()

^{Created on 2024-04-22 with reprex v2.1.0}