跟着Nature学作图:R语言ggplot2频率分布直方图/堆积柱形图/散点图

论文

Graph pangenome captures missing heritability and empowers tomato breeding

https://www.nature.com/articles/s41586-022-04808-9#MOESM8

s41586-022-04808-9.pdf

没有找到论文里的作图的代码,但是找到了部分做图数据,我们可以用论文中提供的原始数据模仿出论文中的图

今天的推文重复一下论文中的 Figure3a Figure3b Figure3c 频率分布直方图,堆积柱形图,散点图

image.png

频率分布直方图代码

library(readxl)
fig3a<-read_excel("data/20220711/41586_2022_4808_MOESM7_ESM.xlsx",
                  sheet = "Fig3a",
                  skip = 1)
head(fig3a)
dim(fig3a)

library(ggplot2)
library(latex2exp)

ggplot(data=fig3a,aes(x=h2))+
  geom_histogram(aes(fill=type),
                 bins = 100)+
  scale_fill_manual(values = c("#d1edcd","#94c2db","#fdbeb8"),
                    label=c(TeX(r"(\textit{h}${^2}$ (all variants)        )"),
                            TeX(r"(\textit{h}${^2}$ (leading variants))"),
                            TeX(r"(\textit{h}${^2}$ (local variants)    )")),
                    name="")+
  theme_bw()+
  theme(panel.grid = element_blank(),
        legend.position = c(0.8,0.8))+
  scale_x_continuous(expand = expansion(mult = c(0,0)),
                     breaks = seq(0,1,0.2))+
  scale_y_continuous(expand = expansion(mult = c(0,0)))+
  labs(y="Counts",
       x=TeX(r"(\textit{h}${^2}$)"))+
  geom_vline(xintercept = 0.27,lty="dashed",color="#94c2db")+
  geom_vline(xintercept = 0.37,lty="dashed",color="#fdbeb8")+
  geom_vline(xintercept = 0.62,lty="dashed",color="#d1edcd") -> p1

x<-c(0.27,0.37,0.62)

for (i in 1:3){
  p1<-p1+
    annotate(geom = "text",x=x[i],y=80,label=x[i],hjust=0)
}
p1
image.png

堆积柱形图

fig3b<-read_excel("data/20220711/41586_2022_4808_MOESM7_ESM.xlsx",
                  sheet = "Fig3b")
head(fig3b)
dim(fig3b)

fig3b$var2<-factor(fig3b$var2,
                   levels = c("MLM","LASSO","Overlapping"))

library(tidyverse)
fig3b %>% 
  group_by(var1) %>% 
  summarise(y=stack.bar.label.position(value),
            y_label=value) %>% 
  ungroup() -> df.label


stack.bar.label.position<-function(x){
  x<-rev(x)
  new.x<-vector()
  
  for (i in 1:length(x)){
    if (i == 1){
      new.x<-append(new.x,x[i]/2)
    }
    
    else{
      new.x<-append(new.x,sum(x[1:i-1])+x[i]/2)
    }
  }
  return(new.x)
}


ggplot(data=fig3b,aes(x=var1,y=value))+
  geom_bar(stat="identity",
           position = "stack",
           aes(fill=var2))+
  scale_fill_manual(values = c("#5ba555","#2baae1","#c6dcf0"),
                    name="",
                    label=c("MLM unique (11)",
                            "LASSO unique (1,249)",
                            "Overlapping (538)"))+
  theme_classic()+
  theme(legend.position = c(0.8,0.8))+
  geom_text(data=df.label,
            aes(x=var1,y=y,label=y_label)) -> p2
p2
image.png

最后的散点图

fig3c<-read_excel("data/20220711/41586_2022_4808_MOESM7_ESM.xlsx",
                  sheet = "Fig3c",
                  skip = 1)
head(fig3c)
dim(fig3c)



ggplot(data=fig3c %>% filter(Type=="MLM"),
       aes(x=pos,y=-log10(pvalue)))+
  geom_point(aes(shape=Variant,color=Variant,size=Variant))+
  scale_color_manual(values = c("#868686","#b8275a"))+
  theme_classic()+
  scale_x_continuous(labels = function(x)
    {sprintf("%0.2f",x/1000000)})+
  labs(x="Chr3 (Mb)",
       y=TeX(r"(-log${_1}{_0}$$\left[$\textit{P}$\right]$)"))+
  geom_hline(yintercept = 6,lty="dashed")+
  ggtitle("MLM")+
  theme(legend.position = "none")+
  scale_y_continuous(limits = c(0,10),
                     breaks = c(0,5,10)) -> p3.1

ggplot(data=fig3c %>% filter(Type=="LASSO"),
       aes(x=pos,y=-log10(pvalue)))+
  geom_point(aes(shape=Variant,color=Variant),
             size=3)+
  scale_color_manual(values = c("#b8275a"))+
  scale_shape_manual(values = 17)+
  theme_classic()+
  scale_x_continuous(labels = function(x)
  {sprintf("%0.2f",x/1000000)},
  limits = c(42.90*1000000,43*1000000))+
  labs(x="Chr3 (Mb)",
       y=TeX(r"(-log${_1}{_0}$$\left[$\textit{P}$\right]$)"))+
  geom_hline(yintercept = 6,lty="dashed")+
  ggtitle("LASSO")+
  theme(legend.position = "none")+
  scale_y_continuous(breaks = c(0,5,10))+
  geom_text(aes(label=ID),hjust=1.2) -> p3.2
library(patchwork)
p3.1/p3.2
image.png

最终的拼图

p1+p2 + (p3.1/p3.2)
image.png

示例数据和代码可以自己到论文中获取,或者给本篇推文点赞,点击在看,然后留言获取

欢迎大家关注我的公众号

小明的数据分析笔记本

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

©著作权归作者所有,转载或内容合作请联系作者
  • 序言:七十年代末,一起剥皮案震惊了整个滨河市,随后出现的几起案子,更是在滨河造成了极大的恐慌,老刑警刘岩,带你破解...
    沈念sama阅读 212,332评论 6 493
  • 序言:滨河连续发生了三起死亡事件,死亡现场离奇诡异,居然都是意外死亡,警方通过查阅死者的电脑和手机,发现死者居然都...
    沈念sama阅读 90,508评论 3 385
  • 文/潘晓璐 我一进店门,熙熙楼的掌柜王于贵愁眉苦脸地迎上来,“玉大人,你说我怎么就摊上这事。” “怎么了?”我有些...
    开封第一讲书人阅读 157,812评论 0 348
  • 文/不坏的土叔 我叫张陵,是天一观的道长。 经常有香客问我,道长,这世上最难降的妖魔是什么? 我笑而不...
    开封第一讲书人阅读 56,607评论 1 284
  • 正文 为了忘掉前任,我火速办了婚礼,结果婚礼上,老公的妹妹穿的比我还像新娘。我一直安慰自己,他们只是感情好,可当我...
    茶点故事阅读 65,728评论 6 386
  • 文/花漫 我一把揭开白布。 她就那样静静地躺着,像睡着了一般。 火红的嫁衣衬着肌肤如雪。 梳的纹丝不乱的头发上,一...
    开封第一讲书人阅读 49,919评论 1 290
  • 那天,我揣着相机与录音,去河边找鬼。 笑死,一个胖子当着我的面吹牛,可吹牛的内容都是我干的。 我是一名探鬼主播,决...
    沈念sama阅读 39,071评论 3 410
  • 文/苍兰香墨 我猛地睁开眼,长吁一口气:“原来是场噩梦啊……” “哼!你这毒妇竟也来了?” 一声冷哼从身侧响起,我...
    开封第一讲书人阅读 37,802评论 0 268
  • 序言:老挝万荣一对情侣失踪,失踪者是张志新(化名)和其女友刘颖,没想到半个月后,有当地人在树林里发现了一具尸体,经...
    沈念sama阅读 44,256评论 1 303
  • 正文 独居荒郊野岭守林人离奇死亡,尸身上长有42处带血的脓包…… 初始之章·张勋 以下内容为张勋视角 年9月15日...
    茶点故事阅读 36,576评论 2 327
  • 正文 我和宋清朗相恋三年,在试婚纱的时候发现自己被绿了。 大学时的朋友给我发了我未婚夫和他白月光在一起吃饭的照片。...
    茶点故事阅读 38,712评论 1 341
  • 序言:一个原本活蹦乱跳的男人离奇死亡,死状恐怖,灵堂内的尸体忽然破棺而出,到底是诈尸还是另有隐情,我是刑警宁泽,带...
    沈念sama阅读 34,389评论 4 332
  • 正文 年R本政府宣布,位于F岛的核电站,受9级特大地震影响,放射性物质发生泄漏。R本人自食恶果不足惜,却给世界环境...
    茶点故事阅读 40,032评论 3 316
  • 文/蒙蒙 一、第九天 我趴在偏房一处隐蔽的房顶上张望。 院中可真热闹,春花似锦、人声如沸。这庄子的主人今日做“春日...
    开封第一讲书人阅读 30,798评论 0 21
  • 文/苍兰香墨 我抬头看了看天上的太阳。三九已至,却和暖如春,着一层夹袄步出监牢的瞬间,已是汗流浃背。 一阵脚步声响...
    开封第一讲书人阅读 32,026评论 1 266
  • 我被黑心中介骗来泰国打工, 没想到刚下飞机就差点儿被人妖公主榨干…… 1. 我叫王不留,地道东北人。 一个月前我还...
    沈念sama阅读 46,473评论 2 360
  • 正文 我出身青楼,却偏偏与公主长得像,于是被迫代替她去往敌国和亲。 传闻我的和亲对象是个残疾皇子,可洞房花烛夜当晚...
    茶点故事阅读 43,606评论 2 350

推荐阅读更多精彩内容