R可视化之桑吉图

0.1.1 基础桑吉图绘制

可以使用两种格式的数据进行桑吉图绘制:

• connection data frame(一共三列),可以理解为长数据.
• 关联矩阵(incidence matrix),可以理解为宽数据.

library(networkD3)
library(tidyverse)

## Warning: package 'tidyverse' was built under R version 3.6.1

## -- Attaching packages ------------------------------------------------------------------------ tidyverse 1.2.1 --

## v ggplot2 3.2.1     v purrr   0.3.2
## v tibble  2.1.3     v dplyr   0.8.3
## v tidyr   1.0.0     v stringr 1.4.0
## v readr   1.3.1     v forcats 0.4.0

## Warning: package 'ggplot2' was built under R version 3.6.1

## Warning: package 'tibble' was built under R version 3.6.1

## Warning: package 'tidyr' was built under R version 3.6.1

## Warning: package 'dplyr' was built under R version 3.6.1

## -- Conflicts --------------------------------------------------------------------------- tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag()    masks stats::lag()

links <- data.frame(
  source = c("group_A","group_A", "group_B", "group_C", "group_C", "group_E"), 
  target = c("group_C","group_D", "group_E", "group_F", "group_G", "group_H"), 
  value = c(2,3, 2, 3, 1, 3)
  )
head(links)

##    source  target value
## 1 group_A group_C     2
## 2 group_A group_D     3
## 3 group_B group_E     2
## 4 group_C group_F     3
## 5 group_C group_G     1
## 6 group_E group_H     3

##构建connection data frame中所有nodes的data frame
nodes <- data.frame(
  name = c(as.character(links$source), 
  as.character(links$target)) %>% unique()
)

#然后我们需要将每个node的名字代替为其在node data frame中的位置index,注意是要从哦开始计算.
links$IDsource <- match(links$source, nodes$name) - 1 
links$IDtarget <- match(links$target, nodes$name) - 1

#开始创建桑吉图
p <- networkD3::sankeyNetwork(
  Links = links,
  Nodes = nodes,
  Source = "IDsource",
  Target = "IDtarget",
  Value = "value",
  NodeID = "name",
  sinksRight = FALSE
)
p

0.1.2 另外一个例子

我们使用桑吉图来展示科学家的移民或者说是流动情况.左边代表科学家的移出国,右边代表科学家的移进国.数据来自scientific publication(https://onlinelibrary.wiley.com/doi/abs/10.1111/imre.12327).

#加载包
library(tidyverse)
library(networkD3)

# 读取数据
data <- 
  read.table("https://raw.githubusercontent.com/holtzy/data_to_viz/master/Example_dataset/13_AdjacencyDirectedWeighted.csv", header = TRUE)

# 讲数据转换为长数据
data_long <- data %>%
  rownames_to_column(var = "name") %>%
  pivot_longer(cols = -name, names_to = "key", values_to = "value") %>% 
  filter(value > 0) %>% 
  as.data.frame()

colnames(data_long) <- 
  c("source", "target", "value")

data_long$target <- 
  paste(data_long$target, " ", sep = "")

# 创建node data frame
nodes <- 
  data.frame(name = c(as.character(data_long$source),  
                      as.character(data_long$target)) %>% unique()
             ) %>% 
  arrange(name) %>% 
  as.data.frame()
 
data_long$IDsource = match(data_long$source, nodes$name) - 1 
data_long$IDtarget = match(data_long$target, nodes$name) - 1

# prepare colour scale
ColourScal <- 'd3.scaleOrdinal() .range(["#FDE725FF","#B4DE2CFF","#6DCD59FF","#35B779FF","#1F9E89FF",
"#26828EFF","#31688EFF","#3E4A89FF","#482878FF","#440154FF"])'

# Make the Network
sankeyNetwork(
  Links = data_long,
  Nodes = nodes,
  Source = "IDsource",
  Target = "IDtarget",
  Value = "value",
  NodeID = "name",
  sinksRight = FALSE,
  colourScale = ColourScal,
  nodeWidth = 40,
  fontSize = 13,
  nodePadding = 20
)

0.1.3 使用ggalluvial包绘制桑吉图

ggalluvial包是ggplot2的一个扩展包.可以用来绘制桑吉图.

##加载包
library(ggalluvial)

## Warning: package 'ggalluvial' was built under R version 3.6.1

## 使用示例数据
data(vaccinations)
head(vaccinations)

##   freq           a subject    survey response
## 1   48 0.050367261       1 ms153_NSA   Always
## 2    9 0.009443861       2 ms153_NSA   Always
## 3   66 0.069254984       3 ms153_NSA   Always
## 4    1 0.001049318       4 ms153_NSA   Always
## 5   11 0.011542497       5 ms153_NSA   Always
## 6    1 0.001049318       6 ms153_NSA   Always

levels(vaccinations$response) <- rev(levels(vaccinations$response))
ggplot(vaccinations,
       aes(x = survey, 
           y = freq,
           stratum = response, 
           alluvium = subject,
           fill = response, 
           label = response)) +
  scale_x_discrete(expand = c(.1, .1)) +
  ggalluvial::geom_flow() +
  labs(x = "", y = "") +
  ggalluvial::geom_stratum(alpha = .5) +
  geom_text(stat = "stratum", size = 3) +
  theme_bw() +
  theme(legend.position = "none", 
        plot.background = element_blank(), 
        panel.border = element_blank(), 
        panel.grid = element_blank(), 
        axis.ticks = element_blank(), 
        axis.text.y = element_blank()) +
  ggtitle("vaccination survey responses at three points in time")

我们在对该包做一个详细的讲解.