1

I have a simple directed network. It could be rivers that merge and separate. Here river A and river B both contribute 50% to the water in downstream river A12, etc.

Network

I want to calculate how large a percent of water in each river comes from different upstream rivers.

I gather that I have to multiply the weights along all paths between vertices and then sum them. But I am unsure how to achieve this in igraph?

library(igraph)
# Network structure
df <- structure(list(pid = c("A1", "A1", "B1", "A11", "A11", "A12", "A12")
                     , cid = c("A11", "A12", "A12", "A111", "A121", "A121", "A122")
                     , w = c(1, 0.5, 0.5, 1, 0.6, 0.4, 1))
                , row.names = c(NA, -7L)
                , class = "data.frame")

df_g <- graph_from_data_frame(df, directed=TRUE)

# Wanted list with each pair of connected vertices and sum of muliplied weights along connections:
wanted_df <- as.data.frame(rbind(c('A1','A11',1)
                  ,c('A1','A12',0.5)
                  ,c('A1','A111',1) # 1*1
                  ,c('A1','A121',0.8) # 1*0.6 + 0.5*0.4 
                  ,c('A1','A122',0.5) # 0.5**1
                  ,c('A11','A111',1)
                  ,c('A11','A121',0.6)
                  ,c('A12','A121',0.4)
                  ,c('A12','A122',1)
                  ,c('B1','A12',0.5)
                  ,c('B1','A121',0.2) #0.5*0.4
                  ,c('B1','A122',0.5))) #0.5*1
colnames(wanted_df) <- c('pid','cid','share')
zaphoid
  • 98
  • 7

1 Answers1

1

I found a method using purrr to manipulate the graph. It first extracts all paths, then find the weights corresponding to those paths and does the final multiplication and summation. It can probably be simplified.

For this toy example the solution works fine. I am not sure how well it generalizes to much larger problems.

library(tidyverse)
calc_df <- map(V(df_g), ~all_simple_paths(df_g, from=.x)) %>% #Extract all paths
  purrr::discard(., ~length(.x)==0) %>% #Remove empty paths
  purrr::flatten() %>% #Drop one level
  map(., ~ rep(attr(.x, "names"), each=2)) %>% #Get paths by name
  map(., ~ .x[2:(length(.x)-1)]) %>% #Get paths by name (remove duplicate initial and trailing)
  map_dfr(., ~data.frame("pid"=.x[1], "cid"=.x[length(.x)], "strength"=prod(E(df_g)$w[get.edge.ids(df_g, .x)]))) %>% # extract edge weights and multiply
  group_by(pid, cid) %>% 
  summarize(strength=sum(strength)) %>% #Sum weights from different paths
  ungroup() %>%
  arrange(pid, cid) %>% #Sort before we compare
  as.data.frame() #Convert from tibble to dataframe for comparison
    
wanted_df$strength <- as.numeric(wanted_df$strength) #Convert to numeric
identical(calc_df, arrange(wanted_df, pid, cid)) 
# [1] TRUE
zaphoid
  • 98
  • 7
  • I had the same type of question about multiplying edge weights in a much different context. Not being an experienced user of purrr or igraph, it took me awhile to figure out the syntax and apply it to my data, yet the approach from @zaphoid worked once I did. I would imagine that this question arises a lot, so Ilm wondering why there hasn't been more interest---perhaps there's a simpler way to approach it? Either way, thank you for the question and answer. – Corey N. Sep 28 '22 at 02:20