diff --git a/NAMESPACE b/NAMESPACE index 9b96ffa7..ea42a034 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -67,6 +67,7 @@ export(read_waterdata_samples) export(read_waterdata_stats_daterange) export(read_waterdata_stats_por) export(read_waterdata_ts_meta) +export(read_wateruse) export(renameNWISColumns) export(setAccess) export(stateCd) diff --git a/NEWS b/NEWS index a4ccbe0c..19d5dcc0 100644 --- a/NEWS +++ b/NEWS @@ -1,3 +1,10 @@ +dataRetrieval 2.7.26 +=================== +* Added suite of read_ngwmn to access new National Groundwater Monitoring +Network API. +* Added read_waterdata_use to access USGS's National Water Availability +Assessment Data Companion API service. + dataRetrieval 2.7.25 =================== * Added read_waterdata_ratings to access USGS rating curves with diff --git a/R/readNWISunit.R b/R/readNWISunit.R index fd6f5c88..0478f0b0 100644 --- a/R/readNWISunit.R +++ b/R/readNWISunit.R @@ -454,18 +454,17 @@ readNWISstat <- function( #' County and state fields will be included as appropriate. #' #' @export -readNWISuse <- function( - stateCd, - countyCd, - years = "ALL", - categories = "ALL", - convertType = TRUE, - transform = FALSE -) { - .Deprecated( - new = "read_waterdata_use_data in development", - package = "dataRetrieval", - msg = "NWIS servers for water use have been decommission. New functions are being developed." - ) +readNWISuse <- function(stateCd, + countyCd, + years = "ALL", + categories = "ALL", + convertType = TRUE, + transform = FALSE) { + + .Deprecated(new = "read_waterdata_use", + package = "dataRetrieval", + msg = "NWIS servers for water use have been decommission. New functions are being developed.") return(NULL) + + } diff --git a/R/read_wateruse.R b/R/read_wateruse.R new file mode 100644 index 00000000..4b43a8a8 --- /dev/null +++ b/R/read_wateruse.R @@ -0,0 +1,181 @@ +#' Get USGS Water Use Data +#' +#' @description USGS's National Water Availability Assessment Data Companion +#' (NWDC) offers web services that provide access to national-scale USGS +#' modeled water availability data underlying the National Water Availability +#' Assessment. More information at \url{https://water.usgs.gov/nwaa-data}. +#' +#' @export +#' @param model See model IDs on the NWDC data catalog page. +#' Options are : "wu-public-supply-wd", "wu-thermoelectric", "wu-irrigation-cu", +#' "wu-irrigation-wd", and "wu-public-supply-cu" +#' \url{https://water.usgs.gov/nwaa-data/data-catalog} +#' @param variable See variable IDs on the NWDC data catalog page. +#' @param location Options : huc12, huc10, huc8, huc6, huc4, huc2, countyCd, stateCd +#' Locations can be visualized with the Spatial Extent Viewer. Only one location +#' can be queried at a time. All data are returned on a HUC12 spatial resolution. +#' When a queried location contains more than the maximum number of HUC12s +#' allowed per page or file (defined under limit below), multiple pages or files +#' will be returned. All huc12, huc10, and countyCd location queries return a +#' single page or file. All huc2 location queries return multiple pages or files. +#' All other (huc8, huc6, huc4, stateCd) location queries may or may not return +#' multiple pages or files, depending on their size. +#' @param timeres Options : monthly, annualcy, annualwy. +#' @param startdate Format : YYYY (for annual data) or YYYY-MM (for monthly data) +#' @param enddate Format : YYYY (for annual data) or YYYY-MM (for monthly data) +#' @param intersection Options : overlap, envelop +#' @param limit Defines the number of HUC12s returned per page or file. +#' Queries of locations containing more than the below maximum value of HUC12s +#' will return multiple pages or files (see location above for details). +#' @param attach_request logical, defaults to `r getOption("dataRetrieval.attach_request")`. +#' If set to `TRUE`, the full request sent to the Water Data API is attached +#' as an attribute to the data set. +#' @examplesIf is_dataRetrieval_user() +#' +#' \donttest{ +#' wu1 <- read_wateruse(model = "wu-public-supply-wd", +#' variable = c("pswdtot", "pswdgw", "pswdsw"), +#' location = "stateCd:RI", +#' startdate = "2020-01", +#' timeres = "monthly") +#' +#' wu2 <- read_wateruse(model = "wu-thermoelectric", +#' variable = c('tecufgw', 'tecufsw', 'tecuftot', +#' 'tewdfgw', 'tewdfsw', 'tewdftot', +#' 'tewdssw'), +#' location = "stateCd:RI", +#' startdate = "2020-01", +#' timeres = "monthly") +#' +#' wu3 <- read_wateruse(model = "wu-irrigation-cu", +#' variable = "irrcutot", +#' location = "stateCd:WI", +#' startdate = "2020-01", +#' timeres = "monthly") +#' +#' wu4 <- read_wateruse(model = "wu-irrigation-wd", +#' variable = c("irrwdtot", "irrwdgw", "irrwdsw"), +#' location = "huc2:04", +#' startdate = "2015", +#' timeres = "annualcy") +#' +#' wu5 <- read_wateruse(model = "wu-public-supply-cu", +#' variable = "pscutot", +#' location = "stateCd:WI", +#' startdate = "2020", +#' timeres = "annualwy") +#' } +read_wateruse <- function(model = NA_character_, + variable = NA_character_, + location = NA_character_, + timeres = NA_character_, + startdate = NA_character_, + enddate = NA_character_, + intersection = "overlap", + limit = 500, + attach_request = getOption("dataRetrieval.attach_request")){ + + match.arg(intersection, choices = c("overlap", "envelop"), several.ok = FALSE) + match.arg(model, choices = c("wu-public-supply-wd", + "wu-thermoelectric", + "wu-irrigation-cu", + "wu-irrigation-wd", + "wu-public-supply-cu"), several.ok = FALSE) + + match.arg(timeres, choices = c("monthly", "annualcy", "annualwy")) + + location_prefix <- sapply(strsplit(location, ":"), function(x) x[1]) + choices = c("huc12", "huc10", "huc8", "huc6", "huc4", "huc2", "countyCd", "stateCd") + + + if(!location_prefix %in% choices){ + stop("Invalid location argument.") + } + + if(limit > 500){ + limit <- 500 + message("limit was reset to 500 which is the maximum value for this service.") + } + + if(!is.character(variable)){ + stop("Invalid variable argument.") + } + + # Monthly needs XXXX-XX + if(timeres == "monthly"){ + if(!is.na(startdate) & !grepl("^[0-9]{4}-[0-9]{2}$", startdate, perl = TRUE)){ + stop("Invalid startdate argument.") + } + + if(!is.na(enddate) & !grepl("^[0-9]{4}-[0-9]{2}$", enddate, perl = TRUE)){ + stop("Invalid enddate argument.") + } + } else { # Annual needs XXXX + if(!is.na(startdate) & !grepl("^[0-9]{4}$", startdate, perl = TRUE)){ + stop("Invalid startdate argument.") + } + + if(!is.na(enddate) & !grepl("^[0-9]{4}$", enddate, perl = TRUE)){ + stop("Invalid enddate argument.") + } + } + + args <- mget(names(formals())) + + args[["attach_request"]] <- NULL + + args <- Filter(Negate(anyNA), args) + + format <- "csv" + + baseURL <- httr2::request("https://api.water.usgs.gov/") |> + httr2::req_url_path_append("nwaa-data") |> + httr2::req_url_path_append("data") |> + httr2::req_user_agent(default_ua()) |> + httr2::req_headers(`Accept` = "application/json") |> + httr2::req_url_query(format = format ) |> + httr2::req_error(body = error_body) |> + httr2::req_timeout(seconds = 180) + + baseURL <- explode_query(baseURL, POST = FALSE, args, multi = "comma") + + message("Requesting:\n", baseURL$url) + + resps <- httr2::req_perform_iterative(baseURL, + next_req = next_req_url_wu_csv, + max_reqs = Inf, on_error = "stop") + + df <- resps |> + httr2::resps_successes() |> + httr2::resps_data(\(resp) data.table::fread(text = httr2::resp_body_string(resp), + data.table = FALSE, + colClasses = list(character = "huc12_id"))) + + if(attach_request){ + attr(df, "request") <- baseURL + } + attr(df, "queryTime") <- Sys.time() + return(df) + +} + +next_req_url_wu_csv <- function(resp, req){ + + headers <- httr2::resp_headers(resp) + if("link" %in% names(headers)){ + if(grepl(pattern = '\"next\"', headers$link)){ + next_url <- gsub(pattern = ".*<(.*)>.*", + replacement = "\\1", + x = headers$link) + next_url <- gsub(pattern = "https://water.usgs.gov", + replacement = "https://api.water.usgs.gov", + x = next_url) + return(httr2::req_url(req = req, url = next_url)) + } + } + return(NULL) +} + + + + diff --git a/R/walk_pages.R b/R/walk_pages.R index ab90e9f6..1d4f63f1 100644 --- a/R/walk_pages.R +++ b/R/walk_pages.R @@ -11,13 +11,13 @@ walk_pages <- function(req) { max_reqs = Inf, on_error = "stop" ) - + failures <- resps |> httr2::resps_failures() - + return_list <- resps |> httr2::resps_successes() |> httr2::resps_data(\(resp) get_resp_data(resp)) - + return(return_list) } @@ -34,30 +34,30 @@ walk_pages <- function(req) { get_resp_data <- function(resp) { body <- httr2::resp_body_json(resp) use_sf <- !grepl("skipGeometry=true", resp$url, ignore.case = TRUE) - + if (isTRUE(body[["numberReturned"]] == 0)) { return(data.frame()) } - + return_df <- sf::read_sf(httr2::resp_body_string(resp)) - + return_df <- coerce_num_cols(return_df, is_sf = TRUE) return_df <- coerce_time_cols(return_df, is_sf = TRUE) return_df <- coerce_qualifier_cols(return_df, is_sf = TRUE) - + if ("altitude_accuracy" %in% names(return_df)) { return_df$altitude_accuracy <- as.character(return_df$altitude_accuracy) } - + if (!use_sf) { return_df <- sf::st_drop_geometry(return_df) if ("AsGeoJSON(geometry)" %in% names(return_df)) { return_df <- return_df[, !names(return_df) %in% "AsGeoJSON(geometry)"] } } - + return(return_df) } @@ -74,24 +74,24 @@ get_resp_data <- function(resp) { #' next_req_url <- function(resp, req) { body <- httr2::resp_body_json(resp) - + if (isTRUE(body[["code"]] == "InvalidQuery")) { message(body[["description"]]) return(NULL) } - + if (isTRUE(body[["numberReturned"]] == 0)) { return(NULL) } - + log_rate_limit(resp) if ("links" %in% names(body)) { links <- body$links if (any(sapply(links, function(x) x$rel) == "next")) { next_index <- which(sapply(links, function(x) x$rel) == "next") - + next_url <- links[[next_index]][["href"]] - + return(httr2::req_url(req = req, url = next_url)) } } else if (!is.null(body[["next"]])) { @@ -105,9 +105,9 @@ next_req_url <- function(resp, req) { get_csv <- function(req, limit) { skip_geo <- grepl("skipGeometry=true", req$url, ignore.case = TRUE) resp <- httr2::req_perform(req) - + log_rate_limit(resp) - + if (httr2::resp_has_body(resp)) { return_list <- httr2::resp_body_string(resp) df <- data.table::fread( @@ -119,7 +119,7 @@ get_csv <- function(req, limit) { df <- coerce_num_cols(df, is_sf = FALSE) df <- coerce_time_cols(df, is_sf = FALSE) - + if (skip_geo) { df <- df[, names(df)[!names(df) %in% c("x", "y")]] } else { @@ -128,7 +128,7 @@ get_csv <- function(req, limit) { sf::st_crs(df) <- 4269 } } - + if (nrow(df) == limit) { warning( "Missing data is probable. Use no_paging = FALSE to @@ -138,7 +138,7 @@ ensure all requested data is returned." } else { df <- data.frame() } - + return(df) } @@ -180,13 +180,13 @@ coerce_num_cols <- function(df, is_sf = FALSE) { if (length(included_num_cols) == 0) { return(df) } - + check_df <- if (is_sf) { sf::st_drop_geometry(df[, included_num_cols, drop = FALSE]) } else { df[, included_num_cols, drop = FALSE] } - + if (!all(vapply(check_df, is.numeric, logical(1)))) { df[, included_num_cols] <- lapply(check_df, as.numeric) } diff --git a/_pkgdown.yml b/_pkgdown.yml index 8af889bd..38223dae 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -83,14 +83,13 @@ reference: - read_waterdata_parameter_codes - read_waterdata_metadata - read_waterdata - - summarize_waterdata_samples - - check_waterdata_sample_params - - get_ogc_params - read_waterdata_channel - read_waterdata_field_meta - read_waterdata_combined_meta - read_waterdata_ratings - read_waterdata_peaks + - summarize_waterdata_samples + - check_waterdata_sample_params - title: National Water Information System (NWIS) desc: Functions to retrieve (USGS) NWIS data. These will be slowly phased out and replaced with the read_waterdata family of functions. contents: @@ -119,16 +118,21 @@ reference: - title: National Ground-Water Monitoring Network desc: Functions to retrieve NGWMN data. contents: - - read_ngwmn_water_levels + - read_ngwmn_water_level - read_ngwmn_sites - read_ngwmn_providers - read_ngwmn_well_construction - read_ngwmn_lithology + - read_ngwmn - title: Network Linked Data Index desc: Functions to interface with the NLDI. contents: - findNLDI - get_nldi_sources + - title: National Water Availability Assessment Data + desc: Functions to get Water Use data + contents: + - read_wateruse - title: Import data desc: Functions to import different data formats contents: @@ -163,3 +167,4 @@ reference: - getWebServiceData - is_dataRetrieval_user - checkWQPdates + - get_ogc_params diff --git a/man/read_wateruse.Rd b/man/read_wateruse.Rd new file mode 100644 index 00000000..f475e0e5 --- /dev/null +++ b/man/read_wateruse.Rd @@ -0,0 +1,96 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/read_waterdata_use.R +\name{read_wateruse} +\alias{read_wateruse} +\title{Get USGS Water Use Data} +\usage{ +read_wateruse( + model = NA_character_, + variable = NA_character_, + location = NA_character_, + timeres = NA_character_, + startdate = NA_character_, + enddate = NA_character_, + intersection = "overlap", + limit = 500, + attach_request = getOption("dataRetrieval.attach_request") +) +} +\arguments{ +\item{model}{See model IDs on the NWDC data catalog page. +Options are : "wu-public-supply-wd", "wu-thermoelectric", "wu-irrigation-cu", +"wu-irrigation-wd", and "wu-public-supply-cu" +\url{https://water.usgs.gov/nwaa-data/data-catalog}} + +\item{variable}{See variable IDs on the NWDC data catalog page.} + +\item{location}{Options : huc12, huc10, huc8, huc6, huc4, huc2, countyCd, stateCd +Locations can be visualized with the Spatial Extent Viewer. Only one location +can be queried at a time. All data are returned on a HUC12 spatial resolution. +When a queried location contains more than the maximum number of HUC12s +allowed per page or file (defined under limit below), multiple pages or files +will be returned. All huc12, huc10, and countyCd location queries return a +single page or file. All huc2 location queries return multiple pages or files. +All other (huc8, huc6, huc4, stateCd) location queries may or may not return +multiple pages or files, depending on their size.} + +\item{timeres}{Options : monthly, annualcy, annualwy.} + +\item{startdate}{Format : YYYY (for annual data) or YYYY-MM (for monthly data)} + +\item{enddate}{Format : YYYY (for annual data) or YYYY-MM (for monthly data)} + +\item{intersection}{Options : overlap, envelop} + +\item{limit}{Defines the number of HUC12s returned per page or file. +Queries of locations containing more than the below maximum value of HUC12s +will return multiple pages or files (see location above for details).} + +\item{attach_request}{logical, defaults to TRUE. +If set to \code{TRUE}, the full request sent to the Water Data API is attached +as an attribute to the data set.} +} +\description{ +USGS's National Water Availability Assessment Data Companion +(NWDC) offers web services that provide access to national-scale USGS +modeled water availability data underlying the National Water Availability +Assessment. More information at \url{https://water.usgs.gov/nwaa-data}. +} +\examples{ +\dontshow{if (is_dataRetrieval_user()) withAutoprint(\{ # examplesIf} + +\donttest{ +wu1 <- read_wateruse(model = "wu-public-supply-wd", + variable = c("pswdtot", "pswdgw", "pswdsw"), + location = "stateCd:RI", + startdate = "2020-01", + timeres = "monthly") + +wu2 <- read_wateruse(model = "wu-thermoelectric", + variable = c('tecufgw', 'tecufsw', 'tecuftot', + 'tewdfgw', 'tewdfsw', 'tewdftot', + 'tewdssw'), + location = "stateCd:RI", + startdate = "2020-01", + timeres = "monthly") + +wu3 <- read_wateruse(model = "wu-irrigation-cu", + variable = "irrcutot", + location = "stateCd:WI", + startdate = "2020-01", + timeres = "monthly") + +wu4 <- read_wateruse(model = "wu-irrigation-wd", + variable = c("irrwdtot", "irrwdgw", "irrwdsw"), + location = "huc2:04", + startdate = "2015", + timeres = "annualcy") + +wu5 <- read_wateruse(model = "wu-public-supply-cu", + variable = "pscutot", + location = "stateCd:WI", + startdate = "2020", + timeres = "annualwy") +} +\dontshow{\}) # examplesIf} +} diff --git a/tests/testthat/tests_wateruse.R b/tests/testthat/tests_wateruse.R new file mode 100644 index 00000000..a908de63 --- /dev/null +++ b/tests/testthat/tests_wateruse.R @@ -0,0 +1,52 @@ +context("Water Use functions") + +test_that("Water Use retrievals working", { + testthat::skip_on_cran() + testthat::skip_on_ci() + + vars <- c("pswdtot", "pswdgw", "pswdsw") + wu1 <- read_wateruse(model = "wu-public-supply-wd", + variable = vars, + location = "stateCd:RI", + startdate = "2020-01", + timeres = "monthly") + + expect_all_true(paste0(vars, "_mgd") %in% names(wu1)) + + expect_error(read_wateruse(model = "wu-public-supply-wd", + variable = c("pswdtot", "pswdgw", "pswdsw"), + location = "stateCd:RI", + startdate = "2020", #wrong type of startdate + timeres = "monthly")) + + wu2 <- read_wateruse(model = "wu-thermoelectric", + variable = c('tecufgw'), + location = "stateCd:RI", + startdate = "2020-01", + timeres = "monthly") + + expect_all_true(paste0("tecufgw", "_mgd") %in% names(wu2)) + + wu3 <- read_wateruse(model = "wu-irrigation-cu", + variable = "irrcutot", + location = "stateCd:WI", + startdate = "2020-01", + timeres = "monthly") + + expect_all_true(paste0("irrcutot", "_mgd") %in% names(wu3)) + + vars <- c("irrwdtot", "irrwdgw", "irrwdsw") + wu4 <- read_wateruse(model = "wu-irrigation-wd", + variable = vars, + location = "huc2:04", + startdate = "2015", + timeres = "annualcy") + expect_all_true(paste0(vars, "_mgd") %in% names(wu4)) + + wu5 <- read_wateruse(model = "wu-public-supply-cu", + variable = "pscutot", + location = "stateCd:WI", + startdate = "2020", + timeres = "annualwy") + expect_all_true(paste0("pscutot", "_mgd") %in% names(wu5)) +}) diff --git a/vignettes/Status.Rmd b/vignettes/Status.Rmd index f6aab200..36aa1c93 100644 --- a/vignettes/Status.Rmd +++ b/vignettes/Status.Rmd @@ -181,9 +181,6 @@ Currently, any "qw" data summaries provided by `whatNWISdata` are very likely ou ## National Groundwater Monitoring Network -Coming soon, a new new access point for the National Groundwater Monitoring Network. The original `readNGWMNdata` functions have been broken for some time. Stay tuned! - - - +Coming soon, a new new access point for the National Groundwater Monitoring Network. The original `readNGWMNdata` functions have been broken for some time. `read_waterdata_use` is currently in development! diff --git a/vignettes/dataRetrieval.Rmd b/vignettes/dataRetrieval.Rmd index d5b3c69c..4614fe95 100644 --- a/vignettes/dataRetrieval.Rmd +++ b/vignettes/dataRetrieval.Rmd @@ -681,4 +681,3 @@ Water Quality Portal. Washington (DC): National Water Quality Monitoring Council # Disclaimer This information is preliminary and is subject to revision. It is being provided to meet the need for timely best science. The information is provided on the condition that neither the U.S. Geological Survey nor the U.S. Government may be held liable for any damages resulting from the authorized or unauthorized use of the information. -