是否有一种巧妙的方法可以在R GT表中获取两个列扳手标签？

问题描述

下面的代码

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,9)
TestColumn_four <- c(1,9)
TestColumn_five <- c(1,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,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",NCRiskLevel,TestIncidence,TestRiskLevel)) %>%
  tab_spanner(label="Localities",columns=vars(LocalCommunity,LocalRisk))


print(testBoard)

生成此表...数据显然很垃圾，无法在列中占据一席之地，但您明白了。

您会看到两个扳手列标签

  tab_spanner(label="New Cases",TestRiskLevel)) %>%

被覆盖。有没有办法解决这两个扳手标签行？还是不可能？

Stackoverflow说我的帖子主要是代码，我必须添加更多详细信息，所以我在这里键入了更多字符，以期消除这一障碍...但希望问题很清楚。

解决方法

gt不支持具有多个扳手行。

最简单的方法是修改HTML。

之前：

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

之后：

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

这可以在R中使用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",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)))

gt r r