remove duplicate outlets

R/aggregate_network.R

@@ -264,6 +264,8 @@ make_outlets_valid <- function(outlets, flowpath,
     }
   }
 
+  otl <- distinct(otl)
+
   # Need to check that a "next down tributary" in the outlet set has a break along the
   # main stem that each outlet contributes to.
   otl <- left_join(otl, select(drop_geometry(flowpath),
@@ -338,6 +340,14 @@ make_outlets_valid <- function(outlets, flowpath,
       otl <- get_outlets(outlets, lps)
     }
   }
+
+  # deduplicate outlets.
+  outlets <- distinct(outlets) %>%
+    group_by(.data$ID) %>%
+    filter(!(n() > 1 & # this removes outlets that duplicate terminals.
+               # they can be added in the above outlets check.
+               .data$type == "outlet")) %>%
+    ungroup()
 
   return(outlets)
 }
@@ -485,7 +495,7 @@ get_catchment_sets <- function(flowpath, outlets) {
                      cut(path,
                          breaks = c(0, breaks$id),
                          labels = c(breaks$set)))
-
+      
       cat_sets$set[as.integer(names(paths))] <-
         lapply(names(paths), function(x) {
           my_combine(cat_sets$set[as.integer(x)][[1]],

tests/testthat/test_aggregate_catchments.R

@@ -50,15 +50,15 @@ aggregate_lookup_cat <- dplyr::select(sf::st_drop_geometry(aggregated$cat_sets),
 expect_true(all(walker_fline_rec$ID %in% unlist(aggregate_lookup_cat$set)), 
             "all input ids should be in catchment output")
 
-expect_equal(aggregated_cat$toID, get_id(c(NA, "5329843", "5329339.1", "5329303")), info = "Expect these toIDs")
+expect_true(all(aggregated_cat$toID %in% get_id(c(NA, "5329843", "5329339.1", "5329303"))), info = "Expect these toIDs")
 
 expect_true(all(aggregated_cat$toID[!is.na(aggregated_cat$toID)] %in% aggregated_cat$ID),
        "All not NA toIDs should be in IDs")
 
 ### Make sure we can run split_catchment_divide on aggregate output.
-crs <- st_crs(walker_fdr)
-aggregated_cat <- st_transform(aggregated_cat, crs)
-aggregated_fline <- st_transform(aggregated_fline, crs)
+crs <- sf::st_crs(walker_fdr)
+aggregated_cat <- sf::st_transform(aggregated_cat, crs)
+aggregated_fline <- sf::st_transform(aggregated_fline, crs)
 
 aggregated_cat <- aggregated_cat[match(aggregated_fline$ID, aggregated_cat$ID), ]