Aggregating weights of bidirectional edges in igraph while retaining edge attributes

Question

In a directed, weighted graph, when I have bidirectional edges, (I.e. A->B and B->A exist), I would like to subtract the two weights such that the resulting edge direction is in the direction of the larger weight. My example below accomplishes this for edges with only a 'weight' attribute, but when I have other edge attributes (multiple edges), I want to retain the attributes when aggregating. The issue with my example is that when I convert my graph to an adjacency matrix via as_adjacency_matrix, the function combines the weights and I lose the attribute data. How can I combine bidirectional edge weights while retaining edge attribute data?

Example with a "group" attribute:

library(dplyr)
library(igraph)
library(visNetwork)

df<-data.frame(from = c('A','A','B','B','C','C','G','A','A','B','B','C','C','G'),
               to = c('B','C','A','E','F','G','C','B','C','A','E','F','G','C'),
               weight = c(50,30,20,15,45,34,60,40,100,20,25,35,72,50),
               group = c('1','2','2','1','1','1','2','2','1','2','1','1','2','2'))

g<-igraph::graph_from_data_frame(df)

# visual - original graph
edges<-igraph::as_data_frame(g, what = 'edges')
nodes<-data.frame(id = append(edges$from, edges$to) %>% unique())
visNetwork(nodes=nodes, edges = edges)%>%
  visEdges(arrows ="to")

# aggregate bidirectional edges 
g_old<-g
mx_old<-as_adjacency_matrix(g_old, attr = "weight") %>% as.matrix()
mx_new<-mx_old

u = mx_old[row(mx_old) == (col(mx_old) - 1)] # upper off-diagonal
l = mx_old[row(mx_old) == (col(mx_old) + 1)] # lower off-diagonal

mx_new[row(mx_new) == (col(mx_new) - 1)]<-ifelse((u - l) > 0, (u - l), ifelse((u - l) < 0, 0, u))
mx_new[row(mx_new) == (col(mx_new) + 1)]<-ifelse((l - u) > 0, (l - u), ifelse((l - u) < 0, 0, l))

# new graph with bidrectional edges removes
g_new = graph_from_adjacency_matrix(mx_new, weighted = TRUE)

# visual - new graph
edges<-igraph::as_data_frame(g_new, what = 'edges')
nodes<-data.frame(id = append(edges$from, edges$to) %>% unique())
visNetwork(nodes=nodes, edges = edges)%>%
  visEdges(arrows ="to")

adc adc · Accepted Answer · 2021-01-06T15:59:12

Here is a function implemented with dplyr. I'm sure there is a more elegant approach, but this offers a solution.

library(dplyr)
remove_bidirect_edges<-function(df, weight_attr) {
  
  wt<-weight_attr
  join_cols<-names(df)
  join_cols<-join_cols[join_cols != wt]
  
  df1<-df %>% rename("wt_attr"=wt)
  df2<-df1 %>% rename('to'='from', 'from'='to')
  
  df3<-left_join(df1, df2, by = join_cols) %>%
    mutate(diff = wt_attr.x - wt_attr.y) %>%
    filter(!is.na(diff)) %>%
    mutate('NewWeight' = diff)%>%
    select(-wt_attr.x, -wt_attr.y, -diff)
  
  df_return<-left_join(df1, df3, by = join_cols)%>%
    mutate(wt_attr = ifelse(!is.na(NewWeight), NewWeight, wt_attr)) %>%
    filter(wt_attr>=0)%>%
    select(-NewWeight)
  
  names(df_return)[names(df_return) == "wt_attr"] <- wt
  
  return(df_return)
}

Aggregating weights of bidirectional edges in igraph while retaining edge attributes

1 Answers