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

Question

再会。

我有一些任务。

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)
 }) 
 
}

我需要标题是两级的，但他的列数（城市）总是不同的。 因此，带有容器的标准版本不适合，您需要立即指示列数

需要...

谢谢！！！

Answer 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)