修改 tbl_summary 中的数字时出现问题

Question

我在调整 tbl_summary() 的数字时遇到问题。这是我的代码：

library(flextable)
library(dplyr)
library(officer)
library(gtsummary)
library(janitor)

### Effect size
my_ES_test <- function(data, variable, by, ...) {
  aovmod = aov(data[[variable]] ~ data[[by]])
  lsr::etaSquared(aovmod)[1,1]
}

### Standard Error Mean
sem <- function(x){
  sqrt(var(x, na.rm=TRUE)/sum(!is.na(x)))
}

### Pooled Standard Error
PSE <- function(data, variable, by,...) {
  s <- data %>% 
    group_by(!!sym(by)) %>% 
    summarise(s = var(!!sym(variable)), 
              n = n()) %>% 
    mutate(num = s*(n-1))
  psd <- sqrt(sum(s$num)/(sum(s$n) - nrow(s)))
  psd*sqrt(sum(1/s$n))
}

### gtsummary
Iris_data <- iris %>%
  select(names(iris))%>% 
  tbl_summary(
    by = Species,
    digits = all_continuous() ~ c(2,2),
    type = list(everything() ~ "continuous"),
    statistic = all_continuous() ~ "{mean} ± {sem}",
    label = list(Sepal.Length = "Sepal Length", 
                 Sepal.Width = "Sepal Width", 
                 Petal.Length = "Petal Length",
                 Petal.Width = "Petal Width")
  ) %>%
  add_stat(fns = all_continuous() ~ PSE) %>% 
  add_stat(fns = all_continuous() ~ my_ES_test) %>% 
  add_p(
    test = all_continuous() ~ "aov", pvalue_fun = function(x) style_pvalue(x, digits = 3)
  ) %>% 
  modify_header(label = "**Size**", p.value = "**p-value**", add_stat_1 = "**PSE**", add_stat_2 = "**\U03B7\U00B2**") %>%
  modify_footnote(add_stat_1 = "Pooled Standard Error", abbreviation = FALSE) %>%
  bold_levels() %>%
  bold_labels() %>%
  as_flex_table()

一般来说，table 工作得很好。但是，如果我将 p 值移动到 add_stat(fns = all_continuous() ~ PSE) 以上，那么 p 值数字将变回原来的格式，没有三位数字。这是解决这个问题的方法吗？此外，出于某些原因，我无法使用 purrr::partial(style_ratio, digits = 3) 调整 PSE 的数字。反复尝试还是无法解决问题

谢谢。

Answer 1

可以使用modify_fmt_fun()函数修改format/style列的函数。这是你要问的吗？

library(dplyr, warn.conflicts = FALSE)
library(officer)
library(gtsummary)
#> #BlackLivesMatter

### Effect size
my_ES_test <- function(data, variable, by, ...) {
  aovmod = aov(data[[variable]] ~ data[[by]])
  lsr::etaSquared(aovmod)[1,1]
}

### Standard Error Mean
sem <- function(x){
  sqrt(var(x, na.rm=TRUE)/sum(!is.na(x)))
}

### Pooled Standard Error
PSE <- function(data, variable, by,...) {
  s <- data %>% 
    group_by(!!sym(by)) %>% 
    summarise(s = var(!!sym(variable)), 
              n = n()) %>% 
    mutate(num = s*(n-1))
  psd <- sqrt(sum(s$num)/(sum(s$n) - nrow(s)))
  psd*sqrt(sum(1/s$n))
}

### gtsummary
iris %>%
  select(names(iris))%>% 
  tbl_summary(
    by = Species,
    statistic = all_continuous() ~ "{mean} ± {sem}"
  ) %>% 
  add_p(
    test = all_continuous() ~ "aov", 
    pvalue_fun = function(x) style_pvalue(x, digits = 3)
  ) %>%
  add_stat(fns = all_continuous() ~ PSE) %>% 
  add_stat(fns = all_continuous() ~ my_ES_test)  %>% 
  modify_header(label = "**Size**", p.value = "**p-value**", add_stat_1 = "**PSE**", add_stat_2 = "**\U03B7\U00B2**") %>%
  modify_footnote(add_stat_1 = "Pooled Standard Error", abbreviation = FALSE) %>%
  modify_fmt_fun( c(add_stat_1, add_stat_2) ~ purrr::partial(style_sigfig, digits = 5)) %>%
  as_kable()

Size	setosa, N = 50	versicolor, N = 50	virginica, N = 50	p-value	PSE	η²
Sepal.Length	5.01 ± 0.05	5.94 ± 0.07	6.59 ± 0.09	<0.001	0.12610	0.61871
Sepal.Width	3.43 ± 0.05	2.77 ± 0.04	2.97 ± 0.05	<0.001	0.08321	0.40078
Petal.Length	1.46 ± 0.02	4.26 ± 0.07	5.55 ± 0.08	<0.001	0.10541	0.94137
Petal.Width	0.25 ± 0.01	1.33 ± 0.03	2.03 ± 0.04	<0.001	0.05013	0.92888

^{由 reprex package (v2.0.1)}

于 2022-04-24 创建

修改 tbl_summary 中的数字时出现问题

Problem with modifying the digits in tbl_summary

gtsummary