Colors, More Colors

发表于2022-03-28更新于2022-10-21

最近接到一个需求，希望能够复现一张图，来自一篇单细胞的paper：

[Single-cell transcriptomic analysis of human lung provides insights

into the pathobiology of pulmonary fibrosis](https://www.ncbi.nlm.nih.gov/pmc/articles/PMC6580683/ )中的figure4A，并给了我一个数据：

avg_logFC fibrosis_pct.exp donor_pct.exp cluster gene
6.546466818 0.91 0.214 Plasma Cells IGKC
6.107130048 0.72 0.103 Plasma Cells IGLC2
5.778478118 0.778 0.075 Plasma Cells IGHG3
5.66169075 0.734 0.063 Plasma Cells IGHG4
5.290993873 0.509 0.04 Plasma Cells IGLC3
5.205159287 0.799 0.068 Plasma Cells IGHG1

和一个期望的基因列表。

原本我以为这张图只是用dotplot做出来的，或者Seurat的DotPlot函数画出来的基因表达的点图，并希望能够提供Seurat的对象，这样多简单。

可惜，很快就发现，事情没这么简单。

其一，它有两个颜色的色阶，分别是fibrosis组和donor组的数据对应的范围映射，其二，它的x轴有gap，将不同的组分开了，其三，图上面还有一些注释，而且是对应的。

事实上，后面两个需求，用AI能够手动做到，但是前面那个分组话色阶，我还没见过能做到。

而且，经过交流，对方没有Seurat对象，连表达矩阵都没下载，所以我就得熄了用Seurat的DotPlot的心思，只能用ggplot2做了。

所以，先确定方案，这肯定是geom_point，颜色由某些数值映射得到，点的大小则是pct.exp映射，现在唯一需要解决的，就是如何在同一张图里映射两种颜色，如何将同一种cell cluster分为fibrosis和donor的组而且对应。

经过查找stackflow，我找到了解决方案，由此，只要我们有上述类似表格的数据，就能做类似的图，只需要替换对应的映射即可：

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
#首先将文件另存为csv，方便读入。这一步手动在excel中完成。
library(tidyverse)
library(ggnewscale)
#这里需要修改为文件存放的路径
setwd("C://Users//Administrator//Desktop//tempwork")
#读取数据
dt<-read.csv("reyfman.csv",header=T,check.names = F)
head(dt)
selectgene <- read.table("gene.txt",header = T,check.names = F)
selectgene <- selectgene$gene
dt_draw <- dt %>% filter(.,gene %in% all_of(selectgene))

#数据需要重新整理，原图中是将细胞类型分成了donor和fibrosis的，这两个需要分开，需要重新命名.
#还需要增加一个group来区分是哪一组
#为了全部在R中进行，将数据变成两个矩阵同时做。
#draw <- read.csv("reyfman_draw.csv",header = T,check.names = F)
#draw <- draw %>% arrange(.,cluster)
draw2 <- dt_draw %>% mutate(.,group="fibrosis") %>% mutate(.,accu_cluster = paste(cluster,"fibrosis",sep = "_"))
draw3 <- dt_draw %>% mutate(.,group="donor") %>% mutate(.,accu_cluster = paste(cluster,"donor",sep = "_"))

#确认映射：
#根据参考图可知，plot映射如下：
#点的大小映射为pct.exp，颜色映射到avg_logFC上，映射本身可以随意改动，这个很容易
#如果想改动颜色的色阶，在scale_color_gradientn中改动即可。
ggplot(mapping = aes(x=gene,y=accu_cluster)) +
  geom_point(data = draw2, aes(size= fibrosis_pct.exp,color=avg_logFC)) +
  scale_color_gradientn(colors = c('grey', 'red')) +
  new_scale_color() +
  geom_point(data = draw3, aes(size= donor_pct.exp,color=avg_logFC)) +
  scale_color_gradientn(colors = c('grey', 'blue'))+
  theme_classic()+
  theme(panel.grid = element_blank(),
        axis.text.x=element_text(angle=45,hjust = 0.8,vjust = 0.8))+
  labs(x=NULL,y=NULL)

其中，关于颜色区分映射，是由ggnewscale这个包做到的，这样我们就可以不用使用极其复杂的函数就能够做出这张图。

事实上，这张图是用Seurat的一个函数做的，可惜，这个函数只有在Seurat<3.0的版本才有，需要另外安装旧版本的Seurat，而现在版本的Seurat的DotPlot虽然也提供split.by函数，但我看源码非常复杂。

原本这张图是这么画的：

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
# Contribution of different cell populations to pulmonary fibrosis pathways ------------------------------------------------

cell.idents <- c("AT2 Cells", "Basal Cells", "Endothelial/Lymphatic Cells", "Ciliated Cells", "AT1 Cells",
                 "Club Cells", "Fibroblasts", "Macrophages")

dotplot.hl <- SubsetData(hl, ident.use = cell.idents)

dotplot.hl@ident <- factor(dotplot.hl@ident, levels = (c("Macrophages", "Basal Cells", "Club Cells", "Ciliated Cells", 
                                                         "AT2 Cells", "AT1 Cells", "Endothelial/Lymphatic Cells", "Fibroblasts")))

dotplot.genes <- c("WNT2", "WNT3A", "WNT7A", "WNT7B", "WNT5A",
                   "WNT9A", "RSPO1", "RSPO2", "RSPO3",
                   "LGR4", "LGR6", "LRP5", "LRP6", "AXIN2", "ZNRF3", "RNF43", 
                   "NOTCH1", "NOTCH2", "NOTCH3", "NOTCH4", "HES1", "HEY1", "JAG1", "JAG2",
                   "SHH", "GLI1", "GLI2", "GLI3", 
                   "YAP1", "TAZ",
                   "SNAI1", "SNAI2", "SNAI3",
                   "TWIST1", "TWIST2",
                   "ZEB1", "ZEB2",
                   "HIF1A",
                   "PDGFRA", "PDGFRB",
                   "KRT5", "KRT14",
                   "ITGA6", "ITGB4",
                   "CDH1")

genegroups <- c(rep(c("EMT-Related Genes"), times = 21), rep(c("Notch Pathway Genes"), times = 8), rep(c("WNT Pathway Genes"), times = 16))

genegroups <- factor(genegroups, levels = (c("WNT Pathway Genes", "Notch Pathway Genes", "EMT-Related Genes")))

#Dot Plots (Figure 4A)
SplitDotPlotGG(dotplot.hl, genes.plot = rev(dotplot.genes), gene.groups = rev(genegroups), cols.use = c("blue", "red"), 
               x.lab.rot = T, plot.legend = T, dot.scale = 8, do.return = T, grouping.var = "condition")

这个SplitDotPlotGG函数新版Seurat已经没咯～

虽然完全不知道为什么……但就是没了……而且现在看来感觉我的解决方案还是更简单一点，也不必须依赖于Seuratobject。

最后剩下的问题就是，这个将坐标轴间隔是怎么做到的，以及上面的文字注释是怎么做到的，我看了gg.gap包也没法实现，看来要学的还有很多。