From ba1e3f2743c50c2258fd0d34fa040f75d0a54965 Mon Sep 17 00:00:00 2001
From: Andy Bock <abock@usgs.gov>
Date: Fri, 1 Oct 2021 10:14:22 -0600
Subject: [PATCH] Reconfigured cat_rpu function
---
workspace/R/utils.R | 114 ++++++++++++++++++--------------------------
1 file changed, 47 insertions(+), 67 deletions(-)
diff --git a/workspace/R/utils.R b/workspace/R/utils.R
index d30e126..389f191 100644
--- a/workspace/R/utils.R
+++ b/workspace/R/utils.R
@@ -178,11 +178,14 @@ Merge_VPU <- function(feat, in_gpkg, out_gpkg){
if(needs_layer(out_gpkg, feat)) {
all_sf <- paste0(feat, "_CONUS")
- VPUs <- c(paste0("0", c(1:9)), as.character(11:18), "10U", "10L")
+ #VPUs <- c("03N", "03S", "03W")
+ #VPUs <- c("10L", "10U")
+ VPUs <-c(paste0("0", c(1:2)), "03N", "03S", "03W", paste0("0", c(4:9)),
+ as.character(11:18), "10U", "10L")
featCON <- do.call("rbind", lapply(VPUs, function(x) {
tryCatch({
layer <- ifelse(feat %in% c("nhd_flowline", "unassigned_gages", "unassigned_TE"),
- layer, paste0(feat, "_", x))
+ feat, paste0(feat, "_", x))
read_sf(file.path("cache", paste0(in_gpkg, x, ".gpkg")),
layer)},
error = function(e) stop(paste("didn't find", x,
@@ -289,71 +292,48 @@ try({
#' @param fl_rds character path to flowline rds file
#' @param nhd_gdb character path to NHD geodatabase
#' @return (sf data.frame) with FEATUREID, RPUID, FTYPE, TERMINAFL
-cat_rpu <- function(fcats, the_RPU, nhd_gdb){
-
- if(substr(the_RPU, 1, 2) == "20"){
- fl <- read_sf(nhd_gdb, "NHDFlowline_Network") %>%
- align_nhdplus_names()
- } else {
- fl <- read_sf(nhd_gdb, "NHDFlowline_Network")
- }
-
- if(the_RPU %in% unique(fl$RPUID)){
-
- # read the Flowlines
- flowln_df <- fl %>%
- st_as_sf() %>%
- st_drop_geometry() %>%
- dplyr::select(COMID, FTYPE, TerminalFl, RPUID)%>%
- dplyr::filter(RPUID == the_RPU)%>%
- dplyr::rename(FEATUREID = COMID) %>%
- dplyr::rename(TERMINALFL = TerminalFl)
-
- # read the CatchmentSP
- cats <- fcats %>%
- st_as_sf() %>%
- st_drop_geometry() %>%
- dplyr::select(FEATUREID, SOURCEFC) %>%
- dplyr::filter(FEATUREID %in% flowln_df$FEATUREID)
-
- # Read in sinks
- sink_df <- sf::st_read(nhd_gdb, layer = "Sink") %>%
- st_drop_geometry() %>%
- dplyr::select(SINKID, InRPU) %>%
- dplyr::rename(FEATUREID = SINKID, RPUID = InRPU) %>%
- dplyr::filter(RPUID == the_RPU)%>%
- dplyr::mutate(FTYPE = "Sink", TERMINALFL = 0) %>%
- dplyr::filter(FEATUREID %in% cats$FEATUREID)
-
- #combine all the RPUIDs
- lkup_rpu <- rbind(cats, sink_df)
-
- # FEATUREID 10957920, 20131674, 24534636 - this are the ids of the missing, checked on map,
- # they look like they should not be used
- #
- # add the records for the missing
- missrec_df <- data.frame(FEATUREID=c(10957920, 20131674, 245346360),
- RPUID = c("03a", "03d", "17b"),
- TERMINALFL = c(0, 0, 0))
-
- missrec_df <- missrec_df %>%
- dplyr::mutate(FTYPE = "")
-
- if(the_RPU %in% c("03a", "03d", "17b")){
- missrec_df <- missrec_df %>%
- dplyr::filter(RPUID == the_RPU)
- # add the missing to the lkup_rpu data frame
- lkup_rpu2 <- rbind(lkup_rpu, select(missrec_df, FEATUREID, SOURCEFC = FTYPE))
- return(lkup_rpu2)
- } else {
- return(lkup_rpu)
- }
-
- } else {
- print("Invalid RPUID")
- df_empty <- data.frame(FEATUREID = integer(), RPUID = character(), FTYPE = character(), TERMINALFL = integer(), stringsAsFactors = FALSE)
- return(df_empty)
- }
+cat_rpu <- function(fcats, nhd_gdb, vpu){
+
+ fl <- read_sf(nhd_gdb, "NHDFlowline_Network") %>%
+ align_nhdplus_names()
+
+ # read the CatchmentSP
+ cats <- fcats %>%
+ st_as_sf() %>%
+ st_drop_geometry() %>%
+ dplyr::select(FEATUREID, SOURCEFC)
+
+ # read the Flowlines
+ flowln_df <- fl %>%
+ st_as_sf() %>%
+ st_drop_geometry() %>%
+ select(COMID, FTYPE, TerminalFl, RPUID)%>%
+ rename(FEATUREID = COMID) %>%
+ rename(TERMINALFL = TerminalFl)%>%
+ filter(FEATUREID %in% cats$FEATUREID)
+
+ # Read in sinks
+ sink_df <- sf::st_read(nhd_gdb, layer = "Sink") %>%
+ st_drop_geometry() %>%
+ dplyr::select(SINKID, RPUID = InRPU) %>%
+ dplyr::rename(FEATUREID = SINKID) %>%
+ dplyr::mutate(FTYPE = "Sink", TERMINALFL = 0) %>%
+ dplyr::filter(!FEATUREID %in% flowln_df$FEATUREID)
+
+ #combine all the RPUIDs
+ lkup_rpu <- rbind(flowln_df, sink_df)
+
+ # FEATUREID 10957920, 20131674, 24534636 - this are the ids of the missing, checked on map,
+ # they look like they should not be used
+
+ # add the records for the missing
+ missrec_df <- data.frame(FEATUREID=c(10957920, 20131674, 245346360),
+ RPUID = c("03a", "03d", "17b"),
+ TERMINALFL = c(0, 0, 0)) %>%
+ mutate(FTYPE = "")
+
+ lkup_rpu2 <- rbind(lkup_rpu, missrec_df)
+ return(lkup_rpu2)
}
### DEPRECATED moved to nhdplusTools as subset_vpu with different methods###
--
GitLab