R語言實現桑基圖繪製

  • 2020 年 2 月 25 日
  • 筆記

說到流程圖大家應該都很熟悉,那麼我們今天介紹流程圖的一個分支桑基圖(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)

至此繪製桑基圖的包介紹完畢了,如果自己的數據那就根據自己的需求選擇適合的包進行繪製。

歡迎大家學習交流!