R语言绘制三线表

表格
R语言
可视化
使用R语言绘制美观的三线表，添加统计值与p值
作者

不止BI

发布于

2023年12月13日

R语言是数据分析和可视化领域的强大工具，今天和大家分享如何使用R语言绘制三线表来汇总统计数据。在线绘图为你提供了基于webr的在线执行R代码的方法，里面包含了本文示例及其他图表模板

示例数据

以下为随机生成的示例数据格式

# A tibble: 400 × 4
   分组   时间   方法   value
   <fct>  <fct>  <chr>  <dbl>
 1 实验组 实验前 方法一    22
 2 实验组 实验后 方法一    31
 3 对照组 实验前 方法一    51
 4 对照组 实验后 方法一    31
 5 实验组 实验前 方法二    34
 6 实验组 实验后 方法二    25
 7 对照组 实验前 方法二    52
 8 对照组 实验后 方法二    35
 9 实验组 实验前 方法一    32
10 实验组 实验后 方法一    37
# ℹ 390 more rows

单表三线表绘制

library(gtsummary)
ttest_statistic <- function(data, variable, by, ...) {
  t.test(data[[variable]] ~ as.factor(data[[by]]))$statistic
}
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**", p.value = "**p值**")

gt1 %>%
  as_flex_table()

组别

实验前, N = 501

实验后, N = 501

p值2

t

实验组

27 (±6)

41 (±5)

<0.001***

-12.0

对照组

50 (±2)

41 (±27)

0.008**

2.24

1Mean (±SD)

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

需要注意的是,gtsummary目前不支持直接添加p值对应的统计量，所以这里我们定义了一个函数 ttest_statistic，该函数用于计算两组数据的 t 值，并通过 add_stat 添加到 统计表中。针对不同的tbl_* 函数 add_p支持t.test,chisq.test,aov等不同类型的检验，详细参数可见包说明文件，这里不一一列举。

合并多个表

gtsummary提供了合并多个三线表的方法，支持纵向堆叠与横向合并。

纵向堆叠

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**", p.value = "**p值**")


gt <- tbl_stack(
  tbls = list(gt1, gt2),
  group_header = c("方法一", "方法二")
) %>%
  modify_header(
    groupname_col = "**评分方法**"
  )
gt %>%
  modify_header(all_stat_cols() ~ "**{level}**") %>%
  as_flex_table()

评分方法

组别

实验前1

实验后1

p值2

t

方法一

实验组

27 (±6)

41 (±5)

<0.001***

-12.0

对照组

50 (±2)

41 (±27)

0.008**

2.24

方法二

实验组

34 (±3)

23 (±7)

<0.001***

10.7

对照组

55 (±4)

44 (±5)

<0.001***

11.9

1Mean (±SD)

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

横向堆叠

gt <- tbl_merge(
  tbls = list(gt1, gt2),
  tab_spanner = c("方法一", "方法二")
)
gt %>%
  modify_header(all_stat_cols() ~ "**{level}**") %>%
  as_flex_table()

方法一

方法二

组别

实验前1

实验后1

p值2

t

实验前1

实验后1

p值2

t

实验组

27 (±6)

41 (±5)

<0.001***

-12.0

34 (±3)

23 (±7)

<0.001***

10.7

对照组

50 (±2)

41 (±27)

0.008**

2.24

55 (±4)

44 (±5)

<0.001***

11.9

1Mean (±SD)

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

多类型输出

上面的表格都是基于flextable输出的表格，gtsummary还集成了一些其他格式的输出

huxtable

gt %>% as_hux_table()

方法一

方法二

组别

实验前

实验后

p值

t

实验前

实验后

p值

t

实验组27 (±6)41 (±5)<0.001***-12.034 (±3)23 (±7)<0.001***10.7
对照组50 (±2)41 (±27)0.008**2.2455 (±4)44 (±5)<0.001***11.9
Mean (±SD)
*p<0.05; **p<0.01; ***p<0.001

kable

gt %>% as_kable()
组别 实验前 实验后 p值 t 实验前 实验后 p值 t
实验组 27 (±6) 41 (±5) <0.001*** -12.0 34 (±3) 23 (±7) <0.001*** 10.7
对照组 50 (±2) 41 (±27) 0.008** 2.24 55 (±4) 44 (±5) <0.001*** 11.9

kable_extra

gt %>% as_kable_extra()
方法一
方法二
组别 实验前 实验后 p值 t 实验前 实验后 p值 t
实验组 27 (±6) 41 (±5) <0.001*** -12.0 34 (±3) 23 (±7) <0.001*** 10.7
对照组 50 (±2) 41 (±27) 0.008** 2.24 55 (±4) 44 (±5) <0.001*** 11.9
1 Mean (±SD)
2 *p<0.05; **p<0.01; ***p<0.001

tibble

gt %>% as_tibble()
# A tibble: 2 × 9
  `**组别**` `**实验前**` `**实验后**` `**p值**` `**t**` `**实验前**`
  <chr>      <chr>        <chr>        <chr>     <chr>   <chr>       
1 实验组     27 (±6)      41 (±5)      <0.001*** -12.0   34 (±3)     
2 对照组     50 (±2)      41 (±27)     0.008**   2.24    55 (±4)     
# ℹ 3 more variables: `**实验后**` <chr>, `**p值**` <chr>, `**t**` <chr>

gt

gt %>% as_gt()
组别 方法一 方法二
实验前1 实验后1 p值2 t 实验前1 实验后1 p值2 t
实验组 27 (±6) 41 (±5) <0.001*** -12.0 34 (±3) 23 (±7) <0.001*** 10.7
对照组 50 (±2) 41 (±27) 0.008** 2.24 55 (±4) 44 (±5) <0.001*** 11.9
1 Mean (±SD)
2 *p<0.05; **p<0.01; ***p<0.001

xlsx

输出到指定的excel也是支持的

gt %>% as_hux_xlsx("./gt.xlsx")

回到顶部