用gtsummary一行代码函数创建多个交叉表

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 将 Drug test 的百分比除以每个 Grade。此示例取自 gtsummary vignette：https://www.danieldsjoberg.com/gtsummary/reference/tbl_strata.html

我认为我的问题的解决方案可能涉及 purrr 或 apply 的一些变通方法，我已经尝试了一些，但我不太擅长使用列表和迭代。

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

答案 22 年 3 月 28 日

自从我发布我的问题后，我收到了不同的答案，它们都非常有效。随意使用适合您的那个。感谢 Mike 在 Whosebug 中提供的答案，并感谢 Tan、June C 和 Tyler Grant Smith 在 Slack R4DS 社区中提供的答案。就我而言，我会坚持使用 方法 3.

方法 1：Mike 方法

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 的输入创建标签扳手名称，并将 t0 table 附加到 lapply() 创建的列表中。然后你可以将 tlist2 传递给 tbl_merge() 并使用 tabspannername 创建的名称来动态标记 tables.

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"))

用gtsummary一行代码函数创建多个交叉表

create multiple cross tables with one-line code function with gtsummary

r

purrr

tidyverse

gtsummary

gt