跟着Nature学作图：R语言ggplot2热图

论文

A saturated map of common genetic variants associated with human height

https://www.nature.com/articles/s41586-022-05275-y

s41586-022-05275-y.pdf

代码没有公开，但是作图数据基本都公开了，争取把每个图都重复一遍

今天的推文重复论文中的extended Figure8 热图

这里是三个热图，我们做三个图，然后将3个图拼接到一起

论文中提供的数据如下

作图的话需要对数据进行简单的整理，比如第一个图的数据

加载需要用到的R包

library(readxl)
library(tidyverse)
library(stringr)

第一个热图

dat01<-read_excel("data/20221014/extendFig8.xlsx",
                  sheet = "Sheet2")
p1<-dat01 %>% 
  pivot_longer(-y,names_to = "x") %>% 
  mutate(signif=case_when(
    value > 1.35 ~ "*",
    TRUE ~ ""
  ),
  value=round(value,2),
  x=str_replace(x,"\\(","\n"),
  x=str_replace(x,"\\)","")) %>% 
  ggplot(aes(x=x,y=y))+
  geom_tile(aes(fill=value))+
  scale_fill_gradient2(low="blue",
                       high = "red",
                       mid = "white",
                       midpoint=1,
                       name="")+
  scale_x_discrete(position = "top",
                   expand = expansion(mult = c(0,0)))+
  scale_y_discrete(expand = expansion(mult = c(0,0)))+
  labs(x=NULL,y="DEPICT")+
  geom_text(aes(label=paste0(value,signif)))+
  #guide_colorbar()
  guides(fill = guide_colourbar(barwidth = 0.5, 
                                barheight = 5,
                                ticks.colour = "black",
                                ticks.linewidth = 0.5,
                                frame.colour = "black"))
p1

后面两个图的代码是一样的，只需要换一下数据就可以了

dat02<-read_excel("data/20221014/extendFig8.xlsx",
                  sheet = "Sheet3")


p2<-dat02 %>% 
  pivot_longer(-y,names_to = "x") %>% 
  mutate(signif=case_when(
    value > 1.35 ~ "*",
    TRUE ~ ""
  ),
  value=round(value,2),
  x=str_replace(x,"\\(","\n"),
  x=str_replace(x,"\\)","")) %>% 
  ggplot(aes(x=x,y=y))+
  geom_tile(aes(fill=value))+
  scale_fill_gradient2(low="blue",
                       high = "red",
                       mid = "white",
                       midpoint=1,
                       name="")+
  scale_x_discrete(position = "top",
                   expand = expansion(mult = c(0,0)))+
  scale_y_discrete(expand = expansion(mult = c(0,0)))+
  theme(axis.text.x = element_blank(),
        axis.ticks.x = element_blank())+
  labs(x=NULL,y="MAGMA")+
  geom_text(aes(label=paste0(value,signif)))+
  #guide_colorbar()
  guides(fill = guide_colourbar(barwidth = 0.5, 
                                barheight = 10,
                                ticks.colour = "black",
                                ticks.linewidth = 0.5,
                                frame.colour = "black"))

p2

dat03<-read_excel("data/20221014/extendFig8.xlsx",
                  sheet = "Sheet4")


p3<-dat03 %>% 
  pivot_longer(-y,names_to = "x") %>% 
  mutate(signif=case_when(
    value > 1.35 ~ "*",
    TRUE ~ ""
  ),
  value=round(value,2),
  x=str_replace(x,"\\(","\n"),
  x=str_replace(x,"\\)","")) %>% 
  ggplot(aes(x=x,y=y))+
  geom_tile(aes(fill=value))+
  scale_fill_gradient2(low="blue",
                       high = "red",
                       mid = "white",
                       midpoint=1,
                       name="",
                       breaks=c(1,2))+
  scale_x_discrete(position = "top",
                   expand = expansion(mult = c(0,0)))+
  theme(axis.text.x = element_blank(),
        axis.ticks.x = element_blank())+
  scale_y_discrete(expand = expansion(mult = c(0,0)))+
  labs(x=NULL,y=NULL)+
  geom_text(aes(label=paste0(value,signif)))+
  #guide_colorbar()
  guides(fill = guide_colourbar(barwidth = 0.5, 
                                barheight = 1.5,
                                ticks.colour = "black",
                                ticks.linewidth = 0.5,
                                frame.colour = "black"))
p3

最后是拼图

library(patchwork)

p1/p2/p3 + 
  plot_layout(heights = c(7,7,1))

示例数据和代码可以给公众号推文点赞，点击在看，最后留言获取

欢迎大家关注我的公众号

小明的数据分析笔记本

小明的数据分析笔记本 公众号 主要分享：1、R语言和python做数据分析和数据可视化的简单小例子；2、园艺植物相关转录组学、基因组学、群体遗传学文献阅读笔记；3、生物信息学入门学习资料及自己的学习笔记！