vpu/VPU to vpu_codes, MR cleanup

workspace/02_NHD_navigate.Rmd

@@ -32,17 +32,6 @@ source("R/config.R")
 # Gages output from Gage_selection
 gages <- read_sf(gage_info_gpkg, "Gages")
 
-# NWM network
-nc <- RNetCDF::open.nc(data_paths$nwm_network)
-# NWM gages
-nwm_gages <- data.frame(
- comid = RNetCDF::var.get.nc(nc, "link"),
- gage_id = RNetCDF::var.get.nc(nc, "gages")) %>%
- mutate(gage_id = gsub(" ", "", gage_id)) %>%
- mutate(gage_id = ifelse(gage_id == "", NA, gage_id))
-
-RNetCDF::close.nc(nc)
-
 # need some extra attributes for a few POI analyses
 atts <- readRDS(file.path(data_paths$nhdplus_dir, "nhdplus_flowline_attributes.rds"))
 ```
@@ -52,15 +41,15 @@ atts <- readRDS(file.path(data_paths$nhdplus_dir, "nhdplus_flowline_attributes.r
 if(needs_layer(temp_gpkg, nav_poi_layer)) {
   
    nhd <- read_sf(nav_gpkg, nhd_flowline) 
-   #try(nhd <- select(nhd, -c(minNet, WB, struct_POI, struct_Net, POI_ID, dend)), silent = TRUE)
-  
+   try(nhd <- select(nhd, -c(minNet, WB, struct_POI, struct_Net, POI_ID, dend, poi)), silent = TRUE)
+
   # Some NHDPlus VPUs include HUCs from other VPUs
-  if(vpu == "02"){
+  if(vpu_codes == "02"){
     grep_exp <-"^02|^04"
-  } else if (vpu == "08") {
+  } else if (vpu_codes == "08") {
     grep_exp <- "^03|^08"
   } else {
-    grep_exp <- paste0("^", substr(vpu, start = 1, stop = 2))
+    grep_exp <- paste0("^", substr(vpu_codes, start = 1, stop = 2))
   }
   
   # Join HUC12 outlets with NHD
@@ -115,7 +104,7 @@ if(!"Type_Gages" %in% names(tmp_POIs)) {
     # Start documenting gages that are dropped out; these gages have no mean daily Q
     gage_document(filter(streamgages_VPU, !site_no %in% tmp_POIs$Type_Gages) %>%
                     select(site_no),
-              "Gages_info", paste0("VPU ", vpu, "; low gage score"))
+              "Gages_info", paste0("VPU ", vpu_codes, "; low gage score"))
     
   }
   
@@ -134,7 +123,7 @@ mapview(filter(tmp_POIs, !is.na(Type_Gages)), layer.name = "Streamgage POIs", co
 ```{r TE POIs}
 if(!"Type_TE" %in% names(tmp_POIs)) {
   
-  if(vpu == "08"){
+  if(vpu_codes == "08"){
     nhd$VPUID <- "08"
   } else {
     nhd$VPUID <- substr(nhd$RPUID, 1, 2)
@@ -144,7 +133,7 @@ if(!"Type_TE" %in% names(tmp_POIs)) {
   TE_COMIDs <- read_sf(data_paths$TE_points_path, "2015_TE_Model_Estimates_lat.long_COMIDs") %>%
     mutate(COMID = as.integer(COMID)) %>%
     inner_join(., select(st_drop_geometry(nhd), COMID, VPUID), by = "COMID") %>%
-    filter(grepl(paste0("^", substr(vpu, 1, 2), ".*"), .data$VPUID), COMID > 0) %>%
+    filter(grepl(paste0("^", substr(vpu_codes, 1, 2), ".*"), .data$VPUID), COMID > 0) %>%
     switchDiv(., nhd) %>%
     group_by(COMID) %>%
     summarize(EIA_PLANT = paste0(unique(EIA_PLANT_), collapse = " "), count = n()) %>%
@@ -152,7 +141,7 @@ if(!"Type_TE" %in% names(tmp_POIs)) {
   
    # Derive TE POIs
   tmp_POIs <- POI_creation(st_drop_geometry(TE_COMIDs), filter(nhd, poi == 1), "TE") %>%
-    addType(., tmp_POIs, "TE") 
+    addType(., tmp_POIs, "TE", nexus = FALSE) 
 
   # As a fail-safe, write out list of TE plants not assigned a POI
   if(nrow(filter(TE_COMIDs, !COMID %in% tmp_POIs$COMID)) > 0) {
@@ -261,7 +250,8 @@ if(!"Type_WBOut" %in% names(tmp_POIs)) {
       dplyr::filter(!is.na(Type_WBOut)) %>%
       dplyr::inner_join(select(resops_wb_df, -FlowLcomid), by = c("Type_WBOut" = "COMID")) 
     
-    write.csv(resops_POIs_df, file.path("data/reservoir_Data", paste0("resops_POIs_",vpu,".csv")))
+    write.csv(resops_POIs_df, file.path("data/reservoir_Data", 
+                                        paste0("resops_POIs_", vpu_codes, ".csv")))
   }
     
   write_sf(nhd, nav_gpkg, nhd_flowline)
@@ -602,6 +592,7 @@ if(needs_layer(temp_gpkg, nsegments_layer)) {
 
   # create and write out final dissolved segments
   nsegments_fin <- segment_creation(nhd_Final, xWalk)
+  
   nhd_Final <- select(nhd_Final, -POI_ID) %>%
     left_join(select(st_drop_geometry(nsegments_fin$raw_segs), COMID, POI_ID), by = "COMID")
   nsegments <- nsegments_fin$diss_segs
@@ -630,7 +621,8 @@ write_sf(noDA_pois, temp_gpkg, "noDA_pois")
 
 ```{r POI Collapse}
 # number POIs
-final_POIs <- mutate(final_POIs, id = row_number(), moved = NA)
+final_POIs <- mutate(final_POIs, id = row_number(), moved = NA) %>%
+  write_sf(temp_gpkg, pois_all_layer)
 collapse <- TRUE
 
 #  Load data
@@ -698,16 +690,15 @@ if(collapse){
     final_POIs <- moved_pois$final_pois
     moved_pois_table <- moved_pois_table %>%
       rbind(moved_pois$moved_points %>%
-              mutate(move_type = "nid to wnpit"))
+              mutate(move_type = "nid to wb_out"))
   } else {
     final_POIs <- moved_pois
   }
 
+  write_sf(final_POIs, nav_gpkg, pois_all_layer)
   write_sf(moved_pois_table, temp_gpkg, "pois_collapsed")
 } 
 
-write_sf(final_POIs, nav_gpkg, pois_all_layer)
-
 check_dups <- final_POIs %>%
   group_by(COMID) %>%
   filter(n() > 1) 
@@ -744,14 +735,21 @@ final_POIs_table <- POIs %>%
   select(-identifier) 
 
 # POI data theme table
-pois_data <- reshape2::melt(st_drop_geometry(select(final_POIs_table,
+pois_data_orig <- reshape2::melt(st_drop_geometry(select(final_POIs_table,
                                              -nexus)),
                             id.vars = c("COMID", "geom_id")) %>%
   filter(!is.na(value)) %>%
   group_by(COMID, geom_id) %>%
   mutate(identifier = cur_group_id()) %>%
   rename(hy_id = COMID, poi_id = identifier, hl_reference = variable, hl_link = value) %>%
-  distinct()
+  distinct() 
+
+pois_data_moved <- select(st_drop_geometry(moved_pois_table), hy_id = COMID, hl_link = new_val, hl_reference = moved_value) %>%
+  inner_join(distinct(pois_data_orig, hy_id, geom_id, poi_id), by = "hy_id") 
+
+pois_data <- data.table::rbindlist(list(pois_data_moved, pois_data_orig), use.names = TRUE) %>%
+  filter(!hl_reference %in% c("id", "moved"))
+
 
 # POI Geometry table
 poi_geometry <- select(final_POIs_table, hy_id = COMID, geom_id) %>%