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",等等