utils.R

needs_layer <- function(db, layer) {
  if(file.exists(db)) {
    layers <- st_layers(db)
    if(layer %in% layers$name)
      return(FALSE)
  }
  TRUE
}

layer_exists <- function(db, layer) {
  if(file.exists(db)) {
    layers <- st_layers(db)
    if(layer %in% layers$name)
      return(TRUE)
  }
  FALSE
}

# Subset NHD RDS by hydrologic region
VPU_Subset <- function(nhdPath, VPU){
  # Read in COMIDs of outlets
  RegOutlets <- jsonlite::read_json(file.path("cache", "RegOutlets.json"))
  print (paste0("subsetting for VPU ",VPU))
  
  if (!VPU %in% names(RegOutlets)){
    
    # For regions that terminate to the NHDPlus domain
    # 1,2,3,4,8,9,12,15,17,18
    # Read in NHDPlusV2 flowline simple features and filter by vector processing unit (VPU)
    nhd <- readRDS(nhdPath) %>% 
      filter(grepl(paste0("^",VPU,".*"), .data$VPUID))
    
    keep <- prepare_nhdplus(nhd, 5, 2, 10, FALSE)
    
    nhd <- filter(nhd, COMID %in% keep$COMID)
    
  } else if (VPU %in% c("05", "06", "07", "10U","r14")){
    
    # Subset VPUs that are single outlet
    outlet <- RegOutlets[VPU]
    #print (outlet)
    
    nhd <- readRDS(nhdPath)
    
    #nhd_US <- get_UT(nhd, outlet)
    
    nhd <- nhd %>% filter(COMID %in% unlist(get_UT(nhd, outlet)))
     
    keep <- prepare_nhdplus(nhd, 5, 2, 10, FALSE)
    
    nhd <- filter(nhd, COMID %in% keep$COMID, VPUID == VPU)
    
  } else if (VPU == "10L"){

    # Subset by flowlines in Region 10
    nhd <- readRDS(nhdPath) %>% 
      filter(grepl(paste0("^",substr(VPU,1,2),".*"), .data$VPUID)) # take out this VPUID
    
    # R10U upstream
    nhd_US_10U <- nhd %>% filter(COMID %in% unlist(get_UT(nhd, RegOutlets["10U"])))
    
    # R10L upstream
    nhd_US_10L <- nhd %>% filter(COMID %in% unlist(get_UT(nhd, RegOutlets["10L"])))
    
    nhd_10L <- nhd_US_10L %>% filter(!COMID %in% nhd_US_10U$COMID)
    
    keep <- prepare_nhdplus(nhd_10L, 5, 2, 10, FALSE)
    
    nhd <- filter(nhd, COMID %in% keep$COMID)
    
  } else {
    
    outlets <- unlist(RegOutlets[VPU])
    
    nhd <- readRDS(nhdPath) 
    
    #outlets <- c(14320629, 941140164, 15334434)
    
    for (out in outlets){
      #print (out)
      nhd_US <- get_UT(nhd, out)
      keep <- prepare_nhdplus(nhd %>% filter(COMID %in% unlist(nhd_US)), 5, 2, 10, FALSE)
      #print (dim(keep))
      ifelse( exists("final") , final <- rbind(final, keep), final <- keep)
    }
    
    nhd <- nhd %>% filter(COMID %in% final$COMID)
  }
  return (nhd)
}

return_NonDendirtic <- function(VPU, nhd, nhdPath){
  # Returns non-dendritic flowlines for assignment of coastal/non-dendritic catchments/flowlines
  nhdAll <- readRDS(nhdPath) %>%
    filter(grepl(paste0("^",VPU,".*"), .data$VPUID))
    nhd_ND <- nhdAll %>% filter(!COMID %in% nhd$COMID) %>% filter(TerminalFl == 1)
    
  return(nhd_ND)
  }

Merge_hydReg <- function(feat){
  out_gpkg <-"cache/GF_CONUS.gpkg"
  if(needs_layer(out_gpkg, feat)) {
    feat_01 <- read_sf("cache/GF_01.gpkg", paste0(feat,"_01")) 
    feat_02 <- read_sf("cache/GF_02.gpkg", paste0(feat,"_02"))
    feat_03 <- read_sf("cache/GF_03.gpkg", paste0(feat,"_03"))
    feat_04 <- read_sf("cache/GF_04.gpkg", paste0(feat,"_04"))
    feat_05 <- read_sf("cache/GF_05.gpkg", paste0(feat,"_05"))
    feat_06 <- read_sf("cache/GF_06.gpkg", paste0(feat,"_06"))
    feat_07 <- read_sf("cache/GF_07.gpkg", paste0(feat,"_07"))
    feat_08 <- read_sf("cache/GF_08.gpkg", paste0(feat,"_08"))
    feat_09 <- read_sf("cache/GF_09.gpkg", paste0(feat,"_09"))
    feat_10U <- read_sf("cache/GF_10U.gpkg", paste0(feat,"_10U"))
    feat_10L <- read_sf("cache/GF_10L.gpkg", paste0(feat,"_10L"))
    feat_11 <- read_sf("cache/GF_11.gpkg", paste0(feat,"_11"))
    feat_12 <- read_sf("cache/GF_12.gpkg", paste0(feat,"_12"))
    feat_13 <- read_sf("cache/GF_13.gpkg", paste0(feat,"_13"))
    feat_14 <- read_sf("cache/GF_14.gpkg", paste0(feat,"_14"))
    feat_15 <- read_sf("cache/GF_15.gpkg", paste0(feat,"_15"))
    feat_16 <- read_sf("cache/GF_16.gpkg", paste0(feat,"_16"))
    feat_17 <- read_sf("cache/GF_17.gpkg", paste0(feat,"_17"))
    feat_18 <- read_sf("cache/GF_18.gpkg", paste0(feat,"_18"))

    allfeat <- list(feat_01, feat_02, feat_03, feat_04, feat_05, feat_06, feat_07, feat_08, feat_09,
                    feat_10L, feat_10U, feat_11, feat_12, feat_13, feat_14, feat_15, feat_16, feat_17,
                    feat_18)
                  
  
    all_sf<-do.call(rbind, allfeat)
    write_sf(all_sf, out_gpkg, feat)
  }
}