first pass at NLDI additions.

Preparing for pull request.
Added vignette, nldi functions, and test

.gitignore

@@ -8,3 +8,5 @@ dataRetrieval.Rproj
 .gitignore
 vignettes/usMaps_cache
 docs
+.DS_Store
+vignettes/.DS_Store

DESCRIPTION

@@ -40,10 +40,15 @@ Imports:
     readr (>= 1.0.0),
     jsonlite
 Suggests:
+    covr,
+    dplyr,
+    ggplot2,
+    gridExtra,
     htmlTable,
     knitr,
     testthat,
-    covr
+    sf
+Encoding: UTF-8
 BuildVignettes: true
 VignetteBuilder: knitr
 BugReports: https://github.com/USGS-R/dataRetrieval/issues

NAMESPACE

@@ -8,12 +8,14 @@ export(constructUseURL)
 export(constructWQPURL)
 export(countyCd)
 export(countyCdLookup)
+export(findNLDI)
 export(getWebServiceData)
 export(importNGWMN)
 export(importRDB1)
 export(importWQP)
 export(importWaterML1)
 export(importWaterML2)
+export(nldi_offerings)
 export(pCodeToName)
 export(parameterCdFile)
 export(readNGWMNdata)
@@ -47,6 +49,9 @@ export(whatWQPsites)
 export(zeroPad)
 import(stats)
 import(utils)
+importFrom(httr,RETRY)
+importFrom(httr,content)
+importFrom(jsonlite,fromJSON)
 importFrom(xml2,read_xml)
 importFrom(xml2,xml_attr)
 importFrom(xml2,xml_attrs)

R/AAA.R

@@ -2,6 +2,7 @@ pkg.env <- new.env()
 
 .onLoad = function(libname, pkgname){
     suppressMessages(setAccess('public'))
+    pkg.env$nldi_base <- "https://labs.waterdata.usgs.gov/api/nldi/linked-data/"
+    pkg.env$local_sf <- requireNamespace("sf")
+    pkg.env$current_nldi <- nldi_offerings()
 }
-
-

R/findNLDI.R

+#' @title Filter NULLs
+#' @description Remove NULL arguments from a named list
+#' @param x a list
+#' @keywords nldi internal
+#' @return a list
+
+tc <- function(x) {
+  Filter(Negate(is.null), x)
+}
+
+#' @title Get current NLDI offerings
+#' @description Used to query the current resources available through the NLDI
+#' @return data.frame
+#' @export
+#' @keywords nldi
+#' @importFrom httr RETRY content
+#' @importFrom jsonlite fromJSON
+#' @examples
+#' nldi_offerings()
+
+nldi_offerings <- function() {
+  res <-
+    httr::RETRY("GET",
+                pkg.env$nldi_base,
+                times = 3,
+                pause_cap = 60)
+
+  if (res$status_code == 200) {
+
+    d <- httr::content(res, "text", encoding = "UTF8")
+
+    d <- jsonlite::fromJSON(d, simplifyDataFrame = TRUE)
+
+    return(d)
+  } else {
+    message("Error in: ",  url)
+  }
+}
+
+#' @title Query NLDI
+#' @description Queries the NLDI for a given URL. If local sf install is available the function returns a data.frame with the sfc geometry column listed. Such an object can be converted to sf with `sf::st_as_sf()`. If the object requested is a POINT object, the XY coordinates are added as columns. Otherwise the columns returned are "sourceName" and "identifier" for features, and "nhdplus_comid" for navigated paths.
+#' @param url the URL to retrieve
+#' @param type the type of data being returned (nav or feature)
+#' @param use_sf should a local sf install be usedto parse data
+#' @keywords nldi internal
+#' @return a data.frame
+#' @importFrom httr content RETRY
+#' @importFrom jsonlite fromJSON
+#' @examples
+#' \dontrun{
+#'  base = "https://labs.waterdata.usgs.gov/api/nldi/linked-data/"
+#'  get_nldi(paste0(base, "comid/101"), type = "feature", use_sf = FALSE)
+#'  get_nldi(paste0(base, "comid/101"), type = "feature", use_sf = TRUE)
+#'  get_nldi(paste0(base, "nwissite/USGS-11120000"), type = "feature", use_sf = TRUE)
+#'  get_nldi(paste0(base, "nwissite/USGS-11120000"), type = "feature", use_sf = TRUE)
+#'  }
+
+get_nldi = function(url, type = "", use_sf = FALSE){
+
+  # The features names are different across features, navigation, and basin returns
+  # This sets the environment for what to expect
+
+  if(type == "nav"){
+    good.name = c("nhdplus_comid")
+  } else if(type == "feature") {
+    good.name = c("sourceName", "identifier")
+  } else {
+    good.name = NULL
+  }
+
+  # Query
+  res <- httr::RETRY("GET", url, times = 3, pause_cap = 60)
+
+  # If successful ...
+  if(res$status_code == 200){
+
+    # Interpret as text
+    d <- httr::content(res, "text", encoding = "UTF8")
+
+    if(d == ""){
+      stop("No data returned for: ", url, call. = FALSE)
+    }
+
+  if(use_sf){
+
+    #Parse with sf
+     tmp = sf::read_sf(d)
+
+    # if of type POINT at the X,Y coordinates as columns
+    if(sf::st_geometry_type(tmp)[1] =="POINT"){
+
+      tmp$X = sf::st_coordinates(tmp)[,1]
+      tmp$Y = sf::st_coordinates(tmp)[,1]
+
+      tmp = tmp[,c(good.name, "X", "Y")]
+
+    } else {
+      # If line/polygon then keep geometry but don't expand
+      tmp = tmp[,c(good.name, "geometry")]
+
+    }
+     # Returning as data.frame drops the geometry column ...
+      return(data.frame(tmp))
+
+  } else {
+
+    # Parse as simplified JSON
+    d <- jsonlite::fromJSON(d, simplifyDataFrame = TRUE)
+
+    # if of type POINT at the X,Y coordinates as columns
+    if(d$features$geometry$type[1] == "Point"){
+
+      geom = d$features$geometry$coordinates
+
+      tmp = cbind(d$features$properties[,good.name], do.call(rbind, geom))
+
+      names(tmp) <- c(good.name, "X", "Y")
+
+      return(tmp)
+
+    } else {
+      # If line/polygon then keep geometry but don't expand
+      return(d$features$properties[,c(good.name)])
+    }
+  }
+
+  } else {
+    message("Error in: ",  url)
+  }
+}
+
+#' Clean NWIS NLDI ids
+#' @description The NWIS ids come as "USGS-XXXXXXXX". This is not suitable for passing to other package functions like readNWISdv.
+#' This function strips the "USGS-" from these ids.
+#' @param tmp a data.frame retrived from get_nldi()
+#' @return the iput object with potentially modified identifiers
+#' @keywords nldi internal
+
+clean_nwis_ids = function(tmp) {
+  # If data.frame and of type NWIS then strip "USGS-" from identifiers
+  if (class(tmp) == 'data.frame') {
+
+    if (sum(tmp$sourceName[1] == "NWIS Sites") == 1) {
+
+      tmp$identifier = gsub("USGS-", "", tmp$identifier)
+
+    }
+  }
+  tmp
+}
+
+#' @title NLDI Validity Check
+#' @description tests if NLDI feature is available. Is vecotrized and works with partial string matching.
+#' @param all a data.frame of available features (see nldi_offerings)
+#' @param type a type(s) to check (character)
+#' @return a list with good and bad entries
+#' @keywords nldi internal
+#' @examples
+#' \dontrun{
+#' valid_ask(nldi_offerings(), "nwis")
+#' }
+
+valid_ask = function(all, type){
+  # those in which the requested pattern in included in a nldi_source ...
+    # mean we will catch nwis - not just nwissite ...
+    # means we will catch both wqp and WQP ...
+  cond  <- grepl(paste0(tolower(type), collapse = "|"), tolower(all$source))
+
+  cond2 <- grepl(paste0(tolower(all$source), collapse = "|"), tolower(type))
+
+  list(good = all[cond,], bad = type[!cond2])
+
+}
+
+#' @title 	Retrieve features from the \href{https://labs.waterdata.usgs.gov/api/nldi/swagger-ui/index.html?configUrl=/api/nldi/v3/api-docs/swagger-config}{NLDI}
+#' @description Provides a formal query to the \href{https://labs.waterdata.usgs.gov/about-nldi/index.html}{Network Linked Data Index}. The function is useful for topology and location based featrue discovery. A user must supply a starting feature, and can add optional navigation direction(s), and features to identify on the navigated networks. Valid starting options can be given by one of the following arguments: comid, nwis, huc12, wqp, location, and start.
+#' @param comid an NHDPlusV2 COMID
+#' @param nwis  a USGS NWIS siteID
+#' @param wqp a water quality point ID
+#' @param huc12 a HUC12 ID
+#' @param location Coordinate pair in WGS84 GCS provided as a numeric vector ordered lng/lat
+#' @param origin a named list specifying a feature type and ID (e.g. list("comid" = 101))
+#' @param nav where to navigate from the starting point ("UM", "UT", DM", "DD")
+#' @param find what resources to find along the navigation path(s) (see nldi_offerings()$source). Can also include 'basin', which will return the upstream basin of the starting feature
+#' @param distance_km how far to look along the navigation path in kilometers
+#' @param no_sf if available, should `sf` be used for parsing, defaults to `TRUE` if `sf` is locally installed
+#' @return a list of data.frames
+#' @export
+#' @keywords nldi
+#' @examples
+#'
+#' # Find Features / Define origin features
+#'
+#' ## Find feature by COMID
+#'  findNLDI(comid = 101)
+#'
+#' ## Find feature by NWIS ID
+#'  findNLDI(nwis = '11120000')
+#'
+#' ## Find feature by WQP ID
+#'  findNLDI(wqp = 'USGS-04024315')
+#'
+#' ## Find feature by LOCATION
+#'  findNLDI(location = c(-115,40))
+#'
+#' ## GENERAL ORIGIN: COMID
+#'  findNLDI(origin = list("comid" = 101))
+#'
+#' ## GENERAL ORIGIN: WaDE
+#'  findNLDI(origin = list("wade" = 'CA_45206'))
+#'
+#' # Navigation
+#' # UPPER MAINSTEM of USGS-11120000
+#'  str(findNLDI(nwis = '11120000', nav = "UM"), max.level = 1)
+#'
+#' # MULTI-REQUEST
+#' # UPPER MAINSTEM and TRIBUTARY of USGS-11120000
+#'  str(findNLDI(nwis = '11120000', nav = c("UT", "UM")), max.level = 1)
+#'
+#' # Discover Features
+#'
+#' ## Find feature(s) on the upper tributary of USGS-11120000
+#'  str(findNLDI(nwis = '11120000', nav = "UT", find = c("nwis", "wqp")), max.level = 1)
+#'
+#' ## Find upstream basin boundary of USGS-11120000
+#'  str(findNLDI(nwis = '11120000',  find = "basin"), max.level = 1)
+#'
+#' # Control Distance
+#'
+#' ## Limit search to 100 km
+#'  str(findNLDI(comid = 101, nav = "DM", find = c("nwis", "wqp"), distance_km = 100), max.level = 1)
+#'
+#' ## Convert returned list of data.frames to list of spatial features
+#' \donttest{
+#'  nldi = findNLDI(nwis = '11120000', nav = "UT", find = c("nwis", "wqp"))
+#'  str(lapply(nldi, sf::st_as_sf), max.level = 1)
+#'  }
+
+findNLDI = function(comid = NULL,
+                    nwis = NULL,
+                    wqp = NULL,
+                    huc12 = NULL,
+                    location = NULL,
+                    origin = NULL,
+                    nav = NULL,
+                    find = NULL,
+                    distance_km = NULL,
+                    no_sf = FALSE) {
+
+  # Should sf be used? Both no_sf and pkg.env must agree
+  use_sf = all(pkg.env$local_sf, !no_sf)
+
+  #Should the basin be identified?
+  getBasin = ("basin" %in% find)
+
+  # From the collection of all possible origins, pick 1 and remove NULLS
+  starter <- tc(c(
+    list(
+      comid = comid,
+      nwis = nwis,
+      wqp = wqp,
+      huc12 = huc12,
+      location = location
+    ),
+    origin
+  ))
+
+  # a single starting location must be given ...
+  if (is.null(starter) | length(starter) > 1) {
+    stop("Define a single starting point. Use `find` to identify other resources.")
+  }
+
+  # Ensure nav types are valid
+
+  bad.nav = !nav %in% c("UM", "UT", "DD", "DM")
+
+  if (any(bad.nav)) {
+    stop(nav[bad.nav], " not a valid navigation. Use one of: UM, UT, DD, DM")
+  }
+
+  # name of starter
+  start_type = names(starter)
+
+  # If location, then ensure lng is first argument (hack for USA features)
+  if (start_type == 'location') {
+    if (location[1] > 0) {
+      stop("Please provide location in the form c(lng,lat)")
+    }
+
+  # Must convert location to COMID for latter tracing and discovery ...
+    tmp_url = paste0(
+      pkg.env$nldi_base,
+      "comid/position?coords=POINT%28",
+      location[1] ,
+      "%20",
+      location[2] ,
+      "%29"
+    )
+
+    tmp_return = get_nldi(tmp_url, "feature", use_sf = use_sf)
+
+    # Override starter with location based COMID
+    starter = list("comid" = tmp_return$identifier)
+
+  }
+
+  # Reset (if needed)
+  start_type = names(starter)
+
+  # Defining the origin URL.
+    # Make align request with formal name from offerings
+    # If NWIS, add "USGS-" prefix
+  start_url = paste0(
+    valid_ask(pkg.env$current_nldi, type = start_type)$good$feature,
+    "/",
+    ifelse(start_type == "nwis", paste0("USGS-", starter), starter),
+    "/"
+  )
+
+  # Makes sure that all requested featrues to find are valid and name-aligned
+  if (!is.null(find)) {
+    find = valid_ask(pkg.env$current_nldi, type = find)$good$source
+  }
+
+  # Set empty lists to store origin, navigation, featrues, and basin requests ...
+  start <- navigate <- features <- basin <- list()
+
+  # Set origin url
+  start[["start"]] <- start_url
+
+  # Build navigation URLS, doubl check the Nav is valid
+  for (i in seq_along(nav)) {
+    if (nav[i] %in% c("UM", "UT", "DD", "DM")) {
+      navigate[[nav[i]]] = paste0(start_url, "navigate/", nav[i])
+    }
+  }
+
+  # Build basin URL
+  if (getBasin) {
+    basin[["basin"]] = paste0(start_url, "basin")
+  }
+
+  # Build find URLs
+  if (length(find) > 0) {
+    features = lapply(navigate, paste0, paste0("/", find))
+  }
+
+  # Add distance controls to features
+  if (!is.null(distance_km)) {
+    features = lapply(features, paste0, paste0("?distance=", distance_km))
+  }
+
+  # Add distance controls to navigations
+  if (!is.null(distance_km)) {
+    navigate = lapply(navigate, paste0, paste0("?distance=", distance_km))
+  }
+
+  # combine, unlist, relist
+
+  ll = as.list(unlist(c(start, basin, navigate, features)))
+
+  # define the type of each URL (featrue, basin, or nav)
+  # This is needed as the attribute namespace for each varies
+  types = c("feature",
+            if (getBasin) { 'basin' },
+            rep("nav", length(nav)),
+            rep("feature", length(find) * length(nav)))
+
+  # Send NLDI queries ...
+  shp = lapply(seq_along(ll), function(x) {
+    get_nldi(ll[[x]], type = types[x], use_sf = use_sf)
+  })
+
+  # Remove basin from find list ...
+  find = find[find != 'basin']
+
+  # if no features (aside from basin) were requested then names are NULL
+  # else, the names are the combination of the navigation direction
+  # and the featrue discovered ...
+
+  feats = if (is.null(find) | length(find) == 0) {
+    NULL
+  } else {
+    unlist(lapply(nav, paste0, paste0("_", find)))
+  }
+
+  # Set the names of the parsed URL list
+  names(shp) = c("origin", if (getBasin) {
+    'basin'
+  }, nav,  feats)
+
+  # Clean up NWIS ids and return ...
+  lapply(shp, clean_nwis_ids)
+
+}

_pkgdown.yml

@@ -16,6 +16,8 @@ navbar:
       href: articles/statsServiceMap.html
     - text: Earthquake Exploration
       href: articles/earthquake.html
+    - text: NLDI Interface
+      href: articles/nldi.html
   right:
   - icon: fa-github fa-lg
     href: https://github.com/USGS-R/dataRetrieval
@@ -53,6 +55,11 @@ reference:
       - readNGWMNlevels
       - readNGWMNsites
       - readNGWMNdata
+  - title: Network Linked Data Index
+    desc: Functions to interface with the NLDI
+    contents:
+      - nldi_offerings
+      - findNLDI
   - title: Helper functions
     contents:
       - calcWaterYear

man/clean_nwis_ids.Rd

+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/findNLDI.R
+\name{clean_nwis_ids}
+\alias{clean_nwis_ids}
+\title{Clean NWIS NLDI ids}
+\usage{
+clean_nwis_ids(tmp)
+}
+\arguments{
+\item{tmp}{a data.frame retrived from get_nldi()}
+}
+\value{
+the iput object with potentially modified identifiers
+}
+\description{
+The NWIS ids come as "USGS-XXXXXXXX". This is not suitable for passing to other package functions like readNWISdv.
+This function strips the "USGS-" from these ids.
+}
+\keyword{internal}
+\keyword{nldi}

man/findNLDI.Rd

+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/findNLDI.R
+\name{findNLDI}
+\alias{findNLDI}
+\title{Retrieve features from the \href{https://labs.waterdata.usgs.gov/api/nldi/swagger-ui/index.html?configUrl=/api/nldi/v3/api-docs/swagger-config}{NLDI}}
+\usage{
+findNLDI(
+  comid = NULL,
+  nwis = NULL,
+  wqp = NULL,
+  huc12 = NULL,
+  location = NULL,
+  origin = NULL,
+  nav = NULL,
+  find = NULL,
+  distance_km = NULL,
+  no_sf = FALSE
+)
+}
+\arguments{
+\item{comid}{an NHDPlusV2 COMID}
+
+\item{nwis}{a USGS NWIS siteID}
+
+\item{wqp}{a water quality point ID}
+
+\item{huc12}{a HUC12 ID}
+
+\item{location}{Coordinate pair in WGS84 GCS provided as a numeric vector ordered lng/lat}
+
+\item{origin}{a named list specifying a feature type and ID (e.g. list("comid" = 101))}
+
+\item{nav}{where to navigate from the starting point ("UM", "UT", DM", "DD")}
+
+\item{find}{what resources to find along the navigation path(s) (see nldi_offerings()$source). Can also include 'basin', which will return the upstream basin of the starting feature}
+
+\item{distance_km}{how far to look along the navigation path in kilometers}
+
+\item{no_sf}{if available, should `sf` be used for parsing, defaults to `TRUE` if `sf` is locally installed}
+}
+\value{
+a list of data.frames
+}
+\description{
+Provides a formal query to the \href{https://labs.waterdata.usgs.gov/about-nldi/index.html}{Network Linked Data Index}. The function is useful for topology and location based featrue discovery. A user must supply a starting feature, and can add optional navigation direction(s), and features to identify on the navigated networks. Valid starting options can be given by one of the following arguments: comid, nwis, huc12, wqp, location, and start.
+}
+\examples{
+
+# Find Features / Define origin features
+
+## Find feature by COMID
+ findNLDI(comid = 101)
+
+## Find feature by NWIS ID
+ findNLDI(nwis = '11120000')
+
+## Find feature by WQP ID
+ findNLDI(wqp = 'USGS-04024315')
+
+## Find feature by LOCATION
+ findNLDI(location = c(-115,40))
+
+## GENERAL ORIGIN: COMID
+ findNLDI(origin = list("comid" = 101))
+
+## GENERAL ORIGIN: WaDE
+ findNLDI(origin = list("wade" = 'CA_45206'))
+
+# Navigation
+# UPPER MAINSTEM of USGS-11120000
+ str(findNLDI(nwis = '11120000', nav = "UM"), max.level = 1)
+
+# MULTI-REQUEST
+# UPPER MAINSTEM and TRIBUTARY of USGS-11120000
+ str(findNLDI(nwis = '11120000', nav = c("UT", "UM")), max.level = 1)
+
+# Discover Features
+
+## Find feature(s) on the upper tributary of USGS-11120000
+ str(findNLDI(nwis = '11120000', nav = "UT", find = c("nwis", "wqp")), max.level = 1)
+
+## Find upstream basin boundary of USGS-11120000
+ str(findNLDI(nwis = '11120000',  find = "basin"), max.level = 1)
+
+# Control Distance
+
+## Limit search to 100 km
+ str(findNLDI(comid = 101, nav = "DM", find = c("nwis", "wqp"), distance_km = 100), max.level = 1)
+
+## Convert returned list of data.frames to list of spatial features
+\donttest{
+ nldi = findNLDI(nwis = '11120000', nav = "UT", find = c("nwis", "wqp"))
+ str(lapply(nldi, sf::st_as_sf), max.level = 1)
+ }
+}
+\keyword{nldi}

man/get_nldi.Rd

+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/findNLDI.R
+\name{get_nldi}
+\alias{get_nldi}
+\title{Query NLDI}
+\usage{
+get_nldi(url, type = "", use_sf = FALSE)
+}
+\arguments{
+\item{url}{the URL to retrieve}
+
+\item{type}{the type of data being returned (nav or feature)}
+
+\item{use_sf}{should a local sf install be usedto parse data}
+}
+\value{
+a data.frame
+}
+\description{
+Queries the NLDI for a given URL. If local sf install is available the function returns a data.frame with the sfc geometry column listed. Such an object can be converted to sf with `sf::st_as_sf()`. If the object requested is a POINT object, the XY coordinates are added as columns. Otherwise the columns returned are "sourceName" and "identifier" for features, and "nhdplus_comid" for navigated paths.
+}
+\examples{
+\dontrun{
+ base = "https://labs.waterdata.usgs.gov/api/nldi/linked-data/"
+ get_nldi(paste0(base, "comid/101"), type = "feature", use_sf = FALSE)
+ get_nldi(paste0(base, "comid/101"), type = "feature", use_sf = TRUE)
+ get_nldi(paste0(base, "nwissite/USGS-11120000"), type = "feature", use_sf = TRUE)
+ get_nldi(paste0(base, "nwissite/USGS-11120000"), type = "feature", use_sf = TRUE)
+ }
+}
+\keyword{internal}
+\keyword{nldi}

man/nldi_offerings.Rd

+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/findNLDI.R
+\name{nldi_offerings}
+