• 主页
  • 课程

    关于课程

    • 课程归档
    • 成为一名讲师
    • 讲师信息
    同等学历教学

    同等学历教学

    免费
    阅读更多
  • 特色
    • 展示
    • 关于我们
    • 问答
  • 事件
  • 个性化
  • 博客
  • 联系
  • 站点资源
    有任何问题吗?
    (00) 123 456 789
    weinfoadmin@weinformatics.cn
    注册登录
    恒诺新知
    • 主页
    • 课程

      关于课程

      • 课程归档
      • 成为一名讲师
      • 讲师信息
      同等学历教学

      同等学历教学

      免费
      阅读更多
    • 特色
      • 展示
      • 关于我们
      • 问答
    • 事件
    • 个性化
    • 博客
    • 联系
    • 站点资源

      R语言

      • 首页
      • 博客
      • R语言
      • R画树状图:一种轻量级方法

      R画树状图:一种轻量级方法

      • 发布者 weinfoadmin
      • 分类 R语言
      • 日期 2019年6月18日
      测试开头

      R画树状图

      树状图是用于表示层次关系的图,例如从分层聚类获得的层次关系。它们常用于生物学,尤其是遗传学,用于揭示一组基因或者分群的关系。

      R中已有一些方法可以画树形图(请查看这里),比如基础R或ape包。 对于基于ggplot2的解决方案,让我们提一下ggdendro,dendextend或ggtree。
      ggdendro是稳定的,轻量级的(除了MASS和ggplot2之外没有依赖性),并且允许以方便的格式访问聚类数据,但其功能在可视化方面有点局限。 另一方面,dendextend和ggtree提供了许多强大的功能,但代价是更高的依赖性要求和更陡峭的学习曲线才能有效地使用它们。

      我想要一个“轻量级”且灵活的基于ggplot2的解决方案来绘制树形图,特别是可以使用不同的分支颜色突出显示聚类。
      受到这个stackoverflow问题的启发,我终于完成了使用ggdendro和ggplot2编写下面描述的函数。

      1library(ggdendro)
      2library(ggplot2)

      调整ggdendro

      首先,我’扩展’了ggdendro :: dendro_data()。 dendro_data_k()函数接受一个k参数,一个整数,指定所需簇的数量。 此值仅用于base :: cutree()函数,并且对于每个集群,将根据其x,xend和yend坐标为这些段分配相应叶子的集群ID。 这可能不是最优雅的方式,但它非常简单。

       1dendro_data_k <- function(hc, k) {
      2
      3  hcdata    <-  ggdendro::dendro_data(hc, type = "rectangle")
      4  seg       <-  hcdata$segments
      5  labclust  <-  cutree(hc, k)[hc$order]
      6  segclust  <-  rep(0L, nrow(seg))
      7  heights   <-  sort(hc$height, decreasing = TRUE)
      8  height    <-  mean(c(heights[k], heights[k - 1L]), na.rm = TRUE)
      9
      10  for (i in 1:k) {
      11    xi      <-  hcdata$labels$x[labclust == i]
      12    idx1    <-  seg$x    >= min(xi) & seg$x    <= max(xi)
      13    idx2    <-  seg$xend >= min(xi) & seg$xend <= max(xi)
      14    idx3    <-  seg$yend < height
      15    idx     <-  idx1 & idx2 & idx3
      16    segclust[idx] <- i
      17  }
      18
      19  idx                    <-  which(segclust == 0L)
      20  segclust[idx]          <-  segclust[idx + 1L]
      21  hcdata$segments$clust  <-  segclust
      22  hcdata$segments$line   <-  as.integer(segclust < 1L)
      23  hcdata$labels$clust    <-  labclust
      24
      25  hcdata
      26}

      绘图函数

      通过从ggdendro和上面的函数获得的所需的数据结构,可以使用ggplot2构建树。 使用两个geom:分支的geom_segment()和标签的geom_text()。
      如果我们想要自定义树的方向(例如从上到下或从左到右)或格式(圆形图),事情会变得有点复杂。 为了更容易地处理它,使用(内部)不同的函数来设置标签的参数(角度,偏移,……)。

       1set_labels_params <- function(nbLabels,
      2                              direction = c("tb", "bt", "lr", "rl"
      ),
      3                              fan       = FALSE) 
      {
      4  if (fan) {
      5    angle       <-  360 / nbLabels * 1:nbLabels + 90
      6    idx         <-  angle >= 90 & angle <= 270
      7    angle[idx]  <-  angle[idx] + 180
      8    hjust       <-  rep(0, nbLabels)
      9    hjust[idx]  <-  1
      10  } else {
      11    angle       <-  rep(0, nbLabels)
      12    hjust       <-  0
      13    if (direction %in% c("tb", "bt")) { angle <- angle + 45 }
      14    if (direction %in% c("tb", "rl")) { hjust <- 1 }
      15  }
      16  list(angle = angle, hjust = hjust, vjust = 0.5)
      17}
       1plot_ggdendro <- function(hcdata,
      2                          direction   = c("lr", "rl", "tb", "bt"),
      3                          fan         = FALSE,
      4                          scale.color = NULL,
      5                          branch.size = 1,
      6                          label.size  = 3,
      7                          nudge.label = 0.01,
      8                          expand.y    = 0.1) {
      9
      10  direction <- match.arg(direction) # if fan = FALSE
      11  ybreaks   <- pretty(segment(hcdata)$y, n = 5)
      12  ymax      <- max(segment(hcdata)$y)
      13
      14  ## branches
      15  p <- ggplot() +
      16    geom_segment(data         =  segment(hcdata),
      17                 aes(x        =  x,
      18                     y        =  y,
      19                     xend     =  xend,
      20                     yend     =  yend,
      21                     linetype =  factor(line),
      22                     colour   =  factor(clust)),
      23                 lineend      =  "round",
      24                 show.legend  =  FALSE,
      25                 size         =  branch.size)
      26
      27  ## orientation
      28  if (fan) {
      29    p <- p +
      30      coord_polar(direction = -1) +
      31      scale_x_continuous(breaks = NULL,
      32                         limits = c(0, nrow(label(hcdata)))) +
      33      scale_y_reverse(breaks = ybreaks)
      34  } else {
      35    p <- p + scale_x_continuous(breaks = NULL)
      36    if (direction %in% c("rl", "lr")) {
      37      p <- p + coord_flip()
      38    }
      39    if (direction %in% c("bt", "lr")) {
      40      p <- p + scale_y_reverse(breaks = ybreaks)
      41    } else {
      42      p <- p + scale_y_continuous(breaks = ybreaks)
      43      nudge.label <- -(nudge.label)
      44    }
      45  }
      46
      47  # labels
      48  labelParams <- set_labels_params(nrow(hcdata$labels), direction, fan)
      49  hcdata$labels$angle <- labelParams$angle
      50
      51  p <- p +
      52    geom_text(data        =  label(hcdata),
      53              aes(x       =  x,
      54                  y       =  y,
      55                  label   =  label,
      56                  colour  =  factor(clust),
      57                  angle   =  angle),
      58              vjust       =  labelParams$vjust,
      59              hjust       =  labelParams$hjust,
      60              nudge_y     =  ymax * nudge.label,
      61              size        =  label.size,
      62              show.legend =  FALSE)
      63
      64  # colors and limits
      65  if (!is.null(scale.color)) {
      66    p <- p + scale_color_manual(values = scale.color)
      67  }
      68
      69  ylim <- -round(ymax * expand.y, 1)
      70  p    <- p + expand_limits(y = ylim)
      71
      72  p
      73}
      74

      基本的树状图

      我们现在准备建立一个树状图。 默认情况下,应用ggplot2的标准主题。

       1mtc <- scale(mtcars)
      2D   <- dist(mtc)
      3hc  <- hclust(D)
      4
      5hcdata <- dendro_data_k(hc, 3)
      6
      7p <- plot_ggdendro(hcdata,
      8                   direction   = "lr",
      9                   expand.y    = 0.2)
      10p
      R画树状图:一种轻量级方法

      定制的树状图

      我们可以通过调整Plot_ggdendro()参数或添加其他属性来进一步自定义树形图。 下面是ggplot2 :: theme_void()的示例。

       1cols <- c("#a9a9a9", "#1f77b4", "#ff7f0e", "#2ca02c")
      2
      3p <- plot_ggdendro(hcdata,
      4                   direction   = "tb",
      5                   scale.color = cols,
      6                   label.size  = 2.5,
      7                   branch.size = 0.5,
      8                   expand.y    = 0.2)
      9
      10p <- p + theme_void() + expand_limits(x = c(-1, 32))
      11p

      R画树状图:一种轻量级方法

      下面是添加自定义主题元素的另一个示例。

      1mytheme <- theme(axis.text          = element_text(color = "#50505030"),
      2                 panel.grid.major.y = element_line(color = "#50505030",
      3                                                   size  = 0.25))
      4p + mytheme
      5

      最后,让我们做一个扇形树状图。

       1p <- plot_ggdendro(hcdata,
      2                   fan         = TRUE,
      3                   scale.color = cols,
      4                   label.size  = 4,
      5                   nudge.label = 0.02,
      6                   expand.y    = 0.4)
      7
      8mytheme <- theme(panel.background = element_rect(fill = "black"))
      9
      10p + theme_void() + mytheme
      11

      R画树状图:一种轻量级方法

      进一步定制

      除了图形属性之外,还可以添加其他geom元素,使可能性无限。

       1p <- plot_ggdendro(hcdata,
      2                   fan         = TRUE,
      3                   scale.color = cols,
      4                   label.size  = 4,
      5                   nudge.label = 0.15,
      6                   expand.y    = 0.8)
      7
      8mytheme <- theme(panel.background = element_rect(fill = "black"))
      9
      10p <- p + theme_void() + mytheme
      11
      12p + geom_point(data     = mtcars, 
      13               aes(x    = match(rownames(mtcars), hcdata$labels$label),
      14                   y    = -0.7,
      15                   fill = as.factor(cyl)),
      16               size     = 5,
      17               shape    = 21,
      18               show.legend = FALSE) +
      19  scale_fill_manual(values = c("white", "yellow", "red")) +
      20  geom_text(data      = mtcars, 
      21            aes(x     = match(rownames(mtcars), hcdata$labels$label),
      22                y     = -0.7,
      23                label = cyl),
      24            size = 3)
      25

      R画树状图:一种轻量级方法

      使用gridExtra组合多个图,很容易地得到联结图。

       1library(gridExtra)
      2
      3mtc     <- scale(mtcars)
      4D       <- dist(mtc)
      5hc1     <- hclust(D, "average")
      6hc2     <- hclust(D, "ward.D2")
      7hcdata1 <- dendro_data_k(hc1, 5)
      8hcdata2 <- dendro_data_k(hc2, 5)
      9cols    <- c("#a9a9a9", "#1f77b4", "#ff7f0e", "#2ca02c", "#d62728", "#9467bd")
      10
      11p1 <- plot_ggdendro(hcdata1,
      12                    direction   = "lr",
      13                    scale.color = cols,
      14                    expand.y    = 0.2) +
      15  theme_void()
      16
      17p2 <- plot_ggdendro(hcdata2,
      18                    direction   = "rl",
      19                    scale.color = cols,
      20                    expand.y    = 0.2) +
      21  theme_void()
      22
      23idx <- data.frame(y1 = 1:nrow(hcdata1$labels),
      24                  y2 = match(hcdata1$labels$label, hcdata2$labels$label))
      25
      26p3 <- ggplot() +
      27  geom_segment(data     = idx, 
      28               aes(x    = 0,
      29                   y    = y1,
      30                   xend = 1,
      31                   yend = y2),
      32               color    = "grey") +
      33  theme_void()
      34
      35grid.arrange(p1, p3, p2, ncol = 3, widths = c(2, 1, 2))

      最后一个例子,有一个树状图和一个“bubblemap”。我认为与标准的热图相比,添加尺寸编码有助于更好地获得数据的结构。在mtcars数据集中,变量有不同的单位,但这里的目标只是突出显示低值或高值。

       1library(data.table)
      2
      3mtc    <- scale(mtcars)
      4D      <- dist(mtc)
      5hc     <- hclust(D)
      6hcdata <- dendro_data_k(hc, 3)
      7
      8p1 <- plot_ggdendro(hcdata,
      9                    direction   = "lr",
      10                    scale.color = cols,
      11                    expand.y    = 0.15) +
      12  theme(axis.text.x      = element_text(color = "#ffffff"),
      13        panel.background = element_rect(fill  = "#ffffff"),
      14        axis.ticks       = element_blank()) + 
      15  scale_color_brewer(palette = "Set1") +
      16  xlab(NULL) +
      17  ylab(NULL)
      18
      19# scale from 0 to 1 and reshape mtcars data
      20scaled <- setDT(lapply(mtcars, scales::rescale))
      21melted <- melt(scaled, measure.vars = colnames(mtcars))
      22melted[, variable := as.factor(variable)]
      23idx    <- match(rownames(mtcars), hcdata$labels$label)
      24melted[, car := rep(idx, ncol(mtcars))]
      25
      26# 'bubblemap'
      27p2 <- ggplot(melted) +
      28  geom_point(aes(x      = variable,
      29                 y      = car,
      30                 size   = value,
      31                 color  = value),
      32             show.legend = FALSE) +
      33  scale_color_viridis_c(direction = -1) +
      34  theme_minimal() +
      35  theme(axis.text.y = element_blank()) +
      36  xlab(NULL) +
      37  ylab(NULL)
      38
      39grid.arrange(p1, p2, ncol = 2, widths = 3:2)
      40

      R画树状图:一种轻量级方法

      总结

      像ggtree或dendextend这样的R包对于开箱即用的树状图非常有用。使用大约120行代码和三个函数,本文描述的方法非常基本,但也很灵活。定制主题参数并将树状图与其他绘图元素结合起来,可以很容易地构建更复杂的可视化。

      原文链接:
      https://atrebas.github.io/post/2019-06-08-lightweight-dendrograms/

      您在阅读中有什么问题,请留言。若是觉得有用,请您点赞和分享给其他朋友,感谢支持和分享。


      公众号推荐:

      数据人才(ID:datarencai)

      (一个帮助数据人才找工作,

      帮助数据公司招人才的公众号,

      也分享数据人学习和生活的有趣事情。)

      R画树状图:一种轻量级方法

      测试结尾

      请关注“恒诺新知”微信公众号,感谢“R语言“,”数据那些事儿“,”老俊俊的生信笔记“,”冷🈚️思“,“珞珈R”,“生信星球”的支持!

      • 分享:
      作者头像
      weinfoadmin

      上一篇文章

      一道价值3199的R语言题
      2019年6月18日

      下一篇文章

      豆豆学Python第三集
      2019年6月22日

      你可能也喜欢

      3-1665801675
      R语言学习:重读《R数据科学(中文版)》书籍
      28 9月, 2022
      6-1652833487
      经典铁死亡,再出新思路
      16 5月, 2022
      1-1651501980
      R语言学习:阅读《R For Everyone 》(第二版)
      1 5月, 2022

      搜索

      分类

      • R语言
      • TCGA数据挖掘
      • 单细胞RNA-seq测序
      • 在线会议直播预告与回放
      • 数据分析那些事儿分类
      • 未分类
      • 生信星球
      • 老俊俊的生信笔记

      投稿培训

      免费

      alphafold2培训

      免费

      群晖配置培训

      免费

      最新博文

      Nature | 单细胞技术揭示衰老细胞与肌肉再生
      301月2023
      lncRNA和miRNA生信分析系列讲座免费视频课和课件资源包,干货满满
      301月2023
      如何快速批量修改 Git 提交记录中的用户信息
      261月2023
      logo-eduma-the-best-lms-wordpress-theme

      (00) 123 456 789

      weinfoadmin@weinformatics.cn

      恒诺新知

      • 关于我们
      • 博客
      • 联系
      • 成为一名讲师

      链接

      • 课程
      • 事件
      • 展示
      • 问答

      支持

      • 文档
      • 论坛
      • 语言包
      • 发行状态

      推荐

      • iHub汉语代码托管
      • iLAB耗材管理
      • WooCommerce
      • 丁香园论坛

      weinformatics 即 恒诺新知。ICP备案号:粤ICP备19129767号

      • 关于我们
      • 博客
      • 联系
      • 成为一名讲师

      要成为一名讲师吗?

      加入数以千计的演讲者获得100%课时费!

      现在开始

      用你的站点账户登录

      忘记密码?

      还不是会员? 现在注册

      注册新帐户

      已经拥有注册账户? 现在登录

      close
      会员购买 你还没有登录,请先登录
      • ¥99 VIP-1个月
      • ¥199 VIP-半年
      • ¥299 VIP-1年
      在线支付 激活码

      立即支付
      支付宝
      微信支付
      请使用 支付宝 或 微信 扫码支付
      登录
      注册|忘记密码?