---
title: "箱线图+散点图+均值比较"
author: "Rui"
date: "2022-10-13"
categories: [R, 可视化, ggplot2]
image: "green-leaves.jpg"
format:
html:
code-fold: true
code-tools: true
---
```{r setup, include = FALSE}
# 设置默认参数
knitr::opts_chunk$set(
echo = TRUE,
fig.align = "center",
message = FALSE,
warning = FALSE,
collapse = TRUE
)
```
## 导入数据
```{r}
library(tidyverse)
library(ggpubr)
library(magrittr)
library(ggsci)
library(ggsignif)
setwd("F:\\RuiBlog\\posts\\R\\箱线图+散点图+均值比较")
load(file = "df.RData") # 这是一个虚拟的数据集
df %>% tail() %>% knitr::kable()
```
::: {.callout-note}
虚拟数据集 df 的最后一行记录的是每一列的均值，作图时不应将其作为箱线图和散点图的输入数据，而应该作为注释来说明每一列的均值。
:::
## 创建文本
```{r}
# 构建文本
text <- df %>%
filter(sample != "Geometric mean") %>%
column_to_rownames(var = "sample") %>% # 将sample这一列变成行名，即不在数据中
log10() %>%
summarise_if(is.numeric, max) %>%
rownames_to_column(var = "sample") %>% # 将行名变成第一列，sample这一列又在数据中了
pivot_longer(-sample) %>% # 宽数据转长数据
select(-1) %>%
left_join(., df %>% filter(sample == "Geometric mean") %>% # 数据左合并
pivot_longer(-sample) %>% select(-1), by = "name") %>%
set_colnames(c("name", "value", "num")) %>%
mutate(num = round(num, digits = 1)) # num一列保留一位小数
```
::: {.column-margin}
`summarise_if()` 函数的第一个参数接受一个 tibble 数据框，第二个参数接受一个函数并且这个函数返回一个逻辑型向量用于筛选数据框中的列，第三个参数也接受一个函数并且对筛选出来的列进行操作。这里 `summarise_if(df, is.numeric, max)` 的意思就是：对 df 数据框筛选出数值型的列，再对这些列进行汇总，求出每一列的最大值。类似的函数还有 `summarise_all()` 和 `summarise_at()`
:::
- 使用 `filter()` 函数滤去最后一行。
- 由于数据尺度比较大，可以对其进行对数化。但是 `sample` 这一列也不应该作为输入数据，一般的做法是将其删去。但如果之后又要用到这一列数据，删去则不是一个好办法。明智的做法是使用 `column_to_rownames()` 将 `sample` 这一列变为行名。这样做既保留了 `sample` 这一列，又能防止它作为输入数据。
- 如果之后还需要将 `sample` 这一列作为输入数据，则可以使用 `rownames_to_column()` 将它从行名再变为数据框中的一列数据。
```{r}
#| column: margin
text %>% knitr::kable()
```
## 数据清洗
还是一样的方法，主要是将宽数据转换为长数据。
```{r}
df2 <- df %>%
filter(sample != "Geometric mean") %>%
column_to_rownames(var = "sample") %>%
log10() %>%
rownames_to_column(var = "sample") %>%
pivot_longer(-sample) # 宽数据转换成长数据
```
## 定义因子
```{r}
# 定义因子
df2$name <- factor(
df2$name,
levels = colnames(df) %>% as.data.frame() %>% slice(., -1) %>% pull()
) # 注意pull()用法
```
::: {.column-margin}
- `slice()` 函数按行对数据框进行切片。它的第一个参数接受一个数据框，第二个参数接受数据框的行的索引。比如 `slice(df, -1)` 就是去除 df 数据框的第一行。类似的函数还有 `slice_head()`, `slice_tail()`, `slice_min()`, `slice_max()` 和 `slice_sample()` 等。
- `pull()` 函数类似于 `$` 用于提取数据框中的某一列，可以按列名提取也可以按列的索引提取，但可惜的是只能提取一列（默认提取最后一列）。
:::
## 可视化
```{r}
p1 <- df2 %>%
ggplot(aes(name, value)) +
stat_boxplot(geom = "errorbar",
position = position_dodge(width = 0.2),
width = 0.1) +
geom_boxplot(position = position_dodge(width = 0.2), width = 0.4) +
geom_point(aes(fill = name, group = sample, color = name),
pch = 21,
position = position_dodge(0.2))
p1 # 基本图形
```
### 添加文本（注释）
添加我们之前处理好的文本 text
```{r}
p2 <- p1 +
geom_text(data = text,
aes(label = num, y = value + 0.1),
size = 4,
color = "black",
hjust = 0.5,
vjust = 0.5)
p2
```
### 均值比较
比较 BBBBB 与 DDDDD 的均值差异是否显著。这里使用的是非参数统计中的 wilcox 检验，也可以按需要使用参数统计中的 t 检验。
```{r}
p3 <- p2 +
geom_signif(comparisons = list(c("BBBBB", "DDDDD")),
map_signif_level = TRUE,
textsize = 6,
test = wilcox.test,
step_increase = 0.2) +
scale_size_continuous(range = c(1, 3))
p3 # wilcox检验
```
### 添加 R2、p 值以及拟合方程
```{r}
p4 <- p3 +
stat_cor(aes(label = paste(..rr.label.., ..p.label.., sep = "~`, `~"), group = 1),
color = "black",
label.y = 3.1, # R2和p在图中的位置
label.x.npc = "middle") +
stat_regline_equation(aes(group = 1),
color = "black",
label.y = 3.0, # y~x在图中的位置
label.x.npc = "middle") +
scale_fill_simpsons(alpha = 0.7) +
scale_color_simpsons(alpha = 0.7)
p4
```
### 美化
```{r}
p5 <- p4 +
labs(x = NULL, y = NULL) +
theme(plot.margin = unit(c(0.5, 0.5, 0.5, 0.5), units = ,"cm"),
# 设置图片边界，注意unit()函数
axis.line = element_line(color = "black", size = 0.4),
panel.grid.minor = element_blank(),
panel.grid.major = element_line(size = 0.2, color = "#e5e5e5"),
panel.background = element_blank(),
axis.text.y = element_text(color = "black", size = 10, face = "bold"),
axis.text.x = element_text(color = "black", size = 10,
vjust = 0.5, hjust = 1,
face = "bold", angle = 90),
axis.line.x.top = element_line(color = "black"),
axis.text.x.top = element_blank(),
axis.ticks.y.right = element_blank(),
axis.text.y.right = element_blank(),
axis.ticks.x.top = element_blank(),
panel.spacing.x = unit(0, "cm"),
panel.border = element_blank(),
legend.position = "none",
panel.spacing = unit(0, "lines")) +
guides(x.sec = "axis", y.sec = "axis")
p5
```
