In dblodgett-usgs/hygeo: Hydrologic Geospatial Fabric Creation Functions

knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>",
  fig.width=6,
  fig.height=4,
  eval=nzchar(Sys.getenv("BUILD_VIGNETTES")),
  cache = FALSE
)
oldoption <- options(scipen = 9999)
options(scipen = 9999)
options("rgdal_show_exportToProj4_warnings"="none")

The following example shows how to work with data following the NHDPlusV2 schema.

# https://github.com/usgs-r/nhdplusTools
library(nhdplusTools)
# https://github.com/tidyverse/dplyr
library(dplyr)
# https://github.com/r-spatial/sf
library(sf)

library(hygeo)

sample_data <- system.file("gpkg/nhdplus_subset.gpkg", package = "hygeo")

plot_nhdplus(outlets = list(8895396),
             nhdplus_data = sample_data,
             overwrite = FALSE,
             plot_config = list(basin = list(border = NA),
                                outlets = list(default = list(col = NA))),
             cachedir = tempdir(check = TRUE))

fline <- read_sf(sample_data, "NHDFlowline_Network") %>%
  align_nhdplus_names() %>%
  filter(COMID %in% get_UT(., 8895396))

catchment <- read_sf(sample_data, "CatchmentSP") %>%
  align_nhdplus_names() %>%
  filter(FEATUREID %in% fline$COMID)

nexus <- get_nexus(fline)

plot(st_transform(st_geometry(catchment), 3857), add = TRUE)
plot(st_transform(st_geometry(nexus), 3857), add = TRUE)

Given the flowpaths, catchments, and nexuses, we can generate topology edge lists and data representations. The nexuses are outlet points along flowpaths in this case. Waterbodies are 1:1 with flowpath catchment realizations in this example but the data model will support 1:n or n:1 waterbody:catchment relationships.

catchment_prefix <- "catchment_"
nexus_prefix <- "nexus_"
waterbody_prefix <- "flowpath_"

(catchment_edge_list <- get_catchment_edges(fline, 
                                            catchment_prefix = catchment_prefix, 
                                            nexus_prefix = nexus_prefix))

(waterbody_edge_list <- get_waterbody_edge_list(fline, waterbody_prefix = waterbody_prefix))

(catchment_data <- get_catchment_data(catchment, catchment_edge_list))

(flowpath_data <- get_flowpath_data(fline, catchment_edge_list) %>%
    mutate(realized_catchment = gsub(waterbody_prefix, 
                                     catchment_prefix, ID)))

(nexus_data <- get_nexus_data(nexus, catchment_edge_list))

The outputs can be rendered into csv or json:

hygeo_list <- list(catchment = catchment_data, 
                   flowpath = flowpath_data, 
                   nexus = nexus_data,
                   catchment_edges = catchment_edge_list,
                   waterbody_edges = waterbody_edge_list)

class(hygeo_list) <- "hygeo"

temp_path <- file.path(tempdir(check = TRUE), "hygeo")
dir.create(temp_path, recursive = TRUE, showWarnings = FALSE)

temp_path <- write_hygeo(hygeo_list, out_path = temp_path, overwrite = TRUE)

(hygeo_list_read <- read_hygeo(temp_path))