From a1621b9cbafe6d082d8ce84abf7d0dc430537644 Mon Sep 17 00:00:00 2001 From: Josiah Parry Date: Tue, 26 Nov 2024 12:18:02 -0800 Subject: [PATCH] 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)) +})