1

The tidygraph package is really fantastic for computing network statistics. However, I have a network with a temporal dimension, and I'd like to calculate network statistics (e.g. centrality) over each of those networks. (E.g. calculate centrality separate for each date.)

I imagine there's a way to do this via purrr and map, but I'm struggling with the exact syntax. Any help here is appreciated. Repex example below.

library(tidygraph)
library('purrr')
library(dplyr)
library(tidyr)

# example network data with temporal dimension
edges <- tibble(
  from = c(1, 2, 2, 3, 4, 1, 2, 3, 4, 4, 4, 2), 
  to =   c(2, 3, 4, 2, 1, 2, 3, 4, 3, 2, 1, 3),
  date = c(rep(1,4), rep(2,4), rep(3,4))
)

nodes <- tibble(id = 1:4)

# calculate centrality over all time periods of network
graph <- 
  tbl_graph(
    nodes = nodes,
    edges = edges,
    directed = FALSE
  )

graph_out <- 
  graph %>% 
  mutate(cent_alpha = centrality_alpha()))


# calculate centrality for each time period of the network? 
edges_list <- 
  split(edges, edges$date)

# this doesn't work for me
graph_list <- 
  lmap(edges_list, 
      ~ tbl_graph(nodes = nodes, edges = .x, directed = FALSE))

## Yikes... no idea 
graph_out <-
Carl
  • 4,232
  • 2
  • 12
  • 24
jhersh
  • 11
  • 1

2 Answers2

1

The quickest approach that I could think of is to use the split function to create a list, where each element if the list is the structure of the graph at the given date. Then you can use map to create a tidygraph object for each date, and finally a centrality measure for each date:

edges %>%
  split(.$date) %>%
  map(~tbl_graph(edges = ., nodes = nodes, directed = FALSE)) %>%
  map(~igraph::alpha_centrality(.))

# $`1`
# [1]  0 -1 -1  0

# $`2`
# [1] -1 -1 -1 -1

# $`3`
# [1]  0 -1 -1 -1

If you prefer to save each step along the way, you can create a nested table instead:

df <- 
   edges %>%
   group_by(date) %>%
   nest() %>%
   rename(edges = data) %>%
   mutate(
     graph = map(edges, ~tbl_graph(edges = ., nodes = nodes, directed = FALSE)),
     cent_alpha = map(graph, ~igraph::alpha_centrality(.))
   )


df

## A tibble: 3 x 5
## Groups:   date [3]
#   date edges            graph      cent_alpha  
#  <dbl> <list>           <list>     <list>     
#1     1 <tibble [4 × 2]> <tbl_grph> <dbl [4]>  
#2     2 <tibble [4 × 2]> <tbl_grph> <dbl [4]>  
#3     3 <tibble [4 × 2]> <tbl_grph> <dbl [4]>  

df$cent_alpha

# [[1]]
# [1]  0 -1 -1  0

# [[2]]
# [1] -1 -1 -1 -1

# [[3]]
# [1]  0 -1 -1 -1

The nice thing about the last approach is that you can store any kind of data you want about each date's graph in the rows, even plots:

library(ggraph)
plot_fun <- function(gr){
  gr %>%
    ggraph(layout = "kk") +
    geom_edge_link() + 
    geom_node_point(size = 6, colour = 'steelblue') +
    geom_node_text(aes(label = id), colour = 'white', vjust = 0.4) +
    theme_void()
}

df <-
  df %>%
  mutate(plot = map(graph, ~plot_fun(.)))

cowplot::plot_grid(plotlist = df$plot, labels = df$date, vjust = 5)

graphs

And if we are only given the tidygraph object and not the edge/node data frames, we can easily create those data frames as follows:

edges <- 
  graph %>%
  activate(edges) %>%
  data.frame()

nodes <- 
  graph %>%
  activate(nodes) %>%
  data.frame()
0

You can use map as -

library(purrr)
library(tidygraph)

result <- map(edges_list, ~tbl_graph(nodes = nodes,edges = .x,directed = FALSE))

or with lapply -

result <- lapply(edges_list, function(x) 
                tbl_graph(nodes = nodes, edges = x, directed = FALSE))
Ronak Shah
  • 377,200
  • 20
  • 156
  • 213