From 8a6af51bd5a87d7ed2d9854c093a6ab3673020e7 Mon Sep 17 00:00:00 2001 From: Eli Pousson Date: Thu, 21 Nov 2024 00:20:58 -0500 Subject: [PATCH 01/13] Add `list_field_domains()` and `pull_coded_values()` --- R/utils.R | 38 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 38 insertions(+) diff --git a/R/utils.R b/R/utils.R index 28c22e0..14c9ab6 100644 --- a/R/utils.R +++ b/R/utils.R @@ -263,3 +263,41 @@ parse_url_query <- function(url, keep_default = FALSE) { url_elements[["query"]] } +#' @noRd +list_field_domains <- function(x, field = NULL, keep_null = FALSE) { + fields <- list_fields(x) + nm <- fields[["name"]] + + domains <- rlang::set_names(fields[["domain"]], nm) + + if (!is.null(field)) { + field <- rlang::arg_match(nm, multiple = TRUE) + domains <- domains[nm %in% field] + } + + if (keep_null) { + return(domains) + } + + domains[!vapply(domains, is.null, logical(1))] +} + +#' @noRd +pull_coded_values <- function(x, field = NULL) { + domains <- list_field_domains(x, field = field, keep_null = FALSE) + + domains <- lapply( + domains, + \(x) { + if (x[["type"]] != "codedValue") { + return(NULL) + } + + values <- x[["codedValues"]] + + rlang::set_names(values[["code"]], values[["name"]]) + } + ) + + domains +} From 75d0ce91cf7cc84e5bcc222f20a5f0c9f9bd7fb1 Mon Sep 17 00:00:00 2001 From: Eli Pousson Date: Thu, 21 Nov 2024 00:59:38 -0500 Subject: [PATCH 02/13] Correct order of coded values --- R/utils.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/utils.R b/R/utils.R index 14c9ab6..a999c3c 100644 --- a/R/utils.R +++ b/R/utils.R @@ -295,7 +295,7 @@ pull_coded_values <- function(x, field = NULL) { values <- x[["codedValues"]] - rlang::set_names(values[["code"]], values[["name"]]) + rlang::set_names(values[["name"]], values[["code"]]) } ) From 80e0bf446f5db50b36a79f7e07fc5b800a6cef23 Mon Sep 17 00:00:00 2001 From: Eli Pousson Date: Thu, 21 Nov 2024 01:02:13 -0500 Subject: [PATCH 03/13] Export set_layer_col_names Also swap argument names layer -> .data and x -> .layer Also fix arc_read example to avoid deprecated use of col_names = "alias" --- NAMESPACE | 1 + R/arc-read.R | 82 +++++++++++++++++++++----------------- man/arc_read.Rd | 2 +- man/set_layer_col_names.Rd | 53 ++++++++++++++++++++++++ 4 files changed, 101 insertions(+), 37 deletions(-) create mode 100644 man/set_layer_col_names.Rd diff --git a/NAMESPACE b/NAMESPACE index dbb8d5e..fc5e4ae 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -39,6 +39,7 @@ export(publish_layer) export(pull_field_aliases) export(query_layer_attachments) export(refresh_layer) +export(set_layer_col_names) export(truncate_layer) export(update_features) export(update_params) diff --git a/R/arc-read.R b/R/arc-read.R index 0cdd7c2..236694f 100644 --- a/R/arc-read.R +++ b/R/arc-read.R @@ -13,34 +13,17 @@ #' `r lifecycle::badge("experimental")` #' #' @inheritParams arc_open -#' @param col_names Default `TRUE`. Column names or name handling rule. -#' `col_names` can be `TRUE`, `FALSE`, `NULL`, or a character vector: -#' -#' - If `TRUE`, use existing default column names for the layer or table. -#' If `FALSE` or `NULL`, column names will be generated automatically: X1, X2, -#' X3 etc. -#' - If `col_names` is a character vector, values replace the existing column -#' names. `col_names` can't be length 0 or longer than the number of fields in -#' the returned layer. #' @param col_select Default `NULL`. A character vector of the field names to be #' returned. By default, all fields are returned. #' @param n_max Defaults to `Inf` or an option set with #' `options("arcgislayers.n_max" = )`. Maximum number of records #' to return. -#' @param alias Use of field alias values. Default `c("drop", "label", -#' "replace"),`. There are three options: -#' -#' - `"drop"`, field alias values are ignored. -#' - `"label"`: field alias values are assigned as a label attribute for each field. -#' - `"replace"`: field alias values replace existing column names. `col_names` -#' must `TRUE` for this option to be applied. +#' @inheritParams set_layer_col_names #' @param fields Default `NULL`. a character vector of the field names to #' returned. By default all fields are returned. Ignored if `col_names` is #' supplied. #' @inheritParams arc_select #' @inheritParams arc_raster -#' @param name_repair Default `"unique"`. See [vctrs::vec_as_names()] for -#' details. If `name_repair = NULL`, names are set directly. #' @param ... Additional arguments passed to [arc_select()] if URL is a #' `FeatureLayer` or `Table` or [arc_raster()] if URL is an `ImageLayer`. #' @returns An sf object, a `data.frame`, or an object of class `SpatRaster`. @@ -62,7 +45,7 @@ #' ) #' #' # use field aliases as column names -#' arc_read(furl, col_names = "alias") +#' arc_read(furl, alias = "replace") #' #' # read an ImageServer directly #' img_url <- "https://landsat2.arcgis.com/arcgis/rest/services/Landsat/MS/ImageServer" @@ -130,22 +113,49 @@ arc_read <- function( ) set_layer_col_names( - layer, + .data = layer, + .layer = x, col_names = col_names, name_repair = name_repair, - alias = alias, - x = x + alias = alias ) } -#' Set names for layer or table -#' @noRd +#' Set and repair column names for FeatureLayer or Table data frame +#' +#' [set_layer_col_names()] can replace or label column names based on the the +#' field aliases from a corresponding `Table` or `FeatureLayer` object created +#' with `arc_open()`. Optionally repair names using [vctrs::vec_as_names()]. +#' +#' @param .data A data frame returned by `arc_select() `or `arc_read()`. +#' @param .layer A Table or FeatureLayer object. Required if `alias` is `"label"` or +#' `"replace"`. +#' @param col_names Default `TRUE`. Column names or name handling rule. +#' `col_names` can be `TRUE`, `FALSE`, `NULL`, or a character vector: +#' +#' - If `TRUE`, use existing default column names for the layer or table. +#' If `FALSE` or `NULL`, column names will be generated automatically: X1, X2, +#' X3 etc. +#' - If `col_names` is a character vector, values replace the existing column +#' names. `col_names` can't be length 0 or longer than the number of fields in +#' the returned layer. +#' @param alias Use of field alias values. Default `c("drop", "label", +#' "replace"),`. There are three options: +#' +#' - `"drop"`, field alias values are ignored. +#' - `"label"`: field alias values are assigned as a label attribute for each field. +#' - `"replace"`: field alias values replace existing column names. `col_names` +#' must `TRUE` for this option to be applied. +#' @param name_repair Default `"unique"`. See [vctrs::vec_as_names()] for +#' details. If `name_repair = NULL`, names are set directly. +#' @inheritParams rlang::args_error_context +#' @export set_layer_col_names <- function( - layer, + .data, + .layer = NULL, col_names = TRUE, name_repair = NULL, alias = c("drop", "label", "replace"), - x = NULL, call = rlang::caller_env()) { # check col_names input if (!is.null(col_names) && !rlang::is_logical(col_names) && !is.character(col_names)) { @@ -159,19 +169,19 @@ set_layer_col_names <- function( # skip col_names and alias handling if possible if (rlang::is_true(col_names) && alias == "drop") { - return(repair_layer_names(layer, name_repair = name_repair, call = call)) + return(repair_layer_names(.data, name_repair = name_repair, call = call)) } - existing_nm <- names(layer) - n_col <- ncol(layer) - sf_column <- attr(layer, "sf_column") + existing_nm <- names(.data) + n_col <- ncol(.data) + sf_column <- attr(.data, "sf_column") # Use existing names by default replace_nm <- existing_nm if (alias != "drop" || identical(col_names, "alias")) { # get alias values and drop names - alias_val <- pull_field_aliases(x)[setdiff(existing_nm, sf_column)] + alias_val <- pull_field_aliases(.layer)[setdiff(existing_nm, sf_column)] alias_val <- as.character(alias_val) if (alias == "replace") { @@ -216,20 +226,20 @@ set_layer_col_names <- function( replace_nm <- c(replace_nm, paste0("X", seq(replace_nm_len + 1, n_col))) # But keep the default sf column name - if (inherits(layer, "sf")) { + if (inherits(.data, "sf")) { replace_nm[[n_col]] <- sf_column } } - layer <- repair_layer_names( - layer, + .data <- repair_layer_names( + .data, names = replace_nm, name_repair = name_repair, call = call ) if (alias != "label") { - return(layer) + return(.data) } # Name alias values with layer names @@ -238,7 +248,7 @@ set_layer_col_names <- function( nm = setdiff(replace_nm, sf_column) ) - label_layer_fields(layer, values = alias_val) + label_layer_fields(.data, values = alias_val) } #' Repair layer names using `vctrs::vec_as_names` and `rlang::set_names` diff --git a/man/arc_read.Rd b/man/arc_read.Rd index 48bde5c..fd3dd3b 100644 --- a/man/arc_read.Rd +++ b/man/arc_read.Rd @@ -96,7 +96,7 @@ data in the \code{{readr}} package. ) # use field aliases as column names - arc_read(furl, col_names = "alias") + arc_read(furl, alias = "replace") # read an ImageServer directly img_url <- "https://landsat2.arcgis.com/arcgis/rest/services/Landsat/MS/ImageServer" diff --git a/man/set_layer_col_names.Rd b/man/set_layer_col_names.Rd new file mode 100644 index 0000000..72d52b9 --- /dev/null +++ b/man/set_layer_col_names.Rd @@ -0,0 +1,53 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/arc-read.R +\name{set_layer_col_names} +\alias{set_layer_col_names} +\title{Set and repair column names for FeatureLayer or Table data frame} +\usage{ +set_layer_col_names( + .data, + .layer = NULL, + col_names = TRUE, + name_repair = NULL, + alias = c("drop", "label", "replace"), + call = rlang::caller_env() +) +} +\arguments{ +\item{.data}{A data frame returned by \code{arc_select() }or \code{arc_read()}.} + +\item{.layer}{A Table or FeatureLayer object. Required if \code{alias} is \code{"label"} or +\code{"replace"}.} + +\item{col_names}{Default \code{TRUE}. Column names or name handling rule. +\code{col_names} can be \code{TRUE}, \code{FALSE}, \code{NULL}, or a character vector: +\itemize{ +\item If \code{TRUE}, use existing default column names for the layer or table. +If \code{FALSE} or \code{NULL}, column names will be generated automatically: X1, X2, +X3 etc. +\item If \code{col_names} is a character vector, values replace the existing column +names. \code{col_names} can't be length 0 or longer than the number of fields in +the returned layer. +}} + +\item{name_repair}{Default \code{"unique"}. See \code{\link[vctrs:vec_as_names]{vctrs::vec_as_names()}} for +details. If \code{name_repair = NULL}, names are set directly.} + +\item{alias}{Use of field alias values. Default \verb{c("drop", "label", "replace"),}. There are three options: +\itemize{ +\item \code{"drop"}, field alias values are ignored. +\item \code{"label"}: field alias values are assigned as a label attribute for each field. +\item \code{"replace"}: field alias values replace existing column names. \code{col_names} +must \code{TRUE} for this option to be applied. +}} + +\item{call}{The execution environment of a currently +running function, e.g. \code{caller_env()}. The function will be +mentioned in error messages as the source of the error. See the +\code{call} argument of \code{\link[rlang:abort]{abort()}} for more information.} +} +\description{ +\code{\link[=set_layer_col_names]{set_layer_col_names()}} can replace or label column names based on the the +field aliases from a corresponding \code{Table} or \code{FeatureLayer} object created +with \code{arc_open()}. Optionally repair names using \code{\link[vctrs:vec_as_names]{vctrs::vec_as_names()}}. +} From 6f82bdeb86f4dc9f79c6e30bb72b391b246759ef Mon Sep 17 00:00:00 2001 From: Eli Pousson Date: Thu, 21 Nov 2024 01:03:38 -0500 Subject: [PATCH 04/13] Add `set_layer_coded_values()` --- NAMESPACE | 1 + R/arc-read.R | 85 +++++++++++++++++++++++++++++++++++ man/set_layer_coded_values.Rd | 39 ++++++++++++++++ 3 files changed, 125 insertions(+) create mode 100644 man/set_layer_coded_values.Rd diff --git a/NAMESPACE b/NAMESPACE index fc5e4ae..c2689a2 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -39,6 +39,7 @@ export(publish_layer) export(pull_field_aliases) export(query_layer_attachments) export(refresh_layer) +export(set_layer_coded_values) export(set_layer_col_names) export(truncate_layer) export(update_features) diff --git a/R/arc-read.R b/R/arc-read.R index 236694f..3dc33a6 100644 --- a/R/arc-read.R +++ b/R/arc-read.R @@ -296,3 +296,88 @@ label_layer_fields <- function( attr(x, "label") <- value x } + + +#' Set coded values for FeatureLayer or Table data frame +#' +#' [set_layer_coded_values()] can replace column values based on `codedValue` +#' type field domains from a corresponding `Table` or `FeatureLayer` object +#' created with `arc_open()`. +#' +#' @param .data A data frame returned by `arc_select()` or `arc_read()`. +#' @param .layer A Table or FeatureLayer object. Required. +#' @param field Default `NULL`. Field or fields to replace. Fields that are do +#' not have coded values domains are ignored. +#' @param codes Use of field alias values. Default `c("replace"),`. +#' There are two options: +#' +#' - `"replace"`: coded values replace existing column values. +#' - `"label"`: coded values are applied as value labels. +#' @inheritParams rlang::args_error_context +#' @export +set_layer_coded_values <- function( + .data, + .layer, + field = NULL, + codes = c("replace", "label"), + call = rlang::caller_env()) { + values <- pull_coded_values(.layer, field = field) + + # Check if coded values is an empty list + if (rlang::is_empty(values)) { + if (is.null(field)) { + cli::cli_warn( + "{.arg layer} does not contain any coded values." + ) + } else { + cli::cli_warn( + "{.arg field} does not specific any coded value fields." + ) + } + + return(.data) + } + + codes <- rlang::arg_match(codes, error_call = call) + + if (codes == "replace") { + # Replace column values by default + for (col in names(values)) { + .data[[col]] <- values[[col]][.data[[col]]] + } + } else { + # Label column values using new_labelled_col helper + for (col in names(values)) { + .data[[col]] <- new_labelled_col( + .data[[col]], + labels = rlang::set_names( + names(values[[col]]), + values[[col]] + ), + call = call + ) + } + } + + .data +} + +#' Set value labels compatible w/ `haven::labelled` package +#' @noRd +new_labelled_col <- function(x, + labels = NULL, + label = NULL, + ..., + class = character(), + call = rlang::caller_env()) { + rlang::check_installed("vctrs", call = call) + + vctrs::new_vctr( + x, + labels = rlang::set_names(labels, names(labels)), + label = label, + ..., + class = c(class, "haven_labelled"), + inherit_base_type = TRUE + ) +} diff --git a/man/set_layer_coded_values.Rd b/man/set_layer_coded_values.Rd new file mode 100644 index 0000000..f2dcd76 --- /dev/null +++ b/man/set_layer_coded_values.Rd @@ -0,0 +1,39 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/arc-read.R +\name{set_layer_coded_values} +\alias{set_layer_coded_values} +\title{Set coded values for FeatureLayer or Table data frame} +\usage{ +set_layer_coded_values( + .data, + .layer, + field = NULL, + codes = c("replace", "label"), + call = rlang::caller_env() +) +} +\arguments{ +\item{.data}{A data frame returned by \code{arc_select()} or \code{arc_read()}.} + +\item{.layer}{A Table or FeatureLayer object. Required.} + +\item{field}{Default \code{NULL}. Field or fields to replace. Fields that are do +not have coded values domains are ignored.} + +\item{codes}{Use of field alias values. Default \verb{c("replace"),}. +There are two options: +\itemize{ +\item \code{"replace"}: coded values replace existing column values. +\item \code{"label"}: coded values are applied as value labels. +}} + +\item{call}{The execution environment of a currently +running function, e.g. \code{caller_env()}. The function will be +mentioned in error messages as the source of the error. See the +\code{call} argument of \code{\link[rlang:abort]{abort()}} for more information.} +} +\description{ +\code{\link[=set_layer_coded_values]{set_layer_coded_values()}} can replace column values based on \code{codedValue} +type field domains from a corresponding \code{Table} or \code{FeatureLayer} object +created with \code{arc_open()}. +} From 06584eee0f98123bc4b045ee2137f1d585fa22c9 Mon Sep 17 00:00:00 2001 From: Eli Pousson Date: Thu, 21 Nov 2024 01:06:51 -0500 Subject: [PATCH 05/13] Update NEWS --- NEWS.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/NEWS.md b/NEWS.md index b5519b9..8494a48 100644 --- a/NEWS.md +++ b/NEWS.md @@ -4,6 +4,8 @@ ## New features - Improve handling of `filter_geom` by `arc_select()` by warning if applying `sf::st_union()` to the filter does not generate a length 1 sfc, or if `filter_geom` is supplied when accessing a Table, or if `filter_geom` is empty (@elipousson, #166) +- Export `set_layer_col_names()` (previously used internally by `arc_read()`) to allow use of alias values with data returned by `arc_select()` (#169). +- Add new `set_layer_coded_values()` function to support replacement or labelling of values with coded value domains (#134). ## Bug fixes From 3954804bf7b9aff470a17a3b57469c2bca975798 Mon Sep 17 00:00:00 2001 From: Eli Pousson Date: Thu, 21 Nov 2024 10:46:44 -0500 Subject: [PATCH 06/13] Update pkgdown index --- _pkgdown.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/_pkgdown.yml b/_pkgdown.yml index e73dfa9..f0c573c 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -45,4 +45,4 @@ reference: - prepare_spatial_filter - match_spatial_rel - update_params - \ No newline at end of file + - starts_with("set_layer") From 28820cde28c73144bd9927183b91192e755fed27 Mon Sep 17 00:00:00 2001 From: Eli Pousson Date: Thu, 21 Nov 2024 15:09:33 -0500 Subject: [PATCH 07/13] Update codes parameter definition Co-authored-by: Josiah Parry --- R/arc-read.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/arc-read.R b/R/arc-read.R index 3dc33a6..df98668 100644 --- a/R/arc-read.R +++ b/R/arc-read.R @@ -312,7 +312,7 @@ label_layer_fields <- function( #' There are two options: #' #' - `"replace"`: coded values replace existing column values. -#' - `"label"`: coded values are applied as value labels. +#' - `"label"`: coded values are applied as value labels via a `"label"` attribute. #' @inheritParams rlang::args_error_context #' @export set_layer_coded_values <- function( From 46ed94f6057bf2573c2004338ae37fbf90231304 Mon Sep 17 00:00:00 2001 From: Eli Pousson Date: Thu, 21 Nov 2024 16:09:45 -0500 Subject: [PATCH 08/13] Address feedback on PR - Move col_names handling to dedicated helper set_col_names - Rename set_layer_col_names to set_layer_aliases (remove option to drop aliases) - Rename set_layer_coded_values to encode_field_values - Add call and arg parameters to list_field_domains and pull_coded_values --- NAMESPACE | 4 +- R/arc-read.R | 255 +++++++++--------- R/utils.R | 29 +- man/arc_read.Rd | 4 +- ...coded_values.Rd => encode_field_values.Rd} | 16 +- man/set_layer_aliases.Rd | 40 +++ man/set_layer_col_names.Rd | 53 ---- 7 files changed, 203 insertions(+), 198 deletions(-) rename man/{set_layer_coded_values.Rd => encode_field_values.Rd} (69%) create mode 100644 man/set_layer_aliases.Rd delete mode 100644 man/set_layer_col_names.Rd diff --git a/NAMESPACE b/NAMESPACE index c2689a2..57d59c9 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -25,6 +25,7 @@ export(clear_query) export(create_feature_server) export(delete_features) export(download_attachments) +export(encode_field_values) export(get_all_layers) export(get_layer) export(get_layer_estimates) @@ -39,8 +40,7 @@ export(publish_layer) export(pull_field_aliases) export(query_layer_attachments) export(refresh_layer) -export(set_layer_coded_values) -export(set_layer_col_names) +export(set_layer_aliases) export(truncate_layer) export(update_features) export(update_params) diff --git a/R/arc-read.R b/R/arc-read.R index df98668..1a875a9 100644 --- a/R/arc-read.R +++ b/R/arc-read.R @@ -18,7 +18,22 @@ #' @param n_max Defaults to `Inf` or an option set with #' `options("arcgislayers.n_max" = )`. Maximum number of records #' to return. -#' @inheritParams set_layer_col_names +#' @param col_names Default `TRUE`. Column names or name handling rule. +#' `col_names` can be `TRUE`, `FALSE`, `NULL`, or a character vector: +#' +#' - If `TRUE`, use existing default column names for the layer or table. +#' If `FALSE` or `NULL`, column names will be generated automatically: X1, X2, +#' X3 etc. +#' - If `col_names` is a character vector, values replace the existing column +#' names. `col_names` can't be length 0 or longer than the number of fields in +#' the returned layer. +#' @param alias Use of field alias values. Default `c("drop", "label", +#' "replace"),`. There are three options: +#' +#' - `"drop"`, field alias values are ignored. +#' - `"label"`: field alias values are assigned as a label attribute for each field. +#' - `"replace"`: field alias values replace existing column names. `col_names` +#' @inheritParams set_layer_aliases #' @param fields Default `NULL`. a character vector of the field names to #' returned. By default all fields are returned. Ignored if `col_names` is #' supplied. @@ -112,85 +127,53 @@ arc_read <- function( ... ) - set_layer_col_names( - .data = layer, - .layer = x, - col_names = col_names, - name_repair = name_repair, - alias = alias - ) -} - -#' Set and repair column names for FeatureLayer or Table data frame -#' -#' [set_layer_col_names()] can replace or label column names based on the the -#' field aliases from a corresponding `Table` or `FeatureLayer` object created -#' with `arc_open()`. Optionally repair names using [vctrs::vec_as_names()]. -#' -#' @param .data A data frame returned by `arc_select() `or `arc_read()`. -#' @param .layer A Table or FeatureLayer object. Required if `alias` is `"label"` or -#' `"replace"`. -#' @param col_names Default `TRUE`. Column names or name handling rule. -#' `col_names` can be `TRUE`, `FALSE`, `NULL`, or a character vector: -#' -#' - If `TRUE`, use existing default column names for the layer or table. -#' If `FALSE` or `NULL`, column names will be generated automatically: X1, X2, -#' X3 etc. -#' - If `col_names` is a character vector, values replace the existing column -#' names. `col_names` can't be length 0 or longer than the number of fields in -#' the returned layer. -#' @param alias Use of field alias values. Default `c("drop", "label", -#' "replace"),`. There are three options: -#' -#' - `"drop"`, field alias values are ignored. -#' - `"label"`: field alias values are assigned as a label attribute for each field. -#' - `"replace"`: field alias values replace existing column names. `col_names` -#' must `TRUE` for this option to be applied. -#' @param name_repair Default `"unique"`. See [vctrs::vec_as_names()] for -#' details. If `name_repair = NULL`, names are set directly. -#' @inheritParams rlang::args_error_context -#' @export -set_layer_col_names <- function( - .data, - .layer = NULL, - col_names = TRUE, - name_repair = NULL, - alias = c("drop", "label", "replace"), - call = rlang::caller_env()) { # check col_names input if (!is.null(col_names) && !rlang::is_logical(col_names) && !is.character(col_names)) { - cli::cli_abort( - "{.arg col_names} must be `TRUE`, `FALSE`, `NULL`, or a character vector.", - call = call - ) + cli::cli_abort("{.arg col_names} must be `TRUE`, `FALSE`, `NULL`, or a character vector.") } - alias <- rlang::arg_match(alias, error_call = call) - - # skip col_names and alias handling if possible - if (rlang::is_true(col_names) && alias == "drop") { - return(repair_layer_names(.data, name_repair = name_repair, call = call)) + if (identical(col_names, "alias")) { + # Set alias to "replace" as name if col_names = "alias" + alias <- "replace" + lifecycle::deprecate_soft( + "deprecated", + what = "arc_read(col_names = \"can't be alias\")", + with = "arc_read(alias = \"replace\")", + ) } - existing_nm <- names(.data) - n_col <- ncol(.data) - sf_column <- attr(.data, "sf_column") + if (identical(alias, "drop") || is.character(col_names) || isFALSE(col_names)) { + layer <- set_col_names( + .data = layer, + col_names = col_names, + name_repair = name_repair + ) - # Use existing names by default - replace_nm <- existing_nm + return(layer) + } - if (alias != "drop" || identical(col_names, "alias")) { - # get alias values and drop names - alias_val <- pull_field_aliases(.layer)[setdiff(existing_nm, sf_column)] - alias_val <- as.character(alias_val) + set_layer_aliases( + .data = layer, + .layer = x, + name_repair = name_repair, + alias = alias + ) +} - if (alias == "replace") { - # NOTE: alias values may not be valid names - replace_nm <- alias_val - } - } +#' Handle col_names +#' @noRd +set_col_names <- function(.data, + col_names = TRUE, + name_repair = NULL, + call = rlang::caller_env() +) { + n_col <- ncol(.data) + nm <- names(.data) - if (is.character(col_names)) { + if (rlang::is_false(col_names)) { + # Use X1, X2, etc. as names if col_names is FALSE + nm <- paste0("X", seq(n_col)) + } else if (is.character(col_names)) { col_names_len <- length(col_names) # Check col_names length @@ -199,55 +182,73 @@ set_layer_col_names <- function( "{.arg col_names} must be length {n_col}{? or shorter}, not {col_names_len}.", call = call ) + } else if ((col_names_len + 1) < n_col) { + # fill missing field names using pattern, X1, X2, etc. + col_names <- c(col_names, paste0("X", seq(length(col_names) + 1, n_col))) } - if (identical(col_names, "alias")) { - # Assign alias values as name if col_names = "alias" - col_names <- alias_val - lifecycle::signal_stage( - "superseded", - what = "arc_read(col_names = \"can't be alias\")", - with = "arc_read(alias = \"replace\")", - ) + # But always keep the default sf column name + if (inherits(.data, "sf")) { + col_names[[n_col]] <- attr(.data, "sf_column") } - replace_nm <- col_names + nm <- col_names } - if (rlang::is_false(col_names) || is.null(col_names)) { - # Use X1, X2, etc. as names if col_names is FALSE - replace_nm <- paste0("X", seq_along(existing_nm)) - } + repair_layer_names(.data, names = nm, name_repair = name_repair, call = call) +} - replace_nm_len <- length(replace_nm) +#' Set column labels or names based FeatureLayer or Table data frame field aliases +#' +#' [set_layer_aliases()] can replace or label column names based on the the +#' field aliases from a corresponding `Table` or `FeatureLayer` object created +#' with `arc_open()`. Optionally repair names using [vctrs::vec_as_names()]. +#' +#' @param .data A data frame returned by `arc_select()` or `arc_read()`. +#' @param .layer A Table or FeatureLayer object. Required. +#' @param alias Use of field alias values. Default `c("label", "replace"),`. +#' There are two options: +#' +#' - `"label"`: field alias values are assigned as a label attribute for each field. +#' - `"replace"`: field alias values replace existing column names. +#' @param name_repair Default `"unique"`. See [vctrs::vec_as_names()] for +#' details. If `name_repair = NULL` and `alias = "replace"` may include +#' invalid names. +#' @inheritParams rlang::args_error_context +#' @export +set_layer_aliases <- function( + .data, + .layer, + name_repair = "unique", + alias = c("label", "replace"), + call = rlang::caller_env()) { + alias <- rlang::arg_match(alias, error_call = call) + nm <- names(.data) + sf_column <- attr(.data, "sf_column") + alias_val <- pull_field_aliases(.layer)[setdiff(nm, sf_column)] - if (replace_nm_len < n_col) { - # fill missing field names using pattern, X1, X2, etc. - replace_nm <- c(replace_nm, paste0("X", seq(replace_nm_len + 1, n_col))) + # NOTE: alias values may not be valid names + if (alias == "replace") { + # get unnamed alias values + nm <- unname(alias_val) - # But keep the default sf column name - if (inherits(.data, "sf")) { - replace_nm[[n_col]] <- sf_column + # geometry columns don't include an alias so keep existing + if (!is.null(sf_column)) { + nm[[ncol(.data)]] <- sf_column } } .data <- repair_layer_names( .data, - names = replace_nm, + names = nm, name_repair = name_repair, call = call ) - if (alias != "label") { + if (alias == "replace") { return(.data) } - # Name alias values with layer names - alias_val <- rlang::set_names( - alias_val, - nm = setdiff(replace_nm, sf_column) - ) - label_layer_fields(.data, values = alias_val) } @@ -297,66 +298,64 @@ label_layer_fields <- function( x } - #' Set coded values for FeatureLayer or Table data frame #' -#' [set_layer_coded_values()] can replace column values based on `codedValue` +#' [encode_field_values()] can replace column values based on `codedValue` #' type field domains from a corresponding `Table` or `FeatureLayer` object #' created with `arc_open()`. #' #' @param .data A data frame returned by `arc_select()` or `arc_read()`. #' @param .layer A Table or FeatureLayer object. Required. -#' @param field Default `NULL`. Field or fields to replace. Fields that are do -#' not have coded values domains are ignored. -#' @param codes Use of field alias values. Default `c("replace"),`. +#' @param field Default `NULL`. Field or fields to replace. Fields that do +#' not have coded value domains are ignored. +#' @param codes Use of field alias values. Defaults to `c("replace", "label"),`. #' There are two options: #' #' - `"replace"`: coded values replace existing column values. #' - `"label"`: coded values are applied as value labels via a `"label"` attribute. #' @inheritParams rlang::args_error_context #' @export -set_layer_coded_values <- function( +encode_field_values <- function( .data, .layer, field = NULL, codes = c("replace", "label"), call = rlang::caller_env()) { - values <- pull_coded_values(.layer, field = field) + values <- pull_coded_values(.layer, field = field, call = call) + + codes <- rlang::arg_match(codes, error_call = call) # Check if coded values is an empty list if (rlang::is_empty(values)) { - if (is.null(field)) { - cli::cli_warn( - "{.arg layer} does not contain any coded values." - ) - } else { - cli::cli_warn( - "{.arg field} does not specific any coded value fields." - ) + message <- "{.arg layer} does not contain any coded values." + + if (!is.null(field)) { + message <- "{.arg field} {.val {field}} do not contain any coded values." } + cli::cli_warn(message) return(.data) } - codes <- rlang::arg_match(codes, error_call = call) - + # Replace column values by default if (codes == "replace") { - # Replace column values by default for (col in names(values)) { .data[[col]] <- values[[col]][.data[[col]]] } - } else { - # Label column values using new_labelled_col helper - for (col in names(values)) { - .data[[col]] <- new_labelled_col( - .data[[col]], - labels = rlang::set_names( - names(values[[col]]), - values[[col]] - ), - call = call - ) - } + + return(.data) + } + + # Label column values using new_labelled_col helper + for (col in names(values)) { + .data[[col]] <- new_labelled_col( + .data[[col]], + labels = rlang::set_names( + names(values[[col]]), + values[[col]] + ), + call = call + ) } .data diff --git a/R/utils.R b/R/utils.R index a999c3c..8a4fa8e 100644 --- a/R/utils.R +++ b/R/utils.R @@ -263,15 +263,24 @@ parse_url_query <- function(url, keep_default = FALSE) { url_elements[["query"]] } +#' List field domains for a layer #' @noRd -list_field_domains <- function(x, field = NULL, keep_null = FALSE) { +list_field_domains <- function(x, + field = NULL, + keep_null = FALSE, + arg = rlang::caller_arg(x), + call = rlang::caller_env()) { fields <- list_fields(x) nm <- fields[["name"]] + if (is.null(nm)) { + cli::cli_abort("{.arg {x}} must have field names.", call = call) + } + domains <- rlang::set_names(fields[["domain"]], nm) if (!is.null(field)) { - field <- rlang::arg_match(nm, multiple = TRUE) + field <- rlang::arg_match(nm, multiple = TRUE, error_call = call) domains <- domains[nm %in% field] } @@ -282,13 +291,23 @@ list_field_domains <- function(x, field = NULL, keep_null = FALSE) { domains[!vapply(domains, is.null, logical(1))] } +#' Pull a named list of codes for fields using codedValue domain type #' @noRd -pull_coded_values <- function(x, field = NULL) { - domains <- list_field_domains(x, field = field, keep_null = FALSE) +pull_coded_values <- function(x, + field = NULL, + arg = rlang::caller_arg(x), + call = rlang::caller_env()) { + domains <- list_field_domains( + x, + field = field, + keep_null = FALSE, + arg = arg, + call = call + ) domains <- lapply( domains, - \(x) { + function(x) { if (x[["type"]] != "codedValue") { return(NULL) } diff --git a/man/arc_read.Rd b/man/arc_read.Rd index fd3dd3b..04aa734 100644 --- a/man/arc_read.Rd +++ b/man/arc_read.Rd @@ -39,7 +39,8 @@ returned. By default, all fields are returned.} to return.} \item{name_repair}{Default \code{"unique"}. See \code{\link[vctrs:vec_as_names]{vctrs::vec_as_names()}} for -details. If \code{name_repair = NULL}, names are set directly.} +details. If \code{name_repair = NULL} and \code{alias = "replace"} may include +invalid names.} \item{crs}{the spatial reference to be returned. If the CRS is different than the CRS for the input \code{FeatureLayer}, a transformation will occur @@ -57,7 +58,6 @@ supplied.} \item \code{"drop"}, field alias values are ignored. \item \code{"label"}: field alias values are assigned as a label attribute for each field. \item \code{"replace"}: field alias values replace existing column names. \code{col_names} -must \code{TRUE} for this option to be applied. }} \item{token}{your authorization token.} diff --git a/man/set_layer_coded_values.Rd b/man/encode_field_values.Rd similarity index 69% rename from man/set_layer_coded_values.Rd rename to man/encode_field_values.Rd index f2dcd76..e4c914b 100644 --- a/man/set_layer_coded_values.Rd +++ b/man/encode_field_values.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/arc-read.R -\name{set_layer_coded_values} -\alias{set_layer_coded_values} +\name{encode_field_values} +\alias{encode_field_values} \title{Set coded values for FeatureLayer or Table data frame} \usage{ -set_layer_coded_values( +encode_field_values( .data, .layer, field = NULL, @@ -17,14 +17,14 @@ set_layer_coded_values( \item{.layer}{A Table or FeatureLayer object. Required.} -\item{field}{Default \code{NULL}. Field or fields to replace. Fields that are do -not have coded values domains are ignored.} +\item{field}{Default \code{NULL}. Field or fields to replace. Fields that do +not have coded value domains are ignored.} -\item{codes}{Use of field alias values. Default \verb{c("replace"),}. +\item{codes}{Use of field alias values. Defaults to \verb{c("replace", "label"),}. There are two options: \itemize{ \item \code{"replace"}: coded values replace existing column values. -\item \code{"label"}: coded values are applied as value labels. +\item \code{"label"}: coded values are applied as value labels via a \code{"label"} attribute. }} \item{call}{The execution environment of a currently @@ -33,7 +33,7 @@ mentioned in error messages as the source of the error. See the \code{call} argument of \code{\link[rlang:abort]{abort()}} for more information.} } \description{ -\code{\link[=set_layer_coded_values]{set_layer_coded_values()}} can replace column values based on \code{codedValue} +\code{\link[=encode_field_values]{encode_field_values()}} can replace column values based on \code{codedValue} type field domains from a corresponding \code{Table} or \code{FeatureLayer} object created with \code{arc_open()}. } diff --git a/man/set_layer_aliases.Rd b/man/set_layer_aliases.Rd new file mode 100644 index 0000000..b27675c --- /dev/null +++ b/man/set_layer_aliases.Rd @@ -0,0 +1,40 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/arc-read.R +\name{set_layer_aliases} +\alias{set_layer_aliases} +\title{Set column labels or names based FeatureLayer or Table data frame field aliases} +\usage{ +set_layer_aliases( + .data, + .layer, + name_repair = "unique", + alias = c("label", "replace"), + call = rlang::caller_env() +) +} +\arguments{ +\item{.data}{A data frame returned by \code{arc_select()} or \code{arc_read()}.} + +\item{.layer}{A Table or FeatureLayer object. Required.} + +\item{name_repair}{Default \code{"unique"}. See \code{\link[vctrs:vec_as_names]{vctrs::vec_as_names()}} for +details. If \code{name_repair = NULL} and \code{alias = "replace"} may include +invalid names.} + +\item{alias}{Use of field alias values. Default \verb{c("label", "replace"),}. +There are two options: +\itemize{ +\item \code{"label"}: field alias values are assigned as a label attribute for each field. +\item \code{"replace"}: field alias values replace existing column names. +}} + +\item{call}{The execution environment of a currently +running function, e.g. \code{caller_env()}. The function will be +mentioned in error messages as the source of the error. See the +\code{call} argument of \code{\link[rlang:abort]{abort()}} for more information.} +} +\description{ +\code{\link[=set_layer_aliases]{set_layer_aliases()}} can replace or label column names based on the the +field aliases from a corresponding \code{Table} or \code{FeatureLayer} object created +with \code{arc_open()}. Optionally repair names using \code{\link[vctrs:vec_as_names]{vctrs::vec_as_names()}}. +} diff --git a/man/set_layer_col_names.Rd b/man/set_layer_col_names.Rd deleted file mode 100644 index 72d52b9..0000000 --- a/man/set_layer_col_names.Rd +++ /dev/null @@ -1,53 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/arc-read.R -\name{set_layer_col_names} -\alias{set_layer_col_names} -\title{Set and repair column names for FeatureLayer or Table data frame} -\usage{ -set_layer_col_names( - .data, - .layer = NULL, - col_names = TRUE, - name_repair = NULL, - alias = c("drop", "label", "replace"), - call = rlang::caller_env() -) -} -\arguments{ -\item{.data}{A data frame returned by \code{arc_select() }or \code{arc_read()}.} - -\item{.layer}{A Table or FeatureLayer object. Required if \code{alias} is \code{"label"} or -\code{"replace"}.} - -\item{col_names}{Default \code{TRUE}. Column names or name handling rule. -\code{col_names} can be \code{TRUE}, \code{FALSE}, \code{NULL}, or a character vector: -\itemize{ -\item If \code{TRUE}, use existing default column names for the layer or table. -If \code{FALSE} or \code{NULL}, column names will be generated automatically: X1, X2, -X3 etc. -\item If \code{col_names} is a character vector, values replace the existing column -names. \code{col_names} can't be length 0 or longer than the number of fields in -the returned layer. -}} - -\item{name_repair}{Default \code{"unique"}. See \code{\link[vctrs:vec_as_names]{vctrs::vec_as_names()}} for -details. If \code{name_repair = NULL}, names are set directly.} - -\item{alias}{Use of field alias values. Default \verb{c("drop", "label", "replace"),}. There are three options: -\itemize{ -\item \code{"drop"}, field alias values are ignored. -\item \code{"label"}: field alias values are assigned as a label attribute for each field. -\item \code{"replace"}: field alias values replace existing column names. \code{col_names} -must \code{TRUE} for this option to be applied. -}} - -\item{call}{The execution environment of a currently -running function, e.g. \code{caller_env()}. The function will be -mentioned in error messages as the source of the error. See the -\code{call} argument of \code{\link[rlang:abort]{abort()}} for more information.} -} -\description{ -\code{\link[=set_layer_col_names]{set_layer_col_names()}} can replace or label column names based on the the -field aliases from a corresponding \code{Table} or \code{FeatureLayer} object created -with \code{arc_open()}. Optionally repair names using \code{\link[vctrs:vec_as_names]{vctrs::vec_as_names()}}. -} From 7dc7e49e31ad6d2c625362f89f8c8991978f4adf Mon Sep 17 00:00:00 2001 From: Eli Pousson Date: Thu, 21 Nov 2024 16:15:31 -0500 Subject: [PATCH 09/13] Update pkgdown index --- _pkgdown.yml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/_pkgdown.yml b/_pkgdown.yml index f0c573c..e97a4a8 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -40,9 +40,10 @@ reference: - clear_query - list_fields - pull_field_aliases + - set_layer_aliases + - encode_field_values - list_items - refresh_layer - prepare_spatial_filter - match_spatial_rel - update_params - - starts_with("set_layer") From 07d946f271ef06dd791209570e293d47a2f38e6d Mon Sep 17 00:00:00 2001 From: Eli Pousson Date: Thu, 21 Nov 2024 16:17:52 -0500 Subject: [PATCH 10/13] Update NEWS --- NEWS.md | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/NEWS.md b/NEWS.md index 8494a48..96bcf73 100644 --- a/NEWS.md +++ b/NEWS.md @@ -4,8 +4,8 @@ ## New features - Improve handling of `filter_geom` by `arc_select()` by warning if applying `sf::st_union()` to the filter does not generate a length 1 sfc, or if `filter_geom` is supplied when accessing a Table, or if `filter_geom` is empty (@elipousson, #166) -- Export `set_layer_col_names()` (previously used internally by `arc_read()`) to allow use of alias values with data returned by `arc_select()` (#169). -- Add new `set_layer_coded_values()` function to support replacement or labelling of values with coded value domains (#134). +- Export `set_layer_aliases()` (previously used internally by `arc_read()`) to allow use of alias values with data returned by `arc_select()` (#169). +- Add new `encode_field_values()` function to support replacement or labeling of values with coded value domains (#134). ## Bug fixes @@ -15,6 +15,7 @@ ## Breaking changes - `dplyr` methods for `collect()`, `select()`, and `filter()` have been removed. +- Soft deprecate `arc_read(col_names = "alias")` (use `arc_read(alias = "replace")` instead) # arcgislayers 0.3.1 From fea1030c1f26427609e2605840ead89357c0a5b1 Mon Sep 17 00:00:00 2001 From: Josiah Parry Date: Thu, 21 Nov 2024 17:42:02 -0500 Subject: [PATCH 11/13] Update R/arc-read.R --- R/arc-read.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/arc-read.R b/R/arc-read.R index 1a875a9..3726219 100644 --- a/R/arc-read.R +++ b/R/arc-read.R @@ -308,7 +308,7 @@ label_layer_fields <- function( #' @param .layer A Table or FeatureLayer object. Required. #' @param field Default `NULL`. Field or fields to replace. Fields that do #' not have coded value domains are ignored. -#' @param codes Use of field alias values. Defaults to `c("replace", "label"),`. +#' @param codes Use of field alias values. Defaults to `"replace"`. #' There are two options: #' #' - `"replace"`: coded values replace existing column values. From 4f6b15537bd3b3d48e75f0b71f1791ab30b7d168 Mon Sep 17 00:00:00 2001 From: Eli Pousson Date: Thu, 21 Nov 2024 20:57:05 -0500 Subject: [PATCH 12/13] Fix regression w/ handling of col_names - Add `check_col_names()` to simplify input checks - Correctly rename sf_column if lengths match (otherwise use existing value) - Make docs consistent in listing defaults --- R/arc-read.R | 106 +++++++++++++++++++++++++------------ man/encode_field_values.Rd | 2 +- man/set_layer_aliases.Rd | 7 +-- 3 files changed, 78 insertions(+), 37 deletions(-) diff --git a/R/arc-read.R b/R/arc-read.R index 3726219..fc2b738 100644 --- a/R/arc-read.R +++ b/R/arc-read.R @@ -127,14 +127,11 @@ arc_read <- function( ... ) - # check col_names input - if (!is.null(col_names) && !rlang::is_logical(col_names) && !is.character(col_names)) { - cli::cli_abort("{.arg col_names} must be `TRUE`, `FALSE`, `NULL`, or a character vector.") - } - if (identical(col_names, "alias")) { # Set alias to "replace" as name if col_names = "alias" alias <- "replace" + col_names <- NULL + lifecycle::deprecate_soft( "deprecated", what = "arc_read(col_names = \"can't be alias\")", @@ -142,6 +139,8 @@ arc_read <- function( ) } + alias <- rlang::arg_match(alias) + if (identical(alias, "drop") || is.character(col_names) || isFALSE(col_names)) { layer <- set_col_names( .data = layer, @@ -160,6 +159,36 @@ arc_read <- function( ) } +#' @noRd +check_col_names <- function(col_names, + max_len, + call = rlang::caller_env()) { + if (rlang::is_logical(col_names) || is.null(col_names)) { + return(invisible(NULL)) + } + + # check col_names input + if (!is.character(col_names)) { + cli::cli_abort( + "{.arg col_names} must be `TRUE`, `FALSE`, `NULL`, or a character vector.", + call = call + ) + } + + col_names_len <- length(col_names) + + # Check col_names length + if (col_names_len > 0 && col_names_len <= max_len) { + return(invisible(NULL)) + } + + cli::cli_abort( + "{.arg col_names} must be length {max_len}{? or shorter}, + not {col_names_len}.", + call = call + ) +} + #' Handle col_names #' @noRd set_col_names <- function(.data, @@ -168,28 +197,34 @@ set_col_names <- function(.data, call = rlang::caller_env() ) { n_col <- ncol(.data) + check_col_names(col_names, max_len = n_col, call = call) + nm <- names(.data) + sf_column <- attr(.data, "sf_column") + field_nm <- setdiff(nm, sf_column) if (rlang::is_false(col_names)) { # Use X1, X2, etc. as names if col_names is FALSE - nm <- paste0("X", seq(n_col)) - } else if (is.character(col_names)) { - col_names_len <- length(col_names) + col_names <- paste0("X", seq(n_col)) + } - # Check col_names length - if ((col_names_len > n_col) || col_names_len == 0) { - cli::cli_abort( - "{.arg col_names} must be length {n_col}{? or shorter}, not {col_names_len}.", - call = call - ) - } else if ((col_names_len + 1) < n_col) { - # fill missing field names using pattern, X1, X2, etc. - col_names <- c(col_names, paste0("X", seq(length(col_names) + 1, n_col))) - } + if (is.character(col_names)) { + col_names_len <- length(col_names) - # But always keep the default sf column name - if (inherits(.data, "sf")) { - col_names[[n_col]] <- attr(.data, "sf_column") + if (col_names_len == n_col && !is.null(sf_column)) { + # replace sf column name if lengths match + .data <- sf::st_set_geometry(.data, col_names[[n_col]]) + } else { + # if shorter fill missing field names using pattern, X1, X2, etc. + if (col_names_len < length(field_nm)) { + col_names <- c( + col_names, + paste0("X", seq(length(col_names) + 1, n_col)) + ) + } + + # but keep default sf column name + col_names[[n_col]] <- sf_column %||% col_names[[n_col]] } nm <- col_names @@ -198,7 +233,8 @@ set_col_names <- function(.data, repair_layer_names(.data, names = nm, name_repair = name_repair, call = call) } -#' Set column labels or names based FeatureLayer or Table data frame field aliases +#' Set column labels or names based FeatureLayer or Table data frame field +#' aliases #' #' [set_layer_aliases()] can replace or label column names based on the the #' field aliases from a corresponding `Table` or `FeatureLayer` object created @@ -206,8 +242,8 @@ set_col_names <- function(.data, #' #' @param .data A data frame returned by `arc_select()` or `arc_read()`. #' @param .layer A Table or FeatureLayer object. Required. -#' @param alias Use of field alias values. Default `c("label", "replace"),`. -#' There are two options: +#' @param alias Use of field alias values. Defaults to `"label"`. There are two +#' options: #' #' - `"label"`: field alias values are assigned as a label attribute for each field. #' - `"replace"`: field alias values replace existing column names. @@ -225,19 +261,18 @@ set_layer_aliases <- function( alias <- rlang::arg_match(alias, error_call = call) nm <- names(.data) sf_column <- attr(.data, "sf_column") - alias_val <- pull_field_aliases(.layer)[setdiff(nm, sf_column)] + # get unnamed alias values + alias_val <- unname(pull_field_aliases(.layer)[setdiff(nm, sf_column)]) - # NOTE: alias values may not be valid names if (alias == "replace") { - # get unnamed alias values - nm <- unname(alias_val) - - # geometry columns don't include an alias so keep existing - if (!is.null(sf_column)) { - nm[[ncol(.data)]] <- sf_column - } + # Return if alias values are identical to the existing field names + # NOTE: alias values may not be valid names + nm <- alias_val } + # geometry columns don't include an alias so keep any existing sf column + nm[[ncol(.data)]] <- sf_column %||% nm[[ncol(.data)]] + .data <- repair_layer_names( .data, names = nm, @@ -249,6 +284,11 @@ set_layer_aliases <- function( return(.data) } + alias_val <- rlang::set_names( + alias_val, + setdiff(names(.data), attr(.data, "sf_column")) + ) + label_layer_fields(.data, values = alias_val) } diff --git a/man/encode_field_values.Rd b/man/encode_field_values.Rd index e4c914b..cbbd511 100644 --- a/man/encode_field_values.Rd +++ b/man/encode_field_values.Rd @@ -20,7 +20,7 @@ encode_field_values( \item{field}{Default \code{NULL}. Field or fields to replace. Fields that do not have coded value domains are ignored.} -\item{codes}{Use of field alias values. Defaults to \verb{c("replace", "label"),}. +\item{codes}{Use of field alias values. Defaults to \code{"replace"}. There are two options: \itemize{ \item \code{"replace"}: coded values replace existing column values. diff --git a/man/set_layer_aliases.Rd b/man/set_layer_aliases.Rd index b27675c..05fbe51 100644 --- a/man/set_layer_aliases.Rd +++ b/man/set_layer_aliases.Rd @@ -2,7 +2,8 @@ % Please edit documentation in R/arc-read.R \name{set_layer_aliases} \alias{set_layer_aliases} -\title{Set column labels or names based FeatureLayer or Table data frame field aliases} +\title{Set column labels or names based FeatureLayer or Table data frame field +aliases} \usage{ set_layer_aliases( .data, @@ -21,8 +22,8 @@ set_layer_aliases( details. If \code{name_repair = NULL} and \code{alias = "replace"} may include invalid names.} -\item{alias}{Use of field alias values. Default \verb{c("label", "replace"),}. -There are two options: +\item{alias}{Use of field alias values. Defaults to \code{"label"}. There are two +options: \itemize{ \item \code{"label"}: field alias values are assigned as a label attribute for each field. \item \code{"replace"}: field alias values replace existing column names. From a1621b9cbafe6d082d8ce84abf7d0dc430537644 Mon Sep 17 00:00:00 2001 From: Josiah Parry Date: Tue, 26 Nov 2024 12:18:02 -0800 Subject: [PATCH 13/13] add tests and clean up PR --- R/arc-read.R | 181 +++++++++++++++------- man/arc_read.Rd | 45 +++--- man/encode_field_values.Rd | 19 +++ man/set_layer_aliases.Rd | 26 +++- tests/testthat/test-arc_read.R | 96 +++++++++++- tests/testthat/test-encode-field-values.R | 18 +++ 6 files changed, 301 insertions(+), 84 deletions(-) create mode 100644 tests/testthat/test-encode-field-values.R diff --git a/R/arc-read.R b/R/arc-read.R index fc2b738..7239f60 100644 --- a/R/arc-read.R +++ b/R/arc-read.R @@ -45,47 +45,75 @@ #' @seealso [arc_select()]; [arc_raster()] #' @examples #' \dontrun{ -#' furl <- "https://sampleserver6.arcgisonline.com/arcgis/rest/services/Census/MapServer/3" +#' furl <- "https://sampleserver6.arcgisonline.com/arcgis/rest/services/Census/MapServer/3" #' -#' # read entire service -#' arc_read(furl) +#' # read entire service +#' arc_read(furl) #' -#' # apply tolower() to column names -#' arc_read(url, name_repair = tolower) +#' # apply tolower() to column names +#' arc_read(url, name_repair = tolower) #' -#' # use paste0 to prevent CRAN check NOTE -#' furl <- paste0( -#' "https://sampleserver6.arcgisonline.com/arcgis/rest/services/", -#' "EmergencyFacilities/FeatureServer/0" -#' ) +#' # use paste0 to prevent CRAN check NOTE +#' furl <- paste0( +#' "https://sampleserver6.arcgisonline.com/arcgis/rest/services/", +#' "EmergencyFacilities/FeatureServer/0" +#' ) #' -#' # use field aliases as column names -#' arc_read(furl, alias = "replace") +#' # use field aliases as column names +#' arc_read(furl, alias = "replace") #' -#' # read an ImageServer directly -#' img_url <- "https://landsat2.arcgis.com/arcgis/rest/services/Landsat/MS/ImageServer" -#' -#' arc_read( -#' img_url, -#' width = 100, height = 100, -#' xmin = -71, ymin = 43, -#' xmax = -67, ymax = 47.5, -#' bbox_crs = 4326 -#' ) +#' # read an ImageServer directly +#' img_url <- "https://landsat2.arcgis.com/arcgis/rest/services/Landsat/MS/ImageServer" #' +#' arc_read( +#' img_url, +#' width = 100, height = 100, +#' xmin = -71, ymin = 43, +#' xmax = -67, ymax = 47.5, +#' bbox_crs = 4326 +#' ) #' } #' @export arc_read <- function( - url, - col_names = TRUE, - col_select = NULL, - n_max = Inf, - name_repair = "unique", - crs = NULL, - ..., - fields = NULL, - alias = c("drop", "label", "replace"), - token = arc_token()) { + url, + col_names = TRUE, + col_select = NULL, + n_max = Inf, + name_repair = "unique", + crs = NULL, + ..., + fields = NULL, + alias = "drop", + token = arc_token() +) { + # argument validation + check_string(url, allow_empty = FALSE) + check_character(fields, allow_null = TRUE) + check_character(col_select, allow_null = TRUE) + + # be flexible with alias here + alias <- alias %||% "drop" + alias <- rlang::arg_match(alias, values = c("drop", "label", "replace")) + + is_valid_col_names_arg <- rlang::is_logical(col_names, 1) || + rlang::is_null(col_names) || + rlang::is_character(col_names) + + if (!is_valid_col_names_arg) { + cli::cli_abort( + "{.arg col_names} must be one of {.val TRUE}, {.val FALSE},\\ + {.val NULL}, or a character vector of the new column names" + ) + } + + if (!rlang::is_integerish(n_max, 1)) { + cli::cli_abort("{.arg n_max} must be a scalar integer.") + } + + if (!is.null(token)) { + obj_check_token(token) + } + x <- arc_open(url = url, token = token) # Default crs must be NULL since crs can't be taken from x at execution @@ -139,8 +167,6 @@ arc_read <- function( ) } - alias <- rlang::arg_match(alias) - if (identical(alias, "drop") || is.character(col_names) || isFALSE(col_names)) { layer <- set_col_names( .data = layer, @@ -194,8 +220,7 @@ check_col_names <- function(col_names, set_col_names <- function(.data, col_names = TRUE, name_repair = NULL, - call = rlang::caller_env() -) { + call = rlang::caller_env()) { n_col <- ncol(.data) check_col_names(col_names, max_len = n_col, call = call) @@ -242,7 +267,7 @@ set_col_names <- function(.data, #' #' @param .data A data frame returned by `arc_select()` or `arc_read()`. #' @param .layer A Table or FeatureLayer object. Required. -#' @param alias Use of field alias values. Defaults to `"label"`. There are two +#' @param alias Use of field alias values. Defaults to `"replace"`. There are two #' options: #' #' - `"label"`: field alias values are assigned as a label attribute for each field. @@ -252,12 +277,36 @@ set_col_names <- function(.data, #' invalid names. #' @inheritParams rlang::args_error_context #' @export +#' @returns +#' A data.frame. When `alias = "replace"`, the column names are modified. +#' When `alias = "label"` each column has a new `label` attribute. +#' +#' @examples +#' furl <- paste0( +#' "https://services.arcgis.com/P3ePLMYs2RVChkJx/ArcGIS/", +#' "rest/services/USA_Counties_Generalized_Boundaries/FeatureServer/0" +#' ) +#' +#' # open the feature service +#' flayer <- arc_open(furl) +#' +#' # select first five rows +#' five_counties <- arc_select(flayer, n_max = 5) +#' +#' # add aliases +#' with_aliases <- set_layer_aliases(five_counties, flayer) +#' +#' # preview the new names +#' str(with_aliases, give.attr = FALSE) set_layer_aliases <- function( - .data, - .layer, - name_repair = "unique", - alias = c("label", "replace"), - call = rlang::caller_env()) { + .data, + .layer, + name_repair = "unique", + alias = c("replace", "label"), + call = rlang::caller_env() +) { + check_data_frame(.data) + check_inherits_any(.layer, c("FeatureLayer", "Table", "ImageServer")) alias <- rlang::arg_match(alias, error_call = call) nm <- names(.data) sf_column <- attr(.data, "sf_column") @@ -280,7 +329,7 @@ set_layer_aliases <- function( call = call ) - if (alias == "replace") { + if (alias == "replace" && rlang::is_null(name_repair)) { return(.data) } @@ -295,10 +344,11 @@ set_layer_aliases <- function( #' Repair layer names using `vctrs::vec_as_names` and `rlang::set_names` #' @noRd repair_layer_names <- function( - layer, - names = NULL, - name_repair = "unique", - call = rlang::caller_env()) { + layer, + names = NULL, + name_repair = "unique", + call = rlang::caller_env() +) { names <- names %||% colnames(layer) if (!is.null(name_repair)) { @@ -318,8 +368,9 @@ repair_layer_names <- function( #' Apply a label attribute value to each column of layer #' @noRd label_layer_fields <- function( - layer, - values) { + layer, + values +) { nm <- intersect(names(values), colnames(layer)) for (v in nm) { @@ -355,12 +406,34 @@ label_layer_fields <- function( #' - `"label"`: coded values are applied as value labels via a `"label"` attribute. #' @inheritParams rlang::args_error_context #' @export +#' @examples +#' \donttest{ +#' layer <- arc_open( +#' "https://geodata.baltimorecity.gov/egis/rest/services/Housing/dmxOwnership/MapServer/0" +#' ) +#' +#' res <- arc_select( +#' layer, +#' n_max = 100, +#' where = "RESPAGCY <> ' '", +#' fields = "RESPAGCY" +#' ) +#' encoded <- encode_field_values(res, layer) +#' table(encoded$RESPAGCY) +#' } +#' @returns +#' A data.frame with fields encoded with their respective domains. encode_field_values <- function( - .data, - .layer, - field = NULL, - codes = c("replace", "label"), - call = rlang::caller_env()) { + .data, + .layer, + field = NULL, + codes = c("replace", "label"), + call = rlang::caller_env() +) { + check_data_frame(.data) + check_character(field, allow_null = TRUE) + check_inherits_any(.layer, c("FeatureLayer", "Table", "ImageServer")) + values <- pull_coded_values(.layer, field = field, call = call) codes <- rlang::arg_match(codes, error_call = call) diff --git a/man/arc_read.Rd b/man/arc_read.Rd index 04aa734..9777849 100644 --- a/man/arc_read.Rd +++ b/man/arc_read.Rd @@ -13,7 +13,7 @@ arc_read( crs = NULL, ..., fields = NULL, - alias = c("drop", "label", "replace"), + alias = "drop", token = arc_token() ) } @@ -81,34 +81,33 @@ data in the \code{{readr}} package. } \examples{ \dontrun{ - furl <- "https://sampleserver6.arcgisonline.com/arcgis/rest/services/Census/MapServer/3" +furl <- "https://sampleserver6.arcgisonline.com/arcgis/rest/services/Census/MapServer/3" - # read entire service - arc_read(furl) +# read entire service +arc_read(furl) - # apply tolower() to column names - arc_read(url, name_repair = tolower) +# apply tolower() to column names +arc_read(url, name_repair = tolower) - # use paste0 to prevent CRAN check NOTE - furl <- paste0( - "https://sampleserver6.arcgisonline.com/arcgis/rest/services/", - "EmergencyFacilities/FeatureServer/0" - ) - - # use field aliases as column names - arc_read(furl, alias = "replace") +# use paste0 to prevent CRAN check NOTE +furl <- paste0( + "https://sampleserver6.arcgisonline.com/arcgis/rest/services/", + "EmergencyFacilities/FeatureServer/0" +) - # read an ImageServer directly - img_url <- "https://landsat2.arcgis.com/arcgis/rest/services/Landsat/MS/ImageServer" +# use field aliases as column names +arc_read(furl, alias = "replace") - arc_read( - img_url, - width = 100, height = 100, - xmin = -71, ymin = 43, - xmax = -67, ymax = 47.5, - bbox_crs = 4326 - ) +# read an ImageServer directly +img_url <- "https://landsat2.arcgis.com/arcgis/rest/services/Landsat/MS/ImageServer" +arc_read( + img_url, + width = 100, height = 100, + xmin = -71, ymin = 43, + xmax = -67, ymax = 47.5, + bbox_crs = 4326 +) } } \seealso{ diff --git a/man/encode_field_values.Rd b/man/encode_field_values.Rd index cbbd511..8597d7e 100644 --- a/man/encode_field_values.Rd +++ b/man/encode_field_values.Rd @@ -32,8 +32,27 @@ running function, e.g. \code{caller_env()}. The function will be mentioned in error messages as the source of the error. See the \code{call} argument of \code{\link[rlang:abort]{abort()}} for more information.} } +\value{ +A data.frame with fields encoded with their respective domains. +} \description{ \code{\link[=encode_field_values]{encode_field_values()}} can replace column values based on \code{codedValue} type field domains from a corresponding \code{Table} or \code{FeatureLayer} object created with \code{arc_open()}. } +\examples{ +\donttest{ +layer <- arc_open( + "https://geodata.baltimorecity.gov/egis/rest/services/Housing/dmxOwnership/MapServer/0" +) + +res <- arc_select( + layer, + n_max = 100, + where = "RESPAGCY <> ' '", + fields = "RESPAGCY" +) +encoded <- encode_field_values(res, layer) +table(encoded$RESPAGCY) +} +} diff --git a/man/set_layer_aliases.Rd b/man/set_layer_aliases.Rd index 05fbe51..e3b30ce 100644 --- a/man/set_layer_aliases.Rd +++ b/man/set_layer_aliases.Rd @@ -9,7 +9,7 @@ set_layer_aliases( .data, .layer, name_repair = "unique", - alias = c("label", "replace"), + alias = c("replace", "label"), call = rlang::caller_env() ) } @@ -22,7 +22,7 @@ set_layer_aliases( details. If \code{name_repair = NULL} and \code{alias = "replace"} may include invalid names.} -\item{alias}{Use of field alias values. Defaults to \code{"label"}. There are two +\item{alias}{Use of field alias values. Defaults to \code{"replace"}. There are two options: \itemize{ \item \code{"label"}: field alias values are assigned as a label attribute for each field. @@ -34,8 +34,30 @@ running function, e.g. \code{caller_env()}. The function will be mentioned in error messages as the source of the error. See the \code{call} argument of \code{\link[rlang:abort]{abort()}} for more information.} } +\value{ +A data.frame. When \code{alias = "replace"}, the column names are modified. +When \code{alias = "label"} each column has a new \code{label} attribute. +} \description{ \code{\link[=set_layer_aliases]{set_layer_aliases()}} can replace or label column names based on the the field aliases from a corresponding \code{Table} or \code{FeatureLayer} object created with \code{arc_open()}. Optionally repair names using \code{\link[vctrs:vec_as_names]{vctrs::vec_as_names()}}. } +\examples{ +furl <- paste0( + "https://services.arcgis.com/P3ePLMYs2RVChkJx/ArcGIS/", + "rest/services/USA_Counties_Generalized_Boundaries/FeatureServer/0" +) + +# open the feature service +flayer <- arc_open(furl) + +# select first five rows +five_counties <- arc_select(flayer, n_max = 5) + +# add aliases +with_aliases <- set_layer_aliases(five_counties, flayer) + +# preview the new names +str(with_aliases, give.attr = FALSE) +} diff --git a/tests/testthat/test-arc_read.R b/tests/testthat/test-arc_read.R index 14ca2c5..cfc4b94 100644 --- a/tests/testthat/test-arc_read.R +++ b/tests/testthat/test-arc_read.R @@ -26,7 +26,6 @@ test_that("arc_read(): ImageServer can be read", { expect_s4_class(res, "SpatRaster") expect_equal(attr(class(res), "package"), "terra") - }) @@ -55,7 +54,6 @@ test_that("arc_read(): n_max is correct", { expect_equal(nrow(arc_read(furl, n_max = 1)), 1L) expect_equal(nrow(arc_read(furl, n_max = 1234)), 1234L) - }) test_that("arc_read(): n_max option is respected", { @@ -86,15 +84,14 @@ test_that("arc_read(): correct error with unsupported type", { expect_error(arc_read(furl), "is not a supported type") }) - test_that("arc_read(): no error on tricky polylines", { skip_on_cran() url <- "https://gisportalp.itd.idaho.gov/xserver/rest/services/RH_GeneralService/MapServer/1" - expect_no_error(arc_read(url, where = "OBJECTID = 440013")) + res <- arc_read(url, where = "OBJECTID = 440013") + expect_equal(res, structure(data.frame(), null_elements = integer())) }) - test_that("arc_read(): error with invalid col_names", { skip_on_cran() furl <- "https://services.arcgis.com/P3ePLMYs2RVChkJx/ArcGIS/rest/services/USA_Counties_Generalized_Boundaries/FeatureServer/0" @@ -137,3 +134,92 @@ test_that("arc_read(): work with alias label", { layer <- arc_read(furl, n_max = 1, fields = "STATE_ABBR", alias = "label") expect_identical(attr(layer[[1]], "label"), "State Abbreviation") }) + +test_that("arc_read() permits alias = \"drop\"", { + skip_on_cran() + furl <- "https://sampleserver6.arcgisonline.com/arcgis/rest/services/Census/MapServer/3" + expect_no_error(arc_read(furl, n_max = 20, alias = "drop")) +}) + +test_that("arc_read() permits alias = \"drop\"", { + skip_on_cran() + furl <- "https://sampleserver6.arcgisonline.com/arcgis/rest/services/Census/MapServer/3" + expect_no_error(arc_read(furl, n_max = 20, alias = "drop")) +}) + +test_that("arc_read() validates alias", { + skip_on_cran() + furl <- "https://sampleserver6.arcgisonline.com/arcgis/rest/services/Census/MapServer/3" + expect_no_error(arc_read(furl, n_max = 5, alias = NULL)) + expect_error(arc_read(furl, n_max = 5, alias = c("drop", "label")), "`alias`") +}) + +test_that("arc_read() permits col_names = TRUE", { + skip_on_cran() + furl <- "https://sampleserver6.arcgisonline.com/arcgis/rest/services/Census/MapServer/3" + expect_no_error(arc_read(furl, n_max = 5, col_names = TRUE)) +}) + +test_that("arc_read() permits col_names = FALSE", { + skip_on_cran() + furl <- "https://sampleserver6.arcgisonline.com/arcgis/rest/services/Census/MapServer/3" + res <- arc_read(furl, n_max = 5, col_names = FALSE) + expect_identical(paste("X", 1:52, sep = ""), colnames(res)) +}) + +test_that("arc_read() throws deprecation warning", { + skip_on_cran() + furl <- "https://sampleserver6.arcgisonline.com/arcgis/rest/services/Census/MapServer/3" + # this should give a deprecation warning + expect_warning(arc_read(furl, n_max = 5, col_names = "alias")) +}) + +test_that("set_layer_aliases() replaces names with alias", { + skip_on_cran() + furl <- paste0( + "https://services.arcgis.com/P3ePLMYs2RVChkJx/ArcGIS/", + "rest/services/USA_Counties_Generalized_Boundaries/FeatureServer/0" + ) + + flayer <- arc_open(furl) + res <- arc_select(flayer, n_max = 1) + with_aliases <- set_layer_aliases(res, flayer) + + expect_identical( + colnames(with_aliases), + c( + "OBJECTID", "Name", "State Name", "State FIPS", "FIPS", "Area in square miles", + "2020 Total Population", "People per square mile", "State Abbreviation", + "County FIPS", "Shape__Area", "Shape__Length", "geometry" + ) + ) +}) + +test_that("set_layer_aliases() puts alias as label attribute for the column", { + skip_on_cran() + furl <- paste0( + "https://services.arcgis.com/P3ePLMYs2RVChkJx/ArcGIS/", + "rest/services/USA_Counties_Generalized_Boundaries/FeatureServer/0" + ) + + flayer <- arc_open(furl) + res <- arc_select(flayer, n_max = 1) + with_aliases <- set_layer_aliases(res, flayer, alias = "label") + + aliases <- vapply( + sf::st_drop_geometry(with_aliases), + attr, + character(1), + "label", + USE.NAMES = FALSE + ) + + expect_identical( + aliases, + c( + "OBJECTID", "Name", "State Name", "State FIPS", "FIPS", "Area in square miles", + "2020 Total Population", "People per square mile", "State Abbreviation", + "County FIPS", "Shape__Area", "Shape__Length", "geometry" + ) + ) +}) diff --git a/tests/testthat/test-encode-field-values.R b/tests/testthat/test-encode-field-values.R new file mode 100644 index 0000000..feaceaa --- /dev/null +++ b/tests/testthat/test-encode-field-values.R @@ -0,0 +1,18 @@ +test_that("encode_field_values() encodes field values", { + skip_on_cran() + layer <- arc_open( + "https://geodata.baltimorecity.gov/egis/rest/services/Housing/dmxOwnership/MapServer/0" + ) + + res <- arc_select(layer, n_max = 100, where = "RESPAGCY <> ' '") + encoded <- encode_field_values(res, layer) + + # get unique encoded vals + encoded_vals <- sort(unique(encoded$RESPAGCY)) + + # fetch domains and known values + domains <- list_field_domains(layer) + domain_vals <- domains[[c("RESPAGCY", "codedValues", "name")]] + + expect_true(all(encoded_vals %in% domain_vals)) +})