r - 在时间间隔上刻面 ggraph 图

Question

我热衷于展示社交网络中节点属性和边如何随时间变化。虽然 ggraph 可以很容易地绘制网络，但我不确定如何生成具有不同边缘和节点属性的构面。以 Covid-19 接触者追踪为例 - 受感染的人与其他人联系并可能感染他们。一个更中心的人成为一个超级传播者。我想绘制一个假设的联系网络并展示人们是如何被感染的。边缘每天都在变化，感染状态也是如此。这是我的基于代理的模型：

#--------- start script ---------#

require(tidyverse)
require(tidygraph)
require(ggraph)

# define functions

agent_generator <- function(pop_size, init_exposed){
  # create population of susceptible agents
  agents <- data.frame(agent_no = 1:pop_size,
                       state = "s",
                       mixing = runif(pop_size, 0, 1),
                       stringsAsFactors = FALSE)
  agents$state[1:init_exposed] <- "e"
  return(agents)
}

simple_model <- function(agents, mix, steps){
  pop_size <- nrow(agents)
  
  # define data outputs
  edge_list <- data.frame()
  node_list <- data.frame()
  
  for(k in 1:steps){
    for(i in 1:pop_size){
      # likelihood of an agent to go out and meet others
      connect_with <- round(likelihood * mix, 0) + 1 
      
      # which agents will they probably meet (list of agents)
      meet_ups <- sample(1:pop_size, 
                         connect_with, 
                         replace = T, 
                         prob = agents$mixing)
      
      # create edge list
      df <- data.frame(agent = meet_ups)
      edges <- expand(df, from = agent, to = agent) %>%
        filter(from < to) %>%
        mutate(day = k) %>%
        arrange(day)
      
      edge_list <- bind_rows(edge_list, edges)
      
      for(j in 1:length(meet_ups)){
        contacts <- agents[meet_ups[j],]
        
        # if exposed, change state
        if(contacts$state == "e"){
          urand <- runif(1,0,1)
          
          # control probability of state change
          if(urand < 0.5){
            agents$state[i] <- "e"
          }
        }
        
        # create node list
        nodes <- agents %>%
          select(agent_no, state) %>%
          mutate(day = k) %>%
          arrange(day)
        node_list <- bind_rows(node_list, nodes)
      } 
    }
  }
  return(list(edges = edge_list, nodes = node_list))
}

# execute functions

agents <- agent_generator(20,2)
model_1 <- simple_model(agents, mix = 3, steps = 15)

# create network

edge_list <- model_1[[1]]
node_list <- model_1[[2]]

net <- tbl_graph(nodes = node_list, edges = edge_list, directed = F)

# plot network

k <- ggraph(net %>%
              activate(nodes) %>% 
              filter(!node_is_isolated()) %>%
              group_by(day) %>%
              mutate(degree = centrality_degree()) %>%
              ungroup(), layout = "nicely") + 
  geom_edge_link(color = "grey", alpha = 0.8) +
  geom_node_point(aes(color = state, size = degree)) +
  facet_edges(~ day) +
  theme_graph() 


#--------- end script ---------#

结果没有显示节点状态或度数的变化，但显示了日常联系。如何让节点和边一样变化？

标签： rggraph