R语言如何绘制云雨图(20)

本文详细介绍了云雨图的构成,包括小提琴图和点状直方图的含义。通过R语言提供的ggplot2、reshape2等包,展示了如何读取数据并绘制云雨图的完整代码。此外,还提供了BioLadder生信云平台作为在线绘制云雨图的便捷工具,以供不想手动编写代码的用户使用。

摘要生成于 C知道 ,由 DeepSeek-R1 满血版支持, 前往体验 >

1.什么是云雨图?

云雨图,顾名思义,由2部分组成,上方的半个小提琴图形似云朵,下方的点图形似雨滴。

上方的半个小提琴图,类似于核密度曲线,其曲线下的面积是1。

下方的点图,其实是频率分布直方图的点状抽象。

[外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传(img-US47KaD4-1652085922727)(https://gitee.com/suozhuoPic/pic/raw/master/images/export-plot%20(12)].png)

2.绘图前的数据准备

​ demo数据可以在https://www.bioladder.cn/shiny/zyp/bioladder2/demoData/rainCloud/demo.txt下载。

​ 包含2个维度的数据,通常每一列是个样本,每一行是个基因

image-20211203171052881

3. R语言怎么画云雨图

# 加载R包,没有安装请先安装  install.packages("包名") 
library(ggplot2)
library(reshape2)
library(RColorBrewer)
library(grid)

# 读取云雨图数据文件
df = read.delim("https://www.bioladder.cn/shiny/zyp/bioladder2/demoData/rainCloud/demo.txt",# 这里读取了网络上的demo数据,将此处换成你自己电脑里的文件
                header = T       # 指定第一行是列名
)
# 把数据转换成ggplot常用的类型(长数据)
df = melt(df)                    # melt出自reshape2包
head(df)                         # 查看转换完成的数据的前几行
# 绘图
ggplot(df,aes(x=variable,   
              y=value,
              fill=variable,     # fill填充颜色,根据变量名赋值
              colour=variable))+ # colour图形边界颜色,根据变量名赋值
  geom_flat_violin(position = position_nudge(x=.1))+ # 见下段代码
  geom_dotplot(binaxis = "y",
               binwidth = 0.1,   # 雨滴间隙
               stackdir = "down",
               dotsize = 0.6)+   # 雨滴大小
  coord_flip()+                  # 翻转坐标轴
  theme_classic()                # ggplot2主题

geom_flat_violin函数代码

#<<<<<<<<<<<<<<<<<<<<<<<<
# 由于ggplot2并没有提供半小提琴图,所以经由geom_violin的源码修改成geom_flat_violin函数
"%||%" <- function(a, b) {
  if (!is.null(a)) a else b
}

color<-brewer.pal(7,"Set2")[c(1,2,4,5)]


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)

            data %>%
              group_by(group) %>%
              mutate(ymin = min(y),
                     ymax = max(y),
                     xmin = x,
                     xmax = x + width / 2)
            
          },
          
          draw_group = function(data, panel_scales, coord) {
            data <- transform(data, xminv = x,
                              xmaxv = x + violinwidth * (xmax - x)) 
            
            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")
  )


findParams <- function(mu, sigma, skew, kurt) {
  value <- .C("JohnsonMomentFitR", as.double(mu), as.double(sigma),
              as.double(skew), as.double(kurt - 3), gamma = double(1),
              delta = double(1), xi = double(1), lambda = double(1),
              type = integer(1), PACKAGE = "SuppDists")
  
  list(gamma = value$gamma, delta = value$delta,
       xi = value$xi, lambda = value$lambda,
       type = c("SN", "SL", "SU", "SB")[value$type])
}
#>>>>>>>>>>>>>>>>>>>>>>>>

4. BioLadder生信云平台在线绘制云雨图

不想写代码?可以用BioLadder生信云平台在线绘制云雨图。

网址:https://www.bioladder.cn/web/#/chart/47

image-20220121151014975

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值