Commit cab3ada1 authored by mike's avatar mike
Browse files

first pass at NLDI additions.

Preparing for pull request.
Added vignette, nldi functions, and test
parent 46d3270d
......@@ -8,3 +8,5 @@ dataRetrieval.Rproj
.gitignore
vignettes/usMaps_cache
docs
.DS_Store
vignettes/.DS_Store
......@@ -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
......
......@@ -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)
......
......@@ -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()
}
#' @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)
}
......@@ -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
......
% 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}
% 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}
% 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}
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/findNLDI.R
\name{nldi_offerings}