Get v2.2 modifications made NOAA-OWP/hydrofabric#112

NAMESPACE

@@ -156,6 +156,7 @@ importFrom(sf,st_intersection)
 importFrom(sf,st_intersects)
 importFrom(sf,st_is_empty)
 importFrom(sf,st_is_longlat)
+importFrom(sf,st_is_valid)
 importFrom(sf,st_layers)
 importFrom(sf,st_length)
 importFrom(sf,st_line_merge)

R/add_nonnetwork_divides.R

@@ -43,8 +43,8 @@ add_nonnetwork_divides = function(gpkg = NULL,
   u_fl = unique(net$hf_id)
 
   # Reference ND catchments
-  non_network_divides = filter(reference_divides, !featureid %in% u_fl) %>%
-    select(id = featureid) %>%
+  non_network_divides = filter(reference_divides, !divide_id %in% u_fl) %>%
+    select(id = divide_id) %>%
     st_transform(st_crs(out_nl$catchments)) %>%
     mutate(areasqkm = add_areasqkm(.),
            type     = ifelse(id < 0, "internal", "coastal")) %>%

R/aggregate_along_mainstems.R

@@ -44,13 +44,13 @@ aggregate_along_mainstems = function(network_list,
 
   tmp = network_list$flowpaths %>% 
     st_drop_geometry() %>% 
+    as.data.frame() |> 
     select(id = toid, hl_un = poi_id) %>% 
-    st_drop_geometry() %>% 
-    distinct() %>% 
+    distinct() |> 
     filter(!is.na(hl_un)) %>% 
     group_by(id) %>% 
     slice(1) %>% 
-    ungroup()
+    ungroup() 
 
   fline = network_list$flowpaths %>% 
     st_drop_geometry() %>% 
@@ -59,9 +59,7 @@ aggregate_along_mainstems = function(network_list,
     distinct() 
 
   index_table = fline %>%
-    group_by(levelpathid) %>%
-    arrange(hydroseq) %>%
-    mutate(hl_un = ifelse(hl_un %in% hl_dn, NA, hl_un)) %>% 
+    group_by(levelpathid) |> 
     mutate(
       ind = cs_group(
         areasqkm,

R/aggregate_to_distribution.R

@@ -73,11 +73,10 @@ aggregate_to_distribution = function(gpkg = NULL,
   network_list <- read_hydrofabric(gpkg,
                                    catchments = divide,
                                    flowpaths = flowpath,
-                                   crs = 5070) 
-
-  network_list            <- add_network_type(prepare_network(network_list), verbose = FALSE)
+                                   crs = 5070) |> 
+    prepare_network() |> 
+    add_network_type(verbose = FALSE)
 
-
   # Add outlets
   if (!is.null(hydrolocations)) {
 
@@ -86,8 +85,9 @@ aggregate_to_distribution = function(gpkg = NULL,
     outflows = hydrolocations %>%
       st_drop_geometry() %>% 
       select(poi_id, id) %>% 
+      filter(!is.na(poi_id)) |> 
       group_by(id) %>% 
-      mutate(poi_id = paste(poi_id, collapse = ",")) %>% 
+      mutate(poi_id = paste(na.omit(poi_id), collapse = ",")) %>% 
       slice(1) %>% 
       ungroup()
 
@@ -117,27 +117,24 @@ aggregate_to_distribution = function(gpkg = NULL,
     network_list$flowpaths$member_comid = NA
   }
 
-  network_list2 = aggregate_along_mainstems(
-    network_list,
+  network_list = network_list |> 
+    aggregate_along_mainstems(
     ideal_size_sqkm,
     min_area_sqkm,
     min_length_km,
     verbose = verbose,
     cache_file = cache_file
-  )
-
-  network_list3  = collapse_headwaters2(
-    network_list2,
+  ) |> collapse_headwaters2(
     min_area_sqkm,
     min_length_km,
     verbose = verbose,
     cache_file = cache_file)
 
-  network_list3$catchments = clean_geometry(network_list3$catchments, ID = "id")
+  network_list$catchments = clean_geometry(network_list$catchments, ID = "id", keep = NULL)
 
 if(!is.null(hydrolocations)){
 
-  network_list3$hydrolocations =  network_list3$flowpaths %>% 
+  network_list$hydrolocations =  network_list$flowpaths %>% 
     st_drop_geometry() %>%
     select(id, poi_id) %>% 
     filter(!is.na(poi_id)) %>% 
@@ -147,26 +144,30 @@ if(!is.null(hydrolocations)){
 
 } 
 
-  network_list3$flowpaths = hydroloom::add_streamorder(network_list3$flowpaths) 
+  network_list$flowpaths = hydroloom::add_streamorder(network_list$flowpaths) 
 
-  network_list3$flowpaths = 
-    select(network_list3$flowpaths, id, toid, mainstem = levelpathid, order = stream_order, member_comid, any_of('poi_id'), hydroseq, lengthkm, 
+  network_list$flowpaths = 
+    select(network_list$flowpaths, 
+           id, toid, 
+           mainstem = levelpathid, 
+           order = stream_order, 
+           member_comid, poi_id, hydroseq, lengthkm, 
            areasqkm, tot_drainage_areasqkm = tot_drainage_area, has_divide) %>% 
-    mutate(divide_id = ifelse(id %in% network_list3$catchments$id, id, NA))
+    mutate(divide_id = ifelse(id %in% network_list$catchments$id, id, NA))
 
-  topo = st_drop_geometry(network_list3$flowpaths) %>% 
+  topo = st_drop_geometry(network_list$flowpaths) %>% 
     select(divide_id, toid)
 
-  network_list3$divides = select(network_list3$catchments, id,  areasqkm) %>% 
+  network_list$divides = select(network_list$catchments, id,  areasqkm) %>% 
     mutate(divide_id = id, has_flowline = TRUE, ds_id = NA, type = "network") %>% 
     left_join(topo, by = "divide_id")
 
-  network_list3$catchments = NULL
+  network_list$catchments = NULL
 
-  network_list3$network  = st_drop_geometry(network_list3$flowpaths) %>%
+  network_list$network  = st_drop_geometry(network_list$flowpaths) %>%
    select(
      id,
-     toid          = toid,
+     toid,
      member  = member_comid,
      divide_id,
      any_of('poi_id'),
@@ -182,32 +183,32 @@ if(!is.null(hydrolocations)){
           member = NULL,
           hf_source = "NHDPlusV2"
    ) %>%
-   left_join(st_drop_geometry(select(network_list3$divides, divide_id, type, ds_id)), by = "divide_id")
+   left_join(st_drop_geometry(select(network_list$divides, divide_id, type, ds_id)), by = "divide_id")
 
   if(!is.null(vpu)){
-    network_list3$network$vpu = vpu
+    network_list$network$vpu = vpu
   } else {
-    network_list3$network$vpu = NA
+    network_list$network$vpu = NA
   }
 
 
- if(!all(st_geometry_type(network_list3$divides) == "POLYGON")){
+ if(!all(st_geometry_type(network_list$divides) == "POLYGON")){
    warning("MULTIPOLYGONS FOUND VPU: ", vpu)
  }
 
 
   if (!is.null(outfile)) {
 
     outfile = write_hydrofabric(
-      network_list3,
+      network_list,
       outfile,
       verbose = verbose, 
       enforce_dm = FALSE)
 
     return(outfile)
 
   } else {
-    network_list3
+    network_list
   }
 
 }

R/hyaggregate_utils.R

@@ -39,6 +39,7 @@ prepare_network = function(network_list) {
   network_list$flowpaths = add_hydroseq(flowpaths = network_list$flowpaths)
   # Add area and length measures to the network list
   network_list = add_measures(network_list$flowpaths, network_list$catchments)
+
   network_list$flowpaths = mutate(network_list$flowpaths, areasqkm = ifelse(is.na(areasqkm), 0, areasqkm))
  #network_list$flowpaths$order = get_streamorder(st_drop_geometry(mutate(select(network_list$flowpaths, ID = id, toID = toid), divergence = 0)))
   network_list$flowpaths$tot_drainage_area = calculate_total_drainage_area(select(network_list$flowpaths, ID = id, toID = toid, area = areasqkm))
@@ -125,15 +126,15 @@ add_hydroseq = function(flowpaths) {
 #' @importFrom dplyr select left_join
 #' @importFrom sf st_drop_geometry
 
-add_measures = function(flowpaths, cat) {
+add_measures = function(flowpaths, divides) {
   flowpaths$lengthkm  = add_lengthkm(flowpaths)
-  cat$areasqkm = add_areasqkm(cat)
+  divides$areasqkm = add_areasqkm(divides)
   flowpaths$areasqkm = NULL
   flowpaths = left_join(flowpaths,
-                        select(st_drop_geometry(cat), id, areasqkm),
+                        select(st_drop_geometry(divides), id, areasqkm),
                         by = "id")
   list(flowpaths  = rename_geometry(flowpaths, "geometry"),
-       catchments = rename_geometry(cat, "geometry"))
+       catchments = rename_geometry(divides, "geometry"))
 }
 
 #' Compute length in kilometers

R/hydrofab.R

@@ -3,7 +3,7 @@
 #' @importFrom rvest read_html html_nodes html_attr
 #' @importFrom httr RETRY write_disk progress
 #' @importFrom sf write_sf read_sf st_read st_write st_as_sf
-#' @importFrom sf st_layers st_crs st_touches st_transform st_area st_make_valid st_intersection st_collection_extract st_cast st_intersects st_length st_filter st_union st_is_empty st_drop_geometry
+#' @importFrom sf st_layers st_crs st_touches st_transform st_area st_make_valid st_intersection st_collection_extract st_cast st_intersects st_length st_filter st_union st_is_empty st_drop_geometry st_is_valid
 #' @importFrom rmapshaper ms_explode ms_dissolve ms_simplify check_sys_mapshaper
 #' @importFrom rlang := sym
 #' @importFrom RSQLite SQLite

R/reconcile.R

@@ -334,11 +334,6 @@ par_split_cat <- function(fid, to_split_ids, fline_ref, catchment, fdr, fac,
     message(paste0(Sys.time(), " par_split_cat() on pid: ", 
                    Sys.getpid(), " catchment: ", fid))
 
-    # nolint start
-    #requireNamespace("hyRefactor", quietly = TRUE)
-    #requireNamespace("terra", quietly = TRUE)
-    # nolint end
-
     if(!inherits(fdr, "SpatRaster")){
       fdr = terra::rast(fdr)
     }

R/refactor_wrapper.R

@@ -105,9 +105,7 @@ refactor  = function (gpkg = NULL,
 
   rec =  rename_geometry(st_transform(read_sf(tr), 5070), "geometry")
 
-  if ("ID.1" %in% names(rec)) {
-    rec = select(rec, -"ID.1")
-  }
+  if ("ID.1" %in% names(rec)) { rec = select(rec, -"ID.1") }
 
   ##### LOOKUP #####
   refactor_lookup <- st_drop_geometry(rec) %>%