最近有人在群里提问，下面的热图该怎么画。

这张热图，在每一个格子里面用对角线一分为二，呈现了两类信息。图片来自于这篇文章的图1D。

通常，遇到这种需求，我都会直接检索，看看有没有现成的R包可用。可以提取检索词检索一下，这里主要信息应该是"对角线 热图 R语言"，
查阅字典后，关键词就变成了英文，“diagonal heatmap r”。在浏览器中检索后得到以下结果。

然后有人给出了使用base plot画图的方案

d=data.frame(p1=rep(LETTERS[1:2],times=2,each=2),             p2=rep(LETTERS[4:5],times=4),             value=c(.2,.4,.56,.32,.7,.16,.12,.71),             group=rep(c("A1","B1"),each=4))

x=as.numeric(d$p1)y=as.numeric(d$p2)

plot(1,xlim=c(1,length(unique(x))+1),ylim=c(1,length(unique(y))+1),  type="n",bty="n",xaxt="n",yaxt="n",xlab="",ylab="")

for(i in 1:nrow(d)) {  if(d$group[i]=="A1") polygon(x[i]+c(0,1,1),y[i]+c(0,0,1),col=gray(d$value[i]))  if(d$group[i]=="B1") polygon(x[i]+c(0,1,0),y[i]+c(0,1,1),col=gray(d$value[i]))}

axis(1,at=sort(unique(x))+.5,labels=levels(d$p1),lty=0)axis(2,at=sort(unique(y))+.5,labels=levels(d$p2),lty=0)

复制到R语言后运行得到如下结果

这意味着，只要用基本功扎实，复现原图是没有问题的。
但是，我不会base plot，我只会用ggplot2, 检索了一圈也没有现成的解决方案，所以我就准备自己画。

自己画我就开始拆分这张图，一个热图的格子由上下两个三角形构成，我可以先画上三角形，再画下三角形，然后给他们分别配色就可以。

三角形可以通过geom_polygon来画。

## 下三角数据cone1 = data.frame(x = c(1,2,2),                   y = c(1,1,2))library(dplyr)library(ggplot2)## 下三角画图cone1 %>%   ggplot(aes(x=x, y=y)) +  geom_polygon(fill="#213c18")

上三角也是一样的

## 上三角数据cone2 = data.frame(x = c(1,1,2),                   y = c(1,2,2)) ## 上三角画图cone2 %>%   ggplot(aes(x=x, y=y)) +  geom_polygon(fill = "#668c6f")

通过叠加图层，我们可以把两个三角形放在一起，这就是热图的一个小格子

cone1 %>%   ggplot(aes(x=x, y=y)) +  geom_polygon(fill="#213c18")+  geom_polygon(data=cone2, fill = "#668c6f")

解决了基本的元素，我就可以批量产生数据。
下面写了一个函数，批量算出指定行列的三角形数据。

trianle function(a,b,type="up"){  ## 单个下三角数据的函数  trianle_down function(a,b){    data.frame(x=c(0,1,1)+a,               y= c(0,0,1)+b,               group=paste0(a,"_",b),               stringsAsFactors = F)  }  ## 单个上三角数据的函数  trianle_up function(a,b){    data.frame(x=c(0,0,1)+a,               y= c(0,1,1)+b,               group=paste0(a,"_",b),               stringsAsFactors = F)  }  ### 批量产生上三角的数据  if(type=="up"){    data do.call(rbind,lapply(1:b, function(i){      do.call(rbind,lapply(1:a,trianle_up,i))    }))  }  ### 批量产生下三角的数据  if(type=="down"){    data do.call(rbind,lapply(1:b, function(i){      do.call(rbind,lapply(1:a,trianle_down,i))    }))  }  return(data)}

因为我们的测试数据是33行，20列，所以用这个函数来产生对应个数的三角形

updata 33,20,"up")downdata 33,20,"down")

updata的数据是这样的，每一个框线里面都是一个三角形的数据

可以作图来测试一下上三角形

library(ggplot2)updata %>%   ggplot(aes(x=x, y=y)) +  geom_polygon(aes(group=group,fill=group))+  theme(legend.position = "none")

下三角也是一样的

downdata %>%   ggplot(aes(x=x, y=y)) +  geom_polygon(aes(group=group,fill=group))+  theme(legend.position = "none")

现在我比较安心了，只要调整原始数据的格式，然后把他跟三角形的数据匹配起来就行。匹配就依靠group那一列

读入第一个数据, 行是基因，列是癌症类型

dd table::fread("easy_input_amp.txt",data.table = F)

接下来宽数据变长

library(dplyr)library(tidyr)data1 %   ## 数据变长  pivot_longer(-1,               names_to = "type",               values_to = "exp") %>%   rename(gene=V1) 

现在的数据是这个样子的

如果想要改变未来热图基因的顺序，可以使用因子的水平来控制

data1$gene $gene,                     levels = c("ALKBH5","FTO",                                "HNRNPA2B1","HNRNPC", "IGF2BP1", "IGF2BP2","IGF2BP3","RBMX","YTHDC1","YTHDC2","YTHDF1","YTHDF2","YTHDF3",                                "METTL14","METTL3","RBM15","RBM15B","VIRMA","WTAP","ZC3H13"),                     ordered = F)

接下来就是给这个数据增加能够和三角形group匹配的列,
这一步的操作有trick，比如，因子转为数值，是需要先变成字符串再变成字符的，但是我们这里直接as.numeric可以获取他的levels数值

data1 %   mutate(a=as.numeric(as.factor(type)),         b=as.numeric(gene)) %>%   mutate(group = paste0(a,"_",b)) %>%   as.data.frame() %>%   inner_join(updata,by="group")

最终获取了完整的作图数据

有了数据，作图就很简单了

library(ggplot2)data1 %>%   ggplot(aes(x=x, y=y)) +  geom_polygon(aes(group=group,fill=exp))+  theme(legend.position = "none")

第二个数据也是同样的处理

dd "easy_input_del.txt",data.table = F)data2 %   pivot_longer(-1,               names_to = "type",               values_to = "del") %>%   rename(gene=V1)

data2$gene                      levels = c("ALKBH5","FTO",                                "HNRNPA2B1","HNRNPC", "IGF2BP1", "IGF2BP2","IGF2BP3","RBMX","YTHDC1","YTHDC2","YTHDF1","YTHDF2","YTHDF3",                                "METTL14","METTL3","RBM15","RBM15B","VIRMA","WTAP","ZC3H13"),                     ordered = F)data2 %   mutate(a=as.numeric(as.factor(type)),         b=as.numeric(as.factor(gene))) %>%   mutate(group = paste0(a,"_",b)) %>%   as.data.frame() %>%   inner_join(downdata,by="group")

data2 %>%   ggplot(aes(x=x, y=y)) +  geom_polygon(aes(group=group,fill=del))+  theme(legend.position = "none")

现在只要把两个图叠加在一起就行了，但是这里面有个问题。这两个图是分别用两个不同的变量来控制颜色的。
但是如果画在一起，ggplot2是不允许的，但是我记得Y叔发过的大部分帖子，我记得他曾经解决过这种情况，就去翻了一下。
答案在这个帖子里面
连续型和离散型数据一起画热图，外加分开配色和图例

这是我们常见的使用gheatmap做图的代码，为了实现不同数据类型的热图放在一起，让我们祭出ggnewscale包，只需要用new_scall_fill()，就可以把后面的fill映射和前面的分离开，然后我们就可以愉快地，再加一条gheatmap再画一个热图。

这样我的问题就完美解决了。
安装和加载 R包

options("repos"=c(CRAN="https://mirrors.tuna.tsinghua.edu.cn/CRAN/"))if(!require("ggnewscale")) install.packages("ggnewscale",update = F,ask = F)library(ggnewscale)

分别抽离出基因名称和亚型名称，用来加在图上

## x轴文字xlabels %   filter(y==1) %>%   distinct(type,.keep_all = T) %>%   arrange(x) %>%   pull(type)## y轴文字ylabels %   filter(x==1) %>%   distinct(gene,.keep_all = T) %>%   arrange(y) %>%   pull(gene) %>%   as.character()

指定三个颜色,来自小丫画图的144号作品

red  "#AB221F"blue "#3878C1"nake "#FFFADD"

画图开始

p1 <- ggplot(data1,aes(x=x, y=y)) +  ## 画出上三角geom_polygon(data = data1,aes(x=x, y=y, group=group,fill=exp),color="black") +  ## 上三角用表达值来配色scale_fill_gradientn(colours = c(nake,red)) +  ## 神技能，清空aesnew_scale_fill() +  ## 画出下三角geom_polygon(data = data2,aes(x=x, y=y, group=group,fill=del),color="black") +  ## 下三角用表达值来配色scale_fill_gradientn(colours = c(nake,blue))+  ## 调整x轴scale_x_continuous(limits = c(1, NA), expand = c(0,0),breaks = c(1:33)+0.5,labels=xlabels) +  ## 调整y轴scale_y_continuous(limits = c(1, NA), expand = c(0,0),breaks = c(1:20)+0.5,labels=ylabels) +  ## 定主题theme(axis.title.x=element_blank(),axis.title.y=element_blank(),axis.text.x = element_text(angle = 90, hjust = 1))+  ## legend置于底部theme(legend.position="bottom")+theme(plot.margin = margin(0.5,0.01,0.5,0.01, "cm"))p1

现在来画侧边的标识，也是自己设计四边形的数据就行了

data <- data.frame(x = rep(c(1,1,2,2),3),y = c(1,3,3,1,3,14,14,3,14,21,21,14),type= rep(c("Eraser","Reader","Writer"),each=4))p2 <- ggplot(data,aes(x=x, y=y)) +geom_polygon(aes(x=x, y=y, group=type,fill=type),color="black",alpha = 0.5)+scale_fill_manual(values = c(red,nake,blue))+  ## 打标签geom_text(data=data.frame(x=1.5,y=c(2,8.5,17.5)),aes(label=c("Eraser","Reader","Writer")),angle = 90,size=4)+scale_x_continuous(limits = c(1, NA), expand = c(0,0))+scale_y_continuous(limits = c(1, NA), expand = c(0,0)) +theme(axis.title=element_blank(),axis.text = element_blank(),axis.ticks = element_blank())+theme(legend.position="none")+theme(plot.margin = margin(0.5,0.1,0.5,0.01, "cm"))p2

现在我们用cowplot把他们拼接起来

library(cowplot)plot_grid(p1,p2,align = "h", axis = "tb",nrow = 1, rel_widths = c(33, 1))

如果用Y叔的新欢就更加简单
cowplot乃旧爱，patchwork是新欢

options("repos"=c(CRAN="https://mirrors.tuna.tsinghua.edu.cn/CRAN/"))if(!require("patchwork")) install.packages("patchwork",update = F,ask = F)library(patchwork)p1 + p2 +  plot_layout(widths = c(33, 1))

虽然解决了问题，但是我觉得还是不够优雅，我还在学习图层中。Y叔有一篇帖子是让我夜不能寐的
扪心自问，meme几何？
这一年多来，很多次都想去回答这里面的问题，但是次次无功而返。好在近期洲更给了初步的回答，
答: 扪心自问，meme几何？

洲更说他对于图层顿悟了，就跟我问Y叔，他给出的答案是一样的，顿悟。但是我还没有，我还在找寻属于我自己的答案。学习图层，对我个人而言并不是为了画图，我就那么点数据，以后的知识以及足够去呈现了，我只是想从高手的视角去看待作图这件事，就跟Y叔给我启发最大的话那样：

图就是数据，数据就是图。