Merge pull request #154 from dblodgett-usgs/master

NLDI updates fixes #152 and #153

.travis.yml

@@ -5,7 +5,7 @@ cache:
   - ccache
 
 sudo: required
-dist: trusty
+dist: xenial
 latex: false
 
 r:

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: nhdplusTools
 Type: Package
 Title: NHDPlus Tools
-Version: 0.3.14
+Version: 0.3.15
 Authors@R: c(person(given = "David", 
                     family = "Blodgett", 
                     role = c("aut", "cre"), 
@@ -19,5 +19,5 @@ Suggests: testthat, knitr, rmarkdown, ggmap, ggplot2, sp, lwgeom, devtools, code
 License: CC0
 Encoding: UTF-8
 LazyData: true
-RoxygenNote: 7.1.0
+RoxygenNote: 7.1.1
 VignetteBuilder: knitr

NAMESPACE

@@ -4,6 +4,7 @@ export(align_nhdplus_names)
 export(calculate_arbolate_sum)
 export(calculate_total_drainage_area)
 export(discover_nhdplus_id)
+export(discover_nldi_characteristics)
 export(discover_nldi_navigation)
 export(discover_nldi_sources)
 export(download_nhdplushr)
@@ -19,6 +20,7 @@ export(get_hr_data)
 export(get_levelpaths)
 export(get_nhdplushr)
 export(get_nldi_basin)
+export(get_nldi_characteristics)
 export(get_nldi_feature)
 export(get_node)
 export(get_pathlength)

NEWS.md

@@ -1,5 +1,7 @@
 nhdplusTools 0.3.15
 ==========
+* Added `discover_nldi_characteristics()` and `get_nldi_characteristics()`
+* Changed `navigate_nldi()` to use the new NLDI navigation end point. Distance is now required.
 * Fixed a bug in `get_flowline_index()` to handle multipart lines.
 * Added flowline_only input to `plot_nhdplus()` to improve scalability
 * Added streamorder filtering to `subset_nhdplus()` for download filtering.

R/get_nldi.R

@@ -20,7 +20,7 @@ discover_nldi_sources <- function(tier = "prod") {
 #' and `featureID` where `featureSource` is derived from the "source" column of
 #' the response of discover_nldi_sources() and the `featureSource` is a known identifier
 #' from the specified `featureSource`. e.g. list("nwissite", "USGS-08279500")
-#' @param tier character optional "prod" or "test"
+#' @inheritParams discover_nldi_sources
 #' @return data.frame with three columns "source", "sourceName" and "features"
 #' @export
 #' @examples
@@ -38,11 +38,50 @@ discover_nldi_navigation <- function(nldi_feature, tier = "prod") {
 
   query <- paste(nldi_feature[["featureSource"]],
                  nldi_feature[["featureID"]],
-                 "navigate", sep = "/")
+                 "navigation", sep = "/")
 
   query_nldi(query, tier)
 }
 
+#' @title Discover Characteristics Metadata
+#' @description Provides access to metadata for characteristics that are returned by `get_nldi_characteristics()`.
+#' @param type character "all", "local", "total", or "divergence_routed".
+#' @inheritParams discover_nldi_sources
+#' @export
+#' @examples
+#' chars <- discover_nldi_characteristics()
+#' names(chars)
+#' head(chars$local, 10)
+discover_nldi_characteristics <- function(type="all", tier = "prod") {
+
+  tc <- type_check(type)
+
+  out <- lapply(tc$type_options[[type]], function(x, tier) {
+    o <- query_nldi(paste0(x, "/characteristics"),
+                    base_path = "/lookups", tier = tier)
+    o$characteristicMetadata$characteristic
+  }, tier = tier)
+
+  names(out) <- tc$char_names
+
+  out
+}
+
+type_check <- function(type) {
+  type_options <- list("all" = c("local", "tot", "div"),
+                       "local" = "local",
+                       "total" = "tot",
+                       "divergence_routed" = "div")
+
+  if(!type %in% names(type_options)) stop(paste("Type must be one of", paste(names(type_options), collapse = ", ")))
+
+  char_names <- type
+
+  if(type == "all") char_names <- names(type_options)[2:4]
+
+  return(list(type_options = type_options, char_names = char_names))
+}
+
 #' @title Navigate NLDI
 #' @description Navigate the Network Linked Data Index network.
 #' @param nldi_feature list with names `featureSource` and `featureID` where
@@ -54,7 +93,7 @@ discover_nldi_navigation <- function(nldi_feature, tier = "prod") {
 #' @param data_source character chosen from "source" column of the response
 #' of discover_nldi_sources() or empty string for flowline geometry.
 #' @param distance_km numeric distance in km to stop navigating.
-#' @param tier character optional "prod" or "test"
+#' @inheritParams discover_nldi_sources
 #' @return sf data.frame with result
 #' @export
 #' @importFrom utils tail
@@ -66,14 +105,12 @@ discover_nldi_navigation <- function(nldi_feature, tier = "prod") {
 #' nldi_nwis <- list(featureSource = "nwissite", featureID = "USGS-05428500")
 #'
 #' navigate_nldi(nldi_feature = nldi_nwis,
-#'               mode = "upstreamTributaries",
-#'               data_source = "") %>%
+#'               mode = "upstreamTributaries") %>%
 #'   st_geometry() %>%
 #'   plot()
 #'
 #' navigate_nldi(nldi_feature = nldi_nwis,
-#'               mode = "UM",
-#'               data_source = "") %>%
+#'               mode = "UM") %>%
 #'   st_geometry() %>%
 #'   plot(col = "blue", add = TRUE)
 #'
@@ -90,7 +127,7 @@ discover_nldi_navigation <- function(nldi_feature, tier = "prod") {
 #' }
 #'
 navigate_nldi <- function(nldi_feature, mode = "upstreamMain",
-                          data_source = "flowline", distance_km = NULL,
+                          data_source = "flowlines", distance_km = 10,
                           tier = "prod") {
 
   nldi_feature <- check_nldi_feature(nldi_feature)
@@ -108,11 +145,15 @@ navigate_nldi <- function(nldi_feature, mode = "upstreamMain",
     }
   }
 
-  if(data_source == "flowline") data_source <- ""
+  # For backward compatibility
+  if(data_source == "flowline" | data_source == "") {
+    data_source <- "flowlines"
+    warning("data source specified as flowline or '' is deprecated")
+  }
 
   query <- paste(nldi_feature[["featureSource"]],
                  nldi_feature[["featureID"]],
-                 "navigate", mode, data_source,
+                 "navigation", mode, data_source,
                  sep = "/")
 
   if (!is.null(distance_km)) {
@@ -133,11 +174,7 @@ navigate_nldi <- function(nldi_feature, mode = "upstreamMain",
 #' @description Get a basin boundary for a given NLDI feature.
 #' @details Only resolves to the nearest NHDPlus catchment divide. See:
 #' https://owi.usgs.gov/blog/nldi-intro/ for more info on the nldi.
-#' @param nldi_feature list with names `featureSource` and `featureID` where
-#' `featureSource` is derived from the "source" column of  the response of
-#' discover_nldi_sources() and the `featureSource` is a known identifier
-#' from the specified `featureSource`.
-#' @param tier character optional "prod" or "test"
+#' @inheritParams navigate_nldi
 #' @return sf data.frame with result basin boundary
 #' @export
 #' @examples
@@ -172,11 +209,7 @@ get_nldi_basin <- function(nldi_feature,
 
 #' @title Get NLDI Feature
 #' @description Get a single feature from the NLDI
-#' @param nldi_feature list with names `featureSource` and `featureID` where
-#' `featureSource` is derived from the "source" column of  the response of
-#' discover_nldi_sources() and the `featureSource` is a known identifier
-#' from the specified `featureSource`.
-#' @param tier character optional "prod" or "test"
+#' @inheritParams navigate_nldi
 #' @return sf feature collection with one feature
 #' @examples
 #' \donttest{
@@ -191,11 +224,41 @@ get_nldi_feature <- function(nldi_feature, tier = "prod") {
                                 tier, parse_json = FALSE)))
 }
 
+#' @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()`.
+#' @inheritParams navigate_nldi
+#' @inheritParams discover_nldi_characteristics
+#' @export
+#' @examples
+#' chars <- get_nldi_characteristics(list(featureSource = "nwissite", featureID = "USGS-05429700"))
+#' names(chars)
+#' head(chars$local, 10)
+get_nldi_characteristics <- function(nldi_feature, type="local", tier = "prod") {
+
+  tc <- type_check(type)
+
+  nldi_feature <- check_nldi_feature(nldi_feature)
+
+  out <- lapply(tc$type_options[[type]], function(x, tier) {
+    o <- query_nldi(paste(nldi_feature[["featureSource"]],
+                          nldi_feature[["featureID"]],
+                          x,
+                          sep = "/"), tier = tier)
+    o$characteristics
+  }, tier = tier)
+
+  names(out) <- tc$char_names
+
+  out
+
+}
+
 #' @importFrom httr GET
 #' @importFrom jsonlite fromJSON
 #' @noRd
-query_nldi <- function(query, tier = "prod", parse_json = TRUE) {
-  nldi_base_url <- get_nldi_url(tier)
+query_nldi <- function(query, tier = "prod", base_path = "/linked-data", parse_json = TRUE) {
+  nldi_base_url <- paste0(get_nldi_url(tier), base_path)
 
   url <- paste(nldi_base_url, query,
                sep = "/")
@@ -221,9 +284,9 @@ query_nldi <- function(query, tier = "prod", parse_json = TRUE) {
 #' @noRd
 get_nldi_url <- function(tier = "prod") {
   if (tier == "prod") {
-    "https://labs.waterdata.usgs.gov/api/nldi/linked-data"
+    "https://labs.waterdata.usgs.gov/api/nldi"
   } else if (tier == "test") {
-    "https://labs-beta.waterdata.usgs.gov/api/nldi/linked-data"
+    "https://labs-beta.waterdata.usgs.gov/api/nldi"
   } else {
     stop("only prod or test allowed.")
   }

_pkgdown.yml

@@ -37,6 +37,8 @@ reference:
       - '`discover_nhdplus_id`'
       - '`discover_nldi_sources`'
       - '`discover_nldi_navigation`'
+      - '`discover_nldi_characteristics`'
+      - '`get_nldi_characteristics`'
       - '`get_nldi_basin`'
       - '`get_nldi_feature`'
       - '`navigate_nldi`'