使用 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)