Major mods see MR for details

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")
 }