ggplot2 在线绘图

ggplot2
R语言
可视化
对博客中图表收集汇总
作者

不止BI

发布于

2023年12月30日

R语言图表

在线练习

下面的代码输入框可以在线运行R代码，如需安装R包请使用webr::install("packagename"),例如安装ggplot2需要执行webr::install("ggplot2"),安装速度取决于网络与包大小

箱线图

ggsignif

ggsignif包添加p值

代码 
library(ggplot2)
library(ggprism)
library(patchwork)
library(ggsignif)
ggplot(iris, aes(x = Species, y = Sepal.Length, fill = Species)) +
  geom_boxplot() +
  geom_signif(
    comparisons = list(c("setosa", "versicolor")),
    map_signif_level = TRUE
  ) +
  geom_signif(
    comparisons = list(c("versicolor", "virginica")),
    map_signif_level = TRUE
  ) +
  theme_prism()

geom_signif是ggsignif包中用于添加显著性标记的函数。以下是主要参数的作用：

  • comparisons ：需要进行比较的组合列表，每个元素为长度为 2 的向量，指明要比较的两列名称或索引。

  • test ：进行统计检验的函数名称，如 t.test、wilcox.test 等。

  • test.args ：统计检验函数的额外参数。

  • annotations ：自定义注释的文本向量，如果非空则忽略 test 参数。

  • map_signif_level ：是否直接显示 p 值，或使用星号表示显著性水平。可以为布尔值、命名的数值向量（定义自定义映射），或函数（接收 p 值并返回字符串）。

  • y_position ：括号的 y 轴位置。

  • xmin, xmax ：括号的左右两侧位置。

  • margin_top ：括号起始位置高于最大值的比例。

  • step_increase ：每个额外比较的纵向偏移量，用于避免重叠。

  • tip_length ：指示精确列的下指箭头长度占总高度的比例。

  • size ：括号线条的宽度。

  • textsize ：注释文本的字号。

  • family ：注释文本的字体。

  • vjust ：垂直调整注释文本的位置。

  • parse ：是否将标签解析为表达式。

  • manual ：是否手动提供参数数据框。

ggprism包

使用ggprism包的add_pvalue()函数，该函数可以从数据框中获取显著检验结果，同时添加多个分组的显著检验线，示例如下：

代码 
library(rstatix)
df_p_val <- iris %>%
  t_test(Sepal.Length ~ Species) %>%
  add_xy_position()

ggplot(iris, aes(x = factor(Species), y = Sepal.Length)) +
  geom_boxplot(aes(fill = Species)) +
  add_pvalue(df_p_val) +
  theme_prism()

数据框参数:

  • data: 包含要绘制的统计数据的数据框。默认格式包括以下列：group1 | group2 | p.adj | y.position | 等等。group1 和 group2 是进行比较的两组。p.adj 是校正后的 p 值。y.position 是指定 p 值在图上位置的 y 坐标。列名可以与默认值不同，只要在调用函数时指定即可。 文本和位置参数:

  • label: 指定要绘制的文本的列名（例如 label = “p.adj”）。也可以是可以被 glue 格式化的表达式（例如 label = “p = {p.adj}”)。 xmin: 指定括号左侧位置的列名。默认为 “group1”。 xmax: （可选）指定括号右侧位置的列名。默认为 “group2”。如果为 NULL，则 p 值仅显示为文本。 x: 仅当绘制不带括号的 p 值文本时使用。指定 p 值文本的 x 坐标。 y.position: 包含每个 p 值的 y 坐标（数值）的列名。也可以是一个数值，将所有 p 值绘制在同一高度，或一个数值向量来覆盖数据框中的 y.position 列。

文本格式参数:

  • parse: 默认为 FALSE。如果为 TRUE，文本标签将被解析为表达式并按照 plotmath 中的描述显示。

  • label.size: 文本大小。 colour, color: 文本颜色。

括号参数:

  • tip.length: 括号尖端的长度。使用 0 移除尖端。 bracket.size: 括号线宽。

  • bracket.color: 括号颜色。默认为 NULL，这会使括号继承文本的颜色。

  • bracket.shorten: 稍微缩短括号，以便它们可以并排绘制在相同的 y 位置。

  • bracket.nudge.y: 更改 p 值的 y 位置。如果文本被截断，可用于稍微调整 p 值。

  • step.increase: 更改括号之间的空间。

  • step.group.by: 用于对括号进行分组的变量。

  • remove.bracket: 如果为 TRUE，则移除所有括号，仅显示 p 值文本。 其他参数:

  • coord.flip: 如果为 TRUE，则 p 值旋转 90 度。应与 coord_flip 一起使用。 position: 通常用于调整 p 值的 x 位置，以使其与被闪避（dodged）的数据一致。

火山图

代码 
library(ggVolcano)

data(deg_data)


data <- add_regulate(deg_data,
  log2FC_name = "log2FoldChange",
  fdr_name = "padj", log2FC = 1, fdr = 0.05
)


ggvolcano(data,
  x = "log2FoldChange", y = "padj",
  label = "row", label_number = 10, output = FALSE
) +
  ggsci::scale_color_aaas() +
  ggsci::scale_fill_aaas()

代码 
data("term_data")

# plot
term_volcano(deg_data, term_data,
  x = "log2FoldChange", y = "padj",
  label = "row", label_number = 10, output = FALSE
)

代码 
library(RColorBrewer)

# Change the fill and color manually:
deg_point_fill <- brewer.pal(5, "RdYlBu")
names(deg_point_fill) <- unique(term_data$term)

term_volcano(data, term_data,
  x = "log2FoldChange", y = "padj",
  normal_point_color = "#75aadb",
  deg_point_fill = deg_point_fill,
  deg_point_color = "grey",
  legend_background_fill = "#deeffc",
  label = "row", label_number = 10, output = FALSE
)

三线表

示例数据格式

代码 
library(tidyverse)
set.seed(1234)
n <- 50
ttest_statistic <- function(data, variable, by, ...) {
  t.test(data[[variable]] ~ as.factor(data[[by]]))$statistic
}
d_list <- list(
  "实验组_实验前_方法一" = list("mean" = 30, "sd" = 7),
  "实验组_实验后_方法一" = list("mean" = 40, "sd" = 5),
  "对照组_实验前_方法一" = list("mean" = 50, "sd" = 2),
  "对照组_实验后_方法一" = list("mean" = 40, "sd" = 23),
  "实验组_实验前_方法二" = list("mean" = 33, "sd" = 3),
  "实验组_实验后_方法二" = list("mean" = 22, "sd" = 7),
  "对照组_实验前_方法二" = list("mean" = 55, "sd" = 5),
  "对照组_实验后_方法二" = list("mean" = 44, "sd" = 4)
)

mean_list <- sapply(d_list, function(x) x$mean)
sd_list <- sapply(d_list, function(x) x$sd)
df <- map2_df(mean_list, sd_list, rnorm, n = n)


df <- df %>%
  pivot_longer(cols = everything()) %>%
  separate(col = name, into = c("分组", "时间", "方法"), sep = "_")

df$时间 <- factor(df$时间,
  levels = c("实验前", "实验后"),
  labels = c("实验前", "实验后")
)
df$分组 <- factor(df$分组,
  levels = c("实验组", "对照组"),
  labels = c("实验组", "对照组")
)
df
# A tibble: 400 × 4
   分组   时间   方法   value
   <fct>  <fct>  <chr>  <dbl>
 1 实验组 实验前 方法一  21.6
 2 实验组 实验后 方法一  31.0
 3 对照组 实验前 方法一  50.8
 4 对照组 实验后 方法一  31.3
 5 实验组 实验前 方法二  34.5
 6 实验组 实验后 方法二  25.1
 7 对照组 实验前 方法二  52.1
 8 对照组 实验后 方法二  34.7
 9 实验组 实验前 方法一  31.9
10 实验组 实验后 方法一  37.1
# ℹ 390 more rows

输出三线表

代码 
library(gtsummary)

library(flextable)
gt1 <- df %>%
  filter(方法 == "方法一") %>%
  pivot_wider(names_from = 分组, values_from = value) %>%
  unnest(cols = c(实验组, 对照组)) %>%
  select(时间, 实验组, 对照组) %>%
  tbl_summary(
    by = 时间,
    type = everything() ~ "continuous",
    statistic = list(
      all_continuous() ~ "{mean} (±{sd})",
      all_categorical() ~ "{p}%"
    ),
    missing = "no"
  ) %>%
  add_p() %>%
  # add_overall() %>%
  add_significance_stars() %>%
  add_stat(fns = everything() ~ ttest_statistic) %>%
  modify_header(label = "**组别**", add_stat_1 ~ "**t**")

gt2 <- df %>%
  filter(方法 == "方法二") %>%
  pivot_wider(names_from = 分组, values_from = value) %>%
  unnest(cols = c(实验组, 对照组)) %>%
  select(时间, 实验组, 对照组) %>%
  tbl_summary(
    by = 时间,
    type = everything() ~ "continuous",
    statistic = list(
      all_continuous() ~ "{mean} (±{sd})",
      all_categorical() ~ "{p}%"
    ),
    missing = "no"
  ) %>%
  add_p() %>%
  # add_overall() %>%
  add_significance_stars() %>%
  add_stat(fns = everything() ~ ttest_statistic) %>%
  modify_header(label = "**组别**", add_stat_1 ~ "**t**")
# gt = tbl_merge(
#     tbls = list(gt1, gt2),
#     tab_spanner = c("方法一", "方法二")
#   )
gt <- tbl_stack(
  tbls = list(gt1, gt2),
  group_header = c("方法一", "方法二")
) %>%
  modify_header(
    groupname_col = "**评分方法**",
    p.value = "**p值**",
  )
# show_header_names(gt1)
gt %>%
  modify_header(all_stat_cols() ~ "**{level}**") %>%
  as_flex_table()

评分方法

组别

实验前1

实验后1

p值2

t

方法一

实验组

27 (±6)

41 (±5)

<0.001***

-12.1

对照组

50 (±2)

41 (±27)

0.008**

2.22

方法二

实验组

34 (±3)

23 (±7)

<0.001***

10.7

对照组

55 (±4)

44 (±5)

<0.001***

12.1

1Mean (±SD)

2*p<0.05; **p<0.01; ***p<0.001

回到顶部