Added travel time split

workspace/R/NHD_navigate.R

@@ -695,3 +695,83 @@ split_elev <- function(in_POI_ID, split_DF, elev_diff, max_DA){
   return(split_elev_DF)
 }
 
+#'  Splits a network based on estimated travel time and drainage area
+#'  @param in_POI_ID (integer) POI_ID of aggregated flowline that needs to be
+#'                   split based on travel time
+#'  @param split_DF  (sf data.frame) flowlines attributed with POI_ID
+#'  @param tt_diff (numeric) max travel time change threshold within a segment
+#'  @param max_DA (numeric) minimum drainage area for resulting split
+#' 
+#' @return (sf data.frame) flowlines with new POI_IDs identified (elev_POI_ID)
+split_tt <- function(in_POI_ID, split_DF, tt_diff, max_DA){
+  
+  # subset to a given POI_ID
+  split_tt_DF <- filter(split_DF, POI_ID == in_POI_ID) %>%
+    mutate(inc_seg_area = c(TotDASqKM[1], (TotDASqKM - lag(TotDASqKM))[-1]))
+  
+  first_iter <- unique(split_tt_DF$iter)
+  # Iterate through segs that need splitting
+  for (i in c(first_iter:max(split_DF$iter, na.rm = T))){
+    #print(i)
+    
+    # first split
+    tt_pois_init_iter <- split_tt_DF %>%
+      # filter by iteration, comes into play when multiple splits 
+      #        are required per single POI_ID
+      filter(iter == i) %>%
+      # Recalculate inc elev, length, and area based on the last split
+      mutate(csum_length = cumsum(LENGTHKM), 
+             cumsum_tt = cumsum(FL_tt_hrs),
+             sum_area = cumsum(inc_seg_area)) %>%
+      # Determine if split actually necessary on this iteration
+      filter(sum(FL_tt_hrs) > tt_diff, TotDASqKM > max_DA) %>%
+      # This is an important step, identify which row to split on based on incremental
+      #      elevaton value.  Some flowlines exceed the elevation difference threshold
+      # The 'split_index' values determiens which row to create a new POI on
+      mutate(split_index = ifelse(nrow(filter(., cumsum_tt > (tt_diff))) == nrow(.), 
+                                  1, nrow(filter(., cumsum_tt < (tt_diff))))) %>%
+      # Take out if at last iteration to avoid duplicating existng POIs
+      filter(!COMID == POI_ID)
+    
+    if(nrow() == 0){
+      #print("done")
+      # Done iterating on possible splits
+      return(split_tt_DF)}tt_pois_init_iter
+    
+    # Get the flowline POI
+    tt_pois_init_pre <- tt_pois_init_iter %>%
+      filter(row_number() == split_index) %>%
+      mutate(new_POI_ID = COMID) %>%
+      select(COMID, POI_ID, new_POI_ID, Hydroseq_cut = Hydroseq) 
+    
+    # Remaining rows downstream after split
+    tt_pois_init_post <- tt_pois_init_iter %>%
+      left_join(select(tt_pois_init_pre, -COMID), by = "POI_ID") %>%
+      filter(Hydroseq < Hydroseq_cut) %>%
+      ungroup() 
+    
+    # Test for if we need to split again
+    if(nrow(tt_pois_init_post) > 0){
+      #print("yope")
+      # Re-cacl the iter based on results above
+      split_tt_DF <- split_tt_DF %>%
+        left_join(select(tt_pois_init_pre, -COMID), by = "POI_ID") %>%
+        mutate(tt_POI_ID = ifelse((is.na(elev_POI_ID) & Hydroseq >= Hydroseq_cut), new_POI_ID, tt_POI_ID),
+               iter = ifelse((!is.na(new_POI_ID) & Hydroseq < Hydroseq_cut), iter + 1, orig_iter)) %>%
+        select(-c(new_POI_ID, Hydroseq_cut)) %>%
+        ungroup()
+      
+    } else {
+      split_tt_DF <- split_tt_DF %>%
+        left_join(select(tt_pois_init_pre, -COMID), by = "POI_ID") %>%
+        mutate(tt_POI_ID = ifelse((is.na(tt_POI_ID) & Hydroseq >= Hydroseq_cut), new_POI_ID, tt_POI_ID),
+               iter = ifelse((!is.na(new_POI_ID) & Hydroseq < Hydroseq_cut), 0, orig_iter)) %>%
+        select(-c(new_POI_ID, Hydroseq_cut)) %>%
+        ungroup()
+      
+    }
+  }
+  return(split_tt_DF)
+}
+
+