ggraph优雅的绘制网络流程图

2023-08-18 13:54:44 浏览数 (1)

欢迎关注R语言数据分析指南

❝本节来介绍如何使用ggraph包来绘制网络流程图,下面小编就通过一个案例来进行展示数据为随意构建无实际意义仅作图形展示用,添加了详细的注释希望各位观众老爷能够喜欢 ❞

结果图

加载R包

代码语言:javascript复制
library(tidyverse)
library(tidygraph)
library(ggraph)
library(ggtext)

导入数据

代码语言:javascript复制
df <- read_csv("data.xls")

构建点文件

代码语言:javascript复制
nodes <- tibble(
  node = c("root", unique(df$category), unique(df$category_continent))) %>% 
  # 根据不同节点名称给层级赋值(根节点为1,其他category节点为2,category_continent节点为3,其余节点为4)
  mutate(levels = case_when(
      node == "root" ~ 1,
      node %in% unique(df$category) ~ 2,
      node %in% unique(df$category_continent) ~ 3,TRUE ~ 4)) %>% 
  left_join(count(df, category, continent, name = "number") %>% 
      mutate(category_continent = as.character(glue("{category}_{continent}"))),
    by = c("node" = "category_continent")) %>% 
  continent = factor(continent, levels = c("Africa", "Asia", "Europe", "NorthnAmerica", "SouthnAmerica", "Oceania")),
  # 将continent列逆序排列
  continent = fct_rev(continent)) %>% 
  # 根据层级、category、continent列对节点DataFrame进行排序
  arrange(levels, category, continent)

创建层级1的边文件

代码语言:javascript复制
edges_level_1 <- df %>% distinct(category) %>% 
  mutate(from = "root") %>% rename(to = category)
# 创建层级2的边
edges_level_2 <- df %>%
  distinct(category, category_continent) %>% 
  arrange(category, category_continent) %>%
  select(from = category, to = category_continent)

创建颜色边

代码语言:javascript复制
color_edges <- tibble(
  category = c("Identity", "Knowledge", "Creativity" , "Leadership"),
  color = c("#99B898", "#019875", "#FF847C", "#C0392B"))

整合边文件

代码语言:javascript复制
edges <- 
  bind_rows(edges_level_1, edges_level_2) %>% 
  left_join(color_edges, by = c("to" = "category")) %>% 
  left_join(color_edges, by = c("from" = "category")) %>% 
  # 优先选择to节点的颜色,如果to节点没有颜色信息则使用from节点的颜色
  mutate(color = coalesce(color.x, color.y)) %>% 
  select(-color.x, -color.y)

整合边文件与点文件

代码语言:javascript复制
graph_data <- tbl_graph(nodes, edges)

数据可视化

代码语言:javascript复制
ggraph(graph_data, layout = "partition")  
  geom_edge_diagonal(aes(color = color), alpha = 0.5)  
  geom_node_text(aes(x = x, y = y, label = continent, filter = levels == 3, color = category), 
                 size = 3,hjust = 1, vjust = 0.5, lineheight = 0.9)  
  geom_node_text(aes(label = node, filter = levels == 2, color = node),
                 size =3,vjust = 0.5, hjust=0.5,fontface = "bold")  
  geom_node_point(aes(filter = levels == 2, color = node), size = 3, alpha = 0.40)  
  geom_node_point(aes(filter = levels == 2, color = node), size = 3, shape = 1)  
  geom_node_range(aes(y = y   0.02, yend = y   1.5 * number/max(nodes$number, na.rm = TRUE), 
                      x = x, xend = x, filter = levels == 3, color = category), size = 3)  
  geom_node_text(aes(x = x, y = y   1.5 * number/max(nodes$number, na.rm = TRUE),
                     label = number, filter = levels == 3, color = category), nudge_y = 0.025, size = 3,
                 fontface = "bold", hjust = 0, vjust = 0.5)  
  scale_color_manual(values = c("Identity" = "#99B898", "Knowledge" = "#019875", "Creativity" = "#FF847C", "Leadership" = "#C0392B"))  
  scale_edge_color_identity()  
  coord_flip()  
  theme(plot.margin = margin(10,10,10,10),
    panel.background = element_rect(fill = "white", color = "white"),
    legend.position = "none") 

0 人点赞