Add multiple levels of headers to gtsummary regression table with many models-CodePudding

I am trying to generate multiple levels of headers for a gtsummary regression table containing regression models which should be grouped by year in the table. Here's a toy example:

library(dplyr)
library(gtsummary)
library(purrr)

set.seed(92922)
df <- tibble(y_1980 = rbinom(n = 10, size = 1, prob = .4),
             y_1990 = rbinom(n = 10, size = 1, prob = .7),
             x1 = rnorm(10, sd = 1),
             x2 = rnorm(10, sd = 2))

tbls <- c("y_1980 ~ x1", "y_1980 ~ x1   x2", "y_1990 ~ x1", "y_1990 ~ x1   x2") %>% 
  map(as.formula) %>% 
  map(glm,
      data = df, 
      family = binomial(link = "logit")) %>% 
  map(tbl_regression, exponentiate = TRUE) %>% 
  map(add_significance_stars, hide_ci = TRUE, hide_p = TRUE, hide_se = FALSE) %>% 
  map(add_glance_table, include = nobs)

I can get this:

tbls %>% 
  tbl_merge(tab_spanner = c("1980 (1)", "1980 (2)", "1990 (1)", "1990 (2)")) %>% 
  modify_table_body(~.x %>% dplyr::arrange(row_type == "glance_statistic"))

But I want two levels -- year on top, model numbers below:

 1980      1990
_______   ______
(1) (2)   (1) (2)

How can I do this?

CodePudding user response：

You'll need to convert the gtsummary table to a gt table. Then you can use gt::tab_spanner() to place higher level spanning headers.

library(dplyr)
library(gtsummary)
library(purrr)

set.seed(92922)
df <- tibble(y_1980 = rbinom(n = 10, size = 1, prob = .4),
             y_1990 = rbinom(n = 10, size = 1, prob = .7),
             x1 = rnorm(10, sd = 1),
             x2 = rnorm(10, sd = 2))

tbls <- c("y_1980 ~ x1", "y_1980 ~ x1   x2", "y_1990 ~ x1", "y_1990 ~ x1   x2") %>% 
  map(as.formula) %>% 
  map(glm,
      data = df, 
      family = binomial(link = "logit")) %>% 
  map(tbl_regression, exponentiate = TRUE) %>% 
  map(add_significance_stars, hide_ci = TRUE, hide_p = TRUE, hide_se = FALSE) %>% 
  map(add_glance_table, include = nobs) 


tbl <-
  tbls %>% 
  tbl_merge(tab_spanner = FALSE) %>% 
  modify_table_body(~.x %>% dplyr::arrange(row_type == "glance_statistic"))

show_header_names(tbl)

gt_tbl <- 
  as_gt(tbl) %>%
  gt::tab_spanner(
    columns = c(estimate_1, std.error_1, estimate_3, std.error_3),
    label = "(1)",
    gather = FALSE
  ) %>%
  gt::tab_spanner(
    columns = c(estimate_2, std.error_2, estimate_4, std.error_4),
    label = "(2)",
    gather = FALSE
  ) %>%
  gt::tab_spanner(
    columns = c(estimate_1, std.error_1, estimate_2, std.error_2),
    label = "1980",
    level = 2,
    gather = FALSE
  ) %>%
  gt::tab_spanner(
    columns = c(estimate_3, std.error_3, estimate_4, std.error_4),
    label = "1990",
    level = 2,
    gather = FALSE
  )