ixxmu
commented
1 year ago 跟着Nature作图 -- 批量箱线图+多组间显著性检验 by Biomamba 生信基地
❝已经付费加群的小伙伴无需二次付费，等待师兄后续更新即可！
❞
从这个系列开始，师兄就带着大家从各大顶级期刊中的Figuer入手，从仿照别人的作图风格到最后实现自己游刃有余的套用在自己的分析数据上！这一系列绝对是高质量！还不赶紧「点赞+在看」，学起来！
❝本期分享的是期刊：「Nature（IF = 69.5）」上面一篇文章中的一个「批量箱线图+多组间显著性检验」！
本系列所有代码和示例数据将会和生信常用图形系列绘图放在一起，扫描下方二维码添加师兄微信，「付费179元（随着群内绘图资源的增加，入群费用也会随之增加，1群￥99 -- 已满，2群￥149 -- 已满，3群￥169 -- 已满）」，即可加入生信绘图交流群。「群内不仅提供生信常用图形系列的代码，还会提供本系列后续所有Figure的实例数据和代码，我会在文章更新后第一时间上传。」
❞
❝当然了！如果你还想白嫖，师兄的文章中代码已经写的很清楚了！但是师兄还是希望你点个赞再走呗！
「优惠方式：点赞+在看，并转发这两个系列任意一篇文章至朋友圈，集赞30个，即可享受￥149入群！」
❞
话不多说，直接上图！
读图
效果展示
❝本期图形完全使用
ggplot2包实现，可以看到绝大部分的细节都被完美还原！这张图的难点在于显著性的的添加上，如何在一个箱线图上，添加分别与多组比较的显著性！这需要一定的编程能力，值得大家仔细探究。当然，本教程不代表最优结果，如果各位有更好地实现方式，欢迎与师兄交流沟通！
制作不易，欢迎大家看完给个「免费的赞和在看！」让更多的小伙伴看见我们的教程吧！
❞
绘图群附加福利
凡是「已经加群」的小伙伴，你们在看文献的时候如果看到好看的Figure，可以发到群里！师兄会及时关注的，「如果被师兄选中，就会在推文中更新！」
本期图形也是来源于群员推荐哦！
凡是「已经加群」的小伙伴，你们在看文献的时候如果看到好看的Figure，可以发到群里！师兄会及时关注的，「如果被师兄选中，就会在推文中更新！」
Figure的要求如下（被选中的前提）：
首先肯定是要符合大众审美的，在图形样式上要过关。 新颖独特，有与常见图形不一样的地方。 有一定难度，太简单的大家都会做，没什么挑战性哈！
往期选中案例
R包载入、数据构建和整理
library(tidyverse)
library(ggpubr)
library(ggsignif)
library(rstatix)
# 构造模拟数据：
data <- data.frame(
TIME_IA = runif(10, min = 0.05, max = 0.4),
TIME_ISM = runif(10, min = -0.2, max = 0.1),
TIME_ISS = runif(10, min = 0.1, max = 0.5),
TIME_IE = runif(10, min = -0.25, max = 0.2),
TIME_IR = runif(10, min = 0.2, max = 0.6)
)
# 长宽数据转换：
data_long <- pivot_longer(data, cols = everything(),
names_to = "group", values_to = "Score")
data_long$group <- factor(data_long$group, levels = colnames(data))
# 计算显著性：
# 批量t检验：
stat.test <- data_long %>%
wilcox_test(
Score ~ group,
p.adjust.method = "bonferroni"
)
单独绘图
# 绘图：
colors <- c('#eb4b3a', "#48bad0", "#1a9781",
"#355783", "#ef9a80")
p <- ggplot(data_long)+
# 箱线图：
geom_boxplot(aes(group, Score, color = group))+
# 抖动散点：
geom_jitter(aes(group, Score, color = group), width = 0.01)+
# 颜色模式：
scale_color_manual(values = c('#eb4b3a', "#48bad0", "#1a9781",
"#355783", "#ef9a80"))+
xlab("")+
# 主题：
theme_classic()+
theme(legend.position = "none",
# x轴字体、颜色、角度调整：
axis.text.x = element_text(angle = 90, vjust = 0.5, face = "bold",
color = colors))
# 根据显著性检验结果，添加显著性标记：
x_value <- rep(1:4, 4:1)
y_value <- rep(apply(data, 2, max)[1:4], 4:1) + 0.01
y_value <- y_value + c(0.03*1:4, 0.03*1:3, 0.03*1:2, 0.03)
color_value <- c(colors[2:5], colors[3:5], colors[4:5], colors[5])
for (i in 1:nrow(stat.test)) {
if (stat.test$p.adj.signif[i] != "ns") {
y_tmp <- y_value[i]
p <- p+annotate(geom = "text",
label = stat.test$p.adj.signif[i],
x = x_value[i],
y = y_tmp,
color = color_value[i])
}
}
p
ggsave("single_plot.pdf", height = 4, width = 4)
批量作图
# 循环绘制多图：
p_list <- list()
for (j in 1:6) {
# 构造模拟数据：
data <- data.frame(
TIME_IA = runif(10, min = 0.05, max = 0.4),
TIME_ISM = runif(10, min = -0.2, max = 0.1),
TIME_ISS = runif(10, min = 0.1, max = 0.5),
TIME_IE = runif(10, min = -0.25, max = 0.2),
TIME_IR = runif(10, min = 0.2, max = 0.6)
)
# 长宽数据转换：
data_long <- pivot_longer(data, cols = everything(),
names_to = "group", values_to = "Score")
data_long$group <- factor(data_long$group, levels = colnames(data))
# 计算显著性：
# 批量t检验：
stat.test <- data_long %>%
wilcox_test(
Score ~ group,
p.adjust.method = "bonferroni"
)
# 绘图：
colors <- c('#eb4b3a', "#48bad0", "#1a9781",
"#355783", "#ef9a80")
p <- ggplot(data_long)+
# 箱线图：
geom_boxplot(aes(group, Score, color = group))+
# 抖动散点：
geom_jitter(aes(group, Score, color = group), width = 0.01)+
# 颜色模式：
scale_color_manual(values = c('#eb4b3a', "#48bad0", "#1a9781",
"#355783", "#ef9a80"))+
xlab("")+
# 主题：
theme_classic()+
theme(legend.position = "none",
# x轴字体、颜色、角度调整：
axis.text.x = element_text(angle = 90, vjust = 0.5, face = "bold",
color = colors))
# 根据显著性检验结果，添加显著性标记：
x_value <- rep(1:4, 4:1)
y_value <- rep(apply(data, 2, max)[1:4], 4:1) + 0.01
y_value <- y_value + c(0.03*1:4, 0.03*1:3, 0.03*1:2, 0.03)
color_value <- c(colors[2:5], colors[3:5], colors[4:5], colors[5])
for (i in 1:nrow(stat.test)) {
if (stat.test$p.adj.signif[i] != "ns") {
y_tmp <- y_value[i]
p <- p+annotate(geom = "text",
label = stat.test$p.adj.signif[i],
x = x_value[i],
y = y_tmp,
color = color_value[i])
}
}
p_list[[j]] <- p
}
library(cowplot)
plot_grid(plotlist = p_list, ncol = 3)
ggsave("all_plot.pdf", height = 5.5, width = 9)
往期优秀图形目录
❝以上内容仅为群内部分内容，不代表全部。详细目录请看下方列表！已经入群的小伙伴，无需付费购买推文，群内都会及时更新！
❞
示例数据和代码获取
❝本系列所有代码和示例数据将会和生信常用图形系列绘图放在一起，公众号右下角添加师兄微信，「付费179元」，即可加入生信绘图交流群。「群内不仅提供生信常用图形系列的代码，还会提供本系列后续所有Figure的实例数据和代码，我会在文章更新后第一时间上传。」
当然了！如果你还想白嫖，师兄的文章中代码已经写的很清楚了！但是师兄还是希望你点个赞再走呗！
以上就是本期的全部内容啦！「欢迎点赞，点在看！」师兄会尽快更新哦！制作不易，你的打赏将成为师兄继续更新的十足动力！
「优惠方式：点赞+在看，并转发这两个系列任意一篇文章至朋友圈，集赞30个，即可享受￥149入群！」
❞
https://mp.weixin.qq.com/s/5-WIchpmhrtt26n1jFFnLQ