merge_refactor function to merge together RPUs into whole VPUs.

workspace/R/utils.R

@@ -270,3 +270,62 @@ cat_rpu <- function(fcats, nhd_gdb){
   lkup_rpu2 <- rbind(lkup_rpu, missrec_df)
   return(lkup_rpu2)
 }
+
+merge_refactor <- function(rpus, rpu_vpu_out, lookup_table_refactor, reconciled_layer) {
+  fline <- rep(list(list()), length(rpus))
+  names(fline) <- rpus
+  
+  s <- 10000000
+  
+  for(rpu_code in rpus) {
+    
+    gpkg <- paste0("cache/", rpu_code, "_refactor.gpkg")
+    
+    l <- sf::read_sf(gpkg, lookup_table_refactor)
+    o <- sf::read_sf(gpkg, reconciled_layer)
+    
+    o <- select(o, ID, toID, LENGTHKM, TotDASqKM, member_COMID)
+    
+    o$newID <- seq(s, by = 1, length.out = nrow(o))
+    
+    s <- max(o$newID) + 1
+    
+    # get a toID that matches the new IDs
+    o <- left_join(o, select(st_drop_geometry(o), 
+                             ID, newtoID = newID), 
+                   by = c("toID" = "ID"))
+    
+    # find updates that we need to apply
+    update <- rpu_vpu_out[!rpu_vpu_out$toCOMID %in% l$NHDPlusV2_COMID &
+                            rpu_vpu_out$COMID %in% l$NHDPlusV2_COMID, ]
+    
+    # apply these updates for follow up if we got any
+    if(nrow(update) > 0) {
+      update <- left_join(update, l, by = c("COMID" = "NHDPlusV2_COMID")) %>%
+        left_join(select(l, NHDPlusV2_COMID, to_member_COMID = member_COMID), 
+                  by = c("toCOMID" = "NHDPlusV2_COMID"))
+      
+      o <- left_join(o, select(update, reconciled_ID, toCOMID),
+                     by = c("ID" = "reconciled_ID"))
+    }
+    
+    fline[[rpu_code]] <- o
+    
+  }
+  
+  fline <- bind_rows(fline)
+  
+  # blow up so we have unique COMIDs to join on.
+  long_form <- st_drop_geometry(fline) %>%
+    select(newID, member_COMID) %>%
+    mutate(member_COMID = strsplit(member_COMID, ",")) %>%
+    tidyr::unnest(cols = member_COMID) %>%
+    mutate(NHDPlusV2_COMID = as.integer(member_COMID)) %>%
+    select(-member_COMID, update_newtoID = newID)
+  
+  # NOTE: if the missing tocomid is in the next VPU they will still be NA
+  fline <- left_join(fline, long_form, by = c("toCOMID" = "NHDPlusV2_COMID"))
+  fline$newtoID[!is.na(fline$toCOMID)] <- fline$update_newtoID[!is.na(fline$toCOMID)]
+  
+  select(fline, ID = newID, toID = newtoID, LENGTHKM, TotDASqKM, member_COMID)
+}