Nothing
## ----setup, include = FALSE---------------------------------------------------
library(nhdplusTools)
local <- (Sys.getenv("BUILD_VIGNETTES") == "TRUE")
if(local) {
cache_path <- file.path(nhdplusTools_data_dir(), "hr_v_cache")
} else {
cache_path <- tempdir()
}
knitr::opts_chunk$set(
collapse = TRUE,
comment = "#>",
fig.width=6,
fig.height=4,
eval=local,
cache=local,
cache.path=(cache_path)
)
oldoption <- options(scipen = 9999,
"rgdal_show_exportToProj4_warnings"="none")
## ----tldr---------------------------------------------------------------------
library(nhdplusTools)
library(sf)
work_dir <- file.path(nhdplusTools_data_dir(), "hr_v_cache")
source(system.file("extdata/sample_data.R", package = "nhdplusTools"))
hr_gpkg <- file.path(work_dir, "hr_data.gpkg")
# Make a plot and get some background NHDPlusV2 data.
plot_data <- plot_nhdplus(list("nwissite", "USGS-05428500"), streamorder = 3,
nhdplus_data = sample_data)
# Find the HU04 we are interested in.
hu04 <- unique(substr(plot_data$flowline$reachcode, 1, 4))
# Download some NHDPlusHR Data
hr_data_dir <- download_nhdplushr(work_dir, hu04)
# Projection and simplification for demo purposes.
hr <- get_nhdplushr(work_dir, out_gpkg = hr_gpkg,
proj = 3857)
(start_index <- get_flowline_index(st_transform(hr$NHDFlowline, 5070),
st_transform(plot_data$outlets, 5070),
search_radius = 200)) # meters albers eq area
ids <- get_UT(hr$NHDFlowline, start_index$COMID)
hr_subset <- subset_nhdplus(ids, nhdplus_data = hr_gpkg)
## ----plot---------------------------------------------------------------------
plot_nhdplus(list("nwissite", "USGS-05428500"), streamorder = 2,
nhdplus_data = sample_data, overwrite = TRUE,
plot_config = list(flowline = list(lwd = 2.5),
basin = list(lwd = 3)))
plot(st_geometry(hr$NHDPlusCatchment), lwd = 0.25, add = TRUE)
plot(st_geometry(hr$NHDFlowline), col = "blue", lwd = 0.5, add = TRUE)
plot(st_geometry(st_transform(hr_subset$NHDFlowline, 3857)),
col = "cyan", lwd = 1, add = TRUE)
## ----downloadhr---------------------------------------------------------------
(hr_urls <- download_nhdplushr(work_dir, "06", download_files = FALSE))
# already downloaded:
list.files(hr_data_dir)
## ----get_nhdplushr------------------------------------------------------------
hr <- get_nhdplushr(hr_data_dir)
sapply(hr, class)
plot(st_geometry(hr$NHDFlowline), lwd = (hr$NHDFlowline$StreamOrde / 6))
## ----get_nhdplushr2-----------------------------------------------------------
hr <- get_nhdplushr(hr_data_dir, layers = c("NHDFlowline", "NHDWaterbody", "NHDArea"))
sapply(hr, class)
sapply(hr, nrow)
plot(st_geometry(hr$NHDFlowline), lwd = (hr$NHDFlowline$StreamOrde / 6), col = "blue")
plot(c(st_geometry(hr$NHDWaterbody), st_geometry(hr$NHDArea)),
col = "cyan", border = "cyan", lwd = 0.25, add = TRUE)
## ----get_nhdplushr3-----------------------------------------------------------
demo_gpkg <- file.path(work_dir, "demo.gpkg")
hr <- get_nhdplushr(hr_data_dir, out_gpkg = demo_gpkg)
st_layers(demo_gpkg)
## ----get_nhdplushr4-----------------------------------------------------------
demo <- get_nhdplushr(hr_data_dir, layers = "NHDFlowline",
min_size_sqkm = 50)
plot(st_geometry(demo$NHDFlowline),
lwd = demo$NHDFlowline$StreamOrde/4, col = "blue")
## ----get_nhdplushr5-----------------------------------------------------------
demo <- get_nhdplushr(hr_data_dir, layers = "NHDFlowline",
min_size_sqkm = 100,
proj = "+init=epsg:5070", simp = 200,
keep_cols = c("COMID", "StreamOrde"))
names(demo$NHDFlowline)
plot(st_geometry(demo$NHDFlowline),
lwd = demo$NHDFlowline$StreamOrde/4, col = "blue")
## ----make_standalone----------------------------------------------------------
demo <- get_nhdplushr(hr_data_dir, layers = "NHDFlowline",
min_size_sqkm = 100, check_terminals = FALSE)
# Create a standalone basin with the results for comparison.
standalone_demo <- make_standalone(demo$NHDFlowline)
demo_outlet <- dplyr::filter(demo$NHDFlowline, TotDASqKM == max(TotDASqKM))
standalone_demo_outlet <- dplyr::filter(standalone_demo, TotDASqKM == max(TotDASqKM))
broken_outlet <- dplyr::select(st_drop_geometry(demo_outlet),
Hydroseq, TerminalPa, TerminalFl, LevelPathI)
fixed_outlet <- dplyr::select(st_drop_geometry(standalone_demo_outlet),
Hydroseq, TerminalPa, TerminalFl, LevelPathI)
print(data.frame(broken_outlet))
print(data.frame(fixed_outlet))
(broken <- dplyr::filter(demo$NHDFlowline, TerminalPa == demo_outlet$Hydroseq))
(standalone <- dplyr::filter(standalone_demo, TerminalPa == standalone_demo_outlet$Hydroseq))
plot(st_geometry(standalone))
## ----teardown, include=FALSE--------------------------------------------------
options(oldoption)
if(Sys.getenv("BUILD_VIGNETTES") != "TRUE") {
unlink(work_dir, recursive = TRUE)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.