function to display multinomial regression models in wide format

multinom_pivot_wider.R

set.seed(20210511)
library(gtsummary)
library(magrittr)

multinom_pivot_wider <- function(x) {
  # check inputs match expectatations
  if (!inherits(x, "tbl_regression") || !inherits(x$model_obj, "multinom")) {
    stop("`x=` must be class 'tbl_regression' summary of a `nnet::multinom()` model.")
  }
  
  # create tibble of results
  df <- tibble::tibble(outcome_level = unique(x$table_body$groupname_col))
  df$tbl <- 
    purrr::map(
      df$outcome_level,
      function(lvl) {
        gtsummary::modify_table_body(
          x, 
          ~dplyr::filter(.x, .data$groupname_col %in% lvl) %>%
            dplyr::ungroup() %>%
            dplyr::select(-.data$groupname_col)
        )
      }
    )
  
  tbl_merge(df$tbl, tab_spanner = paste0("**", df$outcome_level, "**"))
}

# dummy data
crime <-
  data.frame(
    city = sample(c("SF", "AR", "NYC", "MN"), 13000, replace = TRUE),
    year = sample(as.factor(c(1990, 2000, 1999, 1989)), 13000, replace = TRUE)
  )

# multinom model tabulated with gtsummary
tbl <-
  nnet::multinom(city ~ year, data = crime) %>%
  tbl_regression(exponentiate = TRUE) %>%
  multinom_pivot_wider()

Thank you a million times!

Thank you very much, it's super useful!

The custom function works great, thanks.
I am now trying it with multiple models but I need to distinguish the model header from the the table_spanner argument. See the modified code below.
Is it possible to have 1) one spanner to distinguish the models and 2) one spanner to identify the categories in the factor dependent variable?

Thanks!

set.seed(20210511)
library(gtsummary)
library(magrittr)

multinom_pivot_wider <- function(x) {
  # check inputs match expectatations
  if (!inherits(x, "tbl_regression") || !inherits(x$model_obj, "multinom")) {
    stop("`x=` must be class 'tbl_regression' summary of a `nnet::multinom()` model.")
  }
  
  # create tibble of results
  df <- tibble::tibble(outcome_level = unique(x$table_body$groupname_col))
  df$tbl <- 
    purrr::map(
      df$outcome_level,
      function(lvl) {
        gtsummary::modify_table_body(
          x, 
          ~dplyr::filter(.x, .data$groupname_col %in% lvl) %>%
            dplyr::ungroup() %>%
            dplyr::select(-.data$groupname_col)
        )
      }
    )
  
  tbl_merge(df$tbl, tab_spanner = paste0("**", df$outcome_level, "**"))
}

# dummy data
crime <-
  data.frame(
    city = sample(c("SF", "AR", "NYC", "MN"), 13000, replace = TRUE),
    year = sample(as.factor(c(1990, 2000, 1999, 1989)), 13000, replace = TRUE)
  )

# now creating two models
tbl1 <-
  nnet::multinom(city ~ year, data = crime) %>% 
  tbl_regression(exponentiate = TRUE) %>% 
  multinom_pivot_wider()

tbl2 <-
  nnet::multinom(city ~ year, data = crime) %>% 
  tbl_regression(exponentiate = TRUE) %>% 
  multinom_pivot_wider()

# merging 
tbl_merge(tbls = list(tbl1, tbl2), tab_spanner = c("**Tbl1**", "**Tbl2**"))