zl程序教程

您现在的位置是:首页 >  其他

当前栏目

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

2023-02-19 12:27:49 时间

论文

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 热图

image.png

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

论文中提供的数据如下

image.png

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

image.png

加载需要用到的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

image.png

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

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))