diff --git a/.github/workflows/pkgdown.yaml b/.github/workflows/pkgdown.yaml index 80d76be..94604d4 100644 --- a/.github/workflows/pkgdown.yaml +++ b/.github/workflows/pkgdown.yaml @@ -20,7 +20,7 @@ jobs: env: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} steps: - - uses: actions/checkout@v3 + - uses: actions/checkout@v4 - uses: r-lib/actions/setup-pandoc@v2 diff --git a/DESCRIPTION b/DESCRIPTION index d77ff01..0fa69c4 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -61,13 +61,14 @@ Imports: purrr, readr, terra (>= 1.0), - sf (>= 1.0) + sf (>= 1.0), + arcgislayers (>= 0.1.0) Encoding: UTF-8 LazyData: true NeedsCompilation: no Repository: CRAN Roxygen: list(markdown = TRUE) -RoxygenNote: 7.2.3 +RoxygenNote: 7.3.1 Suggests: covr, ggplot2, @@ -80,3 +81,5 @@ Suggests: rmarkdown, leaflet, rmapshaper +Remotes: + R-ArcGIS/arcgislayers diff --git a/NEWS.md b/NEWS.md index 1b2218c..a28a5c6 100644 --- a/NEWS.md +++ b/NEWS.md @@ -3,6 +3,7 @@ - Updated `get_nlcd()` to include the 2021 NLCD as the default, in response to [Issue #105](https://github.com/ropensci/FedData/issues/105). - Updated outdated package description - Bumped GDAL version req to >= 3.1.0 to accommodate storing spatial vectors as FlatGeoBufs +- Added `arcgislayers` dependency and retired self-written esri functions. Closes [Issue #109](https://github.com/ropensci/FedData/issues/109). # FedData 4.0.0 - Updated the [README](README.md) and moved examples to an article diff --git a/R/NHD_FUNCTIONS.R b/R/NHD_FUNCTIONS.R index 718b467..0b33a02 100644 --- a/R/NHD_FUNCTIONS.R +++ b/R/NHD_FUNCTIONS.R @@ -50,51 +50,85 @@ get_nhd <- } template %<>% - template_to_sf() + template_to_sf() %>% + sf::st_as_sfc() %>% + sf::st_union() %>% + sf::st_cast("POLYGON") if (nhdplus) { + layers <- + c( + "NHDPoint", + "NetworkNHDFlowline", + "NonNetworkNHDFlowline", + "NHDLine", + "NHDArea", + "NHDWaterbody" + ) + nhd_out <- - esri_query( - url = "https://hydro.nationalmap.gov/arcgis/rest/services/NHDPlus_HR/MapServer", - geom = template, - layers = c( - "NHDPoint", - "NetworkNHDFlowline", - "NonNetworkNHDFlowline", - "NHDLine", - "NHDArea", - "NHDWaterbody" + "https://hydro.nationalmap.gov/arcgis/rest/services/NHDPlus_HR/MapServer" %>% + arcgislayers::arc_open() %>% + arcgislayers::get_layers( + name = layers + ) %>% + purrr::map( + ~ tryCatch( + arcgislayers::arc_select( + .x, + filter_geom = + template + ), + error = function(e) { + NULL + } ) - ) %$% + ) %>% + magrittr::set_names(layers) %$% list( Point = NHDPoint, Flowline = list( - nhd_out$NetworkNHDFlowline, - nhd_out$NonNetworkNHDFlowline + NetworkNHDFlowline, + NonNetworkNHDFlowline ) %>% - purrr::map_dfr(tibble::as_tibble) %>% - sf::st_as_sf(), + dplyr::bind_rows(), Line = NHDLine, Area = NHDArea, Waterbody = NHDWaterbody ) } else { + layers <- + c( + "Point", + "Flowline - Large Scale", + "Line - Large Scale ", + "Area - Large Scale", + "Waterbody - Large Scale" + ) + nhd_out <- - esri_query( - url = "https://hydro.nationalmap.gov/arcgis/rest/services/nhd/MapServer", - geom = template, - layers = c( - "Point", - "Flowline - Large Scale", - "Line - Large Scale", - "Area - Large Scale", - "Waterbody - Large Scale" + "https://hydro.nationalmap.gov/arcgis/rest/services/nhd/MapServer" %>% + arcgislayers::arc_open() %>% + arcgislayers::get_layers( + name = layers + ) %>% + purrr::map( + ~ tryCatch( + arcgislayers::arc_select( + .x, + filter_geom = + template + ), + error = function(e) { + NULL + } ) - ) %$% + ) %>% + magrittr::set_names(layers) %$% list( Point = Point, Flowline = `Flowline - Large Scale`, - Line = `Line - Large Scale`, + Line = `Line - Large Scale `, Area = `Area - Large Scale`, Waterbody = `Waterbody - Large Scale` ) @@ -194,7 +228,7 @@ plot_nhd <- #' @param label A character string naming the study area. #' @param extraction.dir A character string indicating where the extracted and cropped NHD data should be put. #' @param force.redo If an extraction for this template and label already exists, should a new one be created? -#' @return A `sf` collection of the HUC 12 regions within +#' @return An `sf` collection of the HUC 12 regions within #' the specified \code{template}. #' @export get_wbd <- function(template, @@ -221,20 +255,20 @@ get_wbd <- function(template, return(read_sf_all(out_dsn)) } - template %<>% - template_to_sf() - - wbd_out <- - "https://hydro.nationalmap.gov/arcgis/rest/services/NHDPlus_HR/MapServer/" %>% - esri_query( - geom = template, - layers = "WBDHU12" + "https://hydro.nationalmap.gov/arcgis/rest/services/NHDPlus_HR/MapServer/" %>% + arcgislayers::arc_open() %>% + arcgislayers::get_layer( + name = "WBDHU12" + ) %>% + arcgislayers::arc_select( + filter_geom = + template %>% + template_to_sf() %>% + sf::st_as_sfc() ) %>% - magrittr::extract2(1) - - - wbd_out %>% sf::write_sf(dsn = out_dsn) - return(sf::read_sf(out_dsn)) + return( + sf::read_sf(out_dsn) + ) } diff --git a/R/PADUS_FUNCTIONS.R b/R/PADUS_FUNCTIONS.R index bbb5ed6..65a57cf 100644 --- a/R/PADUS_FUNCTIONS.R +++ b/R/PADUS_FUNCTIONS.R @@ -109,26 +109,37 @@ get_padus <- purrr::map( function(x) { file.path(padus_base_url, x, "FeatureServer/") %>% - esri_feature_query( - where = paste0("Unit_Nm IN (", paste(paste0("'", template, "'"), collapse = ","), ")") - ) %>% - magrittr::extract2(1) + arcgislayers::arc_open() %>% + arcgislayers::get_layer(id = 0) %>% + arcgislayers::arc_select( + where = + paste0( + "Unit_Nm IN (", + paste(paste0("'", template, "'"), collapse = ","), + ")" + ) + ) } ) } else { template %<>% template_to_sf() %>% - sf::st_transform(4326) + sf::st_transform(4326) %>% + sf::st_as_sfc() %>% + sf::st_union() %>% + sf::st_cast("POLYGON") padus_out <- padus_services[layer] %>% purrr::map( function(x) { file.path(padus_base_url, x, "FeatureServer/") %>% - esri_feature_query( - geom = template - ) %>% - magrittr::extract2(1) + arcgislayers::arc_open() %>% + arcgislayers::get_layer(id = 0) %>% + arcgislayers::arc_select( + filter_geom = + template + ) } ) } diff --git a/R/UTILITY_FUNCTIONS.R b/R/UTILITY_FUNCTIONS.R index 3b9e0d3..fe6b53b 100644 --- a/R/UTILITY_FUNCTIONS.R +++ b/R/UTILITY_FUNCTIONS.R @@ -35,6 +35,9 @@ if (getRversion() >= "2.15.1") { "Point", "SPATIALVER", "Waterbody - Large Scale", + "Line - Large Scale ", + "NetworkNHDFlowline", + "NonNetworkNHDFlowline", "mukey", "musym", "spatial", diff --git a/R/esri.R b/R/esri.R deleted file mode 100644 index 0f34994..0000000 --- a/R/esri.R +++ /dev/null @@ -1,200 +0,0 @@ -esri_describe <- - function(url) { - description <- - url %>% - httr::GET(query = list(f = "json")) %>% - httr::stop_for_status( - task = - paste0("describe the NHD dataset at:\n", url) - ) %>% - httr::content(simplifyVector = TRUE) - - description - } - -is_sfc <- - function(x) { - inherits(x, "sfc") - } - -esri_query <- - function(url, - layers = NULL, - geom = NULL) { - url %<>% - url_base() - - all_layers <- esri_describe(url)$layers - - layer_ids <- - all_layers$id %>% - magrittr::set_names(stringr::str_trim(all_layers$name)) - - if (!is.null(layers)) { - layer_ids %<>% - magrittr::extract(layers) - } - - query <- - list( - where = "1=1", - outFields = "*", - f = "geoJSON" - ) - - if (!is.null(geom)) { - query$geometry <- - geom %>% - sf::st_transform(4326) %>% - sf::st_bbox() %>% - paste0(collapse = ",") - - query$geometryType <- "esriGeometryEnvelope" - - query$inSR <- 4326 - } - - layer_ids %>% - purrr::map(function(x) { - max_count <- - esri_describe(url)$maxRecordCount / 2 - - ids <- - httr::POST( - url = file.path(url, x, "query"), - body = c(query, - returnIdsOnly = TRUE - ) - ) %>% - httr::content(type = "application/json", simplifyVector = TRUE) %>% - magrittr::extract2("objectIds") - - if (is.null(ids)) { - return(NULL) - } - - ids %<>% - split_n(max_count) - - ids %>% - purrr::map_dfr(function(i) { - httr::POST( - url = file.path(url, x, "query"), - body = list( - where = "1=1", - outFields = "*", - f = "geoJSON", - objectIds = paste0(i, collapse = ",") - ) - ) %>% - httr::content( - as = "text", - encoding = "UTF-8" - ) %>% - sf::read_sf() %>% - sf::st_zm() %>% - sf::st_transform(4326) %>% - dplyr::mutate(dplyr::across(!dplyr::where(is_sfc), as.character)) - }) %>% - tibble::as_tibble() %>% - { - suppressMessages(readr::type_convert(., guess_integer = TRUE)) - } %>% - sf::st_as_sf() - }) - } - -esri_feature_query <- - function(url, - layers = NULL, - geom = NULL, - where = "1=1", - outFields = "*", - f = "geoJSON") { - url %<>% - url_base() - - all_layers <- esri_describe(url)$layers - - layer_ids <- - all_layers$id %>% - magrittr::set_names(stringr::str_trim(all_layers$name)) - - if (!is.null(layers)) { - layer_ids %<>% - magrittr::extract(layers) - } - - query <- - list( - where = where, - outFields = "*", - f = "geoJSON" - ) - - if (!is.null(geom)) { - query$geometry <- - geom %>% - sf::st_transform(4326) %>% - sf::st_bbox() %>% - paste0(collapse = ",") - - query$geometryType <- "esriGeometryEnvelope" - - query$inSR <- 4326 - } - - layer_ids %>% - purrr::map(function(x) { - max_count <- - esri_describe(url)$maxRecordCount / 2 - - ids <- - httr::POST( - url = file.path(url, x, "query"), - body = c(query, - returnIdsOnly = TRUE - ) - ) %>% - httr::content( - type = "application/json", - simplifyVector = TRUE - ) %$% - properties %$% - objectIds %>% - unlist() - - if (is.null(ids) || !length(ids)) { - return(NULL) - } - - ids %<>% - split_n(max_count) - - ids %>% - purrr::map_dfr(function(i) { - httr::POST( - url = file.path(url, x, "query"), - body = list( - where = "1=1", - outFields = "*", - f = "geoJSON", - objectIds = paste0(i, collapse = ",") - ) - ) %>% - httr::content( - as = "text", - encoding = "UTF-8" - ) %>% - sf::read_sf() %>% - sf::st_zm() %>% - sf::st_transform(4326) %>% - dplyr::mutate(dplyr::across(!dplyr::where(is_sfc), as.character)) - }) %>% - tibble::as_tibble() %>% - { - suppressMessages(readr::type_convert(., guess_integer = TRUE)) - } %>% - sf::st_as_sf() - }) - } diff --git a/codemeta.json b/codemeta.json index feaed5e..b822a5a 100644 --- a/codemeta.json +++ b/codemeta.json @@ -400,9 +400,16 @@ }, "sameAs": "https://CRAN.R-project.org/package=sf" }, + "18": { + "@type": "SoftwareApplication", + "identifier": "arcgislayers", + "name": "arcgislayers", + "version": ">= 0.1.0", + "sameAs": "https://github.com/R-ArcGIS/arcgislayers" + }, "SystemRequirements": "GDAL (>= 3.1.0)" }, - "fileSize": "1495.85KB", + "fileSize": "1492.683KB", "releaseNotes": "https://github.com/ropensci/FedData/blob/master/NEWS.md", "readme": "https://github.com/ropensci/FedData/blob/main/README.md", "contIntegration": ["https://github.com/ropensci/FedData/actions/workflows/check-standard.yaml", "https://app.codecov.io/gh/ropensci/FedData?branch=master"], diff --git a/man/get_wbd.Rd b/man/get_wbd.Rd index 649eb50..d8462f0 100644 --- a/man/get_wbd.Rd +++ b/man/get_wbd.Rd @@ -22,7 +22,7 @@ or \code{\link[terra:SpatRaster-class]{SpatRaster}} object to serve as a templat \item{force.redo}{If an extraction for this template and label already exists, should a new one be created?} } \value{ -A \code{sf} collection of the HUC 12 regions within +An \code{sf} collection of the HUC 12 regions within the specified \code{template}. } \description{ diff --git a/vignettes/articles/FedData.Rmd b/vignettes/articles/FedData.Rmd index 31f1d36..3b50ab1 100644 --- a/vignettes/articles/FedData.Rmd +++ b/vignettes/articles/FedData.Rmd @@ -217,6 +217,7 @@ SSURGO.MEVE$spatial %>% by = c("MUKEY" = "mukey") ) %>% dplyr::mutate(label = paste0(MUKEY, ": ", muname)) %>% + dplyr::select(-musym) %>% plot_map( zcol = "label", legend = FALSE @@ -239,6 +240,7 @@ SSURGO.areas$spatial %>% by = c("MUKEY" = "mukey") ) %>% dplyr::mutate(label = paste0(MUKEY, ": ", muname)) %>% + dplyr::select(-musym) %>% plot_map( zcol = "brockdepmin", layer.name = "Minimum Bedrock Depth (cm)",