R/domain_lookup.R

In MatthewJWhittle/getarc: An R Wrapper for the ArcGIS Rest API

#' Domain lookup
#'
#' Get the domains for each coded field
#'
#' This function accepts an object generated by \code{get_layer_details} and returns a look up table of the coded domains
#'
#' @param layer_details a list object generated by \code{get_layer_details}
#' @importFrom tibble tibble
#' @importFrom dplyr bind_rows
#' @importFrom purrr map2
#' @importFrom purrr map
#' @importFrom purrr map_lgl
#' @importFrom dplyr mutate
#' @importFrom dplyr across
#' @importFrom dplyr select

#' @return a tibble with three columns: the field name, the descriptive value and the coded value
domain_lookup <-
  function(layer_details){

    layer_fields <-
      layer_details$fields

    # Extract the field names & domains (this will return NULL if the field doesn't have a domain)
    field_names <- purrr::map(layer_fields, "name")
    domains <- purrr::map(layer_fields, "domain")

    # Work out which fields have coded domains
    no_domain <- purrr::map_lgl(domains, is.null)
    # This will fail without the if statement
    # This is because where a field doesn't have a domain it will return an empty logical vector for type == "codedValue"
    coded_domains <- purrr::map_lgl(domains, ~if(is.null(.x$type)){FALSE}else{.x$type == "codedValue"}) & !no_domain

    # If all of the domains are empty then return and empty tibble of the right structure
    if(all(!coded_domains)){
      return(tibble::tibble(field_name = character(0), name = character(0), code = character(0)))
    }

    # Filter the list for just coded domains
    domains <- domains[coded_domains]
    domain_names <- field_names[coded_domains]

    # Extract them into tibbles
    domain_table_list <- purrr::map2(.x = domains,
                                     .y = domain_names,
                                     ~ dplyr::mutate(dplyr::bind_rows(.x$codedValues),
                                                     field_name = .y))
    # Codes can be a character or a integer so need to convert all to caracter first then bind_rows
    domain_table <-
      dplyr::bind_rows(purrr::map(domain_table_list,
                                  ~ dplyr::mutate(.x, dplyr::across(.fns = as.character))))

    dplyr::select(domain_table, .data$field_name, .data$name, .data$code)

  }