complex_scatter
写在前面
【这图怎么画】系列的图都来自VIP群里同学的提问。推文只是对图片的复现，不代表作者对图片展现形式的认同。欢迎同学们在群里分析有意思的图片。
上期补充
对于上期的【这图怎么画】这图怎么画 | 相关分析棒棒糖图，群友张晓东同学对代码进行简化和分享，感谢这位同学的贡献。
library(ggplot2) library(ggsci) library(cowplot) dat = read.csv("cor.csv") head(dat) # 对相关系数和p值转换为分类变量 dat$cor1 <- cut(abs(dat$cor),# 绝对值 breaks = c(0, 0.3, 0.5, 0.7, 0.9, 1), labels = c("< 0.3","0.3 - 0.5","0.5 - 0.7","0.7 - 0.9","> 0.9"), right=FALSE) # right=FALSE表示表示区间为左闭右开 dat$pvalue1 <- cut(dat$pvalue, breaks = c(0, 0.001, 0.01, 0.05, 1), labels = c("< 0.001","< 0.01","< 0.05","> 0.05"), right=FALSE) # 排序 dat = dat[order(dat$cor),] dat$Cell = factor(dat$Cell, levels = dat$Cell) p = ggplot(dat, aes(x = cor, y = Cell, color = pvalue1)) + scale_color_manual(name="pvalue", values = c("#E69F00", "#56B4E9", "#009E73", "gray"))+ geom_segment(aes(x = 0, y = Cell, xend = cor, yend = Cell),size = 0.5) + geom_point(aes(size = cor1))+ theme_test()+ geom_vline(xintercept = c(0.0),size=0.25)+ labs(size = "Cor")+ labs(x = NULL, y = "")+ theme(axis.line = element_line(size = 0.25), plot.margin = unit(c(0.3,0.3,0.3,0.3),'cm'), axis.ticks = element_line(colour = "black", size = 0.25), axis.title = element_text(size = 8), axis.text = element_text(size = 8,face = "plain",color = "black"), legend.text = element_text(size = 6,face = "plain",color = "black"), legend.title = element_text(size = 6,face = "plain",color = "black"), legend.box.spacing = unit(1.2,'cm'))+ coord_cartesian(clip = 'off',xlim = c(-0.55,0.55))+ annotate(geom="text",x=0.7,y=dat$Cell,color="black", size=3,label=dat$pvalue1)+ theme(aspect.ratio = 1.5,legend.position = c(1,0), legend.justification = c(1,0), legend.key = element_rect(fill = NA), legend.background = element_rect(fill = NA)) p ggsave(p,filename = "a.pdf",width = 10,units ="cm")
result1
本期图片
complex_scatter
❝Title：The heterogeneous role of energy policies in the energy transition of Asia–Pacific emerging economies
期刊：Nature Energy
❞
这是一幅对不同地区不同时间的各个指标值大小的展示。我们也可以用来展示不同基因不同时间在各个分组的表达情况。
复现结果
复现结果
示例数据和代码领取
绘图
简单重复代码版
# 示例数据建立 ## 检验指标A testA = matrix(runif(n = 200,0,1), 20, 10) colnames(testA) = paste("Sample", 1:10, sep = "") rownames(testA) = 2000:2019 ## 检验指标B testB = matrix(runif(n = 200,0,1), 20, 10) colnames(testB) = paste("Sample", 1:10, sep = "") rownames(testB) = 2000:2019 ## 检验指标C testC = matrix(runif(n = 200,0,1), 20, 10) colnames(testC) = paste("Sample", 1:10, sep = "") rownames(testC) = 2000:2019 ## 检验指标D testD = matrix(runif(n = 200,0,1), 20, 10) colnames(testD) = paste("Sample", 1:10, sep = "") rownames(testD) = 2000:2019 ## 绘制 ### 数据长宽转换 library(reshape2) datA = melt(testA, varnames = c('time','sample'), value.name = 'exp') datB = melt(testB, varnames = c('time','sample'), value.name = 'exp') datC = melt(testC, varnames = c('time','sample'), value.name = 'exp') datD = melt(testD, varnames = c('time','sample'), value.name = 'exp') head(datA) ### 绘制 library(ggplot2) A <- ggplot(datA, aes(exp,sample,fill = time))+ geom_point(color = '#db99b7',size = 2, shape = 21, stroke = 0.3,)+ theme_bw()+ scale_fill_gradient(low = '#f4e3eb',high = '#c04b81')+ geom_vline(aes(xintercept=0.9), colour="#db99b7", linetype="dashed")+ xlab('A indicator\nindicator A')+ theme(panel.grid.major=element_blank(), panel.grid.minor=element_blank(), legend.title=element_blank(), legend.position = 'bottom') B <- ggplot(datB, aes(exp,sample,fill = time))+ geom_point(color = '#d6ab72',size = 2, shape = 21, stroke = 0.3,)+ theme_bw()+ scale_fill_gradient(low = '#f5ebdd',high = '#c3842d')+ geom_vline(aes(xintercept=0.5), colour="#c48733", linetype="dashed")+ xlab('B indicator\nindicator B')+ theme(panel.grid.major=element_blank(), panel.grid.minor=element_blank(), legend.title=element_blank(), legend.position = 'bottom', axis.text.y = element_blank(), axis.ticks.y = element_blank(), axis.title.y = element_blank()) C <- ggplot(datC, aes(exp,sample,fill = time))+ geom_point(color = '#8f9ac0',size = 2, shape = 21, stroke = 0.3,)+ theme_bw()+ scale_fill_gradient(low = '#daddea',high = '#162d7d')+ geom_vline(aes(xintercept=0.4), colour="#7280b0", linetype="dashed")+ xlab('C indicator\nindicator C')+ theme(panel.grid.major=element_blank(), panel.grid.minor=element_blank(), legend.title=element_blank(), legend.position = 'bottom', axis.text.y = element_blank(), axis.ticks.y = element_blank(), axis.title.y = element_blank()) D <- ggplot(datD, aes(exp,sample,fill = time))+ geom_point(color = '#33746e',size = 2, shape = 21, stroke = 0.3,)+ theme_bw()+ scale_fill_gradient(low = '#d7e3e2',high = '#125d57')+ geom_vline(aes(xintercept=0.2), colour="#2e706b", linetype="dashed")+ xlab('D indicator\nindicator D')+ theme(panel.grid.major=element_blank(), panel.grid.minor=element_blank(), legend.title=element_blank(), legend.position = 'bottom', axis.text.y = element_blank(), axis.ticks.y = element_blank(), axis.title.y = element_blank()) ## 拼图 A|B|C|D ggsave('complex_scatter.pdf',width = 8,height = 6)
复现结果
简洁函数版
看完上个版本后想必大家也发现了我们很多代码都重复了4遍，这个时候就来写个函数简化一下把。
## 写个函数简化一下代码 plot_fun <- function(x, color,low_color,high_color,xlab) { ggplot(melt(x, varnames = c('time','sample'), value.name = 'exp'), aes(exp,sample,fill = time))+ geom_point(color = color,size = 2, shape = 21, stroke = 0.3,)+ theme_bw()+ scale_fill_gradient(low = low_color,high = high_color)+ geom_vline(aes(xintercept=0.5), colour= color, linetype="dashed")+ xlab(xlab)+ theme(panel.grid.major=element_blank(), panel.grid.minor=element_blank(), legend.title=element_blank(), legend.position = 'bottom') } ## 不显示y轴 remove_y <- theme( axis.text.y = element_blank(), axis.ticks.y = element_blank(), axis.title.y = element_blank() ) p <- list( plot_fun(testA, '#db99b7','#f4e3eb','#c04b81','A indicator\nindicator A'), plot_fun(testB, '#d6ab72','#f5ebdd','#c3842d','B indicator\nindicator B') + remove_y, plot_fun(testC, '#8f9ac0','#daddea','#162d7d','C indicator\nindicator C') + remove_y, plot_fun(testD, '#33746e','#d7e3e2','#125d57','D indicator\nindicator D') + remove_y ) wrap_plots(p, nrow = 1) ggsave('complex_scatter2.pdf',width = 8,height = 6)
复现结果2.0
❝❞
R毕竟只是一个工具，对于只画一次的图来说，能画出来就行，至于代码写的漂不漂亮倒是次要的。
