Nothing
## ----setup, include = FALSE---------------------------------------------------
library(nhdplusTools)
local <- (Sys.getenv("BUILD_VIGNETTES") == "TRUE")
if(local) {
cache_path <- file.path(nhdplusTools_data_dir(), "plot_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),
dpi=72
)
oldoption <- options(scipen = 9999,
"rgdal_show_exportToProj4_warnings"="none")
## ----data_dir_setup, echo=FALSE, include=FALSE--------------------------------
work_dir <- file.path(nhdplusTools_data_dir(), "plot_v_cache")
dir.create(work_dir, recursive = TRUE, showWarnings = FALSE)
library(nhdplusTools)
## ----nwis_simple1, message=FALSE----------------------------------------------
plot_nhdplus("05428500")
## ----nwis_simple2, message=FALSE----------------------------------------------
plot_nhdplus(list(list("nwissite", "USGS-05428500"),
list("huc12pp", "070900020602")))
## ----two_outlets, message=FALSE-----------------------------------------------
plot_nhdplus(list(list("nwissite", "USGS-05428500"),
list("huc12pp", "070900020602")))
## ----point_location, message=FALSE--------------------------------------------
start_point <- sf::st_as_sf(data.frame(x = -89.36, y = 43.09),
coords = c("x", "y"), crs = 4326)
plot_nhdplus(start_point)
## ----plot_styles, message=FALSE-----------------------------------------------
source(system.file("extdata/sample_data.R", package = "nhdplusTools"))
plot_nhdplus(list(list("comid", "13293970"),
list("nwissite", "USGS-05428500"),
list("huc12pp", "070900020603"),
list("huc12pp", "070900020602")),
streamorder = 2,
nhdplus_data = sample_data,
plot_config = list(basin = list(lwd = 2),
outlets = list(huc12pp = list(cex = 1.5),
comid = list(col = "green"))))
## ----bbox_plotting, message=FALSE---------------------------------------------
bbox <- sf::st_bbox(c(xmin = -89.56684, ymin = 42.99816, xmax = -89.24681, ymax = 43.17192),
crs = "+proj=longlat +datum=WGS84 +no_defs")
plot_nhdplus(bbox = bbox)
## ----get data-----------------------------------------------------------------
library(sf)
library(nhdplusTools)
nwissite <- list(featureSource = "nwissite",
featureID = "USGS-05428500")
flowline <- navigate_nldi(nwissite,
mode = "upstreamTributaries",
data_source = "flowlines")
nhdplus <- subset_nhdplus(comids = as.integer(flowline$UT$nhdplus_comid),
output_file = file.path(work_dir, "nhdplus.gpkg"),
nhdplus_data = "download",
overwrite = TRUE, return_data = FALSE)
flowline <- read_sf(nhdplus, "NHDFlowline_Network")
upstream_nwis <- navigate_nldi(nwissite,
mode = "upstreamTributaries",
data_source = "nwissite")
basin <- get_nldi_basin(nwissite)
## ----introspect---------------------------------------------------------------
st_layers(nhdplus)
names(flowline)
names(upstream_nwis)
names(basin)
class(st_geometry(flowline))
class(st_geometry(upstream_nwis$UT_nwissite))
class(st_geometry(basin))
## ----plot---------------------------------------------------------------------
prep_layer <- function(x) st_geometry(st_transform(x, 3857))
bb <- sf::st_as_sfc(sf::st_bbox(prep_layer(basin)))
tiles <- maptiles::get_tiles(bb,
zoom = 11, crop = FALSE,
verbose = FALSE,
provider = "Esri.NatGeoWorldMap")
mapsf::mf_map(bb, type = "base", col = NA, border = NA)
maptiles::plot_tiles(tiles, add = TRUE)
mapsf::mf_map(bb, type = "base", add = TRUE, col = NA, border = NA)
mapsf::mf_arrow(adjust = bb)
mapsf::mf_scale()
plot(prep_layer(basin),
lwd = 2, add = TRUE)
plot(prep_layer(flowline),
lwd = 1.5, col = "deepskyblue", add = TRUE)
plot(prep_layer(dplyr::filter(flowline, streamorde > 2)),
lwd = 3, col = "darkblue", add = TRUE)
us_nwis_layer <- prep_layer(upstream_nwis$UT_nwissite)
plot(us_nwis_layer,
pch = 17, cex = 1.5, col = "yellow", add = TRUE)
label_pos <- st_coordinates(us_nwis_layer)
text(label_pos[,1],label_pos[,2],
upstream_nwis$identifier,
adj = c(-0.2, 0.5), cex = 0.7)
## ----ggmap, message=FALSE, warning=FALSE-------------------------------------
library(ggmap)
library(ggplot2)
ggmap_bbox <- setNames(sf::st_bbox(basin), c("left", "bottom", "right", "top"))
ggmap_bbox
upstream_nwis <- dplyr::bind_cols(upstream_nwis$UT_nwissite,
dplyr::rename(dplyr::as_tibble(sf::st_coordinates(upstream_nwis$UT_nwissite)),
lat = Y, lon = X))
# ggmap now requires api keys
# basemap_toner <- get_map(source = "stamen", maptype = "toner",
# location = ggmap_bbox, zoom = 11, messaging = FALSE)
# basemap_terrain <- get_map(source = "stamen", maptype = "terrain-lines",
# location = ggmap_bbox, zoom = 11, messaging = FALSE)
# toner_map <- ggmap(basemap_toner)
# terrain_map <- ggmap(basemap_terrain)
#
# toner_map
ggplot() + geom_sf(data = basin,
inherit.aes = FALSE,
color = "black", fill = NA) +
geom_sf(data = flowline,
inherit.aes = FALSE,
color = "deepskyblue") +
geom_sf(data = dplyr::filter(flowline, streamorde > 2),
inherit.aes = FALSE,
color = "darkblue") +
geom_sf(data = upstream_nwis, inherit.aes = FALSE, color = "red") +
geom_text(data = upstream_nwis, aes(label = identifier, x = lon, y = lat),
hjust = 0, size=2.5, nudge_x = 0.02, col = "black")
## ----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.