How to move row group name into stubhead and center stub using gt()

Question

I'm trying to create a contingency table using the gtsummary and gt packages in R. I have two questions that I'm hoping will correct the table I've made so far:

1. How can I move the row group name to the stubhead so that it is in the same line as the other column names?

2. How can I center the row labels under the row group name? In the attached image (which is output with the code below), the row labels aren't properly centered.

RacexEth <- REDCapTab %>% 
  filter(PTDbloods >= 1) %>% 
  tbl_cross(mrace8905, eth8905, 
            label = list(mrace8905 ~ "Race", eth8905 ~ "Ethnicity")) %>% 
  bold_labels() %>% 
  modify_column_alignment(columns = everything(), align = "center") %>% 
  as_gt() %>%
  cols_width(everything() ~ px(140)) %>% 
  cols_align(align = "center", columns = everything()) %>% 
  tab_header(title = md("**Race by Ethnicity**")) %>%
  tab_style(style = list(cell_text(align = "center")),
            locations = cells_stub())
RacexEth

I've tried using the tab_style() function with cells_stub() and cells_stubhead() to center align the row labels but to no avail. I'm unsure how (or if) you can move the row group name to the stubhead in a contingency table.

Answer 1

Since you are not sharing your data, I am using datasets::Titanic as an example.

library(gt)
library(gtsummary)
library(dplyr)
library(tidyr)

## initial table
as.data.frame(datasets::Titanic) %>% 
  uncount(Freq) %>% 
  tbl_cross(Class, Survived, 
            label = list(Class ~ "Class", Survived  ~ "Survived")) %>% 
  bold_labels() -> SurvivalxClass 

## modify headers/labels
SurvivalxClass$table_styling$header %>% 
  mutate(label = ifelse(column == "label", 
                        "**Class**", label)) -> SurvivalxClass$table_styling$header
  
SurvivalxClass$table_body$label[1] <- ""

## apply the final formatting and render
SurvivalxClass %>% 
  modify_column_alignment(columns = everything(), align = "center") %>% 
  as_gt() %>%
  cols_width(everything() ~ px(140)) %>% 
  cols_align(align = "center", columns = everything()) %>% 
  tab_header(title = md("**Survival by Class**")) %>%
  tab_style(style = list(cell_text(align = "center")),
            locations = cells_stub())

^{Created on 2024-03-13 with reprex v2.0.2}

For your example, it would be like this:

RacexEth <- REDCapTab %>% 
  filter(PTDbloods >= 1) %>% 
  tbl_cross(mrace8905, eth8905, 
            label = list(mrace8905 ~ "Race", eth8905 ~ "Ethnicity")) %>% 
  bold_labels()
 

RacexEth$table_styling$header %>% 
  mutate(label = ifelse(column == "label", 
                        "**Race**", label)) -> SurvivalxClass$table_styling$header
  
RacexEth$table_body$label[1] <- ""


RacexEth %>%
  modify_column_alignment(columns = everything(), align = "center") %>% 
  as_gt() %>%
  cols_width(everything() ~ px(140)) %>% 
  cols_align(align = "center", columns = everything()) %>% 
  tab_header(title = md("**Race by Ethnicity**")) %>%
  tab_style(style = list(cell_text(align = "center")),
            locations = cells_stub()) -> RacexEth

RacexEth