shiny DT multiple levels header with dynamic difference quantity columns using JS

Question

Good day.

I have some task.

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

I need the title to be two-level, but he number of columns (cities) is always different. therefore, the standard version with a container is not suitable, where you need to immediately indicate the number of columns

need...

Thank you!!!

Answer 1

You can use knitr::kable . This will work for any number of columns and any number of city.

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)