使用 JS 的具有动态差异数量列的闪亮 DT 多级标题

Posted 2023-03-24

【中文标题】使用 JS 的具有动态差异数量列的闪亮 DT 多级标题

【英文标题】：shiny DT multiple levels header with dynamic difference quantity columns using JS

【发布时间】：2021-09-07 12:01:05

【问题描述】：

美好的一天。

我有一些任务。

library(shiny)
ui <- fluidPage(
  DT::dataTableOutput('tbl')
)

library(DT)

data <- data.frame(list(
  good = c('a','b','c'),
  city = c('chicago', 'denver','colorado'),
  stock = c(1,2,3),
  transit = c(4,5,6)
))

server <- function(input, output) 
  
 output$tbl <- DT::renderDataTable(
   data%>%
     tidyr::pivot_wider(names_from = city, values_from = c('stock', 'transit'),
                        values_fill = 0, names_glue = 'city_.value')%>%
     dplyr::select(order(names(.)))%>%
     dplyr::relocate(good)
 ) 
 

我需要标题是两级的，但他的列数（城市）总是不同的。 所以带容器的标准版不适合，需要马上注明列数

需要...

谢谢！！！

【参考方案1】：

您可以使用knitr::kable。这适用于任意数量的列和任意数量的城市。

library(shiny)
library(knitr)
library(kableExtra)

ui <- fluidPage(
  htmlOutput('tbl')
)

library(DT)

data <- data.frame(list(
  good = c('a','b','c'),
  city = c('chicago', 'denver','colorado'),
  stock = c(1,2,3),
  transit = c(4,5,6)
))

server <- function(input, output) 
  
  output$tbl <- renderText(
    data%>%
      tidyr::pivot_wider(names_from = city, values_from = c('stock', 'transit'),
                         values_fill = 0, names_glue = 'city_.value')%>%
      dplyr::select(order(names(.)))%>%
      dplyr::relocate(good) -> tmp
    
    cols <- names(tmp)
    names(tmp) <- sub('.*_', '', cols)
    tmp %>%
      knitr::kable(type = 'text') %>%
      kable_styling(
        font_size = 15,
        bootstrap_options = c("striped", "hover", "condensed")
      ) %>%
      add_header_above(c('', table(sub('_.*', '', cols[-1]))))
  ) 
  


shinyApp(ui, server)