跟着Nature学作图:R语言ggplot2散点栅格化能够减小输出pdf的文件大小

论文

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

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

今天的推文重复论文中的Figure1

代码

setwd("data/20221014")
library(readxl)
fig1<-read_excel("Figure1.xlsx")
colnames(fig1)

library(tidyverse)
library(stringr)

str_replace_all("[0,5e-100]","\\(|5e-|\\]|\\[","") %>% 
  str_split_fixed(",",n=2) %>% 
  as.data.frame() %>% 
  pull(V1) %>% as.numeric()
str_replace_all("[0,5e-100]","\\(|5e-|\\]|\\[","") %>% 
  str_split_fixed(",",n=2) %>% 
  as.data.frame() %>% 
  pull(V2) %>% as.numeric()
fig1 %>% 
  mutate(max_value=str_replace_all(`P-value Caregory`,"\\(|5e-|\\]|\\[","") %>% 
           str_split_fixed(",",n=2) %>% 
           as.data.frame() %>% 
           pull(V1) %>% as.numeric(),
         min_value=str_replace_all(`P-value Caregory`,"\\(|5e-|\\]|\\[","") %>% 
           str_split_fixed(",",n=2) %>% 
           as.data.frame() %>% 
           pull(V2) %>% as.numeric()) %>% 
  mutate(group=case_when(
    min_value == 100 & max_value == 0  ~ "group01",
    min_value == 50 & max_value == 100 ~ "group02",
    min_value == 20 & max_value == 50 ~ "group03",
    min_value == 10 & max_value == 20 ~ "group04",
    min_value == 8 & max_value == 10 ~ "group05",
  )) -> new.fig1

table(new.fig1$group)

library(ggplot2)
library(ggh4x)
library(cowplot)

ggplot(data=new.fig1,
       aes(x=`Minor Allele Frequency`,
           y=`Join Effect of Minor Allele`,
           color=group))+
  geom_point( key_glyph = rectangle_key_glyph(color=color,
                                              fill=color,
                                              padding = margin(3, 3, 3, 3)))+
  scale_color_manual(values = c("group01"="#ee82ee",
                                "group02"="#2e8b57",
                                "group03"="#1e90ff",
                                "group04"="#daa520",
                                "group05"="#cdc673"),
                     name="",
                     labels=c("group01"="P < 5 × 10–100 (672 SNPs)",
                              "group02"="5 × 10–50 > P > 5 × 10–100 (1,110 SNPs)",
                              "group03"="5 × 10–20 > P > 5 × 10–50 (3,513 SNPs)",
                              "group04"="5 × 10–10 > P > 5 × 10–20 (5,192 SNPs)",
                              "group05"="5 × 10–8 > P > 5 × 10–10 (1,624 SNPs)"))+
  theme_bw()+
  theme(panel.grid = element_blank(),
        panel.border = element_blank(),
        axis.line = element_line(),
        legend.position = c(0.7,0.8))+
  scale_x_continuous(breaks = c(0.01,0.05,0.1,0.2,0.3,0.4,0.5),
                     labels = c(1,5,10,20,30,40,50))+
  scale_y_continuous(breaks = c(-0.3,-0.2,-0.1,0,0.1,0.2,0.3),
                     limits = c(-0.3,0.3))+
  guides(x=guide_axis_truncated(trunc_lower = 0.01,
                            trunc_upper = 0.5),
         y=guide_axis_truncated(trunc_lower = -0.3,
                                trunc_upper = 0.3))+
  labs(x="MAF (%) in cross-ancestry meta-analysis",
       y="Joint effect sizes (s.d.) of minor alleles\nin cross-ancestry meta-analysis")+
  geom_hline(yintercept = 0,color="gray")+
  geom_smooth(data = new.fig1 %>% 
                filter(group=="group01") %>%
                filter(`Join Effect of Minor Allele`<0),
              aes(x=`Minor Allele Frequency`,
                  y=`Join Effect of Minor Allele`),
              method = 'loess',
              formula = 'y~x',
              se=FALSE,color="gray",
              show.legend = FALSE)+
  geom_smooth(data = new.fig1 %>% 
                filter(group=="group01") %>%
                filter(`Join Effect of Minor Allele`>0),
              aes(x=`Minor Allele Frequency`,
                  y=`Join Effect of Minor Allele`),
              method = 'loess',
              formula = 'y~x',
              se=FALSE,color="gray",
              show.legend = FALSE)
image.png

关于曲线不太清楚是用什么数据做的,这里直接自动添加拟合曲线

图例里的文本上下标 出图后再编辑吧

关于散点图今天还新学到一个知识点是:散点图的点如果非常多,如果输出pdf文件的话,pdf文件会非常大,比如GWAS里常用的曼哈顿图,这个pdf文件如果非常大后续如果想要编辑这个pdf文件会比较麻烦。

关于如何解决这个问题,看到一个讨论群里有人讨论,他们提到一个办法是可以把散点栅格化 (栅格化是什么意思暂时不太明白)可以借助R包ggrastr

对应的github主页是

https://github.com/VPetukhov/ggrastr

正好我们今天的推文内容是数据量比较多的散点图,我们可以按照这个做法试试,这里参考微信公众号推文 https://mp.weixin.qq.com/s/ou0cjD8dLMNaDLk588KSwQ

安装ggrastr这个R包

install.packages('ggrastr')

如果要把点栅格化,只需要把对应的散点图函数geom_point()换成geom_point_rast()

library(ggrastr)
p2<-ggplot(data=new.fig1,
           aes(x=`Minor Allele Frequency`,
               y=`Join Effect of Minor Allele`,
               color=group))+
  geom_point_rast( key_glyph = rectangle_key_glyph(color=color,
                                              fill=color,
                                              padding = margin(3, 3, 3, 3)),
                   size=0.1,
                   raster.dpi = getOption("ggrastr.default.dpi", 300))+
  scale_color_manual(values = c("group01"="#ee82ee",
                                "group02"="#2e8b57",
                                "group03"="#1e90ff",
                                "group04"="#daa520",
                                "group05"="#cdc673"),
                     name="",
                     labels=c("group01"="P < 5 × 10–100 (672 SNPs)$)",
                              "group02"="5 × 10–50 > P > 5 × 10–100 (1,110 SNPs)",
                              "group03"="5 × 10–20 > P > 5 × 10–50 (3,513 SNPs)",
                              "group04"="5 × 10–10 > P > 5 × 10–20 (5,192 SNPs)",
                              "group05"="5 × 10–8 > P > 5 × 10–10 (1,624 SNPs)"))+
  theme_bw()+
  theme(panel.grid = element_blank(),
        panel.border = element_blank(),
        axis.line = element_line(),
        legend.position = c(0.7,0.8))+
  scale_x_continuous(breaks = c(0.01,0.05,0.1,0.2,0.3,0.4,0.5),
                     labels = c(1,5,10,20,30,40,50))+
  scale_y_continuous(breaks = c(-0.3,-0.2,-0.1,0,0.1,0.2,0.3),
                     limits = c(-0.3,0.3))+
  guides(x=guide_axis_truncated(trunc_lower = 0.01,
                                trunc_upper = 0.5),
         y=guide_axis_truncated(trunc_lower = -0.3,
                                trunc_upper = 0.3))+
  labs(x="MAF (%) in cross-ancestry meta-analysis",
       y="Joint effect sizes (s.d.) of minor alleles\nin cross-ancestry meta-analysis")+
  geom_hline(yintercept = 0,color="gray")+
  geom_smooth(data = new.fig1 %>% 
                filter(group=="group01") %>%
                filter(`Join Effect of Minor Allele`<0),
              aes(x=`Minor Allele Frequency`,
                  y=`Join Effect of Minor Allele`),
              method = 'loess',
              formula = 'y~x',
              se=FALSE,color="gray",
              show.legend = FALSE)+
  geom_smooth(data = new.fig1 %>% 
                filter(group=="group01") %>%
                filter(`Join Effect of Minor Allele`>0),
              aes(x=`Minor Allele Frequency`,
                  y=`Join Effect of Minor Allele`),
              method = 'loess',
              formula = 'y~x',
              se=FALSE,color="gray",
              show.legend = FALSE)

pdf("p1.pdf",width = 6,height = 6)
p1
dev.off()


pdf("p2.pdf",width = 6,height = 6)
p2
dev.off()

输出的p2如果放大 点是会变模糊的

image.png

两个文件的大小也不一样,栅格化之前是700k,栅格化之后只有200k

image.png

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

欢迎大家关注我的公众号

小明的数据分析笔记本

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

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

推荐阅读更多精彩内容