有新意：会下雨的小提琴图

2021-09-25 本文已影响0人数据可视化艺术

image

一、介绍

所谓的云雨图，基本形状由云朵和雨点组成，上面云朵是数据密度图，伞就是平铺的箱线图，雨就是下面的数据点。百闻不如一见，快随我一起来瞅瞅如何绘制吧。

二、R 语言实现

2.1 准备数据

准备下图所示数据，数据文件第一列对应分类名称，其它列为对应的数据。

图1 数据文件

2.2 命令实现

# 自定义函数

"%||%" <- 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,
      ...
    )
  )
}

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")
)

绘制基础图

p0 <- ggplot(data = mat, aes(x = variable, y = value, fill = variable)) +
                geom_flat_violin(position = position_nudge(x = 2, y = 0.8), alpha = 0.6)

添加散点图

p1 <- p0 + geom_jitter(aes(color=variable), 
                    width=10,
                    size=2,
                    shape=1,
                    alpha = 0.6,
                    show.legend=NA)

图2 云雨图一

添加箱线图

    p2 <- p0 + geom_boxplot(
                    position=position_nudge(x=0.2),
                    outlier.shape = FALSE, 
                    alpha = 0.4, 
                    width = 20, 
                    colour = "#000000")