diff --git a/NAMESPACE b/NAMESPACE index 002c070f..e8c305dc 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -66,6 +66,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/R/readNWISunit.R b/R/readNWISunit.R index 515054de..af962c9c 100644 --- a/R/readNWISunit.R +++ b/R/readNWISunit.R @@ -464,7 +464,8 @@ readNWISuse <- function( ) { .Deprecated( package = "dataRetrieval", - msg = "NWIS servers for water use have been decommissioned. New functions are being developed." + new = "read_wateruse", + msg = "NWIS servers for water use have been decommissioned." ) 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/_pkgdown.yml b/_pkgdown.yml index d40aaa82..1f732995 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -135,6 +135,10 @@ reference: 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: diff --git a/man/read_wateruse.Rd b/man/read_wateruse.Rd new file mode 100644 index 00000000..96affc46 --- /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_wateruse.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 30781563..4893570f 100644 --- a/vignettes/Status.Rmd +++ b/vignettes/Status.Rmd @@ -63,17 +63,17 @@ df <- data.frame( "`read_waterdata_rating`", #rating "`read_waterdata_stats_por`, `read_waterdata_stats_daterange`", "`read_waterdata_peaks`", - "", + "`read_wateruse`", "`read_waterdata_ts_meta`, `read_waterdata_field_meta`, `read_waterdata_combined_meta`" ), "Available on (branch)" = c(rep("main (CRAN)", 6), "main (CRAN)", "main (CRAN)", "main (CRAN)", - "develop", + "main", "main (CRAN)", + "main", "develop", - "", "main (CRAN)") )