R语言实现桑基图绘制

一粒沙

发布于 2020-02-25 13:26:35

9.7K1

发布于 2020-02-25 13:26:35

说到流程图大家应该都很熟悉，那么我们今天介绍流程图的一个分支桑基图（Sankeydiagram）。它的闻名是因为1898年MatthewHenry Phineas Riall Sankey绘制的“蒸汽机的能源效率图”而闻名，此后便以其名字命名为“桑基图”。桑基图作为一种特定类型的流程图，图中延伸的分支的宽度对应数据流量的大小，通常应用于能源、材料成分、金融等数据的可视化分析。那么我们首先看下需要安装的包：

install.packages("ggalluvial")
install.packages("ggplot2")
install.packages("dplyr")
install.packages("networkD3")
install.packages("riverplot")

以上包中ggalluvial，networkD3，riverplot三个均可构建桑基图，当然从简单到复杂就是networkD3->ggalluvial->riverplot。那么接下来我们看下具体如何实现图的绘制。

首先我们看下networkD3中的函数sankeyNetwork：

其中主要的参数：

Links 指的一个数据框，包括source，target， value三列。其中source和target用的编码替换或者直接对应的名称。

Nodes 指的是所有点的名称，可以获取links中的名称或者自行对应links中的编码。

Source，target，value 对应的links中的值。

NodeID 对应Nodes中的名称。此处如果对应ID的话需要links中的节点从0开始编号。

NodeGroup，LinkGroup指的对应的节点和连接线的颜色的改变，如果分组，不同组之间颜色会分别不同标记。

Nodewidth 指的节点的宽度。

接下来我们看下包自带的实例：

#数据源有时候可能无法访问，需要自行下载。我们也提供了国内链接：
链接:https://pan.baidu.com/s/16OOFHAqU54f8fNczRjFvng 提取码:sarr
 
URL <-paste0('https://cdn.rawgit.com/christophergandrud/networkD3/',
              'master/JSONdata/energy.json')
energy <- jsonlite::fromJSON(URL)

# 节点分组的情况下：
sankeyNetwork(Links = energy$links, Nodes =energy$nodes, Source = 'source',
            Target = 'target', Value = 'value', NodeID = 'name',
            units = 'TWh', fontSize = 12, nodeWidth = 30)

#连接线分组的情况
energy$links$energy_type <- sub(' .*','',
                              energy$nodes[energy$links$source + 1, 'name'])
 
sankeyNetwork(Links = energy$links, Nodes =energy$nodes, Source = 'source',
            Target = 'target', Value = 'value', NodeID = 'name',
            LinkGroup = 'energy_type', NodeGroup = NULL)

这个包呢，有一个缺点就是基于shiny的JS框架，所有的图直接生成到WEB界面，如果保存还需多一个步骤，那就是pdf的转化。

接下来我们看下ggalluvial如何实现桑基图的绘制。在这个包中他不叫桑基图而是叫冲击图（Alluvial Plots），同时也是ggplot2的一个扩展，所以也离不开ggplot2的载入。我们直接进入实例：

##数据源
head(as.data.frame(UCBAdmissions), n = 12)

ggplot(as.data.frame(UCBAdmissions), aes(y= Freq, axis1 = Gender, axis2 = Dept)) +geom_alluvium(aes(fill = Admit), width= 1/12) +geom_stratum(width = 1/12, fill = "black", color ="grey") +geom_label(stat = "stratum", infer.label = TRUE) +scale_x_discrete(limits= c("Gender", "Dept"), expand = c(.05, .05)) +scale_fill_brewer(type= "qual", palette = "Set1") +ggtitle("UC Berkeleyadmissions and rejections, by sex and department")

ggplot(as.data.frame(Titanic), aes(y =Freq, axis1 = Survived, axis2 = Sex, axis3 = Class)) +geom_alluvium(aes(fill =Class), width = 0, knot.pos = 0, reverse = FALSE) +guides(fill = FALSE) +geom_stratum(width= 1/8, reverse = FALSE) +geom_text(stat = "stratum", infer.label =TRUE, reverse = FALSE) +scale_x_continuous(breaks = 1:3, labels =c("Survived", "Sex", "Class")) +coord_flip() +ggtitle("Titanicsurvival by class and sex")

接下来就是对单个样本随着时间获取其它序列追踪的不同属性分布情况：

data(majors)
majors$curriculum <-as.factor(majors$curriculum)
ggplot(majors, aes(x = semester, stratum =curriculum, alluvium = student, fill = curriculum, label = curriculum)) +scale_fill_brewer(type= "qual", palette = "Set2") +geom_flow(stat ="alluvium", lode.guidance = "frontback",color ="darkgray") +geom_stratum() +theme(legend.position ="bottom") +ggtitle("student curricula across severalsemesters")

如何绘制和我们前面类似的桑基图呢，接下来我们看实例：

data(vaccinations)
 
levels(vaccinations$response) <-rev(levels(vaccinations$response))

ggplot(vaccinations, aes(x = survey,stratum = response, alluvium = subject, y = freq, fill = response, label =response)) +scale_x_discrete(expand = c(.1, .1)) +geom_flow() +geom_stratum(alpha= .5) +geom_text(stat = "stratum", size = 3) + theme(legend.position= "none") +ggtitle("vaccination survey responses at three pointsin time")

这个包的好处就是可以直接调用ggplot的所有参数设置，可以更有效的修改绘图的参数。

最后我们再看下这个专业绘制桑基图的riverplot，它绘制桑基图其实并没有前面两个包的灵活性，但是却比前两个包更加丰富，增加了新的功能就是可以将桑基图叠加在一个图里面。我们直接看下实例：

nodes <- c( LETTERS[1:3] )
edges <- list( A= list( C= 10 ), B=list( C= 10 ) )
r <- makeRiver( nodes, edges, node_xpos=c( 1,1,2 ),
 node_labels= c( A= "Node A", B= "Node B", C="Node C" ),
 node_styles= list( A= list( col= "yellow" )) )
plot( r )
x <- riverplot.example()
plot(x，add=T)

其实上面看起来并不是多么好看，那么我们还需要对数据进行美化。那么我们就直接看下他的例子所用的数据，我们直接获取例子中的数据，根据这个数据进行我们的颜色填充。

ret <- list(nodes = data.frame(ID =LETTERS[1:8], x = c(1,
       2, 2, 3, 3, 4, 5, 1), labels = c(NA, NA, "Node C",
       rep(NA, 4), "Node H"), stringsAsFactors = FALSE),
       styles = list(A = list(col = "#00990099", lty = 0,
           textcol = "white"), H = list(col = "#FF000099",
           textcol = "white"), B = list(col = "#00006699",
           textcol ="white"), F = list(col = "yellow"),
           D = list(col = "#00FF0099")))
 ret$edges <- data.frame(N1 =c("A", "A", "A",
       "H", "H", "H", "B","B",
       "C", "C", "C"), N2 = c("B","C",
       "D", "D", "F", "G","D",
       "F", "D", "E", "F"), Value =c(10,
       20, 5, 10, 10, 20, 5, 10, 20, 15, 10), stringsAsFactors = F)
   rownames(ret$nodes) <- ret$nodes$ID
 
 
library(RColorBrewer) 
palette = paste0(brewer.pal(8,"Set1"), "60") 
 
 
###颜色填充
styles = lapply(ret$nodes$x, function(n){ 
 list(col = palette[n+1], lty = 0, textcol = "black") 
}) 
names(styles) = ret$nodes$ID
 
###构建riverplot对象 
rp <- list(nodes = ret$nodes, edges =ret$edges, styles = styles)
 
class(rp) <- c(class(rp),"riverplot")
# 绘制桑基图，plot_area设置绘图面积，yscale设置Y轴方向缩放
plot(rp, plot_area =1, yscale=0.26)