R语言可视化（二十三）：桑基图绘制
2020-10-07 本文已影响0人
Davey1220
23. 桑基图绘制
清除当前环境中的变量
rm(list=ls())
设置工作目录
setwd("C:/Users/Dell/Desktop/R_Plots/23sankey/")
使用riverplot包绘制桑基图
# 安装并加载所需的R包
#install.packages("riverplot")
library(riverplot)
# 构建测序数据集
nodes <- c( LETTERS[1:5] )
nodes
## [1] "A" "B" "C" "D" "E"
edges <- list( A = list( C= 6 ),
B = list( C= 5 ),
C = list( D= 4 ),
E = list( C= 3 )
)
edges
## $A
## $A$C
## [1] 6
##
##
## $B
## $B$C
## [1] 5
##
##
## $C
## $C$D
## [1] 4
##
##
## $E
## $E$C
## [1] 3
# 使用makeRiver函数构造riverplot对象
r <- makeRiver( nodes, edges,
node_xpos= c( 1,1,2,3,3 ),
node_labels= c( A= "Node A", B= "Node B", C= "Node C", D= "Node D", E= "Node E" ),
node_styles= list( A= list( col= "yellow" ), D= list( col= "blue" ), E= list( col= "red" )))
r
## $edges
## ID N1 N2 Value
## A->C A->C A C 6
## B->C B->C B C 5
## C->D C->D C D 4
## E->C E->C E C 3
##
## $nodes
## ID x labels
## A A 1 Node A
## B B 1 Node B
## C C 2 Node C
## D D 3 Node D
## E E 3 Node E
##
## $styles
## $styles$A
## $styles$A$col
## [1] "yellow"
##
##
## $styles$D
## $styles$D$col
## [1] "blue"
##
##
## $styles$E
## $styles$E$col
## [1] "red"
##
##
##
## attr(,"class")
## [1] "list" "riverplot"
# 使用riverplot函数绘制桑基图
riverplot(r)
image.png
# 绘制一个DNA双螺旋
# a DNA strand
plot.new()
par( usr= c( 0, 4, -2.5, 2.5 ) )
w <- 0.4
cols <- c( "blue", "green" )
init <- c( -0.8, -0.5 )
pos <- c( 1, -1 )
step <- 0.5
# Draw a curved segment
for( i in rep( rep( c( 1, 2 ), each= 2 ), 5 ) ) {
curveseg( init[i], init[i] + step, pos[1], pos[2], width= w, col= cols[i] )
init[i] <- init[i] + step
pos <- pos * -1
}
image.png
使用ggforce包绘制桑基图
# 安装并加载所需的R包
#install.packages("ggforce")
library(ggforce)
# 构建示例数据
data <- reshape2::melt(Titanic)
head(data)
## Class Sex Age Survived value
## 1 1st Male Child No 0
## 2 2nd Male Child No 0
## 3 3rd Male Child No 35
## 4 Crew Male Child No 0
## 5 1st Female Child No 0
## 6 2nd Female Child No 0
data <- gather_set_data(data, 1:4)
head(data)
## Class Sex Age Survived value id x y
## 1 1st Male Child No 0 1 Class 1st
## 2 2nd Male Child No 0 2 Class 2nd
## 3 3rd Male Child No 35 3 Class 3rd
## 4 Crew Male Child No 0 4 Class Crew
## 5 1st Female Child No 0 5 Class 1st
## 6 2nd Female Child No 0 6 Class 2nd
# 使用geom_parallel_setsh函数绘制桑基图
ggplot(data, aes(x, id = id, split = y, value = value)) +
geom_parallel_sets(aes(fill = Sex), alpha = 0.5, axis.width = 0.1) +
geom_parallel_sets_axes(axis.width = 0.2,fill="black",color="red") +
geom_parallel_sets_labels(colour = 'white',angle = 45) +
theme_bw()
image.png
使用ggalluvial包绘制桑基图
# 安装并加载所需的R包
#install.packages("ggalluvial")
library(ggalluvial)
# 使用geom_alluvium函数绘制桑基图
admissions <- as.data.frame(UCBAdmissions)
head(admissions)
## Admit Gender Dept Freq
## 1 Admitted Male A 512
## 2 Rejected Male A 313
## 3 Admitted Female A 89
## 4 Rejected Female A 19
## 5 Admitted Male B 353
## 6 Rejected Male B 207
ggplot(admissions,
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", aes(label = after_stat(stratum))) +
scale_x_discrete(limits = c("Gender", "Dept"), expand = c(.05, .05)) +
scale_fill_brewer(type = "qual", palette = "Set1") +
ggtitle("UC Berkeley admissions and rejections, by sex and department")
image.png
data <- as.data.frame(Titanic)
head(data)
## Class Sex Age Survived Freq
## 1 1st Male Child No 0
## 2 2nd Male Child No 0
## 3 3rd Male Child No 35
## 4 Crew Male Child No 0
## 5 1st Female Child No 0
## 6 2nd Female Child No 0
ggplot(data,
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", aes(label = after_stat(stratum)),reverse = FALSE) +
scale_x_continuous(breaks = 1:3, labels = c("Survived", "Sex", "Class")) +
coord_flip() +
ggtitle("Titanic survival by class and sex")
image.png
data(vaccinations)
levels(vaccinations$response) <- rev(levels(vaccinations$response))
head(vaccinations)
## survey freq subject response start_date end_date
## 1 ms153_NSA 48 1 Missing 2010-09-22 2010-10-25
## 2 ms153_NSA 9 2 Missing 2010-09-22 2010-10-25
## 3 ms153_NSA 66 3 Missing 2010-09-22 2010-10-25
## 4 ms153_NSA 1 4 Missing 2010-09-22 2010-10-25
## 5 ms153_NSA 11 5 Missing 2010-09-22 2010-10-25
## 6 ms153_NSA 1 6 Missing 2010-09-22 2010-10-25
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 = 4) +
theme(legend.position = "none") +
ggtitle("vaccination survey responses at three points in time")
image.png
sessionInfo()
R version 3.6.0 (2019-04-26)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows 10 x64 (build 18363)
Matrix products: default
locale:
[1] LC_COLLATE=Chinese (Simplified)_China.936
[2] LC_CTYPE=Chinese (Simplified)_China.936
[3] LC_MONETARY=Chinese (Simplified)_China.936
[4] LC_NUMERIC=C
[5] LC_TIME=Chinese (Simplified)_China.936
attached base packages:
[1] stats graphics grDevices utils datasets methods base
other attached packages:
[1] alluvial_0.1-2 ggalluvial_0.12.2 ggforce_0.2.2 ggplot2_3.2.0
[5] riverplot_0.6 dplyr_0.8.3 plotrix_3.7-6
loaded via a namespace (and not attached):
[1] tidyselect_0.2.5 xfun_0.8 purrr_0.3.2 reshape2_1.4.3
[5] lattice_0.20-38 colorspace_1.4-1 generics_0.0.2 htmltools_0.3.6
[9] yaml_2.2.0 rlang_0.4.7 pillar_1.4.2 glue_1.3.1
[13] withr_2.1.2 tweenr_1.0.1 plyr_1.8.4 stringr_1.4.0
[17] munsell_0.5.0 gtable_0.3.0 evaluate_0.14 labeling_0.3
[21] knitr_1.23 broom_0.5.2 Rcpp_1.0.5 backports_1.1.4
[25] scales_1.0.0 farver_1.1.0 digest_0.6.20 stringi_1.4.3
[29] polyclip_1.10-0 grid_3.6.0 tools_3.6.0 magrittr_1.5
[33] lazyeval_0.2.2 tibble_2.1.3 crayon_1.3.4 tidyr_0.8.3
[37] pkgconfig_2.0.2 MASS_7.3-51.4 assertthat_0.2.1 rmarkdown_1.13
[41] rstudioapi_0.10 R6_2.4.0 nlme_3.1-139 compiler_3.6.0
