写在前面
【这图怎么画】系列的图都来自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")
本期图片
❝Title:The heterogeneous role of energy policies in the energy transition of Asia–Pacific emerging economies
期刊:Nature Energy
Doi:https://doi.org/10.1038/s41560-022-01029-2
❞
这是一幅对不同地区不同时间的各个指标值大小的展示。我们也可以用来展示不同基因不同时间在各个分组的表达情况。
复现结果
示例数据和代码领取
绘图
简单重复代码版
# 示例数据建立
## 检验指标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)
❝❞
R
毕竟只是一个工具,对于只画一次的图来说,能画出来就行,至于代码写的漂不漂亮倒是次要的。