diff --git a/workspace/R/utils.R b/workspace/R/utils.R index ae7cd9fa082e5454f5d1d1a952d7940e4dad1a49..8c0d6da739b84cce76d787a0bdc7d7345856ea63 100644 --- a/workspace/R/utils.R +++ b/workspace/R/utils.R @@ -161,72 +161,6 @@ gage_document <- function(data, source, drop_reason){ } } -#' clean network -#' @param net data.frame nhdplus network -#' @param net_new data.frame new nhdplus network as from e2nhd -#' @param nwm data.frame with national water model new network -#' @return data.frame fully reconciled attributes -clean_net <- function(net, net_new, nwm) { - - # NOTE: need to disconnected diverted paths as indicated in the tonode / fromnode attributes. - - diverted_heads <- filter(net_new, divergence == 2) - - net_new <- filter(net_new, !tocomid %in% diverted_heads$comid) - - # NOTE: avoid fcode == 56600 (coastal) - avoid <- net$comid[net$fcode == 56600] - - # NOTE: avoid large groups where things have been redirected in an un-natural way. - groups <- group_by(nwm, tocomid) - - groups <- data.frame(tocomid = summarise(groups, .groups = "drop"), size = group_size(groups)) - - groups <- filter(groups, size > 10 & tocomid != 0) - - # NOTE: also avoid all flowlines that go to coastal flowlines. - # This is due to unwanted great lakes connections in the NWM. - avoid <- c(avoid, - net_new$comid[net_new$tocomid %in% avoid], - net_new$comid[net_new$tocomid %in% groups$tocomid], - nwm$comid[nwm$tocomid %in% groups$tocomid]) - - avoid <- unique(avoid) - - nwm <- filter(nwm, tocomid %in% c(net_new$comid, 0)) - - net_new <- left_join(net_new, select(nwm, comid, - nwm_tocomid = tocomid), - by = "comid") %>% - mutate(tocomid = ifelse(is.na(tocomid), 0, tocomid)) - ## NWM already uses 0 for outlets. - - # NOTE: just being explicit about this for clarity. - candidate <- select(net_new, comid, tocomid, nwm_tocomid) %>% - filter(!comid %in% avoid) - - mismatch <- candidate[candidate$tocomid != candidate$nwm_tocomid, ] - - net_new <- left_join(net_new, select(mismatch, comid, - new_tocomid = nwm_tocomid), - by = "comid") - - to_change <- filter(net_new, !is.na(new_tocomid)) - - net_new <- net_new %>% - mutate(divergence = ifelse(comid %in% to_change$new_tocomid & divergence == 2, 1, - ifelse(comid %in% to_change$tocomid & divergence == 1, 2, - divergence)), - tocomid = ifelse(comid %in% to_change$comid, new_tocomid, tocomid)) %>% - select(-nwm_tocomid, -new_tocomid) - - net_new <- filter(net_new, fcode != 56600) - - net_new <- mutate(net_new, tocomid = ifelse(!tocomid %in% comid, 0, tocomid)) - - return(net_new) - -} #' Merges geopackages together to create CONUs geopackage of features #' @param feat (character) Type of feature to merge (POIs, segments) character @@ -539,7 +473,7 @@ merge_refactor <- function(rpus, out[[agg_fline_layer]] <- select(out[[agg_fline_layer]], -new_toID, -update_newtoID) } - #out[[split_divide_layer]] <- rename(out[[split_divide_layer]], comid_part = FEATUREID) + out[[split_divide_layer]] <- rename(out[[split_divide_layer]], comid_part = FEATUREID) out[[reconciled_layer]] <- select(out[[reconciled_layer]], ID = newID, toID = newtoID, LENGTHKM, TotDASqKM,