r - 使用gtummary通过一行代码功能创建多个交叉表

Question

我遇到以下问题:

上下文: 我正在使用 gtsummary 使用交叉变量探索数据框中的频率。

这是我的愿望输出:

这样我就有一个主变量tobgp及其由agegp和algp等多个变量的交叉

尝试: 这就是我到目前为止所做的。使用 R 数据集包(数据集)中的 esoph 数据。

pacman::p_load(tidyverse, gt, gtsummary)

multiple_table<-function(data, var){

t0<- data %>% 
  select({{var}}) %>% 
  gtsummary::tbl_summary(statistic = all_categorical()~ "{p}% ({n})",
                         digits = list(everything() ~ c(2, 0))) %>%
  modify_header(label ~ "") %>% 
  bold_labels()

#agep
t1<-data %>% 
  select({{var}}, agegp) %>% 
  gtsummary::tbl_summary(by = agegp, statistic = all_categorical()~ "{p}% ({n})",
                         digits = list(everything() ~ c(2, 0)))


#alcgp
t2<-data %>% 
  select({{var}}, alcgp) %>% 
  gtsummary::tbl_summary(by = alcgp, statistic = all_categorical()~ "{p}% ({n})",
                         digits = list(everything() ~ c(2, 0)))

#MERGE
tbl_merge(tbls = list(t0,t1,t2),
          tab_spanner = c("**Total**", "**agegp**", "**algp**")) %>%
  as_gt() %>% 
  gt::tab_source_note(gt::md("*Fuente: Empresa1*"))

}

esoph %>% 
  multiple_table(tobgp)

到目前为止，我的代码的问题是特定于交叉的，要添加更多交叉变量，我必须修改我创建的函数，这不太友好。

请求: 创建一个函数，以便您可以用一行代码创建所需的输出。例如这样:

multiple_table(data, main, by)    

esoph %>%
    multiple_table(main=tobgp, by=c(agegp, algp)

因此，如果我想使用其他变量来交叉，我只需更改 by=c() 参数。 为了轻松执行以下操作:

esoph %>%
    multiple_table(main=tobgp, by=c(agegp, algp, variable1, variable2)

注释:

• 我已经尝试了 gtsummary 中的其他函数，例如 tbl_strata ，它可以使用两个变量作为交叉变量，但不适合我的需求，因为它混合了两个交叉变量，例如这:

这不是我要找的。正如您所看到的，Grade 将药物测试的百分比除以每个 Grade。此示例取自 gtsummary vignette:https://www.danieldsjoberg.com/gtsummary/reference/tbl_strata.html

• 我认为解决我的问题可能需要使用 purrr 或 apply 来解决，我已经尝试过一些，但我不太擅长使用列表和迭代.

就是这样。非常感谢您的聆听，我希望我说得非常清楚。如果没有，请随时询问。

答复日期:22 年 3 月 28 日

自从我发布问题以来，我收到了不同方法的答案，它们都完美地工作。请随意使用适合您的那一种。感谢 Mike 在 StackOverflow 中提供的答案，并感谢 Tan、June C、Tyler Grant Smith 在 Slack R4DS 社区中提供的答案。就我而言，我会坚持使用方法 3。

方法 1:迈克方法

library(gtsummary)
library(dplyr)
esoph <- mutate(esoph,
                ncases = ifelse(ncases > 2, "High","Low"))

multiple_table<-function(data, var, vars){

  t0 <- data %>%
    select( var  ) %>%
    gtsummary::tbl_summary(statistic = all_categorical()~ "{p}% ({n})",
                           digits = list(everything() ~ c(2, 0))) %>%
    modify_header(label ~ "") %>%
    bold_labels()


  tlist <-  lapply(vars,function(y){
    data %>%
      select( var  ,  y  ) %>%
      gtsummary::tbl_summary(by =  y  , statistic = all_categorical()~ "{p}% ({n})",
                             digits = list(everything() ~ c(2, 0)))
  })

  tabspannername <- c("**Total**", paste0("**",vars,"**"))

  tlist2 <- append(list(t0), tlist,1)


  tbl_merge(tbls = tlist2
            ,tab_spanner = tabspannername
  ) %>%
    as_gt() %>%
    gt::tab_source_note(gt::md("*Fuente: Empresa1*"))
}

multiple_table(data = esoph, var = "tobgp", vars = c("agegp", "alcgp","ncases"))

方法 2:Tan 方法

library(tidyverse)
library(gt)
library(gtsummary)

esoph

fn_subtable <- function(data, main, sub){
  data %>%
    dplyr::select({{main}},{{sub}}) %>%
    gtsummary::tbl_summary(
      by = {{sub}},
      statistic = gtsummary::all_categorical()~ "{p}% ({n})",
      digits = list(dplyr::everything() ~ c(2, 0)))

}

fn_table <-function(data, main_var, sub_vars){

  t0 <- data %>%
    dplyr::select({{main_var}}) %>%
    gtsummary::tbl_summary(statistic = gtsummary::all_categorical() ~ "{p}% ({n})",
                           digits = list(dplyr::everything() ~ c(2, 0))) %>%
    gtsummary::modify_header(label ~ "") %>%
    gtsummary::bold_labels()

  sub_tables <- purrr::map(sub_vars, ~fn_subtable(data = data, main = main_var, sub = .x))

  #MERGE
  tbls <- c(list(t0), sub_tables) %>%
    gtsummary::tbl_merge(tab_spanner = c("**Total**", paste0("**",sub_vars,"**"))) %>%
    gtsummary::as_gt() %>%
    gt::tab_source_note(gt::md("*Fuente: Empresa1*"))

  tbls

}

esoph %>% fn_table("tobgp", c("agegp", "alcgp"))

方法 3:June C - Tyler Grant Smith 方法

library(tidyverse)
library(gt)
library(gtsummary)

fn_subtable <- function(data, main, sub){
  data %>% 
    dplyr::select({{main}},{{sub}}) %>% 
    gtsummary::tbl_summary(
      by = {{sub}}, 
      statistic = gtsummary::all_categorical()~ "{p}% ({n})",
      digits = list(dplyr::everything() ~ c(2, 0)))
  
}

fn_table3 <- function(data, main_var, sub_vars){
  
  main_var <- rlang::enexpr(main_var)
  sub_vars_expr <- rlang::enexpr(sub_vars)         # 1. Capture `list(...)` call as expression
  sub_vars_args <- rlang::call_args(sub_vars_expr) # 2. Pull out the arguments (they're now also exprs)
  sub_vars_fn   <- rlang::call_fn(sub_vars_expr)   # 3. Pull out the fn call
  # 4. Evaluate the fn with expr-ed arguments (this becomes `list( expr(agegp), expr(alcgp) )` )
  sub_vars_reconstructed <- rlang::exec(sub_vars_fn, !!!sub_vars_args)
  
  # --- sub_vars replaced with sub_vars_reconstructed from here onwards ---
  
  t0 <- data %>% 
    dplyr::select({{main_var}}) %>% 
    gtsummary::tbl_summary(statistic = gtsummary::all_categorical() ~ "{p}% ({n})",
                           digits = list(dplyr::everything() ~ c(2, 0))) %>%
    gtsummary::modify_header(label ~ "") %>% 
    gtsummary::bold_labels()
  
  sub_tables <- purrr::map(sub_vars_reconstructed, ~fn_subtable(data = data, main = main_var, sub = .x))
  
  tbls <-  c(list(t0), sub_tables) %>% 
    gtsummary::tbl_merge(tab_spanner = c("**Total**", paste0("**",sub_vars_reconstructed,"**"))) %>%
    gtsummary::as_gt() %>% 
    gt::tab_source_note(gt::md("*Fuente: Empresa1*"))
  
  tbls
  
}

fn_table3(esoph,tobgp,list(agegp,alcgp))

非常感谢，我希望这可以作为 gtsummary 包内的函数实现，因为对于探索具有不同交叉变量的频率非常有用。

Answer 1

您已经非常接近了，只需要进行一些修改。主要的变化是添加了一个 lapply() 来循环遍历 vars 输入来创建一个 tbl_summary 对象列表。然后，我根据 vars 的输入创建制表 Spanner 名称，并将 t0 表附加到 lapply() 创建的列表中。然后您可以将 tlist2 传递给 tbl_merge()，并使用 tabspannername 创建的名称来动态标记表格。

library(gtsummary)
library(dplyr)
esoph <- mutate(esoph,
                ncases = ifelse(ncases > 2, "High","Low"))

multiple_table<-function(data, var, vars){

  t0 <- data %>% 
    select( var  ) %>% 
    gtsummary::tbl_summary(statistic = all_categorical()~ "{p}% ({n})",
                           digits = list(everything() ~ c(2, 0))) %>%
    modify_header(label ~ "") %>% 
    bold_labels()
  
  
  tlist <-  lapply(vars,function(y){
    esoph %>% 
      select( var  ,  y  ) %>% 
      gtsummary::tbl_summary(by =  y  , statistic = all_categorical()~ "{p}% ({n})",
                             digits = list(everything() ~ c(2, 0)))
  })
  
 tabspannername <- c("**Total**", paste0("**",vars,"**"))
  
 tlist2 <- append(list(t0), tlist,1)
 
 
 tbl_merge(tbls = tlist2
            ,tab_spanner = tabspannername
           ) %>%
   as_gt() %>% 
   gt::tab_source_note(gt::md("*Fuente: Empresa1*"))
}


x <-  multiple_table(data = esoph, var = "tobgp", vars = c("agegp", "alcgp","ncases"))