下面的代码
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)
Run Code Online (Sandbox Code Playgroud)
产生这个表...数据显然是垃圾来保存列中的位置,但你明白了。
正如您所看到的两个扳手列标签
tab_spanner(label="New Cases", columns=vars(NCIncidence, NCRiskLevel)) %>%
tab_spanner(label="Test Positivity", columns=vars(TestIncidence, TestRiskLevel)) %>%
Run Code Online (Sandbox Code Playgroud)
被覆盖。有没有办法解决这个问题来实现两行扳手标签?或者说这是不可能的?
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>
Run Code Online (Sandbox Code Playgroud)
后:
<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>
Run Code Online (Sandbox Code Playgroud)
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)))
Run Code Online (Sandbox Code Playgroud)
我相信您现在可以gt使用spanners中的参数来执行多个扳手行tab_spanner。
gt从版本 0.5.0(CRAN 版本 4-21-22)开始:
tab_spanner() 和 tab_spanner_delim() 函数现在支持添加无限级别的列扳手(以前只能添加单级扳手列标签)
首先,创建较低级别的扳手并id为每个扳手添加一个。然后,您可以使用参数根据这些 id 构建更高级别的扳手spanners。请注意,使用level参数将使“Localities”保持与“Statewide”相同的级别,级别为 2。第一个扳手级别(列标签正上方)为 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)
Run Code Online (Sandbox Code Playgroud)
输出