tidyHeatmap使用长数据绘制热图

医学和生信笔记

发布于 2023-08-30 11:40:41

39300

代码可运行

文章被收录于专栏：医学和生信笔记医学和生信笔记

运行总次数：0

代码可运行

tidyHeatmap基于ComplexHeatmap，遵循图形语法，最大的好处是直接使用长数据画热图，这是目前其他画热图的R包所不具备的。

目前大部分图形都是基于ggplot2绘制的，需要长数据，现在画热图也可以直接用长数据了，不需要再进行各种转换，这是我认为最大的优点。

tidyHeatmap的作者还开发了很多好用的、遵循tidy理念的R包，比如：tidybulk, tidyseurat, tidySingleCellExperiment, tidySummarizedExperiment等，看起来作者野心很大，能力也很强！tidybulk我用过，初体验还不错，以后有机会给大家介绍。

可直接访问作者的github：https://github.com/stemangiola/

安装

# 经典2选1
devtools::install_github("stemangiola/tidyHeatmap") # 我装了开发版，功能多
install.packages("tidyHeatmap")

使用

library(tidyHeatmap)
## ========================================
## tidyHeatmap version 1.10.0
## If you use tidyHeatmap in published research, please cite:
## 1) Mangiola et al. tidyHeatmap: an R package for modular heatmap production 
##   based on tidy principles. JOSS 2020.
## 2) Gu, Z. Complex heatmaps reveal patterns and correlations in multidimensional 
##   genomic data. Bioinformatics 2016.
## This message can be suppressed by:
##   suppressPackageStartupMessages(library(tidyHeatmap))
## ========================================
## 
## Attaching package: 'tidyHeatmap'
## The following object is masked from 'package:stats':
## 
##     heatmap
library(tidyverse)
## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.2
## ──
## ✔ ggplot2 3.4.1     ✔ purrr   1.0.1
## ✔ tibble  3.2.1     ✔ dplyr   1.1.1
## ✔ tidyr   1.3.0     ✔ stringr 1.5.0
## ✔ readr   2.1.4     ✔ forcats 1.0.0
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()

首先一定是把数据变为长数据！每一列是一个变量，每一行是一个观测！

mtcars_long <- mtcars %>% 
  as_tibble(rownames = "car name") %>% 
  mutate_at(vars(- `car name`,-hp,-vs),scale) %>% 
  pivot_longer(cols = -c(`car name`,hp,vs),names_to = "property",values_to = "value")

mtcars_long
## # A tibble: 288 × 5
##    `car name`       hp    vs property value[,1]
##    <chr>         <dbl> <dbl> <chr>        <dbl>
##  1 Mazda RX4       110     0 mpg          0.151
##  2 Mazda RX4       110     0 cyl         -0.105
##  3 Mazda RX4       110     0 disp        -0.571
##  4 Mazda RX4       110     0 drat         0.568
##  5 Mazda RX4       110     0 wt          -0.610
##  6 Mazda RX4       110     0 qsec        -0.777
##  7 Mazda RX4       110     0 am           1.19 
##  8 Mazda RX4       110     0 gear         0.424
##  9 Mazda RX4       110     0 carb         0.735
## 10 Mazda RX4 Wag   110     0 mpg          0.151
## # … with 278 more rows

主函数是heatmap，支持管道符：

mtcars_heatmap <- mtcars_long %>% 
  heatmap(.row = `car name`, .column = property, .value = value # 最主要的3个参数
          , scale = "row"
          ) %>% 
  annotation_tile(hp) # 添加注释条，github已改为 annotation_xxx

mtcars_heatmap

保存：

mtcars_heatmap %>% save_pdf("mtcars_heatmap.pdf")

支持自定义颜色也是毫无问题：

mtcars_long %>% 
    heatmap(
        `car name`, 
        property, 
        value,  
        scale = "row",
        palette_value = c("red", "white", "blue")
    )

分割热图

热图分割的思路也是非常tidy，直接使用group_by()即可。

mtcars_long_split <- mtcars_long %>% 
  mutate(property_group = if_else(property %in% c("cyl","disp"),"engine","other"))

glimpse(mtcars_long_split)
## Rows: 288
## Columns: 6
## $ `car name`     <chr> "Mazda RX4", "Mazda RX4", "Mazda RX4", "Mazda RX4", "Ma…
## $ hp             <dbl> 110, 110, 110, 110, 110, 110, 110, 110, 110, 110, 110, …
## $ vs             <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1…
## $ property       <chr> "mpg", "cyl", "disp", "drat", "wt", "qsec", "am", "gear…
## $ value          <dbl[,1]> <matrix[26 x 1]>
## $ property_group <chr> "other", "engine", "engine", "other", "other", "oth…

mtcars_long_split %>% 
  group_by(vs, property_group) %>% 
  heatmap(.row = `car name`, .column = property, .value = value
          , scale = "row"
          , palette_grouping = list( # 可自定义注释条颜色
            
            # For first grouping (vs)
            c("#66C2A5", "#FC8D62"), 
            
            # For second grouping (property_group)
            c("#b58b4c", "#74a6aa")
            )
          ) %>% 
  annotation_tile(hp
           ,palette = c("red", "white", "blue")#注释条颜色也支持自定义
           )

当然也是支持其他分割方法的，比如根据聚类树分割等。

自定义注释条

支持多种注释条，可自定义大小。

pasilla_plus <- 
    tidyHeatmap::pasilla |>
    dplyr::mutate(act = activation) |> 
    tidyr::nest(data = -sample) |>
    dplyr::mutate(size = rnorm(n(), 4,0.5)) |>
    dplyr::mutate(age = runif(n(), 50, 200)) |>
    tidyr::unnest(data) 

library(grid)
pasilla_plus |>
    heatmap(
        .column = sample,
        .row = symbol,
        .value = `count normalised adjusted`,   
        scale = "row"
    ) |>
    annotation_tile(condition, size = unit(0.3, "cm"),  annotation_name_gp= gpar(fontsize = 8)) |>
    annotation_point(activation, size = unit(0.3, "cm"),    annotation_name_gp= gpar(fontsize = 8)) |>
    annotation_tile(act, size = unit(0.3, "cm"),    annotation_name_gp= gpar(fontsize = 8)) |>
    annotation_bar(size, size = unit(0.3, "cm"),    annotation_name_gp= gpar(fontsize = 8)) |>
    annotation_line(age, size = unit(0.3, "cm"),    annotation_name_gp= gpar(fontsize = 8))

小格子修改

增加边框，修改颜色

mtcars_long %>% 
    heatmap(
        `car name`, property, value,    
        scale = "row", 
        rect_gp = grid::gpar(col = "red", lwd = 0.5)
    )

聚类树修改

可调价是否显示聚类树，聚类树的大小等

mtcars_long %>% 
  heatmap(`car name`, property, value
          , scale = "row"
          , cluster_rows = F
          , column_dend_height = unit(0.2,"cm")
          )

行名列名，行标题列标题

修改大小等

library(grid)
mtcars_long %>% 
  heatmap(`car name`, property, value
          , scale = "row"
          , row_names_gp = gpar(fontsize = 7)
          , column_title_gp = gpar(fontsize=10, col="red")
          )

和ggplot2拼图

需要借助wrap_heatmap函数，不能直接使用patchwork

library(ggplot2)
library(patchwork)

p_heatmap =
    mtcars_long %>% 
    heatmap(
        `car name`, property, value,    
        scale = "row", 
            show_heatmap_legend = FALSE,
        row_names_gp = gpar(fontsize = 7)
    ) 

p_ggplot = data.frame(value = 1:10) %>% ggplot(aes(value)) + geom_density()

wrap_heatmap(p_heatmap) + 
    p_ggplot +
    
    # Add padding for better aesthetics
    wrap_heatmap(
        p_heatmap,
        padding = grid::unit(c(-30, -0, -0, -10), "points" ),
        clip = FALSE
    ) + 
    plot_layout(width = c(1, 0.3, 1))