R绘图笔记 | 小提琴图与漂亮的云雨图绘制

参考前文：R绘图笔记 | R语言绘图系统与常见绘图函数及参数

关于绘图图，前面介绍了一些：

R绘图笔记 | 一般的散点图绘制

R绘图笔记 | 柱状图绘制

R绘图笔记 | 直方图和核密度估计图的绘制

R绘图笔记 | 二维散点图与统计直方图组合

R绘图笔记 | 散点分布图与柱形分布图

R绘图笔记 | 箱形图的绘制

这里介绍小提琴图会漂亮的云雨图绘制，小提琴图在生信文章中很常见，云雨图我在文章中很少见到，但真的很漂亮，发表文章可以试试。

一.读入数据

如果你想获取该数据用于自己练习，下面是获取数据的地址：

https://docs.qq.com/sheet/DV0dxREV1YkJ0ZmVj

数据格式是这样的。

数据第A列是病人ID，B~E列是临床信息，其他列是病人的RNAseq数据。

你可以保存副本导出，然后自己读入。

library(ggplot2)
library(grid)
library(RColorBrewer)
library(dplyr)
library(SuppDists) #提供rJohnson()函数

data <- read.csv("BioInfoNotesData1.csv",row.names = 1)

假如我们需要绘制某基因在不同分期的表达情况。

f2.data <- data[,c(1,8)]
colnames(f2.data) <- c("Stage","Value")
table(f2.data$Stage

先检查数据是否有缺失值，分期信息不知用N来表示，可以删除这些数据。

f2.data<-f2.data[f2.data$Stage!="N",]
head(f2.data

二.绘图

1.小提琴图

ggplot绘图系统中，小提琴图用geom_violin函数。

geom_violin(mapping = NULL, data = NULL, stat = "ydensity",
  position = "dodge", ..., draw_quantiles = NULL, trim = TRUE,
  scale = "area", na.rm = FALSE, show.legend = NA,
  inherit.aes = TRUE)

trim：如果为真(默认)，将小提琴的尾部修剪到数据的范围内。如果是假的，就不要修剪尾巴。

 scale ：如果“area”(默认)，所有的小提琴有相同的区域(在修剪尾巴之前)。如果为“count”，面积按观察次数成比例缩放。如果是“宽度”，那么所有的小提琴都有相同的最大宽度。

ggplot(f2.data, aes(Stage,Value))+ 
  geom_violin(aes(fill = Stage),trim = FALSE)+
  geom_boxplot(width = 0.2)+
  scale_fill_manual(values=c(brewer.pal(5,"Set2")[c(1,3,2,5)]))+
  theme_classic()+
  labs(x='Stage',y='The expression level',title='Gene name')+
  theme(panel.background=element_rect(fill="white",colour="black",size=0.25),
        axis.line=element_line(colour="black",size=0.25),
        axis.title=element_text(size=13,face="plain",color="black"),
        axis.text = element_text(size=12,face="plain",color="black"),
        legend.position="none"
  )

修改trim=TRUE,scale="count"，看一下效果就知道什么意思啦。

ggplot(f2.data, aes(Stage,Value))+ 
  geom_violin(aes(fill = Stage),trim = TRUE,scale="count")+
  geom_boxplot(width = 0.2)+
  scale_fill_manual(values=c(brewer.pal(5,"Set2")[c(1,3,2,5)]))+
  theme_classic()+
  labs(x='Stage',y='The expression level',title='Gene name')+
  theme(panel.background=element_rect(fill="white",colour="black",size=0.25),
        axis.line=element_line(colour="black",size=0.25),
        axis.title=element_text(size=13,face="plain",color="black"),
        axis.text = element_text(size=12,face="plain",color="black"),
        legend.position="none"
  )

2.云雨图

云雨图在我看来很美观，我们样本数据大的时候，绘制云雨图是真的很美观。

但这个图绘制比前面的图形稍微复杂一点。需要自定义一个函数，用来绘制半小提琴图，从geom-violin函数修改。下面是geom-violin函数的源码地址：

https://github.com/hadley/ggplot2/blob/master/R/geom-violin.r

下面是修改后的代码【参考资料1】：

"%||%" <- 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)) #利用transform函数为数据框mydata增加数据
 
 
            newdata <- rbind(plyr::arrange(transform(data, x = xmaxv), -y),plyr::arrange(transform(data, x = xminv), y))
            newdata_Polygon <- rbind(newdata, newdata[1,])
            newdata_Polygon$colour<-NA
 
 
            newdata_Path <- plyr::arrange(transform(data, x = xmaxv), -y)
 
 
            ggplot2:::ggname("geom_flat_violin", grobTree(
              GeomPolygon$draw_panel(newdata_Polygon, panel_scales, coord),
              GeomPath$draw_panel(newdata_Path, 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")
  )
 
 

geom_flat_violin函数是自定义的半小提琴图函数，用上面的f2.data数据绘图。下面代码中d变量是统计数据。

d <- group_by(f2.data, Stage) %>%
  summarize(mean = mean(Value),
            sd = sd(Value))
ggplot(f2.data, aes(Stage,Value, fill=Stage))  +
  geom_flat_violin(position=position_nudge(x=.2)) +
  geom_jitter(aes(color=Stage), width=.1) +
  geom_pointrange(aes(y=mean, ymin=mean-sd, ymax=mean+sd),
                  data=d, size=1, position=position_nudge(x=.2)) +
  coord_flip() + 
  theme_bw() +
  theme( axis.text = element_text(size=13),
         axis.title =  element_text(size=15),
         legend.position="none")

这个图就像云下面有雨滴一样，顾名思义叫云雨图。如果想纵向展示，去掉coord_flip()函数就可以啦。coord_flip()翻转笛卡尔坐标使水平变为垂直。

ggplot(f2.data, aes(x=Stage, y=Value))  +
  geom_flat_violin(aes(fill=Stage),position=position_nudge(x=.25),color="black") +
  geom_jitter(aes(color=Stage), width=0.1) +
  geom_boxplot(width=.1,position=position_nudge(x=0.25),fill="white",size=0.5) +
  #coord_flip() + 
  theme_bw() +
  theme( axis.text = element_text(size=13),
         axis.title =  element_text(size=15),
         legend.position="none")
 
 

参考资料：

1. R语言数据可视化之美，张杰/著

2. geom-violin函数帮助文档

3. https://github.com/hadley/ggplot2/blob/master/R/geom-violin.r