R语言可视化(八):小提琴图绘制

08.小提琴图绘制


清除当前环境中的变量

rm(list=ls())

设置工作目录

setwd("C:/Users/Dell/Desktop/R_Plots/08vioplot/")

vioplot包绘制小提琴图

library(vioplot)

# formula input
# 加载示例数据iris
data("iris")
head(iris)
##   Sepal.Length Sepal.Width Petal.Length Petal.Width Species
## 1          5.1         3.5          1.4         0.2  setosa
## 2          4.9         3.0          1.4         0.2  setosa
## 3          4.7         3.2          1.3         0.2  setosa
## 4          4.6         3.1          1.5         0.2  setosa
## 5          5.0         3.6          1.4         0.2  setosa
## 6          5.4         3.9          1.7         0.4  setosa

vioplot(Sepal.Length~Species, data = iris, 
        main = "Sepal Length", # 设置标题
        col=c("lightgreen", "lightblue", "palevioletred")) # 设置小提琴颜色
# 添加图例
legend("topleft", legend=c("setosa", "versicolor", "virginica"),
       fill=c("lightgreen", "lightblue", "palevioletred"), cex = 1.2)
image.png
# 加载示例数据
data("diamonds", package = "ggplot2")
head(diamonds)
##   carat       cut color clarity depth table price    x    y    z
## 1  0.23     Ideal     E     SI2  61.5    55   326 3.95 3.98 2.43
## 2  0.21   Premium     E     SI1  59.8    61   326 3.89 3.84 2.31
## 3  0.23      Good     E     VS1  56.9    65   327 4.05 4.07 2.31
## 4  0.29   Premium     I     VS2  62.4    58   334 4.20 4.23 2.63
## 5  0.31      Good     J     SI2  63.3    58   335 4.34 4.35 2.75
## 6  0.24 Very Good     J    VVS2  62.8    57   336 3.94 3.96 2.48

# 设置画板颜色
palette <- RColorBrewer::brewer.pal(9, "Pastel1")
palette
## [1] "#FBB4AE" "#B3CDE3" "#CCEBC5" "#DECBE4" "#FED9A6" "#FFFFCC" "#E5D8BD"
## [8] "#FDDAEC" "#F2F2F2"

par(mfrow=c(3, 1))
vioplot(price ~ cut, data = diamonds, las = 1, col = palette)
vioplot(price ~ clarity, data = diamonds, las = 2, col = palette)
vioplot(price ~ color, data = diamonds, las = 2, col = palette)
image.png
#generate example data
data_one <- rnorm(100)
data_two <- rnorm(50, 1, 2)
head(data_one)
## [1] -0.8567350  0.2851433 -0.1948110 -0.7102499 -1.0780155  0.2462039
head(data_two)
## [1] 2.164083 3.144620 1.190473 2.285546 3.494566 1.492088
par(mfrow=c(2,2))

#colours can be customised separately, with axis labels, legends, and titles
vioplot(data_one, data_two, 
        col=c("red","blue"), #设置小提琴颜色
        names=c("data one", "data two"),
        main="data violin", 
        xlab="data class", ylab="data read")
legend("topleft", fill=c("red","blue"), legend=c("data one", "data two"))

#colours can be customised for the violin fill and border separately
vioplot(data_one, data_two, 
        col="grey85", border="purple", 
        names=c("data one", "data two"),
        main="data violin", 
        xlab="data class", ylab="data read")

#colours can also be customised for the boxplot rectange and lines (border and whiskers)
vioplot(data_one, data_two, 
        col="grey85", rectCol="lightblue", lineCol="blue",
        border="purple", names=c("data one", "data two"),
        main="data violin", xlab="data class", ylab="data read")

#these colours can also be customised separately for each violin
vioplot(data_one, data_two, 
        col=c("skyblue", "plum"), 
        rectCol=c("lightblue", "palevioletred"),
        lineCol="blue", border=c("royalblue", "purple"), 
        names=c("data one", "data two"), 
        main="data violin", xlab="data class", ylab="data read")
image.png
par(mfrow=c(1,1))
#this applies to any number of violins, given that colours are provided for each
vioplot(data_one, data_two, rnorm(200, 3, 0.5), rpois(200, 2.5),  rbinom(100, 10, 0.4),
        col=c("red", "orange", "green", "blue", "violet"), horizontal = T,
        rectCol=c("palevioletred", "peachpuff", "lightgreen", "lightblue", "plum"),
        lineCol=c("red4", "orangered", "forestgreen", "royalblue", "mediumorchid"),
        border=c("red4", "orangered", "forestgreen", "royalblue", "mediumorchid"),
        names=c("data one", "data two", "data three", "data four", "data five"),
        main="data violin", xlab="data class", ylab="data read")
image.png

ggplot2包绘制小提琴图

library(ggplot2)
# 查看示例数据
head(diamonds)
## # A tibble: 6 x 10
##   carat cut       color clarity depth table price     x     y     z
##   <dbl> <ord>     <ord> <ord>   <dbl> <dbl> <int> <dbl> <dbl> <dbl>
## 1 0.23  Ideal     E     SI2      61.5    55   326  3.95  3.98  2.43
## 2 0.21  Premium   E     SI1      59.8    61   326  3.89  3.84  2.31
## 3 0.23  Good      E     VS1      56.9    65   327  4.05  4.07  2.31
## 4 0.290 Premium   I     VS2      62.4    58   334  4.2   4.23  2.63
## 5 0.31  Good      J     SI2      63.3    58   335  4.34  4.35  2.75
## 6 0.24  Very Good J     VVS2     62.8    57   336  3.94  3.96  2.48

# Basic plot
ggplot(diamonds,aes(cut,log(price),fill=cut)) + 
  geom_violin()
image.png
# 更换填充色,设置分面
ggplot(diamonds,aes(cut,log(price),fill=cut)) + 
  geom_violin() + 
  scale_fill_manual(values = c("palevioletred", "peachpuff", "lightgreen", "lightblue", "plum")) +
  facet_wrap(.~clarity,ncol = 4)
image.png
# 添加箱线图和均值点
ggplot(diamonds,aes(cut,log(price),fill=cut)) + 
  geom_violin() + 
  geom_boxplot(width=0.1,position = position_identity(),fill="white") +
  stat_summary(fun.y="mean",geom="point",shape=23, size=4,fill="red") +
  theme_bw() + theme(legend.position = "top")
image.png

ggpubr包绘制小提琴图

library(ggpubr)

# 加载示例数据
data("ToothGrowth")
df <- ToothGrowth
head(df)
##    len supp dose
## 1  4.2   VC  0.5
## 2 11.5   VC  0.5
## 3  7.3   VC  0.5
## 4  5.8   VC  0.5
## 5  6.4   VC  0.5
## 6 10.0   VC  0.5

# Basic plot
ggviolin(df, x = "dose", y = "len", color = "supp")
image.png
# Change the plot orientation: horizontal
ggviolin(df, "dose", "len", fill = "supp",orientation = "horiz")
image.png
# Add box plot
ggviolin(df, x = "dose", y = "len", fill = "dose",
         add = "boxplot",add.params = list(fill="white"))
image.png
ggviolin(df, x = "dose", y = "len", fill = "supp",
         add = "dotplot")
image.png
# Add jitter points and
# change point shape by groups ("dose")
ggviolin(df, x = "dose", y = "len", fill = "supp",
         add = "jitter", shape = "dose")
image.png
# Add mean_sd + jittered points
ggviolin(df, x = "dose", y = "len", fill = "dose",
         add = c("jitter", "mean_sd"))
image.png
# Change error.plot to "crossbar"
ggviolin(df, x = "dose", y = "len", fill = "dose",
         add = "mean_sd", error.plot = "crossbar")
image.png
# Change colors
# Change outline colors by groups: dose
# Use custom color palette and add boxplot
ggviolin(df, "dose", "len",  color = "dose",
         palette = c("#00AFBB", "#E7B800", "#FC4E07"),
         add = "boxplot")
image.png
# Change fill color by groups: dose
# add boxplot with white fill color
ggviolin(df, "dose", "len", fill = "dose",
         palette = c("#00AFBB", "#E7B800", "#FC4E07"),
         add = "boxplot", add.params = list(fill = "white"))
image.png
ggviolin(df, "dose", "len", facet.by = "supp", color = "supp",
         palette = c("#00AFBB", "#E7B800"), add = "boxplot")
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] ggpubr_0.2.1  magrittr_1.5  ggplot2_3.2.0 vioplot_0.3.2 zoo_1.8-6    
## [6] sm_2.2-5.6   
## 
## loaded via a namespace (and not attached):
##  [1] Rcpp_1.0.1         pillar_1.4.2       compiler_3.6.0    
##  [4] RColorBrewer_1.1-2 tools_3.6.0        zeallot_0.1.0     
##  [7] digest_0.6.20      viridisLite_0.3.0  evaluate_0.14     
## [10] tibble_2.1.3       gtable_0.3.0       lattice_0.20-38   
## [13] pkgconfig_2.0.2    rlang_0.4.0        cli_1.1.0         
## [16] yaml_2.2.0         xfun_0.8           withr_2.1.2       
## [19] stringr_1.4.0      dplyr_0.8.3        knitr_1.23        
## [22] vctrs_0.2.0        grid_3.6.0         tidyselect_0.2.5  
## [25] glue_1.3.1         R6_2.4.0           fansi_0.4.0       
## [28] tcltk_3.6.0        rmarkdown_1.13     purrr_0.3.2       
## [31] backports_1.1.4    scales_1.0.0       htmltools_0.3.6   
## [34] assertthat_0.2.1   colorspace_1.4-1   ggsignif_0.5.0    
## [37] labeling_0.3       utf8_1.1.4         stringi_1.4.3     
## [40] lazyeval_0.2.2     munsell_0.5.0      crayon_1.3.4