inst/doc/hydroloom.R

In hydroloom: Utilities to Weave Hydrologic Fabrics

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

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

library(sf)

oldoption <- options(scipen = 9999)

## -----------------------------------------------------------------------------
library(hydroloom)

hy_net <- sf::read_sf(system.file("extdata/new_hope.gpkg", package = "hydroloom")) |>
  dplyr::select(COMID, REACHCODE, FromNode, ToNode, Hydroseq, TerminalFl, Divergence)

hy(hy_net[1:3,])

attr(hy(hy_net), "orig_names")


## ----echo=FALSE, eval=TRUE, fig.dim=c(6, 4)-----------------------------------
print.data.frame(data.frame(id = c(1, 2, 3), 
                            toid = c(3, 3, NA),
                            fromnode = c("N1", "N2", "N3"),
                            tonode = c("N3", "N3", "N4")), 
                 row.names = FALSE)

## ----node, fig.show="hold", out.width="45%", echo=FALSE, eval=TRUE, fig.cap="In an edge-node topology, edges are directed to nodes which are then directed to other edges. An edge-to-edge toplogy does not include intervening nodes."----
x <- c(1, 5, 3, 3)
y <- c(5, 5, 3, 1)

oldpar <- par(mar = c(0, 0, 0, 0))
plot(x, y, col = NA)
arrows(x[1] + 0.1, y[1] - 0.1, x[3] - 0.1, y [3] + 0.1, 0.1)
arrows(x[2] - 0.1, y[2] -0.1, x[3] + 0.1, y [3] + 0.1, 0.1)
arrows(x[3], y[3] - 0.1, x[4], y [4] + 0.1, 0.1)
text(c(2, 4, 3.15), c(4.2, 4.2, 2), c("1", "2", "3"))

par(mar = c(0, 0, 0, 0))
plot(x, y)
arrows(x[1] + 0.1, y[1] - 0.1, x[3] - 0.1, y [3] + 0.1, 0.1)
arrows(x[2] - 0.1, y[2] -0.1, x[3] + 0.1, y [3] + 0.1, 0.1)
arrows(x[3], y[3] - 0.1, x[4], y [4] + 0.1, 0.1)
text(c(2, 4, 3.1), c(4.2, 4.2, 2), c("1", "2", "3"))
text(c(1, 5, 3, 3.25), c(4.8, 4.8, 3.4, 1), c("N1", "N2", "N3", "N4"))
par(oldpar)

## ----node1, fig.show="hold", fig.width=3, out.width="45%", echo=FALSE, eval=TRUE----
x <- c(2, 2, 3, 2, 2)
y <- c(5, 4, 3, 2, 1)

a <- c(1.4, 3.5)
b <- c(.9, 5.1)

main_col = "darkblue"
div_col = "purple"

oldpar <- par(mar = c(0, 0, 0, 0))
plot(a, b, col = NA)
points(x, y)
text(c(2.15, 1.85, 3.02, 1.85, 2.15), c(5, 4, 3.2, 2, 1), c("N1", "N2", "N3", "N4", "N5"))

make_edges <- function() {
  arrows(x[1], y[1] - .1, x[2], y[2] + .1, length = .1, col = main_col)
  arrows(x[2] + .1, y[2] - .1, x[3] - .1, y[3] + .1, length = .1, col = div_col) # right
  arrows(x[2] + .0, y[2] - .1, x[4] - .0, y[4] + .1, length = .1, col = main_col)
  arrows(x[3] - .1, y[3] - .1, x[4] + .1, y[4] + .1, length = .1, col = div_col)
  arrows(x[4], y[4] - .1, x[5], y[5] + .1, length = .1, col = main_col)
  text(c(2.1, 2.5, 2.5, 1.9, 2.1), c(4.5, 3.8, 2.3, 3, 1.5), c("1", "2", "3", "4", "5"))
}

make_edges()
par(oldpar)

## ----node2, fig.show="hold", fig.width=3, out.width="45%", echo=FALSE, eval=TRUE----

oldpar <- par(mar = c(0, 0, 0, 0))
plot(a, b, col = NA)

make_edges()
par(oldpar)

## -----------------------------------------------------------------------------
y <- add_toids(hy_net, return_dendritic = TRUE)

ind_id <- make_index_ids(y)

names(ind_id)

dim(ind_id$to)

max(lengths(ind_id$lengths))

names(ind_id$to_list)

sapply(ind_id, class)

## -----------------------------------------------------------------------------

y <- add_toids(st_drop_geometry(hy_net), return_dendritic = FALSE)

ind_id <- make_index_ids(y)

names(ind_id)
dim(ind_id$to)

max(ind_id$lengths)

sum(ind_id$lengths == 2)
sum(ind_id$lengths == 3)

names(ind_id$to_list)

sapply(ind_id, class)