#' Process USGS daily values
#' @description This function is a wrapper around \link[dataRetrieval]{readNWISdv} but includes
#' added variables like water year, lat/lon, station name, altitude and tidied dates.
#' @param sites A vector of USGS NWIS sites
#' @param parameter_cd A USGS code for metric, default is "00060".
#' @param start_date A character of date format, e.g. \code{"1990-09-01"}
#' @param end_date A character of date format, e.g. \code{"1990-09-01"}
#' @param stat_cd character USGS statistic code. This is usually 5 digits. Daily mean (00003) is the default.
#' @param parallel \code{logical} indicating whether to use future_map().
#' @param wy_month \code{numeric} indicating the start month of the water year. e.g. 10 (default).
#' @param verbose \code{logical} for printing information. TRUE (default).
#' @param ... arguments to pass on to \link[furrr]{future_map}.
#'
#'
#' @note Use it the same way you would use \link[dataRetrieval]{readNWISdv}.
#' @return A \code{tibble} with daily metrics and added meta-data.
#' @export
#'
#' @examples \dontrun{
#'
#' library(whitewater)
#' yaak_river_dv <- ww_dvUSGS('12304500',
#' parameter_cd = '00060',
#' wy_month = 10)
#'
#' #parallel
#'
#' #get sites
#'
#' huc17_sites <- dataRetrieval::whatNWISdata(huc = 17,
#' siteStatus = 'active',
#' service = 'dv',
#' parameterCd = '00060')
#'
#' library(future)
#' #need to call future::plan()
#' plan(multisession(workers = availableCores()-1))
#'
#' pnw_dv <- ww_dvUSGS(huc17_sites$site_no,
#' parameter_cd = '00060',
#' wy_month = 10,
#' parallel = TRUE)
#'
#' }
#' @importFrom dataRetrieval readNWISdv renameNWISColumns readNWISsite
#' @importFrom dplyr select left_join "%>%"
#' @importFrom purrr safely
<- (sites,
parameter_cd = "00060",
start_date = "",
end_date = "",
stat_cd = "00003",
= ,
wy_month = 10,
verbose = ,
) {
(!(sites)) sites = (sites)
site_id_usgs <- (sites = sites)
<- ()
(()){
usgs_raw_dv <- site_id_usgs %>%
(.$sites) %>%
furrr::future_map(purrr::safely(~prepping_USGSdv(.$sites,
parameter_cd,
start_date,
end_date,
stat_cd,
verbose,
=
)),
) %>%
purrr::keep(~(.) != 0) %>%
purrr::map(~.x'result']]) %>%
plyr::rbind.fill()
} {
usgs_raw_dv <- site_id_usgs %>%
(.$sites) %>%
purrr::map(purrr::safely(~prepping_USGSdv(.$sites,
parameter_cd,
start_date,
end_date,
stat_cd,
verbose,
= 0
))) %>%
purrr::keep(~(.) != 0) %>%
purrr::map(~.x'result']]) %>%
plyr::rbind.fill()
}
((usgs_raw_dv)){usethis::ui_stop("site query ran into an error: please check parameters or stat code...")}
leap_years <- ((1832, = 4, length.out = 2000))
usgs_raw_dv <- usgs_raw_dv %>%
dt_to_tibble() %>%
mutate( = lubridate::as_date(),
year = year(),
month = month(),
day = day(),
doy=lubridate::yday(),
wy_doy = (!(year %in% leap_years),(doy >= month_to_doy(wy_month, leap = F),
doy-month_to_doy(wy_month, leap = F)+1,
(365-month_to_doy(wy_month, leap = F)+1+doy)),
(doy >= month_to_doy(wy_month, leap = T),
doy-month_to_doy(wy_month, leap = T)+1,
(366-month_to_doy(wy_month, leap = T)+1+doy))),
month_day = str_c(month, day, sep = "-"),
wy = waterYear(, wy_month, ),
month_abb = ([month], = ),
month_day = str_c(month, day, sep = "-"),
drainage_area = drainage_area*0.621371) %>%
add_date_counts()
usgs_raw_dv <- usgs_raw_dv %>% add_proportion()
(usgs_raw_dv, 'wy_month') <- wy_month
(usgs_raw_dv, 'parameter_cd') <- parameter_cd
(usgs_raw_dv, 'stat_cd') <- stat_cd
(usgs_raw_dv, 'parameter_cd_names') <- cols_to_update(usgs_raw_dv)
usgs_raw_dv %>%
dplyr::relocate(Station, site_no, drainage_area,
lat, long, altitude,dplyr::everything())
}
#' Prep USGS daily
#'
#' @param site_no A NWIS site number.
#' @param parameter_cd A USGS code for metric, default is "00060".
#' @param start_date A character of date format, e.g. \code{"1990-09-01"}
#' @param end_date A character of date format, e.g. \code{"1990-09-01"}
#' @param stat_cd character USGS statistic code. This is usually 5 digits. Daily mean (00003) is the default.
#' @param verbose logical for printing information.
#' @param delay time to delay in future_call
#' @importFrom crayon red
#' @noRd
#' @return A tidied data frame with gage meta-data.
prepping_USGSdv <- (site_no, parameter_cd, start_date, end_date, stat_cd, verbose, ) {
gage_data <- readNWISdv(siteNumbers = site_no,
parameterCd = parameter_cd,
startDate = start_date,
endDate = end_date,
statCd = stat_cd) %>%
dataRetrieval::renameNWISColumns(p70290 = "Chloride")
# could use attr(gage_data, 'siteInfo') but not a big deal IMO
gage_info <- tibble(
site_no = site_no,
drainage_area = readNWISsite(site_no) %>% dplyr::select(drain_area_va) %>% (),
Station = readNWISsite(site_no) %>% dplyr::select(station_nm) %>% (),
lat = readNWISsite(site_no) %>% dplyr::select(dec_lat_va) %>% (),
long = readNWISsite(site_no) %>% dplyr::select(dec_long_va) %>% (),
altitude = readNWISsite(site_no) %>% dplyr::select(alt_va) %>% ()
)
final_data <- dplyr::left_join(gage_data, gage_info, = 'site_no')
((verbose)){
((final_data) < 1){
final_data <-
cli::cli_alert('{usethis::ui_field(final_data$Station)} {crayon::red("your request for ")} {usethis::ui_value("daily values")} with stat_cd ({stat_cd}), parameter_cd ({parameter_cd}) and site # ({site_no}) ran into a request error.')
} {
cols_in_fd <- cols_to_update(final_data)
names_in_params <- name_params_to_update(parameter_cd)
(((names_in_params)) != (cols_in_fd)){
cli::cli_alert_success('{usethis::ui_field(dplyr::slice(final_data, 1)$Station)} {usethis::ui_value("daily")} was successfully downloaded.
{crayon::red("(warning)")} parameter_cd {usethis::ui_value(names_in_params[which(!(names_in_params %in% cols_in_fd))])} returned no data for {usethis::ui_field(dplyr::slice(final_data, 1)$Station)}.')
} {
cli::cli_alert_success('{usethis::ui_field(dplyr::slice(final_data, 1)$Station)} {usethis::ui_value("daily")} was successfully downloaded.')
}
}}
()
final_data
}
#' Water Year Stats (USGS)
#' @description This function uses the results of the \link[whitewater]{ww_dvUSGS} object to
#' generate mean, maximum, median, standard deviation and some normalization methods (drainage
#' area, scaled by log and standard deviation) per water year.
#' @param procDV A previously created \link[whitewater]{ww_dvUSGS} object.
#' @param sites A \code{character} vector with NWIS site numbers (optional).
#' @param parallel \code{logical} indicating whether to use future_map().
#' @param verbose \code{logical} for printing information. TRUE (default).
#' @param ... arguments to pass on to \link[furrr]{future_map} and/or \link[whitewater]{ww_dvUSGS}.
#'
#' @note If a previously created \link[whitewater]{ww_dvUSGS} object is not used then the user needs to
#' provide a \code{sites} vector. This will run \link[whitewater]{ww_dvUSGS} in the background.
#' @return A \code{tibble} filtered by water year with added meta-data.
#' @export
#'
#' @examples \dontrun{
#'
#' library(whitewater)
#' yaak_river_dv <- ww_dvUSGS('12304500',
#' parameter_cd = '00060',
#' wy_month = 10)
#'
#' yaak_river_wy <- ww_wyUSGS(yaak_river_dv)
#'
#' #parallel
#'
#' #get sites
#'
#' huc17_sites <- dataRetrieval::whatNWISdata(huc = 17,
#' siteStatus = 'active',
#' service = 'dv',
#' parameterCd = '00060')
#'
#' library(future)
#' #need to call future::plan()
#' plan(multisession(workers = availableCores()-1))
#'
#' pnw_dv <- ww_dvUSGS(huc17_sites$site_no,
#' parameter_cd = '00060',
#' wy_month = 10,
#' parallel = TRUE)
#'
#' pnw_wy <- ww_wyUSGS(pnw_dv,
#' parallel = TRUE)
#' }
#'
#' @importFrom lubridate year month day
#' @importFrom dplyr mutate filter group_by summarise slice_head ungroup everything row_number n
#' @importFrom stringr str_c str_remove_all
#' @importFrom stats median sd
#'
<- (procDV,
sites = ,
= ,
verbose = ,
) {
((procDV)) {
(()){
usgs_raw <- ((sites = sites, = , ) %>%
pad_zero_for_logging())
} {
usgs_raw <- ((sites = sites, ) %>%
pad_zero_for_logging())
}
} {
usgs_raw <- procDV %>%
pad_zero_for_logging()
}
#summarize by water year with different stats for different params
cols <- cols_to_update(usgs_raw)
(usgs_min_max_wy <- usgs_raw %>%
group_by(Station,wy,site_no) %>%
summarise(across(dplyr::any_of(cols),
(
= ~(.x, na.rm = ),
= ~(.x, na.rm = ),
= ~(.x, na.rm = ),
= ~(.x, na.rm = ),
= ~(.x, na.rm = ),
stdev = ~(.x, na.rm = ),
coef_var = ~(.x, na.rm = )/(.x, na.rm = ),
max_dnorm = ~(.x, na.rm = )/drainage_area,
min_dnorm = ~(.x, na.rm = )/drainage_area,
mean_dnorm = ~(.x, na.rm = )/drainage_area,
med_dnorm = ~(.x, na.rm = )/drainage_area,
max_sdnorm = ~((.x, na.rm = ))/((.x), na.rm = ),
min_sdnorm = ~((.x, na.rm = ))/((.x), na.rm = ),
mean_sdnorm = ~((.x, na.rm = ))/((.x), na.rm = ),
med_sdnorm = ~((.x, na.rm = ))/((.x), na.rm = ),
sd_norm = ~((.x), na.rm = )))) %>%
slice_head(n=1) %>%
ungroup() %>%
dt_to_tibble() %>%
dplyr::left_join(usgs_raw %>%
dplyr::select(
wy,
drainage_area,
lat,
long,
altitude,
site_no,
obs_per_wy) %>%
dplyr::group_by(site_no,wy) %>%
dplyr::slice(1) %>%
dplyr::ungroup(), = ('site_no', 'wy')) %>%
dplyr::group_by(site_no) %>%
dplyr::add_count( = 'wy_count') %>%
dplyr::ungroup() %>%
dplyr::relocate(Station, site_no, drainage_area,
lat, long, altitude, obs_per_wy, wy_count, dplyr::everything())
)
((usgs_min_max_wy) < 1){
usgs_min_max_wy <-
} {
((verbose)){
cli::cli_alert_success('{usethis::ui_value("water year")} was successfully downloaded.')
}
}
("Flow" %in% cols){
<- ()
wy_month <- (usgs_raw)$wy_month
((verbose)){
cli::cli_alert('now starting to gather peak flows using dataRetrieval::readNWISpeak')
}
usgs_min_max_wy <- ww_peakUSGSdv(usgs_min_max_wy, = , wy_month = wy_month, verbose = verbose, = )
}
usgs_min_max_wy
}
#' Get Peak Flows
#'
#' @param sites A vector of USGS NWIS sites
#' @param parallel \code{logical} indicating whether to use future_map().
#' @param wy_month \code{numeric} indicating the start month of the water year. e.g. 10 (default).
#' @param verbose \code{logical} for printing information. TRUE (default).
#' @param ... arguments to pass on to \link[furrr]{future_map}.
#'
#' @return a \code{tibble} with peaks by water year
#' @export
<- (sites, = ,wy_month = 10,verbose = , ) {
peak_sites <- (peaks = sites)
= ()
(()){
peaks <- peak_sites %>%
(.$peaks) %>%
furrr::future_map(purrr::safely(~peaks_USGS(.$peaks,
wy_month = wy_month,
verbose = verbose,
dv = F,
,
= )), ) %>%
purrr::keep(~(.) != 0) %>%
purrr::map(~.x'result']]) %>%
plyr::rbind.fill()
} {
peaks <- peak_sites %>%
(.$peaks) %>%
purrr::map(purrr::safely(~peaks_USGS(.$peaks,
wy_month = wy_month,
verbose = verbose,
dv = F,
= 0))) %>%
purrr::keep(~(.) != 0) %>%
purrr::map(~.x'result']]) %>%
plyr::rbind.fill()
}
usgs_min_max_wy <- peaks %>%
dt_to_tibble() %>%
dplyr::select(Station, site_no, wy, peak_va, peak_dt, dplyr::everything())
}
#' Water Year & Monthly Stats (USGS)
#'
#' @description This function uses the results of the \link[whitewater]{ww_dvUSGS} object to
#' generate mean, maximum, median, standard deviation and coefficient of variation
#' per water year per month.
#' @param procDV A previously created \link[whitewater]{ww_dvUSGS} object.
#' @param sites A \code{character} vector with NWIS site numbers (optional).
#' @param parallel \code{logical} indicating whether to use future_map().
#' @param verbose \code{logical} for printing information. TRUE (default).
#' @param ... arguments to pass on to \link[furrr]{future_map} and \link[whitewater]{ww_dvUSGS}.
#'
#' @note If a previously created \link[whitewater]{ww_dvUSGS} object is not used then the user needs to
#' provide a \code{sites} vector. This will run \link[whitewater]{ww_dvUSGS} in the background.
#' @return A \code{tibble} filtered by water year and month with added meta-data.
#' @export
#'
#' @examples \dontrun{
#'
#' library(whitewater)
#' yaak_river_dv <- ww_dvUSGS('12304500',
#' parameter_cd = '00060',
#' wy_month = 10)
#'
#' yaak_river_wym <- ww_wymUSGS(yaak_river_dv)
#'
#' }
#'
#' @importFrom dplyr group_by mutate across summarise rename right_join ungroup n
#' @importFrom tidyr pivot_wider
#' @importFrom lubridate parse_date_time ymd
#' @importFrom stringr str_c
#'
<- (procDV, sites = , = , verbose = , ) {
((procDV)) {
(()){
usgs_raw <- (sites = sites, = , )
} {
usgs_raw <- (sites = sites, = , )
}
} {usgs_raw <- procDV }
cols <- cols_to_update(usgs_raw)
wy_month <- (usgs_raw)$wy_month
(final_data <- usgs_raw %>%
group_by(Station, site_no, wy, month_abb, month) %>%
summarise(across(dplyr::any_of(cols),
(
= ~(.x, na.rm = ),
= ~(.x, na.rm = ),
= ~(.x, na.rm = ),
= ~(.x, na.rm = ),
= ~(.x, na.rm = ),
stdev = ~(.x, na.rm = ),
coef_var = ~(.x, na.rm = )/(.x, na.rm = )))) %>%
slice_head(n=1) %>%
ungroup() %>%
mutate(wy_month_day = str_c(wy, month,"1", sep = "-"),
wy_month_day = parse_date_time(wy_month_day, orders = ("%y-%m-%d", "%y%m%d", "%y-%m-%d %H:%M")),
wy_month_day = ymd((wy_month_day)),
doy = dplyr::case_when(month == 1 ~ 1,
month == 2 ~ 32,
month == 3 ~ 60,
month == 4 ~ 91,
month == 5 ~ 122,
month == 6 ~ 152,
month == 7 ~ 182,
month == 8 ~ 213,
month == 9 ~ 244,
month == 10 ~ 274,
month == 11 ~ 305,
month == 12 ~ 335,
~ ),
(doy >= month_to_doy(wy_month, leap = F),
doy-month_to_doy(wy_month, leap = F)+1,
(365-month_to_doy(wy_month, leap = F)+1+doy))) %>%
dplyr::left_join(usgs_raw %>%
dplyr::select(
wy,
month,
drainage_area,
lat,
long,
altitude,
site_no,
obs_per_wy,
obs_per_month) %>%
dplyr::group_by(site_no, wy, month) %>%
dplyr::slice(1) %>%
dplyr::ungroup(), = ('site_no', 'wy', 'month')) %>%
dplyr::group_by(site_no, wy) %>%
dplyr::add_count( = 'wym_count') %>%
dplyr::ungroup() %>%
dplyr::relocate(Station, site_no, wy, wy_month_day, doy, drainage_area,
lat, long, altitude, obs_per_wy,
obs_per_month, wym_count, dplyr::everything())
)
((final_data) < 1){
final_data <-
} {
((verbose)){
cli::cli_alert_success('{usethis::ui_value("water year and month")} was successfully downloaded.')
}
}
final_data %>%
dplyr::relocate(Station, site_no, drainage_area,
lat, long, altitude,dplyr::everything())
}
#' Month-Only Stats (USGS)
#'
#' @description This function uses the results of the \link[whitewater]{ww_dvUSGS} object to
#' generate mean, maximum, median, standard deviation and coefficient of variation for month only.
#' @param procDV A previously created \link[whitewater]{ww_dvUSGS} object.
#' @param sites A \code{character} vector with NWIS site numbers (optional).
#' @param parallel \code{logical} indicating whether to use future_map().
#' @param verbose \code{logical} for printing information. TRUE (default).
#' @param ... arguments to pass on to \link[furrr]{future_map} and \link[whitewater]{ww_dvUSGS}.
#' @note If a previously created \link[whitewater]{ww_dvUSGS} object is not used then the user needs to
#' provide a \code{sites} vector. This will run \link[whitewater]{ww_dvUSGS} in the background.
#' @return A \code{tibble} filtered by month and added meta-data.
#' @export
#' @examples \dontrun{
#'
#' library(whitewater)
#' yaak_river_dv <- ww_dvUSGS('12304500',
#' parameter_cd = '00060',
#' wy_month = 10)
#'
#' yaak_river_month <- ww_monthUSGS(yaak_river_dv)
#'
#' }
#' @importFrom dplyr group_by summarise mutate relocate
#'
#'
<- (procDV, sites = , = , verbose = , ) {
((procDV)) {
(()){
usgs_raw <- (sites = sites, = , )
} {
usgs_raw <- (sites = sites, = , )
}
} {
usgs_raw <- procDV }
cols <- cols_to_update(usgs_raw)
( final_data <- usgs_raw %>%
group_by(Station,site_no, month_abb) %>%
summarise(across(dplyr::any_of(cols),
(
= ~(.x, na.rm = ),
= ~(.x, na.rm = ),
= ~(.x, na.rm = ),
= ~(.x, na.rm = ),
= ~(.x, na.rm = ),
stdev = ~(.x, na.rm = ),
coef_var = ~(.x, na.rm = )/(.x, na.rm = )))) %>%
ungroup()%>%
dplyr::left_join(usgs_raw %>%
dplyr::select(
drainage_area,
lat,
long,
altitude,
site_no,
month_abb) %>%
dplyr::group_by(site_no, month_abb) %>%
dplyr::slice(1) %>%
dplyr::ungroup(), = ('site_no', 'month_abb')))
((final_data) < 1){
final_data <-
} {
((verbose)){
cli::cli_alert_success('{usethis::ui_value("monthly")} data was successfully downloaded.')
}
}
final_data %>%
dplyr::relocate(Station, site_no, drainage_area,
lat, long, altitude,dplyr::everything())
}
#' Floor IV USGS
#' @description This function generates instantaneous NWIS data from \url{https://waterservices.usgs.gov/}
#' and then floors to a user defined interval with \link[whitewater]{wwOptions}
#' ('1 hour' is default) by taking the mean.
#' @param procDV A previously created \link[whitewater]{ww_dvUSGS} object.
#' @param sites A \code{vector} of USGS NWIS sites (optional).
#' @param parameter_cd A USGS code parameter code, only if using \code{sites} argument.
#' @param options A \link[whitewater]{wwOptions} call.
#' @param parallel \code{logical} indicating whether to use future_map().
#' @param verbose \code{logical} for printing information. TRUE (default).
#' @param ... arguments to pass on to \link[furrr]{future_map}.
#'
#'
#' @note For performance reasons, with multi-site retrievals you may
#' retrieve data since October 1, 2007 only. If a previously created \link[whitewater]{ww_dvUSGS} object is not used then the user needs to
#' provide a \code{sites} vector. This will run \link[whitewater]{ww_dvUSGS} in the background.
#' @return A \code{tibble} with a user defined interval time step.
#' @examples \dontrun{
#'
#' library(whitewater)
#' yaak_river_dv <- ww_dvUSGS('12304500',
#' parameter_cd = '00060',
#' wy_month = 10)
#'
#' yaak_river_iv <- ww_floorIVUSGS(yaak_river_dv)
#'
#' #change floor method
#'
#' yaak_river_iv <- ww_floorIVUSGS(yaak_river_dv,
#' options = wwOptions(floor_iv = '6-hour'))
#'
#' #change number of days
#'
#' yaak_river_iv <- ww_floorIVUSGS(yaak_river_dv,
#' options = wwOptions(floor_iv = '2-hour',
#' period = 365))
#'
#' # get by date range
#'
#'
#' yaak_river_wy <- ww_floorIVUSGS(yaak_river_dv,
#' options = wwOptions(date_range = 'date_range',
#' dates = c('2022-03-01', '2022-05-11')))
#'
#' #parallel
#'
#' #get sites
#'
#' huc17_sites <- dataRetrieval::whatNWISdata(huc = 17,
#' siteStatus = 'active',
#' service = 'dv',
#' parameterCd = '00060')
#'
#' library(future)
#' #need to call future::plan()
#' plan(multisession(workers = availableCores()-1))
#'
#' pnw_dv <- ww_dvUSGS(huc17_sites$site_no,
#' parameter_cd = '00060',
#' wy_month = 10,
#' parallel = TRUE)
#'
#' pnw_iv <- ww_floorIVUSGS(pnw_dv,
#' parallel = TRUE)
#' }
#' @export
#' @importFrom lubridate ymd_hm floor_date
#' @importFrom dplyr mutate rename rename_with group_by mutate relocate summarise ungroup contains
#' @importFrom dataRetrieval renameNWISColumns readNWISsite setAccess
#' @importFrom httr GET write_disk http_error
#'
<- (procDV,
sites = ,
parameter_cd = ,
= (),
= ,
verbose = ,
) {
(!(sites) & !(procDV)){("Can't use both Sites and procDV")}
((sites) & (procDV)){("Need at least one argument!")}
#create iteration value
site_station_days <- prepping_reports(procDV, sites, parameter_cd, )
cols <- site_station_days$cols$cols
#run over api, pulling necessary data.
<- ()
(()){
usgs_download_hourly <- site_station_days %>%
(.$sites) %>%
furrr::future_map(safely(~iv_USGS(., = .$options[1]],
= 'hour', verbose = verbose,
= )), ) %>%
purrr::keep(~(.) != 0) %>%
purrr::map(~.x'result']]) %>%
purrr::map(~rename_with(., ~(".*_","", .x),
dplyr::ends_with(('_', cols)))) %>%
plyr::rbind.fill()
} {
usgs_download_hourly <- site_station_days %>%
(.$sites) %>%
purrr::map(safely(~iv_USGS(., = .$options[1]],
= 'hour', verbose = verbose,
= 0)))%>%
purrr::keep(~(.) != 0) %>%
purrr::map(~.x'result']]) %>%
purrr::map(~rename_with(., ~(".*_","", .x),
dplyr::ends_with(('_', cols)))) %>%
plyr::rbind.fill()
}
#final step: clean up data
usgs_download_hourly <- usgs_download_hourly %>%
dt_to_tibble() %>%
mutate( = ymd_hm(datetime))
(usgs_download_hourly <- usgs_download_hourly %>%
mutate(=floor_date(, 'floor_iv']])) %>%
mutate(across(dplyr::any_of(cols), readr::parse_number)) %>%
group_by(Station, site_no,param_type, ) %>%
dplyr::summarise(across(dplyr::any_of(cols),
~(.x, na.rm = ))) %>%
ungroup()) %>%
dplyr::mutate_all(~((.), , .))
# usgs_download_hourly <- usgs_download_hourly %>%
# tidyr::pivot_wider(names_from = param_type, values_from = dplyr::any_of(cols)) %>%
# dplyr::select_if(all_na) %>%
# dplyr::rename_with(~name_params_to_update(.x), dplyr::contains('param'))
usgs_download_hourly <- usgs_download_hourly %>% dplyr::(!())
}
#' Instantaneous USGS
#' @description This function generates Instantaneous NWIS data from
#' \url{https://waterservices.usgs.gov/}.
#' @param procDV A previously created \link[whitewater]{ww_dvUSGS} object.
#' @param sites A \code{vector} of USGS NWIS sites. \code{optional}
#' @param parameter_cd A USGS code parameter code, only if using \code{sites} argument.
#' @param options A \link[whitewater]{wwOptions} call.
#' @param parallel \code{logical} indicating whether to use future_map().
#' @param verbose \code{logical} for printing information. TRUE (default).
#' @param ... arguments to pass on to \link[furrr]{future_map}.
#'
#' @note For performance reasons, with multi-site retrievals you may
#' retrieve data since October 1, 2007 only. If a previously created \link[whitewater]{ww_dvUSGS} object is not used then the user needs to
#' provide a \code{sites} vector. This will run \link[whitewater]{ww_dvUSGS} in the background.
#' @return A \code{tibble} with instantaneous values.
#' @export
#'
#' @examples \dontrun{
#'
#' library(whitewater)
#' yaak_river_dv <- ww_dvUSGS('12304500',
#' parameter_cd = '00060',
#' wy_month = 10)
#'
#' yaak_river_iv <- ww_instantaneousUSGS(yaak_river_dv)
#'
#' #change number of days
#'
#' yaak_river_iv <- ww_instantaneousUSGS(yaak_river_dv,
#' options = wwOptions(period = 365))
#'
#' # get by date range
#'
#' yaak_river_wy <- ww_instantaneousUSGS(yaak_river_dv,
#' options = wwOptions(date_range = 'date_range',
#' dates = c('2022-03-01', '2022-05-11')))
#'
#' # get most recent
#'
#' yaak_river_wy <- ww_instantaneousUSGS(yaak_river_dv,
#' options = wwOptions(date_range = 'recent'))
#'
#' #parallel
#'
#' #get sites
#'
#' huc17_sites <- dataRetrieval::whatNWISdata(huc = 17,
#' siteStatus = 'active',
#' service = 'dv',
#' parameterCd = '00060')
#'
#' library(future)
#' #need to call future::plan()
#' plan(multisession(workers = availableCores()-1))
#'
#' pnw_dv <- ww_dvUSGS(huc17_sites$site_no,
#' parameter_cd = '00060',
#' wy_month = 10,
#' parallel = TRUE)
#'
#' pnw_iv <- ww_instantaneousUSGS(pnw_dv,
#' parallel = TRUE)
#' }
#'
#' @importFrom lubridate ymd_hm floor_date
#' @importFrom dplyr mutate rename rename_with group_by mutate relocate summarise ungroup contains
#' @importFrom dataRetrieval renameNWISColumns readNWISsite
#' @importFrom httr GET write_disk http_error
#'
<- (procDV,
sites = ,
parameter_cd = ,
= (),
= ,
verbose = ,
) {
(!(sites) & !(procDV)){("Can't use both Sites and procDV")}
((sites) & (procDV)){("Need at least one argument!")}
#create iteration value
site_station_days <- prepping_reports(procDV, sites, parameter_cd, )
cols <- site_station_days$cols$cols
#run over api, pulling necessary data.
<- ()
(()){
usgs_download_inst <- site_station_days %>%
(.$sites) %>%
furrr::future_map(safely(~iv_USGS(., = .$options[1]],
= 'inst', verbose = verbose,
= )),) %>%
purrr::keep(~(.) != 0) %>%
purrr::map(~.x'result']])%>%
purrr::map(~rename_with(., ~(".*_","", .x),
dplyr::ends_with(('_', cols)))) %>%
plyr::rbind.fill()
} {
usgs_download_inst <- site_station_days %>%
(.$sites) %>%
purrr::map(safely(~iv_USGS(., = .$options[1]],
= 'inst', verbose = verbose,
= 0)))%>%
purrr::keep(~(.) != 0) %>%
purrr::map(~.x'result']]) %>%
purrr::map(~rename_with(., ~(".*_","", .x),
dplyr::ends_with(('_', cols)))) %>%
plyr::rbind.fill()
}
#final step: clean up data
usgs_download_inst <- usgs_download_inst %>%
dt_to_tibble()
(usgs_download_inst <- usgs_download_inst %>%
mutate(across(dplyr::any_of(cols), iv_error_codes, .names = "{.col}_error")) %>%
mutate(across(dplyr::any_of(cols), readr::parse_number)) %>%
select(Station, site_no,param_type, = 'datetime', dplyr::any_of(cols), dplyr::ends_with("_error")))
# usgs_download_inst <- usgs_download_inst %>%
# tidyr::pivot_wider(names_from = param_type, values_from = dplyr::any_of(cols)) %>%
# dplyr::select_if(all_na) %>%
# dplyr::rename_with(~name_params_to_update(.x), dplyr::contains('param'))
usgs_download_inst <- usgs_download_inst %>%
dplyr::(!()) %>%
dplyr::mutate_all(~((.), , .)) %>%
mutate( = lubridate::ymd_hm((, "%Y-%m-%d %H:%M")))
}
#' Prep USGS Instantaneous
#'
#' @param data the original data.frame
#' @param options a list of API arguments
#' @param type character of API call
#' @param verbose logical for printing information
#' @param delay time to delay in future_call
#'
#' @noRd
#' @return A data.frame with instantaneous values
#'
iv_USGS <- (, , , verbose, ){
df_final <- ()
(i $params[1]]){
# download csv
base_url <- ($date_range,
'pfn' = (
"https://waterservices.usgs.gov/nwis/iv/?format=rdb&sites=",
$sites,
"&period=P",$period,"D¶meterCd=", i, "&siteStatus=", $site_status
),
'date_range' = (
"https://waterservices.usgs.gov/nwis/iv/?format=rdb&sites=",
$sites,
"&startDT=",$dates[1]],"T00:00-0000&endDT=",$dates[2]],"T00:00-0000",
"¶meterCd=", i, "&siteStatus=", $site_status
),
"recent" = (
"https://waterservices.usgs.gov/nwis/iv/?format=rdb&sites=",
$sites,
"¶meterCd=", i, "&siteStatus=", $site_status
)
)
# try to download the data
error <- httr::GET( = base_url,
httr::write_disk(path = ((),
"usgs_tmp.csv"),
overwrite = ))
# read RDB file to R
<- ::(((),"usgs_tmp.csv"),
header = ,
sep = "\t",
stringsAsFactors = )
#remove excess data
<- -1,]
<- %>% dplyr::mutate(dplyr::across(contains(('agency_cd', 'site_no', 'datetime')), ~dplyr::na_if(.,"")))
<- renameNWISColumns() %>%
select(site_no, datetime, dplyr::contains($cols[1]]))
#add metadata
<- %>%
mutate(Station = ($station),
param_type = ('param_',i)) %>%
relocate(Station)
df_final <- plyr::rbind.fill(df_final, )
}
((verbose)){
(((df_final,('site_no', 'datetime')]))){
cli::cli_alert_warning('{usethis::ui_field({data$station})} ran into an error (no data for user input).')
} {
final_data_logic <- df_final %>%
dplyr::group_by(param_type) %>%
dplyr::summarise(dplyr::across(('site_no'), ~((.))))
param_names <- name_params_to_update(final_data_logic[which(final_data_logic'site_no']$site_no == ),]$param_type)
(purrr::is_empty(param_names)){
( == 'inst'){
cli::cli_alert_success('{usethis::ui_field(dplyr::slice(df_final, 1)$Station)} {usethis::ui_value("instantaneous values")} were successfully downloaded.')
} if ( == 'hour'){
cli::cli_alert_success('{usethis::ui_field(dplyr::slice(df_final, 1)$Station)} {usethis::ui_value("floored values")} were successfully downloaded.')
}
} {
( == 'inst'){
cli::cli_alert_success('{usethis::ui_field(dplyr::slice(df_final, 1)$Station)} {usethis::ui_value("instantaneous values")} were successfully downloaded.
{crayon::red("(warning)")} Parameter(s) {usethis::ui_value(param_names)} returned no data.')
} if ( == 'hour'){
cli::cli_alert_success('{usethis::ui_field(dplyr::slice(df_final, 1)$Station)} {usethis::ui_value("floored values")} were successfully downloaded.
{crayon::red("(warning)")} Parameter(s) {usethis::ui_value(param_names)} returned no data.')
}
}
}
}
()
df_final
}
#' Prepping Peaks
#'
#' @param site_no A \code{character} USGS NWIS site.
#' @param wy_month a water year to filter by
#' @param verbose \code{logical} for printing information. TRUE (default).
#' @param dv internal logical
#' @param delay time to delay in future_call
#'
#' @return a data.frame with instantaneous peaks from USGS
#' @noRd
peaks_USGS <- (site_no, wy_month, verbose, dv = , ){
final_data <- dataRetrieval::readNWISpeak(site_no)%>% select(peak_va, peak_dt, site_no) %>%
mutate(wy = waterYear(peak_dt, wy_month, ))
(!(dv)){
gage_info <- tibble(
site_no = site_no,
drainage_area = readNWISsite(site_no) %>% select(drain_area_va) %>% (),
Station = readNWISsite(site_no) %>% select(station_nm) %>% (),
lat = readNWISsite(site_no) %>% select(dec_lat_va) %>% (),
long = readNWISsite(site_no) %>% select(dec_long_va) %>% (),
altitude = readNWISsite(site_no) %>% select(alt_va) %>% ()
)
final_data <- dplyr::left_join(final_data, gage_info, = ('site_no'))
}
((verbose)){
((final_data) < 1){
cli::cli_alert_warning('{usethis::ui_field(dplyr::slice(final_data, 1)$site_no)} ran into an error.')
} {
cli::cli_alert_success('{usethis::ui_field(dplyr::slice(final_data, 1)$site_no)} {usethis::ui_value("peak flows")} were successfully downloaded.')
}
}
()
final_data
}
#' Get Peak Flows
#'
#' @param data data.frame
#' @param parallel whether to use future_map or not
#' @param wy_month a water year to filter by
#' @param verbose \code{logical} for printing information. TRUE (default).
#' @param delay time to delay in future_call
#' @param ... other stuff to pass to future_map
#'
#' @return a \code{tibble} with peaks by water year
#' @noRd
ww_peakUSGSdv <- (, ,wy_month,verbose,, ) {
peak_sites <- (peaks = ($site_no))
(()){
peaks <- peak_sites %>%
(.$peaks) %>%
furrr::future_map(purrr::safely(~peaks_USGS(.$peaks,
wy_month = wy_month,
verbose = verbose,
= )), ) %>%
purrr::keep(~(.) != 0) %>%
purrr::map(~.x'result']]) %>%
plyr::rbind.fill()
} {
peaks <- peak_sites %>%
(.$peaks) %>%
purrr::map(purrr::safely(~peaks_USGS(.$peaks,
wy_month = wy_month,
verbose = verbose,
= 0))) %>%
purrr::keep(~(.) != 0) %>%
purrr::map(~.x'result']]) %>%
plyr::rbind.fill()
}
usgs_min_max_wy <- %>%
dt_to_tibble() %>%
dplyr::left_join(peaks, = ("site_no", "wy")) %>%
dplyr::select(Station, site_no, wy, peak_va, peak_dt, dplyr::everything())
}
