【R语言】--- 云雨图

基本简介

云雨图（Raincloud plots）其实是可以看成核密度估计曲线图、箱形图和抖动散点图的组合图，清晰、完整、美观地展示了所有数据信息。本质上是一个混合图，可同时将原始数据、数据分布和关键汇总统计表现出来，由对分的小提琴图（Violin plot）、箱线图（boxplot）和作为某种散点的原始数据组成。具体可以使用gglayer包的geom_flat_violin()函数绘制，由于该包貌似还没有更新，因此使用网页(https://gist.githubusercontent.com/benmarwick/2a1bb0133ff568cbe28d/raw/fb53bd97121f7f9ce947837ef1a4c65a73bffb3f/geom_flat_violin.R)的函数功能进行绘制。

示例代码

#清空数据
rm(list=ls())

#加载所需要的函数
source("E:/所有R语言/geom_flat_violin.R")
#或者直接在R中运行此函数
'
# somewhat hackish solution to:
# https://twitter.com/EamonCaddigan/status/646759751242620928
# based mostly on copy/pasting from ggplot2 geom_violin source:
# https://github.com/hadley/ggplot2/blob/master/R/geom-violin.r
library(ggplot2)
library(dplyr)

"%||%" <- function(a, b) {
  if (!is.null(a)) a else b
}

geom_flat_violin <- function(mapping = NULL, data = NULL, stat = "ydensity",
                             position = "dodge", trim = TRUE, scale = "area",
                             show.legend = NA, inherit.aes = TRUE, ...) {
  layer(
    data = data,
    mapping = mapping,
    stat = stat,
    geom = GeomFlatViolin,
    position = position,
    show.legend = show.legend,
    inherit.aes = inherit.aes,
    params = list(
      trim = trim,
      scale = scale,
      ...
    )
  )
}

#' @rdname ggplot2-ggproto
#' @format NULL
#' @usage NULL
#' @export
GeomFlatViolin <-
  ggproto("GeomFlatViolin", Geom,
          setup_data = function(data, params) {
            data$width <- data$width %||%
              params$width %||% (resolution(data$x, FALSE) * 0.9)
            
            # ymin, ymax, xmin, and xmax define the bounding rectangle for each group
            data %>%
              group_by(group) %>%
              mutate(ymin = min(y),
                     ymax = max(y),
                     xmin = x,
                     xmax = x + width / 2)
            
          },
          
          draw_group = function(data, panel_scales, coord) {
            # Find the points for the line to go all the way around
            data <- transform(data, xminv = x,
                              xmaxv = x + violinwidth * (xmax - x))
            
            # Make sure it's sorted properly to draw the outline
            newdata <- rbind(plyr::arrange(transform(data, x = xminv), y),
                             plyr::arrange(transform(data, x = xmaxv), -y))
            
            # Close the polygon: set first and last point the same
            # Needed for coord_polar and such
            newdata <- rbind(newdata, newdata[1,])
            
            ggplot2:::ggname("geom_flat_violin", GeomPolygon$draw_panel(newdata, panel_scales, coord))
          },
          
          draw_key = draw_key_polygon,
          
          default_aes = aes(weight = 1, colour = "grey20", fill = "white", size = 0.5,
                            alpha = NA, linetype = "solid"),
          
          required_aes = c("x", "y")
  )
'

使用iris数据集

iris

#作图
ggplot(iris, aes(x=Species, y=Sepal.Width)) +
  geom_flat_violin(aes(fill=Species),position=position_nudge(x=.25),color="black") +
  geom_jitter(aes(color=Species), width=0.1) +
  geom_boxplot(width=.1,position=position_nudge(x=0.25),fill="white",size=0.5) +
  theme_bw()

#或者x和y转置
ggplot(iris, aes(x=Species, y=Sepal.Width)) +
  geom_flat_violin(aes(fill=Species),position=position_nudge(x=.25),color="black") +
  geom_jitter(aes(color=Species), width=0.1) +
  geom_boxplot(width=.1,position=position_nudge(x=0.25),fill="white",size=0.5) +
  coord_flip() +
  theme_bw()

#调整细节
a<- ggplot(iris, aes(x=Species, y=Sepal.Width)) +
  geom_flat_violin(aes(fill=Species),position=position_nudge(x=.25),color="black") +
  geom_jitter(aes(color=Species), width=0.1) +
  geom_boxplot(width=.1,position=position_nudge(x=0.25),fill="white",size=0.5) +
  theme_few()+
  ylab("Sepal width")+xlab("Species")+
  theme(legend.text=element_text(size=12))+
  theme(title=element_text(size=14))+
  theme(axis.text.x = element_text(size = 13, color = "black"))+
  theme(axis.text.y = element_text(size = 13, color = "black"))+
  theme(legend.position="none")+
  theme(axis.ticks.length=unit(0.2,"cm"))


b<- ggplot(iris, aes(x=Species, y=Sepal.Width)) +
  geom_flat_violin(aes(fill=Species),position=position_nudge(x=.25),color="black") +
  geom_jitter(aes(color=Species), width=0.1) +
  geom_boxplot(width=.1,position=position_nudge(x=0.25),fill="white",size=0.5) +
  coord_flip() +
  theme_few()+
  ylab("Sepal width")+xlab("Species")+
  theme(legend.text=element_text(size=12))+
  theme(title=element_text(size=14))+
  theme(axis.text.x = element_text(size = 13, color = "black"))+
  theme(axis.text.y = element_text(size = 13, color = "black"))+
  theme(legend.position="none")+
  theme(axis.ticks.length=unit(0.2,"cm"))
#组合图
cowplot::plot_grid(a,b,
                   align="vh")

参考文献

[1] https://wellcomeopenresearch.org/articles/4-63/v2#ref-9