整理思路:
先画出中间的火山图,再画左右两张放大版的图,最后用AI将三张图拼接到一起,钢笔工具画出中间连接的小T形,同色的小矩形把连接处的实线盖住,打造出一种藕断丝连的神秘感(伪。
1. 数据输入和清洗
数据的输入为 DESeq2的输出 'res'
接下来进行一些清洗,整理成画图的形式
#增加基因名一列
res<-cbind(rownames(res),res)
colnames(res)[1]<-'Symbol'
#增加不同的颜色,将P矫正<0.05且log2FC的绝对值>1作为阈值,表达上调为红色,表达下调为蓝色
a <- dim(res)[1]
res$group<-sapply(1:a,function(i){if(res$log2FoldChange[i]>1 & res$padj[i] < 0.05){"#dd6a64"}
else if(res$log2FoldChange[i]<(-1) & res$padj[i] < 0.05){"#6d95e6"}else{"grey40"}})
#增加不同点的尺寸,这里可以根据自己的喜好自定义
res$size<-sapply(1:a,function(i){if(abs(res$log2FoldChange[i])>1 & res$padj[i] < 0.05){"2"}
else if(abs(res$log2FoldChange[i])>1 & abs(res$log2FoldChange[i])<1.5 & res$padj[i] < 0.05){"2.5"}
else if(abs(res$log2FoldChange[i])>1.5 & abs(res$log2FoldChange[i])<2 & res$padj[i] < 0.05){"3"}
else if(abs(res$log2FoldChange[i])>2 & res$padj[i] < 0.05){"3.5"}
else{"1.5"}})
2. 画中间的plot
fc = res$log2FoldChange
p = -log10(res$padj) #可以将P矫正换成P,取决于你实验的设计
sizes = as.numeric(res$size)
pdf('test1.pdf')
plot(x= fc,y= p,log='y', # indicating if x or y or both coordinates should be plotted in log scale.
pch=16,
xlab=bquote(~Log[2]~'Foldchange'),
ylab=bquote(~Log[10]~'Padj'),
cex=sizes,
col=res$group,
xlim=range(fc*1.2))
至此主图的框架已画完,下面是添油加醋,让他变得更好看
###
## 增加水平线和垂直线
abline(h=-log10(0.05), lty=2, lwd=1)
abline(h=2, lty=3, lwd=1)
abline(v=-1, col="blue", lty=2, lwd=1)
abline(v=1, col="red", lty=2, lwd=1)
## 增加点外面的黑圈
m<-which(p > -log10(0.05) & abs(fc)>1)
points(x=fc[m],y=p[m],pch=1,cex=sizes[m])
## 在主图左右两侧画一个黄色的长方形
# 先要获得橙色的RGB参数
rgb_orange<-col2rgb('orange')/255
# 获得透明度为0.1时的颜色代码
color_rect<-rgb(rgb_orange[,1][1],rgb_orange[,1][2],rgb_orange[,1][3],alpha=0.1)
# 加上长方形
# rect(xleft, ybottom, xright, ytop,XXX)
rect(-3.064454,-log10(0.05),-1,12, col = color_rect)
rect(1,-log10(0.05),2.915735,12, col = color_rect)
dev.off()
注1:在加长方形时,四个角的坐标不太容易获得,可以往下到最后看我的方法
3. 画左右两个小图
先将上调表达和下调表达的挑出来,分别画
res1<-res %>% dplyr::filter(log2FoldChange < (-1) & padj < 0.05)
pdf('test2.pdf',width=5,height=5)
plot(res1$log2FoldChange, -log10(res1$padj), log='y',
col=res1$group,
pch=16,
ylab=bquote(~-Log[10]~"Padj value"), xlab=bquote(~Log[2]~'Foldchange'),
cex=as.numeric(res1$size),
xlim=c(-2.5,-1),
ylim=c(1.5,6))
points(res1$log2FoldChange, -log10(res1$padj), pch=1,cex=as.numeric(res1$size))
text(res1$log2FoldChange, -log10(res1$padj), res1[,1],pos=2, #1, 2, 3 and 4, respectively indicate positions below, to the left of, above and to the right of the specified coordinates.
col='#6d95e6',cex = 1)
rect(-2.7,1,-0.7,6.4, col = color_rect)
dev.off()
有的基因名重叠了,这里可以将离得比较近的点挑出来,换一个方向加基因名,但是我懒就不写了
同理,右图也以此类推
res2<-res %>% dplyr::filter(log2FoldChange > 1 & padj < 0.05)
pdf('red_heat.pdf',width=5,height=5)
#cols.alpha <- add.alpha(res[,7], alpha=0.6)
plot(res2$log2FoldChange, -log10(res2$padj), log='y',
col=res2$group,
pch=16, #实心圆点
ylab=bquote(~-Log[10]~"Padj value"), xlab=bquote(~Log[2]~'Foldchange'),
cex=as.numeric(res2$size), # 用小泡泡画不感兴趣的pathway
xlim=c(1,2.5))
points(res2$log2FoldChange, -log10(res2$padj), pch=1,cex=as.numeric(res2$size))
text(res2$log2FoldChange, -log10(res2$padj), res2[,1],pos=4, #1, 2, 3 and 4, respectively indicate positions below, to the left of, above and to the right of the specified coordinates.
col='#dd6a64',cex = 1)
gray.alpha <- add.alpha("orange", alpha=0.1)
rect(0.7,1,3,10, col = gray.alpha)
dev.off()
最后用AI将三个图拼接,钢笔工具很简单就能画出中间连接的效果,你会比我画的更好,我懒得做细活,草草画了一下,还能看到毛边。
此文版权归作者所有,未经允许严禁转载。特此警告某某某,某某某,和某某某。
(算了我就是说说,我知道你们还是会未经允许转载的,佛了佛了……东京今天的阳光真好,还有什么可值得计较的呢?快出去走走吧!
注:rect函数中四个角的参数,可用完plot函数后,用par('usr'),就会返回4个角的坐标。但是不是很准,因为plot的坐标不是从整点开始的,就需要配合自己的尝试。另外,在plot函数中,我们添加了log='y'让图形变得更好看,但这样就不会准确的返回坐标值了,所以建议重新跑一下没有log='y'的plot,再par('usr')。说的有点乱,自己试一下就知道啦!