R 语言绘制二维密度相关性散点图
测试开头







测试结尾

没关注?伸出手指点这里—


1引言
有人在 老俊俊生信交流群 里提问怎么绘制下面的相关性散点图:

仔细看来一下还不是传统的那种只是散点图的样子,是一种类似于 密度散点图 的感觉,点越密的地方颜色越深,有一种 模糊 的感觉。
刚开始想到的是我之前分享的 R 包 ggblur 模糊你的点(眼) ,使用 ggblur 来对点进行模糊,但是达不到这样的效果,可能方向就错了。后面使用 ggplot 的二维密度图层可以达到这样的效果,此外还查到一个 smoothScatter 这个函数也可以。
今天就分享如何绘制这样的图形。
2smoothScatter 函数绘制
首先加载测试数据,RNA-seq 的 fpkm
数据:
library(ggplot2)
library(ggpubr)
library(tidyverse)
# load data
df <- read.table('test.fpkm.txt',header = T)[2:5]
# log2 transform
df <- log2(df + 1)
df1 <- df[,c(1:2)]
colnames(df1)[1:2] <- c('rep1','rep2')
df2 <- df[,c(3:4)]
colnames(df2)[1:2] <- c('rep1','rep2')
# combine
df_long <- rbind(df1,df2)
df_long$sample <- rep(c('WT','KO'),each = nrow(df))
# check
head(df_long,3)
# rep1 rep2 sample
# 1 9.130976 9.037206 WT
# 2 6.537833 6.382360 WT
# 3 8.565563 8.660298 WT
绘图:
nrpoints 和 nbin 参数控制显示的
点的数量
和图的分辨率
。
# defult plot
par(mfrow=c(1,2),tck = -0.025)
# axis(gap.axis = 0.5)
p1 <- df_long %>% filter(sample == 'WT')
smoothScatter(p1$rep1,p1$rep2,
nrpoints = 200,
nbin = 200,
pch = 16,cex = 0.2,
asp = 0.8,
bandwidth = 0.5,
xlim = c(0,15),ylim = c(0,15),
xlab = 'log2(wt-rep1 + 1)',
ylab = 'log2(wt-rep2 + 1)')
# add title
title(main = 'WT')
# add correlattion
text(x = 5,y = 14,labels = 'R=0.99,p<2.2e-16')
p2 <- df_long %>% filter(sample == 'KO')
smoothScatter(p2$rep1,p2$rep2,
nrpoints = 200,
nbin = 200,
pch = 16,cex = 0.2,
asp = 0.8,
bandwidth = 0.5,
xlim = c(0,15),ylim = c(0,15),
xlab = 'log2(ko-rep1 + 1)',
ylab = 'log2(ko-rep2 + 1)')
# add title
title(main = 'KO')
# add correlattion
text(x = 5,y = 14,labels = 'R=0.99,p<2.2e-16')

3ggplot 绘制
ggplot 好像加不了上面那种点。
# ggplot plot
ggplot(df_long,
aes(x = rep1,y = rep2)) +
stat_density2d(aes(fill = ..density..^0.25),
show.legend = F,
geom = "tile", contour = FALSE, n = 300) +
scale_fill_continuous(low = "white", high = "#003366") +
stat_cor() +
theme_bw(base_size = 16) +
theme(panel.grid = element_blank(),
strip.background = element_blank(),
aspect.ratio = 0.8) +
xlim(0,15) + ylim(0,15) +
facet_wrap(~sample,scales = 'free') +
xlab('log2(ko-rep1 + 1)') +
ylab('log2(ko-rep2 + 1)')

4结尾
这样的二维密度散点图比绘制全部的点速度快很多。可视化效果也挺好的。可以考虑放在文章里使用。

欢迎加入生信交流群。加我微信我也拉你进 微信群聊 老俊俊生信交流群
哦,数据代码已上传至QQ群,欢迎加入下载。
群二维码:
老俊俊微信:
知识星球:
所以今天你学习了吗?
今天的分享就到这里了,敬请期待下一篇!
最后欢迎大家分享转发,您的点赞是对我的鼓励和肯定!
如果觉得对您帮助很大,赏杯快乐水喝喝吧!
往期回顾
◀跟着 Cell 学 Ribo–seq 分析 三 (Metagene Plot)
◀RiboPlotR 优雅的可视化你的 Ribo–seq 数据
◀...
请关注“恒诺新知”微信公众号,感谢“R语言“,”数据那些事儿“,”老俊俊的生信笔记“,”冷🈚️思“,“珞珈R”,“生信星球”的支持!