From 5e573a20fabd8ef432adf0505dd9d3353d09c713 Mon Sep 17 00:00:00 2001 From: David Blodgett Date: Sat, 27 Jul 2024 21:18:53 -0500 Subject: [PATCH 1/2] update nldi error messages fixes #400 --- DESCRIPTION | 2 +- NEWS.md | 8 +++-- R/arcrest_tools.R | 4 ++- R/get_nldi.R | 47 +++++++++++++++----------- man/discover_nldi_characteristics.Rd | 11 +++--- man/get_nldi_characteristics.Rd | 14 +++----- tests/testthat/test_01_get_nldi.R | 7 ++++ tests/testthat/test_03_get_functions.R | 6 ++-- 8 files changed, 56 insertions(+), 43 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index d6ed12f1..1b6301e2 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: nhdplusTools Type: Package Title: NHDPlus Tools -Version: 1.2.2 +Version: 1.3.0 Authors@R: c(person(given = "David", family = "Blodgett", role = c("aut", "cre"), diff --git a/NEWS.md b/NEWS.md index 8eefade7..d5afd6dc 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,6 +1,10 @@ -nhdplusTools 1.2.1 +nhdplusTools 1.3.0 ========== -Bug fix for data cache directory #389 + +- Deprecated `discover_nldi_characteristics()` and `get_nldi_characteristics()` +- Bug fix for data cache directory #389 +- Improved warnings for web service requests. #400, #398 +- Improved documentation for `get_split_catchment()`. #399 nhdplusTools 1.2.0 ========== diff --git a/R/arcrest_tools.R b/R/arcrest_tools.R index ef4e76ba..47a6f6bd 100644 --- a/R/arcrest_tools.R +++ b/R/arcrest_tools.R @@ -170,7 +170,9 @@ query_usgs_arcrest <- function(AOI = NULL, ids = NULL, out[[i]] <- rawToChar(httr::RETRY("POST", URL, body = post_body, - encode = "form")$content) + encode = "form", + pause_base = 2, + times = 3)$content) }, error = function(e) { warning("Something went wrong trying to access a service.") out <- NULL diff --git a/R/get_nldi.R b/R/get_nldi.R index 325a7bc0..19221486 100644 --- a/R/get_nldi.R +++ b/R/get_nldi.R @@ -1,12 +1,14 @@ -#' @title Discover Characteristics Metadata -#' @description Provides access to metadata for characteristics that are returned by `get_nldi_characteristics()`. +#' @title (DEPRECATED) Discover Characteristics Metadata +#' @description +#' +#' This functionality is deprecated and will be removed in the near future. +#' +#' Please use \link{get_characteristics_metadata} instead. +#' #' @param type character "all", "local", "total", or "divergence_routed". #' @export #' @return data.frame containing available characteristics -#' @examples -#' chars <- discover_nldi_characteristics() -#' names(chars) -#' head(chars$local, 10) +#' discover_nldi_characteristics <- function(type="all") { tc <- type_check(type) @@ -174,7 +176,8 @@ get_nldi_basin <- function(nldi_feature, simplify = TRUE, split = FALSE) { ifelse(simplify, "true", "false"), "&", "splitCatchment=", ifelse(split, "true", "false")), - parse_json = FALSE) + parse_json = FALSE, + err_mess = "Are you sure your featureID exists in the NLDI?") if(is.null(o)) return(NULL) @@ -202,22 +205,26 @@ get_nldi_feature <- function(nldi_feature) { out <- tryCatch(dataRetrieval::findNLDI(origin = nldi_feature), error = function(e) NULL) + if(is.null(out)) { + warning(paste("No feature found from NLDI, it is not in the featureSource", + "you are looking in because it was not indexed or is outside", + "the CONUS NLDI domain.")) + } + return(out$origin) } -#' @title Get Catchment Characteristics -#' @description Retrieves catchment characteristics from the Network Linked Data Index. -#' Metadata for these characteristics can be found using `discover_nldi_characteristics()`. +#' @title (DEPRECATED) Get Catchment Characteristics +#' @description +#' +#' This functionality id deprecated and will be removed in the near future. +#' +#' Please use \link{get_catchment_characteristics} instead. +#' #' @inheritParams navigate_nldi #' @inheritParams discover_nldi_characteristics #' @return data.frame containing requested characteristics #' @export -#' @examples -#' \donttest{ -#' chars <- get_nldi_characteristics(list(featureSource = "nwissite", featureID = "USGS-05429700")) -#' names(chars) -#' head(chars$local, 10) -#' } get_nldi_characteristics <- function(nldi_feature, type="local") { tc <- type_check(type) @@ -261,7 +268,8 @@ get_nldi_index <- function(location) { tryCatch({ sf::read_sf(query_nldi(paste0("hydrolocation?coords=POINT(", location[1],"%20", location[2],")"), - parse_json = FALSE)) + parse_json = FALSE, + err_mess = "Make sure your POINT is lon,lat and in the NHDPlusV2 domain.")) }, error = function(e) { warning(paste("Something went wrong querying the NLDI.\n", e)) NULL @@ -272,7 +280,7 @@ get_nldi_index <- function(location) { #' @importFrom httr GET #' @importFrom jsonlite fromJSON #' @noRd -query_nldi <- function(query, base_path = "/linked-data", parse_json = TRUE) { +query_nldi <- function(query, base_path = "/linked-data", parse_json = TRUE, err_mess = "") { nldi_base_url <- paste0(get_nldi_url(), base_path) url <- paste(nldi_base_url, query, @@ -300,7 +308,8 @@ query_nldi <- function(query, base_path = "/linked-data", parse_json = TRUE) { } } }, error = function(e) { - warning("Something went wrong accessing the NLDI.\n", e) + warning("Something went wrong accessing the NLDI.\n", e, + "\n", err_mess) NULL }) } diff --git a/man/discover_nldi_characteristics.Rd b/man/discover_nldi_characteristics.Rd index 36361270..72cb0120 100644 --- a/man/discover_nldi_characteristics.Rd +++ b/man/discover_nldi_characteristics.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/get_nldi.R \name{discover_nldi_characteristics} \alias{discover_nldi_characteristics} -\title{Discover Characteristics Metadata} +\title{(DEPRECATED) Discover Characteristics Metadata} \usage{ discover_nldi_characteristics(type = "all") } @@ -13,10 +13,7 @@ discover_nldi_characteristics(type = "all") data.frame containing available characteristics } \description{ -Provides access to metadata for characteristics that are returned by `get_nldi_characteristics()`. -} -\examples{ -chars <- discover_nldi_characteristics() -names(chars) -head(chars$local, 10) +This functionality is deprecated and will be removed in the near future. + +Please use \link{get_characteristics_metadata} instead. } diff --git a/man/get_nldi_characteristics.Rd b/man/get_nldi_characteristics.Rd index 9d70b061..c9d7db55 100644 --- a/man/get_nldi_characteristics.Rd +++ b/man/get_nldi_characteristics.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/get_nldi.R \name{get_nldi_characteristics} \alias{get_nldi_characteristics} -\title{Get Catchment Characteristics} +\title{(DEPRECATED) Get Catchment Characteristics} \usage{ get_nldi_characteristics(nldi_feature, type = "local") } @@ -18,13 +18,7 @@ from the specified `featureSource`.} data.frame containing requested characteristics } \description{ -Retrieves catchment characteristics from the Network Linked Data Index. -Metadata for these characteristics can be found using `discover_nldi_characteristics()`. -} -\examples{ -\donttest{ -chars <- get_nldi_characteristics(list(featureSource = "nwissite", featureID = "USGS-05429700")) -names(chars) -head(chars$local, 10) -} +This functionality id deprecated and will be removed in the near future. + +Please use \link{get_catchment_characteristics} instead. } diff --git a/tests/testthat/test_01_get_nldi.R b/tests/testthat/test_01_get_nldi.R index d8cb5826..a24bcb12 100644 --- a/tests/testthat/test_01_get_nldi.R +++ b/tests/testthat/test_01_get_nldi.R @@ -99,6 +99,13 @@ test_that("basin works", { basin2 <- get_nldi_basin(nldi_feature = nldi_nwis, simplify = FALSE, split = TRUE) + if(length(sf::st_geometry(basin2)[[1]]) > 1) { + lens <- sapply(sf::st_geometry(basin2)[[1]], \(x) nrow(x[[1]])) + sf::st_geometry(basin2) <- sf::st_sfc( + sf::st_polygon(sf::st_geometry(basin2)[[1]][[which(lens == max(lens))]]), crs = sf::st_crs(basin2)) + basin2 <- sf::st_cast(basin2, "POLYGON") + } + expect_true(length(sf::st_coordinates(nav)) < length(sf::st_coordinates(basin2))) expect_true(!sf::st_crosses(sf::st_cast(nav, "LINESTRING"), diff --git a/tests/testthat/test_03_get_functions.R b/tests/testthat/test_03_get_functions.R index 8c49e642..695d1684 100644 --- a/tests/testthat/test_03_get_functions.R +++ b/tests/testthat/test_03_get_functions.R @@ -247,11 +247,11 @@ test_that("get_nwis", { testthat::skip_on_cran() areaSearch = get_nwis(AOI = area) expect(nrow(areaSearch), 1) - expect_equal(st_crs(areaSearch)$epsg, 4326) + expect_equal(sf::st_crs(areaSearch)$epsg, 4326) areaSearch5070 = get_nwis(AOI = area, t_srs = 5070) expect(nrow(areaSearch5070), 1) - expect_equal(st_crs(areaSearch5070)$epsg, 5070) + expect_equal(sf::st_crs(areaSearch5070)$epsg, 5070) expect_equal(areaSearch$site_no, areaSearch5070$site_no) @@ -266,6 +266,6 @@ test_that("get_nwis", { expect_error(get_nwis(AOI = pt2, buffer = 1000000)) expect_error(get_nwis(AOI = AOI, buffer = 1)) - expect_warning(get_nwis(AOI = st_buffer(st_transform(pt2,5070), 1))) + expect_warning(get_nwis(AOI = sf::st_buffer(sf::st_transform(pt2,5070), 1))) }) From 703ed75c5b2c41ba60db8f2ae9cf0b0686c8f0f8 Mon Sep 17 00:00:00 2001 From: David Blodgett Date: Sat, 27 Jul 2024 21:28:47 -0500 Subject: [PATCH 2/2] service fail if no pause --- tests/testthat/test_03_get_functions.R | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test_03_get_functions.R b/tests/testthat/test_03_get_functions.R index 695d1684..b7b34ccd 100644 --- a/tests/testthat/test_03_get_functions.R +++ b/tests/testthat/test_03_get_functions.R @@ -257,10 +257,12 @@ test_that("get_nwis", { pt2BuffNorm = get_nwis(AOI = pt2) pt2BuffDecrease = get_nwis(AOI = pt2, buffer = 10000) + + Sys.sleep(5) pt2BuffIncrease = get_nwis(AOI = pt2, buffer = 40000) - expect_gt(nrow(pt2BuffIncrease), nrow(pt2BuffNorm)) - expect_gt(nrow(pt2BuffNorm), nrow(pt2BuffDecrease)) + expect_true(nrow(pt2BuffIncrease) > nrow(pt2BuffNorm)) + expect_true(nrow(pt2BuffNorm) > nrow(pt2BuffDecrease)) expect_equal(order(pt2BuffNorm$distance_m), 1:nrow(pt2BuffNorm)) expect_error(get_nwis(AOI = pt2, buffer = 1000000))