【R画图学习13.4】散点图---单细胞不同亚群火山图

下面这个图是我在单细胞相关文章中见过的,也算是火山图的变种。可以看出X轴是不同的细胞类型,Y轴是marker基因的fold change(log2),但是不同类别之间他们是不连续的,其实可以用我们前面讲过的抖动散点图的效果。今天我们就来尝试是否能画出这个效果。



还是用我们最常用的pbmc的单细胞数据。

pbmc.markers <- read.table("markers.txt",sep="\t",header=T)

pbmc.markers <- pbmc.markers %>%mutate(type = ifelse(avg_log2FC >=0,"Up","Down"))%>%mutate(type2 = ifelse(p_val_adj < 0.01,"adjust Pvalue < 0.01","adjust Pvalue >= 0.01"))

然后获得每个细胞类型(cluster)的marker基因。

从结果也很容易理解,第一列:pval。第二列是两组间平均log2 FC,正值表示在第一组较高。pct.1和pct.2则分别为基因在对应细胞类型中的表达比例。cluster代表是在那个细胞类型中。最后一列是基因的名字。type和type2是我们自己添加了一列用于标记是上调还是下调以及P值。

先画一个基本的散点图,这里我们用的是前面的技巧,抖动散点图。

ggplot(pbmc.markers, aes(cluster, avg_log2FC)) +

geom_jitter(aes(color = type))

下面我们尝试在每个cluster周围添加一个柱状的框。ggplot里面两个命令可以添加柱状图。geom_bar和geom_col。前面讲过geom_bar的用法。

简单来说,col,column也。列也,竖直也。bar:条、带也。

在新版本的ggplot中:

geom_col针对最常见的柱状图 ,即既给ggplot映射x值(x值一般是因子型的变量,才能成为柱,而没有成为曲线),也映射y值。

如: ggplot2(data, aes(x = x, y = y)) +geom_col()

geom_bar针对计数的柱状图,即count, 是只给ggplot映射x值(x也一般是因子)。自动计算x的每个因子所拥有的数据点的个数,将这个个数给与y轴。

如:  gplot2(data, aes(x = x)) +  geom_bar()

总结:区别在于给ggplot是否映射y值。

这里明显我们不自动计算Y值,需要自己给Y值,所以我们采用geom_col。


所以首先,我们需要计算Y值,其实就是每个cluster里面FC的最大值和最小值。为了不压着极值点,我们可以稍微多一点点。

所以我们先计算每个cluster的Y轴极坐标,然后再来添加geom_col。

cell <-unique(pbmc.markers$cluster)

back.data<- data.frame()

for(n in 1:length(cell))

{

  tmp <- pbmc.markers %>%filter(cluster==cell[n])

 new.tmp <- data.frame(cluster = cell[n],min = min(tmp$avg_log2FC) - 0.2,max = max(tmp$avg_log2FC) + 0.2)

  back.data <- rbind(back.data,new.tmp)

}

ggplot(pbmc.markers, aes(cluster, avg_log2FC)) +

geom_jitter(aes(color = type)) +

geom_col(data = back.data,aes(x = cluster,y = min),fill="grey93",color="black",alpha=0.5) +

geom_col(data = back.data,aes(x = cluster,y = max),fill="grey93",color="black",alpha=0.5)

这样我们就添加了每个cluster的周边框框。前面我们画曼哈顿图的时候,是用的annotate('rect')来操纵的四个变量,因为我们把每个点转化成了X轴上的连续坐标,不是因子。

我们先简单修改一下背景色,框边色等。

ggplot(pbmc.markers, aes(cluster, avg_log2FC)) +

geom_jitter(aes(color = type)) +

geom_col(data = back.data,aes(x = cluster,y = min),fill="grey93",alpha=0.5) +

geom_col(data = back.data,aes(x = cluster,y = max),fill="grey93",alpha=0.5) +

scale_color_manual(values=c(Down="#0099CC",Up="#CC3333"))+

theme_classic(base_size = 14) +

theme(panel.grid = element_blank(),

                  legend.position = c(0.7,0.9),

                  legend.title = element_blank(),

                  legend.background = element_blank()) +

xlab('Clusters') + ylab('Average log2FoldChange') +

guides(color = guide_legend(override.aes = list(size = 5)))

下面我们在Y=0的地方添加一个框。如果继续使用geom_col则是下面的效果。

ggplot(pbmc.markers, aes(cluster, avg_log2FC)) +

geom_jitter(aes(color = type)) +

geom_col(data = back.data,aes(x = cluster,y = min),fill="grey93",alpha=0.5) +

geom_col(data = back.data,aes(x = cluster,y = max),fill="grey93",alpha=0.5) +

scale_color_manual(values=c(Down="#0099CC",Up="#CC3333"))+

theme_classic(base_size = 14) +

theme(panel.grid = element_blank(),

                  legend.position = c(0.7,0.9),

                  legend.title = element_blank(),

                  legend.background = element_blank()) +

xlab('Clusters') + ylab('Average log2FoldChange') +

guides(color = guide_legend(override.aes = list(size = 5)))+

geom_col(data = back.data,aes(x = cluster,y = 0.5,fill=cluster),show.legend = F)+

geom_col(data = back.data,aes(x = cluster,y = -0.5,fill=cluster),show.legend = F)

但是缺点是,就像添加的数据框一样,是非连续的。

我们在试试其它数据框的方法。一共有三个矩形函数:geom_rect()、geom_tile()、geom_raster()。

geom_rect()和geom_tile()函数的功能是一致的,但是参数有所区别:geom_rect()使用的是矩形四个顶点的位置,即xmin、xmax、ymin和ymax,而geom_tile()使用的是矩形的中心位置及其尺寸,即x、y、width、height。geom_tile()是geom_tile()的特例,其要求所有矩形的尺寸相同。

另外就是使用我们前面使用注释函数annotate()。

所以,都可以根据需要多使用和测试。

ggplot(pbmc.markers, aes(cluster, avg_log2FC)) +

geom_jitter(aes(color = type)) +

geom_col(data = back.data,aes(x = cluster,y = min),fill="grey93",alpha=0.5) +

geom_col(data = back.data,aes(x = cluster,y = max),fill="grey93",alpha=0.5) +

scale_color_manual(values=c(Down="#0099CC",Up="#CC3333"))+

theme_classic(base_size = 14) +

theme(panel.grid = element_blank(),

                  legend.position = c(0.7,0.9),

                  legend.title = element_blank(),

                  legend.background = element_blank()) +

xlab('Clusters') + ylab('Average log2FoldChange') +

guides(color = guide_legend(override.aes = list(size = 5)))+

#geom_col(data = back.data,aes(x = cluster,y = 0.5,fill=cluster),show.legend = F)+

#geom_col(data = back.data,aes(x = cluster,y = -0.5,fill=cluster),show.legend = F)

geom_tile(aes(x = cluster,y = 0,fill = cluster),color = 'black',height = 1,alpha = 0.3,show.legend = F)

可以看出,例子图中他们用的是这个效果。

下面,我们就需要注释掉X轴,以及改变X轴label的位置了。

ggplot(pbmc.markers, aes(cluster, avg_log2FC)) +

geom_jitter(aes(color = type)) +

geom_col(data = back.data,aes(x = cluster,y = min),fill="grey93",alpha=0.5) +

geom_col(data = back.data,aes(x = cluster,y = max),fill="grey93",alpha=0.5) +

scale_color_manual(values=c(Down="#0099CC",Up="#CC3333"))+

theme_classic(base_size = 14) +

theme(panel.grid = element_blank(),

                  legend.position = c(0.7,0.9),

                  legend.title = element_blank(),

                  legend.background = element_blank()) +

xlab('Clusters') + ylab('Average log2FoldChange') +

guides(color = guide_legend(override.aes = list(size = 5)))+

#geom_col(data = back.data,aes(x = cluster,y = 0.5,fill=cluster),show.legend = F)+

#geom_col(data = back.data,aes(x = cluster,y = -0.5,fill=cluster),show.legend = F)

geom_tile(aes(x = cluster,y = 0,fill = cluster),color = 'black',height = 1,alpha = 0.3,show.legend = F)+

geom_text(data=back.data,aes(x = cluster,y = 0,label = cluster),size=4,color="white") +

theme(axis.line.x = element_blank(),

      axis.text.x = element_blank(),

      axis.ticks.x = element_blank())

下面就是要highlight一些top 5的基因了。

cell <-unique(pbmc.markers$cluster)

up.top<- data.frame()

for(n in 1:length(cell))

{

  tmp <- pbmc.markers %>% filter(cluster==cell[n]) %>% filter(avg_log2FC>0)%>% arrange(desc(avg_log2FC)) %>%head(5)

  up.top <- rbind(up.top,tmp)

}

down.top<- data.frame()

for(n in 1:length(cell))

{

  tmp <- pbmc.markers %>% filter(cluster==cell[n]) %>% filter(avg_log2FC<0)%>% arrange(avg_log2FC) %>%head(5)

  down.top <- rbind(down.top,tmp)

}

ggplot(pbmc.markers, aes(cluster, avg_log2FC)) +

geom_jitter(aes(color = type)) +

geom_col(data = back.data,aes(x = cluster,y = min),fill="grey93",alpha=0.5) +

geom_col(data = back.data,aes(x = cluster,y = max),fill="grey93",alpha=0.5) +

scale_color_manual(values=c(Down="#0099CC",Up="#CC3333"))+

scale_y_continuous(breaks = seq(-10, 10, 2), labels = as.character(seq(-10, 10, 2)),expand = c(0, 0),limits = c(-10, 10)) +

theme_classic(base_size = 14) +

theme(panel.grid = element_blank(),

                  legend.position = c(0.7,0.9),

                  legend.title = element_blank(),

                  legend.background = element_blank()) +

xlab('Clusters') + ylab('Average log2FoldChange') +

guides(color = guide_legend(override.aes = list(size = 5)))+

#geom_col(data = back.data,aes(x = cluster,y = 0.5,fill=cluster),show.legend = F)+

#geom_col(data = back.data,aes(x = cluster,y = -0.5,fill=cluster),show.legend = F)

geom_tile(aes(x = cluster,y = 0,fill = cluster),color = 'black',height = 1,alpha = 0.3,show.legend = F)+

geom_text(data=back.data,aes(x = cluster,y = 0,label = cluster),size=4,color="white") +

theme(axis.line.x = element_blank(),

      axis.text.x = element_blank(),

      axis.ticks.x = element_blank()) +

geom_text_repel(data = up.top,aes(x = cluster,y = avg_log2FC,label = gene),max.overlaps = 50)+

geom_text_repel(data = down.top,aes(x = cluster,y = avg_log2FC,label = gene),max.overlaps = 50)

你可能感兴趣的:(【R画图学习13.4】散点图---单细胞不同亚群火山图)