Блог

Приведенный ниже код

 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)
  

создает эту таблицу…данные, очевидно, бесполезны, чтобы занимать место в столбцах, но вы поняли идею.

И, как вы можете видеть, две метки столбцов гаечных ключей

   tab_spanner(label="New Cases", columns=vars(NCIncidence, NCRiskLevel)) %>%
  tab_spanner(label="Test Positivity", columns=vars(TestIncidence, 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", "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)))