Merge pull request #402 from DOI-USGS/webservice

Webservice updates

R/arcrest_tools.R

@@ -39,6 +39,8 @@ get_3dhp_service_info <- memoise::memoise(function() {
 #' Will default to the CRS of the input AOI if provided, and to 4326 for ID requests.
 #' @param buffer numeric. The amount (in meters) to buffer a POINT AOI by for an
 #' extended search. Default = 0.5
+#' @param page_size numeric default number of features to request at a time. Reducing
+#' may help if 500 errors are experienced.
 #' @return a simple features (sf) object or valid types if no type supplied
 #' @keywords internal
 #' @importFrom sf st_crs st_geometry_type st_buffer st_transform st_zm read_sf st_bbox st_as_sfc
@@ -48,7 +50,8 @@ get_3dhp_service_info <- memoise::memoise(function() {
 query_usgs_arcrest <- function(AOI = NULL,  ids = NULL,
                                type = NULL, where = NULL,
                                t_srs = NULL,
-                               buffer = 0.5){
+                               buffer = 0.5,
+                               page_size = 2000){
 
   si <- get_3dhp_service_info()
 
@@ -141,7 +144,7 @@ query_usgs_arcrest <- function(AOI = NULL,  ids = NULL,
       out <- NULL
     } else {
 
-      chunk_size <- 2000
+      chunk_size <- page_size
       all_ids <- split(all_ids, ceiling(seq_along(all_ids)/chunk_size))
 
       out <- rep(list(list()), length(all_ids))

R/get_hydro.R

@@ -228,7 +228,8 @@ get_nwis <- function(AOI = NULL, t_srs = NULL, buffer = 20000){
 #'}
 get_3dhp <- function(AOI = NULL, ids = NULL, type = NULL,
                      universalreferenceid = NULL,
-                     t_srs = NULL, buffer = 0.5) {
+                     t_srs = NULL, buffer = 0.5,
+                     page_size = 2000) {
 
   if(!is.null(universalreferenceid) & !grepl("outlet|reach|hydrolocation", type)) {
     stop("universalereferenceid can only be specified for hydrolocation features")
@@ -247,7 +248,7 @@ get_3dhp <- function(AOI = NULL, ids = NULL, type = NULL,
     ids <- NULL
   }
 
-  query_usgs_arcrest(AOI, ids, type, where, t_srs, buffer)
+  query_usgs_arcrest(AOI, ids, type, where, t_srs, buffer, page_size)
 
 }
 

R/get_oaproc.R

@@ -45,14 +45,22 @@ get_raindrop_trace <- function(point, direction = "down") {
 }
 
 #' Get split catchment
-#' @description Uses catchment splitting web service to retrieve
+#' @description Uses a catchment splitting web service to retrieve
 #' the portion of a catchment upstream of the point provided.
 #' @param point scf POINT including crs as created by:
-#' \code{sf::st_sfc(sf::st_point(.. ,..), crs)}
+#' \code{sf::st_sfc(sf::st_point(.. ,..), crs)}.
 #' @param upstream logical If TRUE, the entire drainage basin upstream
 #' of the point provided is returned in addition to the local catchment.
 #' @return sf data.frame containing the local catchment, the split portion
 #' and optionally the total drainage basin.
+#' @details
+#' This service works within the coterminous US NHDPlusV2 domain. If the point
+#' provided falls on an NHDPlusV2 flowline as retrieved from \link{get_raindrop_trace}
+#' the catchment will be split across the flow line. IF the point is not
+#' along the flowline a small sub catchment will typically result. As a result,
+#' most users of this function will want to use \link{get_raindrop_trace} prior
+#' to calls to this function.
+#'
 #' @export
 #' @examples
 #' \donttest{
@@ -107,7 +115,10 @@ get_split_catchment <- function(point, upstream = TRUE) {
 
   url <- paste0(url_base, "nldi-splitcatchment/execution")
 
-  return(sf_post(url, make_json_input_split(point, upstream)))
+  return(sf_post(url, make_json_input_split(point, upstream),
+                 err_mess = paste("Ensure that the point you submitted is within\n the",
+                 "coterminous US and consider trying get_raindrop_trace\ to ensure",
+                 "your point is not too close to a catchment boundary.")))
 }
 
 #' Get Cross Section From Point (experimental)
@@ -322,7 +333,7 @@ get_xs <- function(url, fun, ...) {
          elevation_m = "elevation")
 }
 
-sf_post <- function(url, json) {
+sf_post <- function(url, json, err_mess = "") {
   tryCatch({
 
     if(nhdplus_debug()) {
@@ -341,7 +352,8 @@ sf_post <- function(url, json) {
     }
 
   }, error = function(e) {
-    message("Error calling processing service. \n Original error: \n", e)
+    message("Error calling processing service. \n Original error: \n", e,
+            "\n", err_mess)
     NULL
   })
 }

tests/testthat/test_01_get_nldi.R

@@ -221,6 +221,11 @@ test_that("split", {
 
   expect_true(area[2] > units::set_units(900000000, "m^2"))
 
+  point <- sf::st_sfc(sf::st_point(c(-20.213274, 42.956989)),
+                      crs = 4326)
+
+  expect_message(get_split_catchment(point, upstream = TRUE), "Ensure that the point")
+
   # Doesn't improve coverage
   # catchment2 <- get_split_catchment(snap_point, upstream = FALSE)
   #