resops and hilarri POIs for #153

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

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

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