accept sf objects in add_hydroseq

Author: mikejohnson51

R/network_properties.R

@@ -93,7 +93,6 @@ accumulate_downstream <- function(x, id   = "flowpath_id", toid = "flowpath_toid
   as.numeric(total[idx])
 }
 
-
 #' Compute and add the hydrosequence to a directed acyclic network.
 #'
 #' @param topology A data frame (or tibble) containing at least the identifier column
@@ -105,23 +104,25 @@ accumulate_downstream <- function(x, id   = "flowpath_id", toid = "flowpath_toid
 #'   Defaults to `"flowpath_toid"`.
 #' @param colname Character scalar. Column name to use in result.
 #'   Defaults to `"hydroseq"`
-#' 
+#'
 #' @returns The data frame `topology` with an additional column, named `colname`, representing the hydrosequence.
 #' @importFrom igraph dfs graph_from_data_frame
 #' @export
+
 add_hydroseq <- function(topology, id = "flowpath_id", toid = "flowpath_toid", colname = "hydroseq") {
   # Create a _transposed_ network, where traversing the network
   # is equivalent to traversing the hydrological network upstream.
   #
   # This assumes the outlets of this network all connect to an
   # ephemeral "0" node (forming a rooted tree network).
-  edgelist <- topology[, c(toid, id)]
+
+  edgelist <- as.data.frame(topology)[, c(toid, id)]
   names(edgelist) <- c("id", "toid")
   edgelist$id[is.na(edgelist$id)] <- "0"
 
   # TODO: Check if multiple components exist. If they do, then
   # we need to add "0" edges for each component not rooted on "0".
-  
+
   # Perform DFS from each terminal upstream to get a
   # distinct topological sort for the hydrosequence.
   sorted <- data.frame(
@@ -148,4 +149,6 @@ add_hydroseq <- function(topology, id = "flowpath_id", toid = "flowpath_toid", c
   # Arrange into input order
   topology[[colname]] <- result$hydroseq[match(topology[[id]], result[[id]])]
   topology
-}
+}
+
+

README.Rmd

@@ -80,6 +80,7 @@ hfutils::as_ogr('/vsis3/lynker-spatial/hydrofabric/v2.2/conus/conus_nextgen.gpkg
 ### Network Properties
 
 ```{r}
+## Accumulate Downstream
 system.time({
   da <-  hfutils::as_ogr('/Users/mikejohnson/hydrofabric/v3.0/reference_fabric.gpkg', 
                          'flowpaths')  |> 
@@ -88,6 +89,17 @@ system.time({
   accumulate_downstream(attr = "areasqkm")})
 
 head(da)
+
+## Hydrosequence
+system.time({
+  hs <-  hfutils::as_ogr('/Users/mikejohnson/hydrofabric/v3.0/reference_fabric.gpkg', 
+                         'flowpaths')  |> 
+  filter(vpuid == "01") |> 
+  st_as_sf() |> 
+  add_hydroseq()
+})
+
+head(hs$hydroseq)
 ```
 
 ### Questions?

README.md

@@ -139,17 +139,32 @@ hfutils::as_ogr('/vsis3/lynker-spatial/hydrofabric/v2.2/conus/conus_nextgen.gpkg
 ### Network Properties
 
 ``` r
+## Accumulate Downstream
 system.time({
   da <-  hfutils::as_ogr('/Users/mikejohnson/hydrofabric/v3.0/reference_fabric.gpkg', 
                          'flowpaths')  |> 
   filter(vpuid == "01") |> 
   st_as_sf() |> 
   accumulate_downstream(attr = "areasqkm")})
 #>    user  system elapsed 
-#>   0.845   0.479   1.327
+#>   0.836   0.506   1.368
 
 head(da)
 #> [1]  15.66720  11.12805   4.44600   6.52365   4.53420 335.51145
+
+## Hydrosequence
+system.time({
+  hs <-  hfutils::as_ogr('/Users/mikejohnson/hydrofabric/v3.0/reference_fabric.gpkg', 
+                         'flowpaths')  |> 
+  filter(vpuid == "01") |> 
+  st_as_sf() |> 
+  add_hydroseq()
+})
+#>    user  system elapsed 
+#>   1.004   0.462   1.468
+
+head(hs$hydroseq)
+#> [1]   804 22722 22724 22723 22725 28137
 ```
 
 ### Questions?