Порядок потоков Strahler с использованием igraph или sfnetwork в R

Question

Я не могу понять, как получить порядок Стралера в R. Вот пример в postgres и neo4j . Попытка в Р.

Есть три правила (из Руководства по GRASS 7.8 ):

• если у узла нет потомков, его порядок Стралера равен 1.
• если в узле есть один и только один приток с наибольшим порядком Стралера i, а все остальные притоки имеют порядок меньше i, то порядок остается i.
• если узел имеет два или более притоков с наибольшим порядком i, то порядок Штралера узла равен i + 1.

Вот чего я ожидал

      library(sfnetworks)
library(igraph)
library(sf)
library(dplyr)
library(tidygraph)
library(RColorBrewer)

# Create an example network.
n01 = st_sfc(st_point(c(0, 0)))
n02 = st_sfc(st_point(c(1, 2)))
n03 = st_sfc(st_point(c(1, 3)))
n04 = st_sfc(st_point(c(1, 4)))
n05 = st_sfc(st_point(c(2, 1)))
n06 = st_sfc(st_point(c(2, 3)))
n07 = st_sfc(st_point(c(2, 4)))
n08 = st_sfc(st_point(c(3, 2)))
n09 = st_sfc(st_point(c(3, 3)))
n10 = st_sfc(st_point(c(3, 4)))
n11 = st_sfc(st_point(c(4, 2)))
n12 = st_sfc(st_point(c(4, 4)))

from = c(1, 2, 2, 3, 3, 5, 5, 8, 8, 9, 9)
to = c(5, 3, 6, 4, 7, 2, 8, 9, 11, 10, 12)

nodes = st_as_sf(c(n01, n02, n03, n04, n05, n06, n07, n08, n09, n10, n11, n12))
edges = data.frame(from = from, to = to)

G = sfnetwork(nodes, edges) %>%
  convert(to_spatial_explicit, .clean = TRUE)

nodes = st_as_sf(G, "nodes")
edges = st_as_sf(G, "edges")

# expected order
edges$expected_order = c(4,2,1,1,1,3,3,2,1,1,1) 

cols = brewer.pal(4, "Blues")
pal = colorRampPalette(cols)

plot(st_geometry(edges))
plot(edges["expected_order"], 
     lwd = 4, , 
     add = TRUE,
     col = pal(4)[edges$expected_order])
legend(x = "topright",
       legend = c("4","3","2","1"),          
       lwd = 4,
       col = pal(4)[edges$expected_order],
       title = "strahler order")
plot(nodes, pch = 20, add = TRUE)

Вот что я попробовал сделать с помощью jsta/streamnet/stream_order.R , который я не могу загрузить из-за отсутствия пакетов

      stream_order_igraph <- function(tree){
  
  tree <- as.igraph(tree)
  
  leaf_nodes <- which(degree(tree,
                                   v = igraph::V(tree),
                                   mode = "in") == 0,
                            useNames = TRUE)
  
  base_order <- 1
  
  edgelist   <- data.frame(as_edgelist(tree))
  edgelist$order <- NA
  names(edgelist)[c(1,2)] <- c("from", "to")
  edgelist$order[edgelist$from %in% leaf_nodes] <- base_order
  
  tree <- igraph::delete.vertices(tree, leaf_nodes)
  
  while(igraph::vcount(tree) >= 1){
    base_order <- max(edgelist$order, na.rm = TRUE) + 1
    leaf_nodes <- which(degree(tree, v = igraph::V(tree),
                                     mode = "in") == 0,
                              useNames = TRUE)
    
    raised_nodes <- sapply(leaf_nodes,
                           function(x) all(edgelist$order[edgelist$to == x] == base_order - 1))
    raised_nodes <- which(raised_nodes)
    flat_nodes <- leaf_nodes[!(leaf_nodes %in% raised_nodes)]
    
    edgelist$order[edgelist$from %in% raised_nodes] <- base_order
    edgelist$order[edgelist$from %in% flat_nodes] <- base_order - 1
    
    tree <- igraph::delete.vertices(tree, leaf_nodes)
    
  }
  edgelist$order
}

stream_order_igraph(G)

> stream_order_igraph(G)
 [1]  4  3  3  3  3  2  2 NA NA NA NA