Skip to content

Commit

Permalink
working on updating issue #6
Browse files Browse the repository at this point in the history
  • Loading branch information
@joshualerickson
joshualerickson committed Jan 17, 2024
1 parent 2675ecd commit 067d111
Show file tree
Hide file tree
Showing 3 changed files with 50 additions and 64 deletions.
7 changes: 4 additions & 3 deletions R/nldi.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -182,14 +182,14 @@ server = function(input, output, session){
color = "black",
fillOpacity = 0,
weight = 3,
opacity = 1)
opacity = 1, popup = paste0("<b>", "DA acres: ", "</b>", scales::comma(as.numeric(round(units::set_units(sf::st_area(values$nldi_data()[[2]]), acres), 1)),1), " Acres"))

map_nldi <- leaflet::addPolylines(map_nldi,
data = values$nldi_data()[[1]],
color = "blue",
weight = 3,
opacity = 1)
}else if (input$location_map == 'local') {
} else if (input$location_map == 'local') {

values$nldi_data <- reactive(get_NLDI_catchments(data_sf,method = 'local'))

Expand All @@ -199,7 +199,8 @@ server = function(input, output, session){
color = "black",
fillOpacity = 0,
weight = 3,
opacity = 1)
opacity = 1, popup = paste0("<b>", "DA acres: ", "</b>", scales::comma(as.numeric(round(units::set_units(sf::st_area(values$nldi_data()[[2]]), acres), 1)),1), " Acres",
"<br>", "<b>", "Total length of Tribs: ", "</b>", round(sum(units::set_units(sf::st_length(values$nldi_data()[[1]]), mi)), 1), " Miles"))

map_nldi <- leaflet::addPolylines(map_nldi,
data = values$nldi_data()[[1]],
Expand Down
75 changes: 14 additions & 61 deletions R/utils.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2,53 +2,27 @@
#' Get NLDI
#'
#' @description This function grabs the upstream tributaries, upstream main stream and basin boundary using
#' the NLDI API. It then combines the NLDI zonal stats to the basin boundary shape, i.e. 'TOT' is the 'total' basin zonal statistic.
#' the NLDI API.
#'
#' @param point A sf point.
#' @noRd
#' @return A list of UT, UM and basin boundary sf objects
#'
get_NLDI <- function(point){

clat <- point$geometry[[1]][[2]]
clng <- point$geometry[[1]][[1]]

ids <- paste0("https://labs.waterdata.usgs.gov/api/nldi/linked-data/comid/position?coords=POINT%28",
clng,"%20", clat, "%29")

error_ids <- httr::GET(url = ids,
httr::write_disk(path = file.path(tempdir(),
"nld_tmp.json"),overwrite = TRUE))

nld <- jsonlite::fromJSON(file.path(tempdir(),"nld_tmp.json"))
comid <- nhdplusTools::discover_nhdplus_id(point)


nldiURLs <- list(site_data = paste0("https://labs.waterdata.usgs.gov/api/nldi/linked-data/comid/position?coords=POINT%28",
clng,"%20", clat, "%29"),
basin_boundary = paste0("https://labs.waterdata.usgs.gov/api/nldi/linked-data/comid/",nld$features$properties$identifier,"/basin"),
UT = paste0("https://labs.waterdata.usgs.gov/api/nldi/linked-data/comid/",nld$features$properties$identifier,"/navigation/UT/flowlines?distance=999"),
UM = paste0("https://labs.waterdata.usgs.gov/api/nldi/linked-data/comid/",nld$features$properties$identifier,"/navigation/UM/flowlines?distance=999"))
nldiURLs <- list(basin_boundary = paste0("https://labs.waterdata.usgs.gov/api/nldi/linked-data/comid/",comid,"/basin"),
UT = paste0("https://labs.waterdata.usgs.gov/api/nldi/linked-data/comid/",comid,"/navigation/UT/flowlines?distance=999"),
UM = paste0("https://labs.waterdata.usgs.gov/api/nldi/linked-data/comid/",comid,"/navigation/UM/flowlines?distance=999"))

nldi_data <- list()


for(n in names(nldiURLs)) {
nldi_data[n] <- list(sf::read_sf(nldiURLs[n][[1]]))
print(paste(n, "is of class", class(nldi_data[[n]]), "and has", nrow(nldi_data[[n]]), "features"))
}

total_characteristic <- data.frame(COMID = nldi_data$site_data$comid) %>% mutate(ID = dplyr::row_number()) %>%
group_by(ID) %>%
tidyr::nest() %>%
mutate(chars = purrr::map(data, ~nhdplusTools::get_nldi_characteristics(list(featureSource = "comid", featureID = as.character(.$COMID)),
type = 'total'))) %>% tidyr::unnest(c(data, chars)) %>% tidyr::unnest(c(chars)) %>% dplyr::ungroup() %>%
dplyr::select(COMID, characteristic_id, characteristic_value) %>%
tidyr::pivot_wider(names_from = "characteristic_id", values_from = "characteristic_value") %>%
dplyr::mutate(dplyr::across(is.character, as.numeric))


nldi_data[['basin_boundary']] <- nldi_data[['basin_boundary']] %>%
cbind(total_characteristic)
nldi_data

}
Expand All @@ -69,50 +43,29 @@ get_NLDI <- function(point){
#'
get_NLDI_catchments <- function(point, type = 'local', method = 'all'){

clat <- point$geometry[[1]][[2]]
clng <- point$geometry[[1]][[1]]
comid <- tryCatch(expr = {nhdplusTools::discover_nhdplus_id(point)},
error = function(e) {NA})

ids <- paste0("https://labs.waterdata.usgs.gov/api/nldi/linked-data/comid/position?coords=POINT%28",
clng,"%20", clat, "%29")

error_ids <- httr::GET(url = ids,
httr::write_disk(path = file.path(tempdir(),
"nld_tmp.json"),overwrite = TRUE))

nld <- jsonlite::fromJSON(file.path(tempdir(),"nld_tmp.json"))
if(is.na(comid)){stop('COMID not found')}

if(method == 'all'){
nldiURLs <- list(UT = paste0("https://labs.waterdata.usgs.gov/api/nldi/linked-data/comid/",nld$features$properties$identifier,"/navigation/UT/flowlines?distance=999"))
nldiURLs <- list(UT = paste0("https://labs.waterdata.usgs.gov/api/nldi/linked-data/comid/",comid,"/navigation/UT/flowlines?distance=999"))
} else if (method == 'local'){
nldiURLs <- list(UT = paste0("https://labs.waterdata.usgs.gov/api/nldi/linked-data/comid/",nld$features$properties$identifier,"/navigation/UT/flowlines?distance=0"))
nldiURLs <- list(UT = paste0("https://labs.waterdata.usgs.gov/api/nldi/linked-data/comid/",comid,"/navigation/UT/flowlines?distance=0"))
}

nldi_data <- list()

for(n in names(nldiURLs)) {
nldi_data[n] <- list(sf::read_sf(nldiURLs[n][[1]]))
print(paste(n, "is of class", class(nldi_data[[n]]), "and has", nrow(nldi_data[[n]]), "features"))
}

nldi_outlets <- nldi_data$UT$nhdplus_comid

nldi_catch <- nhdplusTools::get_nhdplus(comid = nldi_outlets,
realization = 'catchment')

local_characteristic <- data.frame(COMID = nldi_outlets) %>% mutate(ID = dplyr::row_number()) %>%
group_by(ID) %>%
tidyr::nest() %>%
mutate(chars = purrr::map(data, ~nhdplusTools::get_nldi_characteristics(list(featureSource = "comid", featureID = as.character(.$COMID)),
type = type))) %>% tidyr::unnest(c(data, chars)) %>% tidyr::unnest(c(chars)) %>% dplyr::ungroup() %>%
dplyr::select(COMID, characteristic_id, characteristic_value) %>%
tidyr::pivot_wider(names_from = "characteristic_id", values_from = "characteristic_value") %>%
dplyr::rename(featureid = 'COMID') %>%
dplyr::mutate(dplyr::across(is.character, as.numeric))%>%
dplyr::mutate(featureid = as.integer(featureid))


nldi_catch <- nldi_catch %>%
dplyr::left_join(local_characteristic, by = c('featureid'))
nldi_catch <- suppressMessages(purrr::map(nldi_outlets,~nhdplusTools::get_nhdplus(comid = .,
realization = 'catchment'))) %>%
dplyr::bind_rows() %>%
sf::st_as_sf(crs = 4326)

final_data <- list(nldi_data$UT, nldi_catch)
}
Expand Down
32 changes: 32 additions & 0 deletions tests/testthat/test-nldi.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -20,4 +20,36 @@ test_that("testing get catchment characteristics from nhdplusTools", {
testthat::expect_equal(catchment_char$characteristic_value[[1]], 72.07)


})


test_that("testing upstream main and tribs from nhdplusTools", {

point <- dplyr::tibble(Long = -115.2312,Lat = 48.83037)

point <- sf::st_as_sf(point, coords = c("Long", "Lat"), crs = 4326)

comid <- nhdplusTools::discover_nhdplus_id(point)

nldiURLs <- list(site_data = paste0("https://labs.waterdata.usgs.gov/api/nldi/linked-data/comid/position?coords=POINT%28",
clng,"%20", clat, "%29"),
basin_boundary = paste0("https://labs.waterdata.usgs.gov/api/nldi/linked-data/comid/",comid,"/basin"),
UT = paste0("https://labs.waterdata.usgs.gov/api/nldi/linked-data/comid/",comid,"/navigation/UT/flowlines?distance=999"),
UM = paste0("https://labs.waterdata.usgs.gov/api/nldi/linked-data/comid/",comid,"/navigation/UM/flowlines?distance=999"))

nldi_data <- list()


for(n in names(nldiURLs)) {
nldi_data[n] <- list(sf::read_sf(nldiURLs[n][[1]]))
}

testthat::expect_equal(length(nldi_data), 4)
testthat::expect_equal(length(nldi_data$site_data), 6)
testthat::expect_equal(length(nldi_data$basin_boundary), 1)
testthat::expect_equal(nrow(nldi_data$UT), 71)
testthat::expect_equal(nrow(nldi_data$UM), 27)



})

0 comments on commit 067d111

Please sign in to comment.