DT & shiny: 使 header 边框更明显
DT & shiny: make header borders more pronounced
我想在 shiny
应用程序中显示带有自定义嵌套容器的 DT
table。用户得出结论,很难区分不同的 header 部分,即季度和年份。有没有办法让 header 边界更明显,例如通过添加垂直边框?我宁愿避免按颜色区分 header 部分,就像建议的 一样。这是数据示例table,仅一年(闪亮的应用程序支持多年):
library(DT)
library(htmltools)
library(dplyr)
## quarterly breakdown
df_qrt <- data.frame(
group = LETTERS[1:6],
year = rep(2017, 6),
Q1_2017A = rnorm(6),
Q1_2017B = rnorm(6),
Q2_2017A = rnorm(6),
Q2_2017B = rnorm(6),
Q3_2017A = rnorm(6),
Q3_2017B = rnorm(6),
Q4_2017A = rnorm(6),
Q4_2017B = rnorm(6)
)
sketch_qrt = htmltools::withTags(
table(class = 'display',
thead(tr(
th(class = 'dt-center',
rowspan = 3,
'Group'),
lapply(unique(df_qrt$year),
th, colspan = 8)
),
tr(class = 'dt-center',
lapply(paste0('Q', 1:4),
th, colspan = 2)
),
tr(lapply(rep(
c('Alpha', 'Beta'), 4
), th))
))
)
DT::datatable(dplyr::select(df_qrt, -year),
container = sketch_qrt,
class = 'cell-border',
rownames = FALSE,
fillContainer = TRUE)
sketch_qrt = htmltools::withTags(
table(class = 'display',
thead(tr(
th(class = 'dt-center', style = "border-top: solid 3px",
rowspan = 3,
'Group'),
lapply(unique(df_qrt$year), style = "border-top: solid 3px",
th, colspan = 8)
),
tr(class = 'dt-center',
lapply(paste0('Q', 1:4),
th, colspan = 2)
),
tr(lapply(rep(
c('Alpha', 'Beta'), 4
), th))
))
)
headerCallback <- c(
"function(thead, data, start, end, display){",
" $(thead).closest('thead').find('th').css('border-right', 'solid 3px');",
" $(thead).closest('thead').find('th').eq(0).css('border-left', 'solid 3px');",
"}"
)
DT::datatable(dplyr::select(df_qrt, -year),
container = sketch_qrt,
class = 'cell-border',
rownames = FALSE,
fillContainer = TRUE,
options = list(headerCallback = JS(headerCallback)))
要有另一种颜色,请执行 "border-top: solid orange 3px"
,等等
我想在 shiny
应用程序中显示带有自定义嵌套容器的 DT
table。用户得出结论,很难区分不同的 header 部分,即季度和年份。有没有办法让 header 边界更明显,例如通过添加垂直边框?我宁愿避免按颜色区分 header 部分,就像建议的
library(DT)
library(htmltools)
library(dplyr)
## quarterly breakdown
df_qrt <- data.frame(
group = LETTERS[1:6],
year = rep(2017, 6),
Q1_2017A = rnorm(6),
Q1_2017B = rnorm(6),
Q2_2017A = rnorm(6),
Q2_2017B = rnorm(6),
Q3_2017A = rnorm(6),
Q3_2017B = rnorm(6),
Q4_2017A = rnorm(6),
Q4_2017B = rnorm(6)
)
sketch_qrt = htmltools::withTags(
table(class = 'display',
thead(tr(
th(class = 'dt-center',
rowspan = 3,
'Group'),
lapply(unique(df_qrt$year),
th, colspan = 8)
),
tr(class = 'dt-center',
lapply(paste0('Q', 1:4),
th, colspan = 2)
),
tr(lapply(rep(
c('Alpha', 'Beta'), 4
), th))
))
)
DT::datatable(dplyr::select(df_qrt, -year),
container = sketch_qrt,
class = 'cell-border',
rownames = FALSE,
fillContainer = TRUE)
sketch_qrt = htmltools::withTags(
table(class = 'display',
thead(tr(
th(class = 'dt-center', style = "border-top: solid 3px",
rowspan = 3,
'Group'),
lapply(unique(df_qrt$year), style = "border-top: solid 3px",
th, colspan = 8)
),
tr(class = 'dt-center',
lapply(paste0('Q', 1:4),
th, colspan = 2)
),
tr(lapply(rep(
c('Alpha', 'Beta'), 4
), th))
))
)
headerCallback <- c(
"function(thead, data, start, end, display){",
" $(thead).closest('thead').find('th').css('border-right', 'solid 3px');",
" $(thead).closest('thead').find('th').eq(0).css('border-left', 'solid 3px');",
"}"
)
DT::datatable(dplyr::select(df_qrt, -year),
container = sketch_qrt,
class = 'cell-border',
rownames = FALSE,
fillContainer = TRUE,
options = list(headerCallback = JS(headerCallback)))
要有另一种颜色,请执行 "border-top: solid orange 3px"
,等等