From c51901d6531613fe661c3ea9919c43501b448c81 Mon Sep 17 00:00:00 2001
From: Bock <abock@usgs.gov>
Date: Mon, 8 May 2023 10:00:17 -0600
Subject: [PATCH] Major mods see MR for details
---
workspace/05_hyRefactor_flines.Rmd | 114 ++++++++++++++++-------------
1 file changed, 65 insertions(+), 49 deletions(-)
diff --git a/workspace/05_hyRefactor_flines.Rmd b/workspace/05_hyRefactor_flines.Rmd
index 4049aac..ccdb427 100644
--- a/workspace/05_hyRefactor_flines.Rmd
+++ b/workspace/05_hyRefactor_flines.Rmd
@@ -28,36 +28,33 @@ source("R/hyRefactor_funs.R")
source("R/config.R")
```
-Load and filter source NHD Flowline network.
+Load and filter source NHD Flowline network. Bring in POIs
```{r flowlines}
nhd <- read_sf(out_refac_gpkg, nhd_flowline)
cats <- read_sf(out_refac_gpkg, nhd_catchment)
-POIs <- read_sf(nav_gpkg, final_poi_layer)
+POIs_data <- read_sf(nav_gpkg, poi_data_table)
-POI_id <- st_drop_geometry(POIs)
+POIs <- read_sf(nav_gpkg, poi_geometry_table)
-events <- read_sf(temp_gpkg, split_layer)
+POI_id <- st_drop_geometry(POIs)
```
Read POIs and add nhd outlets. Save to a non-spatial table.
```{r refactor}
-POIs <- POIs %>%
- inner_join(select(st_drop_geometry(nhd), TotDASqKM, COMID, DnHydroseq), by = "COMID")
-
-# Gages that were collapsed during navigate; might not correspond to their Gage_info COMIDs;
-# We know DAR for those are acceptable, so will keep those out of the events generation.
-POIs_mv <- filter(POIs, snapped)
+POIs_ref <- POIs %>%
+ inner_join(select(st_drop_geometry(nhd), TotDASqKM, COMID, DnHydroseq), by = c("hy_id" = "COMID"))
# Also need to avoid modification to flowlines immediately downstream of POIs
# This can cause some hydrologically-incorrect catchment aggregation
-POI_downstream <- filter(nhd, Hydroseq %in% POIs$DnHydroseq, AreaSqKM > 0)
+POI_downstream <- filter(nhd, Hydroseq %in% POIs_ref$DnHydroseq, AreaSqKM > 0)
# build final outlets set
-outlets <- POIs %>%
- mutate(type = ifelse(!is.na(Type_Term), "terminal", "outlet"))
-event_POIs <- filter(POIs, nexus == "1")
+term_poi <- filter(POIs_data, hl_reference == "Type_Term")
+
+outlets <- POIs_ref %>%
+ mutate(type = ifelse(poi_id %in% term_poi$poi_id, "terminal", "outlet"))
# derive list of unique terminal paths
TerminalPaths <- unique(nhd$TerminalPa)
@@ -74,7 +71,19 @@ write_sf(nhd, out_refac_gpkg, nhd_flowline)
nhdplus_flines <- sf::st_zm(filter(nhd, refactor == 1)) %>%
st_as_sf()
-events <- filter(events, COMID %in% nhdplus_flines$COMID)
+if(!needs_layer(nav_gpkg, event_geometry_table)){
+ events <- read_sf(nav_gpkg, event_geometry_table) %>%
+ mutate(event_identifier = as.character(row_number()))
+
+ events_ref <- filter(events, hy_id %in% nhdplus_flines$COMID) %>%
+ rename(COMID = hy_id) %>%
+ distinct(COMID, REACHCODE, REACH_meas, event_identifier)
+
+ outlets <- filter(outlets, !poi_id %in% events$poi_id) %>%
+ rename(COMID = hy_id)
+} else {
+ events_ref <- NULL
+}
if(needs_layer(out_refac_gpkg, refactored_layer)) {
@@ -93,7 +102,7 @@ if(needs_layer(out_refac_gpkg, refactored_layer)) {
out_reconciled = tr,
three_pass = TRUE,
purge_non_dendritic = FALSE,
- events = events,
+ events = events_ref,
exclude_cats = c(outlets$COMID, avoid$COMID, POI_downstream$COMID),
warn = TRUE)
@@ -129,49 +138,56 @@ if(needs_layer(out_refac_gpkg, outlets_layer)) {
select(member_COMID = COMID, Hydroseq, event_identifier, event_REACHCODE) %>%
inner_join(select(st_drop_geometry(nhd), orig_COMID = COMID, Hydroseq), by = "Hydroseq")
- # Subset for events
- refactored_events <- refactored %>%
- filter(!is.na(event_REACHCODE), !is.na(event_identifier))
+ if(!is.null(events_ref)){
+ # Subset for events
+ refactored_events <- refactored %>%
+ filter(!is.na(event_REACHCODE), !is.na(event_identifier))
- # Get ref_COMID for events
- # events_ref_COMID <- mutate(events, event_identifier = as.character(row_number())) %>%
- # left_join(select(st_drop_geometry(refactored_events), ref_COMID, event_identifier, orig_COMID),
- # by = "event_identifier")
-
- outlet_events <- filter(outlets, nexus == "1") %>%
- left_join(select(st_drop_geometry(refactored_events), member_COMID, event_identifier, orig_COMID),
- by = c("COMID" = "orig_COMID")) %>%
- filter(!is.na(member_COMID)) %>%
- select(-event_identifier)
-
- # subset for refactored outlets (non-events)
- refactored_outlets <- filter(refactored, !member_COMID %in% outlet_events$member_COMID)
-
- # get ref_COMId for other outlets
- outlets_ref_COMID <- filter(outlets, !identifier %in% outlet_events$identifier) %>%
- left_join(select(st_drop_geometry(refactored_outlets), member_COMID, orig_COMID),
- by = c("COMID" = "orig_COMID")) %>%
- group_by(COMID) %>%
- filter(member_COMID == max(member_COMID)) %>%
- rbind(outlet_events) %>%
+ event_outlets <- events %>%
+ inner_join(st_drop_geometry(refactored_events), by = "event_identifier") %>%
+ select(hy_id, event_id, poi_id, member_COMID)
+
+ # subset for refactored outlets (non-events)
+ refactored_outlets <- filter(refactored, !member_COMID %in% event_outlets$member_COMID)
+
+ # get ref_COMId for other outlets
+ outlets_ref <- outlets %>%
+ left_join(select(st_drop_geometry(refactored_outlets), member_COMID, orig_COMID),
+ by = c("COMID" = "orig_COMID")) %>%
+ group_by(COMID) %>%
+ filter(member_COMID == max(member_COMID)) %>%
+ select(hy_id = COMID, poi_id, member_COMID, type)
+
+ outlets_ref_COMID <- data.table::rbindlist(list(outlets_ref, event_outlets), fill = TRUE) %>%
+ st_as_sf()
+ } else {
+ # get ref_COMId for other outlets
+ outlets_ref_COMID <- outlets %>%
+ left_join(select(st_drop_geometry(refactored), member_COMID, orig_COMID),
+ by = c("COMID" = "orig_COMID")) %>%
+ group_by(COMID) %>%
+ filter(member_COMID == max(member_COMID)) %>%
+ select(hy_id = COMID, poi_id, member_COMID, type)
+ }
+
+ final_outlets <- outlets_ref_COMID %>%
+ st_as_sf() %>%
inner_join(select(lookup_table, member_COMID, reconciled_ID),
- by = "member_COMID")
+ by = "member_COMID")
- write_sf(outlets_ref_COMID, out_refac_gpkg, outlets_layer)
-
-
+ write_sf(final_outlets, out_refac_gpkg, outlets_layer)
} else {
- outlets_ref_COMID <- read_sf(out_refac_gpkg, outlets_layer)
+ final_outlets <- read_sf(out_refac_gpkg, outlets_layer)
}
-check_dups <- outlets_ref_COMID %>%
+check_dups_poi <- final_outlets %>%
group_by(reconciled_ID) %>%
filter(n() > 1) %>%
- ungroup()
+ ungroup
-if(nrow(check_dups) > 1){
+if(nrow(check_dups_poi) > 1){
print("Double-check for double POIs")
- write_sf(check_dups, temp_gpkg, paste0(dup_pois, "_", rpu_code))
+ write_sf(check_dups_poi, out_refac_gpkg, paste0(dup_pois, "_", rpu_code))
} else {
print("no double POIs detected")
}
--
GitLab