zl程序教程

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

当前栏目

跟着Nature学作图:R语言ggplot2散点图和柱形图完整示例(Extended Fig3)

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

论文

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 Figure3

image.png

散点图的部分示例数据

image.png

作图代码

library(readxl)
dat01<-read_excel("extendFig3.xlsx",
                  sheet = "Panel a")
colnames(dat01)<-c("X","Y")
head(dat01)
library(tidyverse)
dat01 %>% 
  mutate(group.info=
           case_when(
             X > 0.8 & Y > 3 ~ "A",
             X > 0.8 & Y < 3 ~ "B",
             TRUE ~ "D"
           )) -> new.dat01

library(ggplot2)
library(ggh4x)
library(latex2exp)
p1<-ggplot(data=new.dat01,aes(x=X,y=Y))+
  geom_point(aes(color=group.info),
             size=3,
             show.legend = FALSE)+
  scale_color_manual(values = c("A"="#83ee81",
                                "B"="#fe6c55",
                                "D"="black"))+
  geom_point(data=new.dat01 %>% filter(group.info!="D"),
             size=1.5)+
  theme_classic()+
  scale_y_continuous(breaks = c(0,3,10,20,30))+
  scale_x_continuous(breaks = seq(0,1,by=0.2))+
  geom_vline(xintercept = 0.8,color="red",
             lty="dashed")+
  geom_hline(yintercept = 3,color="red",
             lty="dashed")+
  guides(x=guide_axis_truncated(trunc_lower = 0,
                                trunc_upper = 1),
         y=guide_axis_truncated(trunc_lower = 0,
                                trunc_upper = 30))+
  labs(x="Expected Sttistical Power for Replication",
       y=TeX(r"(-log${_1}{_0}$\times sign(\beta$_{DISCOVERY}$)\times sign(\beta$_{REPLICATION}$))"))

p1

image.png

柱形图的示例数据

image.png

作图代码

dat02<-read_excel("extendFig3.xlsx",
                  sheet = "Panel b",
                  skip = 1)
dat02 %>% 
  mutate(newCol=letters[1:7]) -> new.dat02
colnames(new.dat02)

ggplot(data=data.frame(x=c("A","B"),
                       y=10),
       aes(x=x,y=y))+
  geom_col(aes(fill=x))+
  scale_fill_manual(values = c("A"="#02178c",
                               "B"="#dba425"),
                    labels=c("A"="Observed",
                             "B"="Expected"))+
  theme(legend.title = element_blank()) -> p2.legend

p2<-ggplot(data=new.dat02,aes(x=newCol,y=Observed))+
  geom_col(fill="#02178c")+
  geom_errorbar(aes(ymin=Observed-`Standard Error of Observed proportion`,
                    ymax=Observed+`Standard Error of Observed proportion`),
                color="#ff6c57",
                width=0.2)+
  geom_segment(aes(x=c(1:7)-0.4,xend=c(1:7)+0.4,
                   y=Expected,yend=Expected),
               color="#daa421")+
  theme_classic()+
  scale_y_continuous(expand = expansion(mult = c(0,0)),
                     breaks = c(0,0.27,0.54,0.8),
                     labels = c("50%","60%","70%","80%"))+
  scale_x_discrete(labels=new.dat02$`Minor Allele Frequency Class`)+
  theme(axis.line.x = element_blank(),
        axis.ticks.x = element_blank(),
        axis.text.x = element_text(angle=90,hjust=1))+
  labs(x="MAF range in Estonian Biobank (EBB)",
       y="Proportion of SNPs with sign-consistent effect\nsizes between discovery and replication")
p2
p2+theme(plot.margin = unit(c(1.5,0.1,0.1,0.1),'cm'))+
  annotation_custom(grob = ggpubr::get_legend(p2.legend),
                    xmin = 1.5,xmax = 1.5,
                    ymin = 0.9,ymax=0.9) -> p2.1
p2.1

image.png

最后是拼图

library(patchwork)

p1+p2.1