From 3a87c02ac3bc2c7779a283cad7e7a58a7fb35a82 Mon Sep 17 00:00:00 2001
From: David Blodgett <dblodgett@usgs.gov>
Date: Fri, 29 Nov 2024 13:22:21 -0600
Subject: [PATCH] resops and hilarri POIs for #153
---
workspace/R/02_POI_creation_functions.R | 164 +++++++++++++++++++
workspace/_targets/02_POI_creation_targets.R | 16 +-
workspace/workflow_runner.R | 2 +-
3 files changed, 180 insertions(+), 2 deletions(-)
diff --git a/workspace/R/02_POI_creation_functions.R b/workspace/R/02_POI_creation_functions.R
index d8d6bc1..a1a371e 100644
--- a/workspace/R/02_POI_creation_functions.R
+++ b/workspace/R/02_POI_creation_functions.R
@@ -215,4 +215,168 @@ make_waterbodies_layer <- function(combined_waterbodies, flowline, geo_crs = 432
sf_use_s2(old_sf_use_s2)
list(wbs_draft = WBs_VPU_all, WBs_layer_orig = ref_WB)
+}
+
+#' create resops POIs
+#' @param tmp_POIs tmp_POIs as created by previous step
+#' @param wbs waterbodies table
+#' @param flowline flowlines to attach pois to
+#' @param poi_name name for poi set
+#'
+create_resops_pois <- function(tmp_POIs, wbs, istarf_xwalk, flowline, poi_name = "resops") {
+
+ # Unnest wb_poi_lst
+ wb_table <- st_drop_geometry(wbs$WBs_layer_orig) %>%
+ dplyr::mutate(member_comid = strsplit(member_comid, ",")) %>%
+ tidyr::unnest(cols = member_comid) %>%
+ mutate(member_comid = as.character(member_comid)) %>%
+ distinct()
+
+ # ResOpsUS locations with attributes from the VPU NHDv2 wb set
+ resops_wb_df <- istarf_xwalk %>%
+ # Subset to VPU, only one DAMID per waterbody
+ filter(flowlcomid %in% flowline$COMID |
+ wbareacomi %in% wb_table$member_comid) %>%
+ dplyr::select(grand_id, nid_source_featureid, source = comi_srclyr,
+ flowlcomid, wbareacomi, hr_permid, onoffnet) %>%
+ mutate(wbareacomi = as.character(wbareacomi)) %>%
+ # Link to waterbody table
+ left_join(distinct(wb_table, member_comid, wb_id),
+ by = c("wbareacomi" = "member_comid")) %>%
+ left_join(select(st_drop_geometry(wbs$wbs_draft), wbareacomi = COMID,
+ wb_id2 = wb_id) %>%
+ mutate(wbareacomi = as.character(wbareacomi)),
+ by = "wbareacomi") %>%
+ mutate(wb_id = ifelse(is.na(wb_id), wb_id2, wb_id),
+ wbareacomi = ifelse(wbareacomi == -2,
+ hr_permid, wbareacomi)) %>%
+ select(-c(wb_id2))
+
+ # POIs with waterbody IDs in reference waterbodies
+ resops_wb_pois <- filter(wbs$WBs_layer_orig, wb_id %in% resops_wb_df$wb_id) %>%
+ inner_join(select(st_drop_geometry(resops_wb_df), grand_id,
+ NID_ID = nid_source_featureid,
+ resops_flowlcomid = flowlcomid, wb_id),
+ by = "wb_id") %>%
+ #mutate(source = "ref_WB") %>%
+ group_by(wb_id) %>%
+ filter(n() == 1) %>%
+ st_as_sf()
+
+ # Add ResOPsUS locations to waterbody list with attributed NID and resops data
+ if(nrow(resops_wb_pois) > 0){
+ wb_poi_lst_filtered <- filter(wbs$WBs_layer_orig, !wb_id %in% resops_wb_pois$wb_id,
+ !is.na(wb_id))
+
+ wb_poi_lst <- data.table::rbindlist(list(wb_poi_lst_filtered, resops_wb_pois),
+ fill = TRUE) %>%
+ mutate(accounted = 0) %>%
+ st_as_sf()
+
+ } else {
+
+ wb_poi_lst <- mutate(wbs$WBs_layer_orig, accounted = 0)
+
+ }
+
+ # Reach resopsus
+ reach_resops <- filter(resops_wb_df, !wb_id %in% wb_poi_lst$wb_id,
+ !source %in% c("NHDAREA", "HR ID AVAILABLE") |
+ onoffnet == 0) %>%
+ mutate(Type_WBOut = NA) %>%
+ select(COMID = flowlcomid, resops = grand_id, Type_WBOut)
+
+ # Existing reservoir-waterbody outlet POIs
+ exist_POIs_WB <- filter(resops_wb_df, flowlcomid %in% tmp_POIs$COMID) %>%
+ mutate(wb_id = ifelse(source == "NHDAREA", wbareacomi, wb_id)) %>%
+ filter(!is.na(wb_id)) %>%
+ select(COMID = flowlcomid, resops = grand_id, Type_WBOut = wb_id)
+
+ # Resops POIs
+ resops_pois <- rbind(reach_resops, exist_POIs_WB)
+
+ # Resops defined by reach
+ if(nrow(resops_pois) > 0){
+ # Resops POIs with no reservoirs, defined by reach
+ tmp_POIs <- POI_creation(resops_pois, filter(flowline, poi == 1), poi_name) %>%
+ addType(., tmp_POIs, poi_name, nexus = TRUE)
+
+ # TODO: investigate many to many join
+ # Add waterbody attribute
+ tmp_POIs <- tmp_POIs %>%
+ left_join(select(resops_pois, COMID, Type_WBOut),
+ by = "COMID") %>%
+ mutate(Type_WBOut = ifelse(!nexus,
+ Type_WBOut, NA))
+
+ # Resops with reservoirs
+ resops_wb_df <- resops_wb_df %>%
+ mutate(accounted = ifelse(grand_id %in% tmp_POIs$Type_resops, 1, 0),
+ source = ifelse(grand_id %in% reach_resops$resops, "REACH", source))
+ }
+ list(wb_pois = wb_poi_lst, wb_resops = resops_wb_df, tmp_POIs = tmp_POIs)
+
+}
+
+#' create hilarri pois
+#' @param tmp_POIs tmp_POIs as created by previous step
+#' @param wbs waterbodies table
+#' @param flowline flowlines to attach pois to
+#' @param poi_name name for poi set
+create_hilarri_pois <- function(tmp_POIs, hilarri_data, wb_poi_lst, flowline, poi_name = "hilarri") {
+ old_sf_use_s2 <- sf::sf_use_s2(FALSE)
+ on.exit(sf::sf_use_s2(old_sf_use_s2))
+ # 1: Many based on original GNIS_ID
+ wb_table <- st_drop_geometry(wb_poi_lst) %>%
+ dplyr::mutate(member_comid = strsplit(member_comid, ",")) %>%
+ tidyr::unnest(cols = member_comid) %>%
+ mutate(member_comid = as.integer(member_comid)) %>%
+ distinct()
+
+ # Hilarri POI Points
+ hilarri_points <- hilarri_data %>%
+ mutate(nhdwbcomid = as.integer(nhdwbcomid)) %>%
+ filter(!dataset %in% c('Power plant only; no reservoir or inventoried dam'),
+ nhdv2comid %in% flowline$COMID) %>%
+ left_join(select(wb_table, member_comid, wb_id),
+ by = c("nhdwbcomid" = "member_comid"))
+
+ # Waterbodies linked to hilarri information
+ hil_wb_pois_rf <- wb_poi_lst %>%
+ inner_join(select(st_drop_geometry(hilarri_points), hilarriid, nhdwbcomid,
+ nidid_hill = nidid, wb_id),
+ by = "wb_id") %>%
+ group_by(wb_id) %>%
+ mutate(hilarriid = paste0(hilarriid, collapse = ","),
+ nidid_hill = paste0(nidid_hill, collapse = ",")) %>%
+ ungroup() %>%
+ distinct() %>%
+ st_as_sf() %>%
+ st_compatibalize(wb_poi_lst)
+
+ # Add ResOPsUS locations to waterbody list
+ if(nrow(hil_wb_pois_rf) > 0){
+ wb_poi_lst <- wb_poi_lst %>%
+ #filter(!is.na(resops_FlowLcomid)) %>%
+ left_join(select(st_drop_geometry(hil_wb_pois_rf), wb_id, hilarriid,
+ nidid_hill), by = "wb_id") %>%
+ mutate(NID_ID = ifelse(is.na(NID_ID), nidid_hill, NID_ID)) %>%
+ select(-nidid_hill) %>%
+ distinct()
+ }
+
+ # Reach POIs
+ reach_pois <- filter(hilarri_points, !hilarriid %in% wb_poi_lst$hilarriid) %>%
+ select(COMID = nhdv2comid, hilarriid) %>%
+ mutate(COMID = as.integer(COMID)) %>%
+ group_by(COMID) %>%
+ filter(row_number() == 1) %>%
+ st_drop_geometry()
+
+ # Make POIs for reach POIs
+ tmp_POIs <- POI_creation(reach_pois, filter(flowline, poi == 1), poi_name) %>%
+ addType(., tmp_POIs, poi_name, nexus = TRUE)
+
+ list(tmp_POIs = tmp_POIs, wb_pois = wb_poi_lst)
+
}
\ No newline at end of file
diff --git a/workspace/_targets/02_POI_creation_targets.R b/workspace/_targets/02_POI_creation_targets.R
index a4bd511..e7d511f 100644
--- a/workspace/_targets/02_POI_creation_targets.R
+++ b/workspace/_targets/02_POI_creation_targets.R
@@ -49,5 +49,19 @@ list(tar_target(data_paths_file, "cache/data_paths.json", format = "file"),
tar_target(combined_waterbodies_file, file.path(prep_path, "combined_waterbodies"), format = "file"),
tar_target(combined_waterbodies, readRDS(combined_waterbodies_file)),
tar_target(waterbodies, make_waterbodies_layer(combined_waterbodies, flowline, geo_crs),
- pattern = map(flowline), deployment = "worker")
+ pattern = map(flowline), deployment = "worker"),
+
+ tar_target(istarf_xwalk_file, data_paths$istarf_xwalk, format = "file"),
+ tar_target(istarf_xwalk, read.csv(istarf_xwalk_file)),
+ tar_target(resops_pois, create_resops_pois(te_pois$tmp_POIs, waterbodies, istarf_xwalk,
+ flowline, "resops"),
+ pattern = map(te_pois, waterbodies, flowline), deployment = "worker"),
+
+ tar_target(hilarri_file, data_paths$hilarri_sites, format = "file"),
+ tar_target(hilarri_data, read.csv(hilarri_file, colClasses = "character")),
+ tar_target(hilarri_pois, create_hilarri_pois(resops_pois$tmp_POIs,
+ hilarri_data,
+ resops_pois$wb_pois,
+ flowline, "hilarri"),
+ pattern = map(resops_pois, flowline), deployment = "worker")
)
\ No newline at end of file
diff --git a/workspace/workflow_runner.R b/workspace/workflow_runner.R
index 2b01ddf..b889d3e 100644
--- a/workspace/workflow_runner.R
+++ b/workspace/workflow_runner.R
@@ -48,5 +48,5 @@ tar_make()
Sys.setenv(TAR_PROJECT = "02_POI_creation")
-tar_make_future(waterbodies, workers = 8)
+tar_make_future(hilarri_pois, workers = 8)
\ No newline at end of file
--
GitLab