您如何将 gtsummary 中比例的置信区间与 by 包括在内？

Question

在此处输入图像描述我尝试在 gtsummry 中添加置信区间，但出现错误 #>Error: Dimension of 'a1' 和添加的统计信息不匹配。 期望统计长度为 2。当我不按任何变量分层时，我成功地添加了区间。 代码如下，如果它太冗长，请见谅。

#---- Libraries
library(gtsummary)
library(tidyverse)


#---- Data

set.seed(2021)

df <- tibble(
  
  a1 = factor(ifelse(sign(rnorm(30))==-1, 0, 1), labels = c("No", "Yes")),
  a2 = factor(ifelse(sign(rnorm(30))==-1, 0, 1), labels = c("No", "Yes")),
  gender = gl(2, 15, labels = c("Males", "Females")),
  b2 = gl(3, 10, labels = c("Primary", "Secondary", "Tertiary")),
  c1 = gl(3, 10, labels = c("15-19", "20-24", "25-30")),
  outcome = factor(ifelse(sign(rnorm(30))==-1, 0, 1), labels = c("No", "Yes")),
  weight = runif(30, 1, 12)
)


#---- Function to calculate CIs

categorical_ci <- function(variable, tbl, ...) {
  
  filter(tbl$meta_data, variable == .env$variable) %>%
    pluck("df_stats", 1) %>%
    mutate(
      # calculate and format 95% CI
      prop_ci = map2(n, N, ~prop.test(.x, .y)$conf.int %>%
                       style_percent(symbol = TRUE)),
      ci = map_chr(prop_ci, ~glue::glue("{.x[1]}, {.x[2]}"))
    ) %>%
    pull(ci)
}



#---- tblsummary with stratified by gender

t1 <- df %>%
  select(gender, a1, a2) %>%
  tbl_summary(by = gender, statistic = everything() ~ "{n} {p}%",
              type = everything() ~ "categorical")


t1 %>%
  add_stat(
    fns = everything() ~ "categorical_ci",
    location = "level",
    header = "**95% CI**"
  ) %>%
  modify_footnote(everything() ~ NA)

Answer 1

这里有一个类似的问题： https://community.rstudio.com/t/tbl-summary-function/100113/6

library(gtsummary)

ll <- function(x) t.test(x)$conf.int[[1]] # Lower 95% CI of mean
ul <- function(x) t.test(x)$conf.int[[2]] # Upper 95% CI of mean

# create table 1
table <-
  trial %>%
  select(trt, age) %>%
  tbl_summary(
    by = trt,
    statistic = all_continuous() ~ "{mean} ({ll} — {ul})",
    missing = "no",
    digits = all_continuous() ~ 2
  ) %>%
  modify_footnote(all_stat_cols() ~ "Mean (95% CI)")

Answer 2

#---- Libraries
library(gtsummary)
library(flextable)
library(tidyverse)


#---- Data

set.seed(2021)

df <- tibble(

  a1 = factor(ifelse(sign(rnorm(30))==-1, 0, 1), labels = c("No", "Yes")),
  a2 = factor(ifelse(sign(rnorm(30))==-1, 0, 1), labels = c("No", "Yes")),
  gender = gl(2, 15, labels = c("Males", "Females")),
  b2 = gl(3, 10, labels = c("Primary", "Secondary", "Tertiary")),
  c1 = gl(3, 10, labels = c("15-19", "20-24", "25-30")),
  outcome = factor(ifelse(sign(rnorm(30))==-1, 0, 1), labels = c("No", "Yes")),
  weight = runif(30, 1, 12)
)


#---- Solution ----

tbl <-
  df %>%
  select(a1, a2, gender) %>%
  tbl_summary(missing = "no",  by = gender, type = everything() ~ "categorical",
              percent = "row") %>%
  add_n() %>%
  modify_footnote(everything() ~ NA)


myci <- tbl$meta_data %>%
  filter(summary_type %in% c("categorical", "dichotomous")) %>%
  select(summary_type, var_label, df_stats) %>%
  unnest(df_stats) %>%
  mutate(
    conf.low = (p - qnorm(0.975) * sqrt(p * (1 - p) / N)) %>%
      style_percent(symbol = TRUE),
    conf.high =( p + qnorm(0.975) * sqrt(p * (1 - p) / N)) %>%
      style_percent(symbol = TRUE),
    ci = str_glue("{conf.low}, {conf.high}"),
    label = coalesce(variable_levels, var_label),
    row_type = ifelse(summary_type == "dichotomous", "label", "level")
  ) %>%
  select(by, variable, row_type, label, ci) %>%
  pivot_wider(names_from = "by", values_from = "ci") %>%
  rename(Male_ci = Males, Female_ci = Females)


tbl %>%
  modify_table_body(
    left_join,
    myci,
    by = c("variable", "row_type", "label")
  ) %>%
  modify_table_header(
    Male_ci,
    hide = FALSE,
    label = "**95% CI Males**"
  ) %>%
  modify_table_header(
    Female_ci,
    hide = FALSE,
    label = "**95% CI Females**"
  )