在仙桃學(xué)術(shù)上的生信工具里面，有一個(gè)折線圖的繪圖工具，可以很快速便捷的得出結(jié)論并可視化結(jié)果，當(dāng)然不是說這個(gè)功能有多強(qiáng)大，而是統(tǒng)計(jì)學(xué)方法非常專業(yè)。
比如用它自帶的數(shù)據(jù)https://bioinfomatics.xiantao.love/biotools/data/demo/free/linePlot/%E6%8A%98%E7%BA%BF%E5%9B%BE.xlsx
通過無(wú)腦式的鼠標(biāo)點(diǎn)擊，可得到下面一系列的結(jié)果。

折線圖

比如統(tǒng)計(jì)描述

又比如異常值分析、正態(tài)性檢驗(yàn)(Shapiro-Wilk normality test)、方差齊性檢驗(yàn)(Levene's test)、協(xié)方差同質(zhì)假設(shè)(Homogeneity of covariances assumption/Box’s M-test)、球形假設(shè)(Mauchly's Test for Sphericity)、兩因素單向重復(fù)測(cè)量數(shù)據(jù)方差分析（Two-way mixed ANOVA）、單獨(dú)效應(yīng)分析(Simple effect)、多重成對(duì)比較(Pairwise Comparisons of Estimated Marginal Means)等等專業(yè)術(shù)語(yǔ)，并且還給了詳細(xì)的統(tǒng)計(jì)學(xué)結(jié)果。

image.png

image.png

image.png

這種統(tǒng)計(jì)學(xué)結(jié)果讓大家很欣慰，那么這些結(jié)果都是如何計(jì)算出來的呢？？？

我們可以點(diǎn)開demo.R這個(gè)結(jié)果，讀一讀代碼
https://bioinfomatics.xiantao.love/biotools/code/open/lineplot.R

現(xiàn)在我們復(fù)現(xiàn)一下：

加載需要的包并導(dǎo)入數(shù)據(jù)

library(ggplot2)
library(reshape2)
library(car)
library(rstatix)
## 導(dǎo)入數(shù)據(jù)，比如我們把下載的折線圖數(shù)據(jù)保存在桌面
library(readxl)
data <- read_excel("~/Desktop/折線圖.xlsx") ## mac系統(tǒng)代碼
data # 顯示結(jié)果

新增一列id，id即為數(shù)字，用于后續(xù)分析，必不可少

data$id <- 1:nrow(data)

將短數(shù)據(jù)轉(zhuǎn)換為長(zhǎng)數(shù)據(jù)

data2 <- gather(data, key = "x", value = "value", -trt, -id)

對(duì)各組進(jìn)行統(tǒng)計(jì)學(xué)描述

data3 <- data2 %>% 
  group_by(trt, x) %>% 
  get_summary_stats(value)

批量運(yùn)行正態(tài)性檢驗(yàn)（Shapiro-Wilk normality test）

for(i in unique(data[,1])){
  data1 <- data[data[,1] == i,]
  print(lapply(data1[,-1], function(x) shapiro.test(x)))
}

$Time1

Shapiro-Wilk normality test

data: x

W = 0.91913, p-value = 0.2788

$Time2

Shapiro-Wilk normality test

data: x

W = 0.88011, p-value = 0.08792

$Time3

Shapiro-Wilk normality test

data: x

W = 0.73897, p-value = 0.002055

$id

Shapiro-Wilk normality test

data: x

W = 0.95933, p-value = 0.7742

批量運(yùn)行方差齊性檢驗(yàn)（Levene's Test）

for(i in unique(data2$x)){
  data1 <- data2[data2$x == i,]
  print(leveneTest(value~trt, data = data1))
}

Levene's Test for Homogeneity of Variance (center = median)
Df F value Pr(>F)
group 1 1.5617 0.2245
22
Levene's Test for Homogeneity of Variance (center = median)
Df F value Pr(>F)
group 1 2.5864 0.122
22
Levene's Test for Homogeneity of Variance (center = median)
Df F value Pr(>F)
group 1 3.8375 0.06291 .
22

---

Signif. codes: 0 ‘’ 0.001 ‘’ 0.01 ‘’ 0.05 ‘.’ 0.1 ‘ ’ 1

兩因素重復(fù)測(cè)量方差分析

anova_test(data = data2, dv = value, wid = id, within = x, between = trt) 

ANOVA Table (type II tests)

$ANOVA
Effect DFn DFd F p p<.05 ges
1 trt 1 22 510.657 1.02e-16 * 0.918
2 x 2 44 391.826 9.19e-29 * 0.902
3 trt:x 2 44 407.706 4.01e-29 * 0.905

$Mauchly's Test for Sphericity
Effect W p p<.05
1 x 0.966 0.699
2 trt:x 0.966 0.699

$Sphericity Corrections
Effect GGe DF[GG] p[GG] p[GG]<.05 HFe DF[HF] p[HF] p[HF]<.05
1 x 0.968 1.94, 42.57 6.65e-28 * 1.059 2.12, 46.61 9.19e-29 *
2 trt:x 0.968 1.94, 42.57 2.98e-28 * 1.059 2.12, 46.61 4.01e-29 *

可視化結(jié)果

ggplot(data = data3, aes(x = x, y = mean, color = trt, group = trt)) +
  geom_errorbar(aes(ymin=mean-sd, ymax=mean+sd), color = "black", width = 0.2) +
  geom_line() +
  geom_point() +
  theme_bw()

image.png

當(dāng)然這個(gè)圖跟原圖不一樣，并且沒有兩兩比較，我們可以使用ggpubr和rstatix進(jìn)行二次繪圖。

關(guān)于rstatix進(jìn)行統(tǒng)計(jì)學(xué)分析，其實(shí)可以Repeated Measures ANOVA in R: The Ultimate Guide - Datanovia
得到答案，具體的分析，我們暫不說了，只說如何進(jìn)行統(tǒng)計(jì)學(xué)分析，并且自動(dòng)兩兩比較

res.aov <- anova_test(data = data2, dv = value, wid = id, within = x, between = trt) 
# 組間兩兩比較
pwc <- data2 %>%
    group_by(x) %>%
    pairwise_t_test(
        value ~ trt, paired = TRUE,
        p.adjust.method = "bonferroni" ## 校正方法，包括 "holm", "hochberg", "hommel", "bonferroni", "BH", "BY", "fdr", "none".等
    )
pwc

可以看到已經(jīng)自動(dòng)進(jìn)行了兩兩比較，我們使用rstatix包的add_xy_position()函數(shù)可以添加兩兩比較列表和x軸y軸位置。

 pwc <- pwc %>% add_xy_position(x = "x")# 按時(shí)間分列
pwc

可視化繪圖

library(ggpubr)
ggline(data2,x='x',y='value',
color = 'trt', #按組配色
add = 'mean_sd', #添加均數(shù)標(biāo)準(zhǔn)差，也可以設(shè)置均數(shù)標(biāo)準(zhǔn)誤，CI等。
palette = "aaas" # aaas雜志配色
)+stat_pvalue_manual(pwc, tip.length = 0, hide.ns = TRUE) + # 添加兩兩比較，隱藏?zé)o意義
    labs(
        subtitle = get_test_label(res.aov, detailed = TRUE), # 添加整體差異
        caption = get_pwc_label(pwc) # 右下角條件兩兩比較方法。
    )

image.png

當(dāng)然，我們還可以繼續(xù)修改圖片，比如全部顯示結(jié)果，取消顯著性標(biāo)記的下劃線，或者顯示具體的p值等

ggline(data2,x='x',y='value',
       color = 'trt', #按組配色
       add = 'mean_sd', #添加均數(shù)標(biāo)準(zhǔn)差，也可以設(shè)置均數(shù)標(biāo)準(zhǔn)誤，CI等。
       palette = "aaas",# aaas雜志配色
ggtheme = theme_bw(), #背景
xlab = F,ylab = "Score", #xy軸名稱
legend.title="Treatment" ,legend="top", #標(biāo)簽名稱和位置
title = "Comparison of two groups at different times" #標(biāo)題
)+stat_pvalue_manual(pwc, bracket.size = 0) + # 添加兩兩比較，顯示所有結(jié)果
    labs(
        subtitle = get_test_label(res.aov, detailed = TRUE), # 添加整體差異
        caption = get_pwc_label(pwc) # 右下角顯示事后兩兩比較方法。
    )

image.png

也可以顯示數(shù)值

ggline(data2,x='x',y='value',
       color = 'trt', #按組配色
       add = 'mean_sd', #添加均數(shù)標(biāo)準(zhǔn)差，也可以設(shè)置均數(shù)標(biāo)準(zhǔn)誤，CI等。
       palette = "aaas",# aaas雜志配色#背景
       xlab = F,ylab = "Score", #xy軸名稱
       legend.title="Treatment" ,legend="right",
       title = "Comparison of two groups at different times" #標(biāo)題
)+stat_pvalue_manual(pwc, bracket.size = 0,label = "p.adj") + # 添加兩兩比較，顯示所有結(jié)果
    labs(
        subtitle = get_test_label(res.aov, detailed = TRUE), # 添加整體差異
        caption = get_pwc_label(pwc) # 右下角顯示事后兩兩比較方法。
    )

image.png