R实用绘图--桑基图 / 冲击图 / networkD3

今天带领大家绘制的是桑基图（Sankey diagram），用于可视化流动、转移或转换过程中的能量、资源或数量。

桑基图主要由两个元素组成：节点和流线。节点代表不同的实体，而流线则表示这些实体之间的流动。

桑基图的特点是它能够清晰地展示复杂的流动关系，使观察者能够迅速理解系统中各个部分之间的相互作用和能量或资源的流动路径。这种图表常常用于能源管理、物流优化、资源分配等领域。

❝

桑基图的名称来源于一名爱尔兰船长，最初他采用这种图展示了蒸汽的能源效率，所以该图以他的名字命名为桑基图。桑基图有时也会被称为流程图（flow diagram）或者冲击图（alluvial diagram）。

❞

networkD3包主要用于绘制交互网络图，优点是语法简单、出图美观、可交互，缺点是功能较少，版本更新慢。

加载包

# 加载包
library(readxl)
library(tidyverse)
library(networkD3) #用于绘图
library(webshot) #用于图片格式转换

数据准备

示例数据已经保存为csv文件了，可以选择通过公众号后台获取示例数据或者自行运行该部分代码。

# 创造示例数据-----------------
## 第一层数据
data12 <- data.frame(source=sample(paste0('layer1_',1:4),100,
                                   prob = c(0.35,0.25,0.2,0.2),replace = T),
                    target=sample(paste0('layer2_',1:4),100,
                                  prob = c(0.3,0.3,0.2,0.2),replace = T))
layer12<- data12 %>%
  group_by(source, target) %>%
  summarise(weight = n())

## 第二层数据
data23 <- data.frame(source=data12$target,
                      target=sample(paste0('layer3_',1:8),100,
                                    prob = c(0.3,0.1,0.1,0.1,0.1,0.1,0.1,0.1),replace = T))
layer23<- data23 %>%
  group_by(source, target) %>%
  summarise(weight = n())

## 第三层数据
data34 <- data.frame(source=data23$target,
                     target=sample(paste0('layer4_',1:4),100,prob = c(0.4,0.2,0.2,0.2),replace = T))
layer34<- data34 %>%
  group_by(source, target) %>%
  summarise(weight = n())

## 合并三层数据
pdata <- rbind(layer12,layer23)
pdata <- rbind(pdata,layer34)

# 保存示例数据
write.csv(pdata,file = 'pdata.csv')

每一层的示例数据格式如下：weight表示相应source和target之间的关系权重。

示例数据

修改数据格式

# 创造示例数据-----------------
## 第一层数据
data12 <- data.frame(source=sample(paste0('layer1_',1:4),100,
                                   prob = c(0.35,0.25,0.2,0.2),replace = T),
                    target=sample(paste0('layer2_',1:4),100,
                                  prob = c(0.3,0.3,0.2,0.2),replace = T))
layer12<- data12 %>%
  group_by(source, target) %>%
  summarise(weight = n())

## 第二层数据
data23 <- data.frame(source=data12$target,
                      target=sample(paste0('layer3_',1:8),100,
                                    prob = c(0.3,0.1,0.1,0.1,0.1,0.1,0.1,0.1),replace = T))
layer23<- data23 %>%
  group_by(source, target) %>%
  summarise(weight = n())

## 第三层数据
data34 <- data.frame(source=data23$target,
                     target=sample(paste0('layer4_',1:4),100,prob = c(0.4,0.2,0.2,0.2),replace = T))
layer34<- data34 %>%
  group_by(source, target) %>%
  summarise(weight = n())

## 合并三层数据
pdata <- rbind(layer12,layer23)
pdata <- rbind(pdata,layer34)

# 保存示例数据
write.csv(pdata,file = 'pdata.csv')

修改数据格式

由于networkD3包要求source和target都是数值型数据，同时需要另外提供一个包含节点名称的数据框作为输入，因此我们需要修改数据格式。

# 修改为符合networkD3包要求的数据格式-------------------
# 创建节点名称数据框
nodes <- data.frame(name = c(as.character(pdata$source), 
                             as.character(pdata$target)) %>% unique())
# 把source、target转换为数字
pdata$IDsource = match(pdata$source, nodes$name)-1
pdata$IDtarget = match(pdata$target, nodes$name)-1
head(pdata)

绘图并保存

# 正式绘图---------------------------------------
p1 <- sankeyNetwork(Links = pdata, # 输入数据1
                    Nodes = nodes, # 输入数据2
                    Source = "IDsource", # 来源变量
                    Target = "IDtarget", # 接受变量
                    Value = "weight", # 关系权重
                    NodeID = "name", #节点名称
                    LinkGroup = 'source', # 颜色分组
                    sinksRight = FALSE, # 设置最后一层标签位置在左/右
                    nodeWidth = 5, #节点格子宽度
                    fontSize = 15, #文本标签字体的大小
                    nodePadding = 4) #节点格子间空隙宽度
p1

# 保存   
saveNetwork(p1,"sankey.html")
webshot("sankey.html" , "sankey.png")
webshot("sankey.html" , "sankey.pdf")

绘图效果

绘图展示

由于我们的数据是随机生成的，图可能看上去没有什么规律，而真实情况下的数据不同层之间可能会存在相关关系，真实数据的桑基图效果应该会更好。

此外，保存的html文件打开后各个节点和线都是可以拖动的，可以手动调整到更合适的位置。