## ----setup, include = FALSE---------------------------------------------------
local <- (Sys.getenv("BUILD_VIGNETTES") == "TRUE")

if (!requireNamespace("nhdplusTools", quietly = TRUE)) local <- FALSE
if (!requireNamespace("mapview", quietly = TRUE)) local <- FALSE

if (local) {
  nhdplusTools::nhdplusTools_data_dir(file.path(tempdir(), "nhd_cache"))
}

oldoption <- options(scipen = 9999)

knitr::opts_chunk$set(
  collapse = TRUE,
  warning = FALSE,
  comment = "#>",
  fig.width = 4,
  fig.height = 4,
  fig.align = "center",
  eval = local
)

## ----message=FALSE------------------------------------------------------------
library(hydroloom)
library(dplyr)

dir <- nhdplusTools::download_nhd(nhdplusTools::nhdplusTools_data_dir(),
  "1908", TRUE)
fs <- list.files(dir, pattern = ".*1908.*.gdb", full.names = TRUE)

# Dropping Z and M and making sure everything is LINESTRING helps later.
fl <- sf::st_cast(sf::st_zm(sf::read_sf(fs, "NHDFlowline"), "LINESTRING"))

# remove any coastal (ftype 566) features
fl <- filter(fl, ftype != 566)

## ----message=FALSE------------------------------------------------------------
# this is a seed point near the outlet of a watershed to consider.
point <- sf::st_sfc(sf::st_point(c(-147.911472, 64.796633)),
  crs = 4269)

# now we get the line our point is along.
i <- index_points_to_lines(fl, point)

# Let's see what we have.
sub <- fl[fl$permanent_identifier == i$permanent_identifier, ]

mapview::mapview(list(sub, point))

## ----message=FALSE------------------------------------------------------------
# remove coastal and make terminals go to an empty id.
flow_table <- sf::read_sf(fs, "NHDFlow") |>
  filter(from_permanent_identifier %in% fl$permanent_identifier) |>
  mutate(to_permanent_identifier =
    ifelse(!to_permanent_identifier %in% from_permanent_identifier,
      "",
      to_permanent_identifier))

# Remove loops found in navigate network dfs
remove <- hydroloom::check_hy_graph(flow_table)

# this is naive and these removals would normally be reviewed.
flow_table <- flow_table |>
  mutate(row = seq_len(n())) |>
  filter(!row %in% remove$row)

down <- navigate_network_dfs(flow_table, sub$permanent_identifier, direction = "down")
up <- navigate_network_dfs(flow_table, sub$permanent_identifier, direction = "up")

subdown <- fl[fl$permanent_identifier %in% unique(unlist(down)), ]
subup <- fl[fl$permanent_identifier %in% unique(unlist(up)), ]

plot(c(sf::st_geometry(subup), sf::st_geometry(subdown)), col = NA)
plot(sf::st_geometry(subup), col = "blue", lwd = 1, add = TRUE)
plot(sf::st_geometry(subdown), col = "red", lwd = 1, add = TRUE)
plot(sf::st_geometry(point), col = "black", pch = 16, cex = 1.5, add = TRUE)

## ----teardown, include=FALSE--------------------------------------------------
options(oldoption)

unlink(nhdplusTools::nhdplusTools_data_dir(), recursive = TRUE)

