Improved Elev POI derivation

workspace/R/NHD_navigate.R

@@ -616,4 +616,82 @@ structPOIsNet <- function(nhdDF, final_POIs){
 }
 
 
+#'  Splits a network based elevation change and size
+#'  @param in_POI_ID (integer) POI_ID of aggregated flowline that needs to be
+#'                   split based on elevation
+#'  @param split_DF  (sf data.frame) flowlines attributed with POI_ID
+#'  @param elev_diff (numeric) max elevation 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_elev <- function(in_POI_ID, split_DF, elev_diff, max_DA){
+  
+  # subset to a given POI_ID
+  split_elev_DF <- filter(split_DF, POI_ID == in_POI_ID) %>%
+    mutate(inc_seg_area = c(TotDASqKM[1], (TotDASqKM - lag(TotDASqKM))[-1]))
+  
+  first_iter <- unique(split_elev_DF$iter)
+  # Iterate through segs that need splitting
+  for (i in c(first_iter:nrow(split_elev_DF))){
+    #print(i)
+    
+    # first split
+    elev_pois_init_iter <- split_elev_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),
+             inc_elev = cumsum(MAXELEVSMO - MINELEVSMO),
+             sum_area = cumsum(inc_seg_area)) %>%
+      # Determine if split actually necessary on this iteration
+      filter((max(MAXELEVSMO) - min(MINELEVSMO)) > (elev_diff), sum_area > 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(., inc_elev > (elev_diff))) == nrow(.), 
+                                  1, nrow(filter(., inc_elev < (elev_diff))))) %>%
+      # Take out if at last iteration to avoid duplicating existng POIs
+      filter(!COMID == POI_ID)
+    
+    if(nrow(elev_pois_init_iter) == 0){
+      #print("done")
+      # Done iterating on possible splits
+      return(split_elev_DF)}
+    
+    # Get the flowline POI
+    elev_pois_init_pre <- elev_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
+    elev_pois_init_post <- elev_pois_init_iter %>%
+      left_join(select(elev_pois_init_pre, -COMID), by = "POI_ID") %>%
+      filter(Hydroseq < Hydroseq_cut) %>%
+      ungroup() 
+    
+    # Test for if we need to split again
+    if(nrow(elev_pois_init_post) > 0){
+      #print("yope")
+      # Re-cacl the iter based on results above
+      split_elev_DF <- split_elev_DF %>%
+        left_join(select(elev_pois_init_pre, -COMID), by = "POI_ID") %>%
+        mutate(elev_POI_ID = ifelse((is.na(elev_POI_ID) & Hydroseq >= Hydroseq_cut), new_POI_ID, elev_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_elev_DF <- split_elev_DF %>%
+        left_join(select(elev_pois_init_pre, -COMID), by = "POI_ID") %>%
+        mutate(elev_POI_ID = ifelse((is.na(elev_POI_ID) & Hydroseq >= Hydroseq_cut), new_POI_ID, elev_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_elev_DF)
+}
 

[Bock, Andy]

Thanks to inspiration from Mike Johnson, this is a much more proficient elevation POI break function, as it incorporates both an elevation threshold and a minimum size criteria.

[Bock, Andy]

Only thing I don't like is how we iterate on this loop.

The iteration takes place over how many estimated breaks are needed for an existing aggregated segment/flowline that exceeds the elevation change threshold.