Is there a clever way to get two column spanner labels in an R GT table?

Question

The code below

library(magrittr)
library(gt)
library(dplyr)

TestColumn_one <- c("CA", "FL", "GA", "MA", "NM", "OH", "OK", "TN", "UT")
TestColumn_two <- c(1, 2, 3, 4, 5, 6, 7, 8, 9)
TestColumn_three <- c(1, 2, 3, 4, 5, 6, 7, 8, 9)
TestColumn_four <- c(1, 2, 3, 4, 5, 6, 7, 8, 9)
TestColumn_five <- c(1, 2, 3, 4, 5, 6, 7, 8, 9)
TestColumn_six <- c("Community 1",
                    "Community 2",
                    "Community 3",
                    "Community 4",
                    "Community 5",
                    "Community 6",
                    "Community 7",
                    "Community 8",
                    "Community 9")
TestColumn_seven <- c(1, 2, 3, 4, 5, 6, 7, 8, 9)

test.dashboard.data <- data.frame(TestColumn_one, TestColumn_two,TestColumn_three, 
                                  TestColumn_four, TestColumn_five, TestColumn_six,
                                  TestColumn_seven,
                                  stringsAsFactors = FALSE)

names(test.dashboard.data)[1] <- "State"
names(test.dashboard.data)[2] <- "NCIncidence"
names(test.dashboard.data)[3] <- "NCRiskLevel"
names(test.dashboard.data)[4] <- "TestIncidence"
names(test.dashboard.data)[5] <- "TestRiskLevel"
names(test.dashboard.data)[6] <- "LocalCommunity"
names(test.dashboard.data)[7] <- "LocalRisk"

testBoard <- test.dashboard.data %>% gt() %>%
  tab_header(
    title = md("**CDC Risk Levels**"),
    subtitle = md("*Based on 14-day moving average of cases per 100,000*")
  ) %>%
  cols_label(NCIncidence = "Incidence",
             NCRiskLevel = "Risk Level",
             TestIncidence = "Incidence",
             TestRiskLevel = "Risk Level",
             LocalCommunity = "Local Community",
             LocalRisk = "Risk Level") %>%
  
  #These two spanners get clobbered by the last two
  tab_spanner(label="New Cases", columns=vars(NCIncidence, NCRiskLevel)) %>%
  tab_spanner(label="Test Positivity", columns=vars(TestIncidence, TestRiskLevel)) %>%
  
  
  tab_spanner(label="Statewide", columns=vars(NCIncidence, NCRiskLevel, TestIncidence, TestRiskLevel)) %>%
  tab_spanner(label="Localities", columns=vars(LocalCommunity, LocalRisk))


print(testBoard)

produces this table...the data is obviously junk to hold the place in the columns but you get the idea.

And as you can see the two spanner column labels

  tab_spanner(label="New Cases", columns=vars(NCIncidence, NCRiskLevel)) %>%
  tab_spanner(label="Test Positivity", columns=vars(TestIncidence, TestRiskLevel)) %>%

are overwritten. Is there a way around this to achieve two rows of spanner labels? Or is that just not possible?

Stackoverflow says my post is mostly code and I have to add more details so I'm typing more characters down here in hopes of clearing that hurdle...but hopefully the question is clear.

AFAIK it's limited to two levels. Agree that another level of nesting would be useful. Perhaps submit a feature request? — Ritchie Sacramento, Oct 29 '20 at 01:16
As of gt version 0.5.0 (CRAN release 4-21-22): *The tab_spanner() and tab_spanner_delim() functions now support the addition of column spanners with unlimited levels (previously, only a single level of spanner column labels was possible to add).* — Ben, Aug 03 '23 at 12:23

score 6 · Accepted Answer · answered Oct 29 '20 at 03:38

Having multiple spanner rows isn't supported by gt.

The easiest way to do it is to simply modify the HTML.

Before:

  <thead class="gt_col_headings">
    <tr>
      <th class="gt_col_heading gt_center gt_columns_bottom_border" rowspan="2" colspan="1">State</th>
      <th class="gt_center gt_columns_top_border gt_column_spanner_outer" rowspan="1" colspan="4">
        <span class="gt_column_spanner">Statewide</span>
      </th>
      <th class="gt_center gt_columns_top_border gt_column_spanner_outer" rowspan="1" colspan="2">
        <span class="gt_column_spanner">Localities</span>
      </th>
    </tr>
    <tr>
      <th class="gt_col_heading gt_columns_bottom_border gt_center" rowspan="1" colspan="1">Incidence</th>
      <th class="gt_col_heading gt_columns_bottom_border gt_center" rowspan="1" colspan="1">Risk Level</th>
      <th class="gt_col_heading gt_columns_bottom_border gt_center" rowspan="1" colspan="1">Incidence</th>
      <th class="gt_col_heading gt_columns_bottom_border gt_center" rowspan="1" colspan="1">Risk Level</th>
      <th class="gt_col_heading gt_columns_bottom_border gt_center" rowspan="1" colspan="1">Local Community</th>
      <th class="gt_col_heading gt_columns_bottom_border gt_center" rowspan="1" colspan="1">Risk Level</th>
    </tr>
  </thead>

After:

  <thead class="gt_col_headings">
    <tr>
      <th class="gt_col_heading gt_center gt_columns_bottom_border" rowspan="3" colspan="1">State</th>
      <th class="gt_center gt_columns_top_border gt_column_spanner_outer" rowspan="1" colspan="4">
        <span class="gt_column_spanner">Statewide</span>
      </th>
      <th class="gt_center gt_columns_top_border gt_column_spanner_outer" rowspan="1" colspan="2">
        <span class="gt_column_spanner">Localities</span>
      </th>
    </tr>
    <tr>
      <th class="gt_center gt_columns_top_border gt_column_spanner_outer" rowspan="1" colspan="2">
        <span class="gt_column_spanner">New Cases</span>
      </th>
      <th class="gt_center gt_columns_top_border gt_column_spanner_outer" rowspan="1" colspan="2">
        <span class="gt_column_spanner">Test Positivity</span>
      </th>
    </tr>
    <tr>
      <th class="gt_col_heading gt_columns_bottom_border gt_center" rowspan="1" colspan="1">Incidence</th>
      <th class="gt_col_heading gt_columns_bottom_border gt_center" rowspan="1" colspan="1">Risk Level</th>
      <th class="gt_col_heading gt_columns_bottom_border gt_center" rowspan="1" colspan="1">Incidence</th>
      <th class="gt_col_heading gt_columns_bottom_border gt_center" rowspan="1" colspan="1">Risk Level</th>
      <th class="gt_col_heading gt_columns_bottom_border gt_center" rowspan="1" colspan="1">Local Community</th>
      <th class="gt_col_heading gt_columns_bottom_border gt_center" rowspan="1" colspan="1">Risk Level</th>
    </tr>
  </thead>

This can be done in R using xml2.

library(xml2)

html <- read_xml(toString(gt:::as.tags.gt_tbl(testBoard)), as_html = TRUE)

xml_set_attr(
  xml_find_all(html, "//th[@rowspan='2']"),
  "rowspan",
  "3"
)

middle_set <- htmltools::tags$tr(list(
  htmltools::tags$th(
    class = paste(c("gt_center", "gt_columns_top_border", "gt_column_spanner_outer"), collapse = " "),
    rowspan = 1,
    colspan = 2,
    htmltools::tags$span(class = "gt_column_spanner", htmltools::HTML("New Cases"))
  ),
  htmltools::tags$th(
    class = paste(c("gt_center", "gt_columns_top_border", "gt_column_spanner_outer"), collapse = " "),
    rowspan = 1,
    colspan = 2,
    htmltools::tags$span(class = "gt_column_spanner", htmltools::HTML("Test Positivity"))
  )
))

xml_add_child(
  xml_find_first(html, '//*[contains(concat(" ", normalize-space(@class), " "), " gt_col_headings ")]'),
  read_xml(as.character(middle_set), html = TRUE),
  .where = 1
)

htmltools::html_print(htmltools::HTML(as.character(html)))

Ben · Answer 2 · 2023-08-03T12:22:12.647

I believe you now can do multiple spanner rows with gt using the spanners argument in tab_spanner.

As of gt version 0.5.0 (CRAN release 4-21-22):

The tab_spanner() and tab_spanner_delim() functions now support the addition of column spanners with unlimited levels (previously, only a single level of spanner column labels was possible to add)

First you create the lower level spanners and add an id to each. Then you build higher level spanners based off those ids using the spanners argument. Note that using level argument will keep "Localities" at the same level as "Statewide" with a level of 2. The first spanner level (right above the column labels) is 1.

test.dashboard.data %>% gt() %>%
  tab_header(
    title = md("**CDC Risk Levels**"),
    subtitle = md("*Based on 14-day moving average of cases per 100,000*")
  ) %>%
  cols_label(NCIncidence = "Incidence",
             NCRiskLevel = "Risk Level",
             TestIncidence = "Incidence",
             TestRiskLevel = "Risk Level",
             LocalCommunity = "Local Community",
             LocalRisk = "Risk Level") %>%
  tab_spanner(label = "New Cases", 
              columns = c(NCIncidence, NCRiskLevel), 
              id = "new_cases") %>%
  tab_spanner(label = "Test Positivity", 
              columns = c(TestIncidence, TestRiskLevel), 
              id = "test_positives") %>%
  tab_spanner(label = "Statewide", 
              spanners = c("new_cases", "test_positives")) %>%
  tab_spanner(label = "Localities", 
              columns = c(LocalCommunity, LocalRisk), 
              level = 2)

Output

Is there a clever way to get two column spanner labels in an R GT table?

2 Answers2

Linked