如何用ggplot2实现一幅叫不上来名字的图

在论文里看到了一张图如下：

最近可能会用到，就琢磨了一下如何实现。不知道这种图叫什么名字，没办法搜索。但是感觉R语言里应该有现成的包来做这幅图。这幅图和ggplot2做的热图有点像。试着用ggplot2来实现这张图。通常用ggplot2做热图会用geom_tile()函数

参考 https://www.r-bloggers.com/how-to-make-a-simple-heatmap-in-ggplot2/构造数据集

df<-expand.grid(teams=paste0("Team",LETTERS[1:4]),
               metrics=paste0("Metric",1:4))
df$performance<-rnorm(nrow(df))
head(df)

library(ggplot2)
ggplot(data=df,aes(x=teams,y=metrics))+
 geom_tile(aes(fill=performance))+
 theme_bw()+
 scale_fill_continuous(low="red",high="blue")

 

这里遇到的问题是：如何实现Metric4，3，2，1添加不同的颜色，比如Metric4是红蓝渐变色，Metric3我想填充黄绿渐变色。

想到一个解决办法是将Metric4，3，2，1 分成四份数据集，分别使用geom_tile()函数作图，然后在将图拼接起来。

df1<-data.frame(A=paste("var",1:100),
               B=rep("TeamA",100),
               D=sample(c("Yes","No"),100,replace = T))
head(df1)
p1<-ggplot(df1,aes(x=A,y=B))+
 geom_tile(aes(fill=D))+
 scale_y_discrete(expand = c(0,0))+
 labs(x="",y="")+theme_bw()+
 scale_fill_manual(values = c("purple","grey"))
p1

接下来调整图片的一些细节：去掉x轴的文字标签；去掉x轴和y轴的小短线；去掉边框

p1<-ggplot(df1,aes(x=A,y=B))+
 geom_tile(aes(fill=D))+
 scale_y_discrete(expand = c(0,0))+
 labs(x="",y="")+theme_bw()+
 scale_fill_manual(values = c("purple","grey"))+
 theme(axis.text.x = element_blank(),
       axis.ticks = element_blank(),
       panel.border = element_blank())
p1

 

接下来同样的思路再做2幅，然后使用cowplot包的plot_grid()函数将图片拼起来

df2<-data.frame(A=paste("var",1:100),
               B=rep("TeamA",100),
               D=sample(c("Yes","No"),100,replace = T))
p2<-ggplot(df2,aes(x=A,y=B))+
 geom_tile(aes(fill=D))+
 scale_y_discrete(expand = c(0,0))+
 labs(x="",y="")+theme_bw()+
 scale_fill_manual(values = c("red","grey"))+
 theme(axis.text.x = element_blank(),
       axis.ticks = element_blank(),
       panel.border = element_blank())
df3<-data.frame(A=paste("var",1:100),
               B=rep("TeamA",100),
               D=sample(c("Yes","No"),100,replace = T))
p3<-ggplot(df3,aes(x=A,y=B))+
 geom_tile(aes(fill=D))+
 scale_y_discrete(expand = c(0,0))+
 labs(x="",y="")+theme_bw()+
 scale_fill_manual(values = c("green","grey"))+
 theme(axis.text.x = element_blank(),
       axis.ticks = element_blank(),
       panel.border = element_blank())

 

找到了 https://github.com/wilkelab/cowplot/issues/31可以使用 plot.margin = unit(c(0,0,0,0),'cm')加到主题theme()设置里

p1.1<-p1+theme(plot.margin = unit(c(0,0,0,0),'cm'))
p2.1<-p2+theme(plot.margin = unit(c(0,0,0,0),'cm'))
p3.1<-p3+theme(plot.margin = unit(c(0,0,0,0),'cm'))
plot_grid(p1.1,p2.1,p3.1,ncol = 1)

 

变化不是太大。看看 https://github.com/wilkelab/cowplot/issues/31这篇文章发现theme(plot.margin = unit(c(0,0,0,0),'cm'))里面的数值可以设置为负数

p1.2<-p1+theme(plot.margin = unit(c(-0.5,-0.5,-0.5,-0.5),'cm'))
p2.2<-p2+theme(plot.margin = unit(c(-0.5,-0.5,-0.5,-0.5),'cm'))
p3.2<-p3+theme(plot.margin = unit(c(-0.5,-0.5,-0.5,-0.5),'cm'))
plot_grid(p1.2,p2.2,p3.2,ncol = 1)

 

这样三幅图就挨到一起去了。每个单独的小图有些高，可以输出图片时压缩整体的高

p1.2<-p1+theme(plot.margin = unit(c(0,-0.3,-0.3,-0.3),'cm'))
p2.2<-p2+theme(plot.margin = unit(c(-0.3,-0.3,-0.3,-0.3),'cm'))
p3.2<-p3+theme(plot.margin = unit(c(-0.3,-0.3,-0.3,-0.3),'cm'))
png("Rplot18.png",height = 120)
plot_grid(p1.2,p2.2,p3.2,ncol = 1)
dev.off()

图例有些被盖住和，可以改变图例的大小

p1.3<-p1+theme(plot.margin = unit(c(0,-0.3,-0.3,-0.3),'cm'),
              legend.key.size = unit(0.2,'cm'),
              legend.title=element_text(size=3),
              legend.text=element_text(size=2))
p2.3<-p2+theme(plot.margin = unit(c(-0.3,-0.3,-0.3,-0.3),'cm'),
              legend.key.size = unit(0.2,'cm'),
              legend.title=element_text(size=3),
              legend.text=element_text(size=2))
p3.3<-p3+theme(plot.margin = unit(c(-0.3,-0.3,-0.3,-0.3),'cm'),
              legend.key.size = unit(0.2,'cm'),
              legend.title=element_text(size=3),
              legend.text=element_text(size=2))
png("Rplot19.png",height = 120)
plot_grid(p1.3,p2.3,p3.3,ncol = 1)
dev.off()
#修改图例大小还可以用
       legend.key.height = unit(0.2,'cm'),
       legend.key.width = unit(0.2,'cm')
#还有一个小知识点是：plot.margin = unit(c(-0.3,-0.3,-0.3,-0.3)四个数字控制的位置分别是上右下左