按时间间隔分面 ggraph 图

问题描述

我热衷于展示社交网络中节点属性和边如何随时间变化。虽然 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,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,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 ---------#

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

解决方法

暂无找到可以解决该程序问题的有效方法，小编努力寻找整理中！

如果你已经找到好的解决方法，欢迎将解决方案带上本链接一起发送给小编。

小编邮箱:dio#foxmail.com (将#修改为@）

ggraph r r