Merge pull request #403 from DOI-USGS/nldi-doco

update nldi error messages fixes #400

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"), 

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
 ==========

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

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
   })
 }

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"),

tests/testthat/test_03_get_functions.R

@@ -247,25 +247,27 @@ 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)
 
   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))
 
   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)))
 
 })