Unable to filter multiple headers in Custom Container using DT::DataTable

[Saad]

I'm using custom container in R ShinyApp. Its currently having Sepal and Petal as headers that are both containing Length and Width columns. So is it possible to get a dropdown from Sepal/Petal for selecting/filtering Length or Width?
i.e. filter out the headers within headers.
I'm currently using checkboxGroupInput for this purpose but its not giving required results.
I have attached my codes as well. Can someone please sort it out. Thanks in advance
Also posted on stackoverflow. You can cross check answers:

Unable to filter multiple headers in Custom Container using DT::DataTable

**MY Codes:**
library(shiny)
library(DT)

iris<-iris[,c(5,1:4)]

ui =basicPage(
tags$head(
tags$style(type = "text/css",
           HTML("th { text-align: center; }")  )),

selectInput(inputId = "Species", 
          label = "Species:",
          choices = c("All",
                      unique(as.character(iris$Species)))),

checkboxGroupInput(inputId = "columns", label = "Select Variable:",
                 choices =c("Sepal.Length", "Sepal.Width", "Petal.Length", 
 "Petal.Width"),
                 selected = c("Sepal.Length", "Sepal.Width", "Petal.Length", 
 "Petal.Width")),

h2('Iris Table'),
DT::dataTableOutput('mytable') )

server = function(input, output) {
output$mytable = DT::renderDataTable({

 # a custom table container
sketch = htmltools::withTags(table(
  class = 'display',
  thead(
    tr(
      th(rowspan = 2, 'Species'),
      th(colspan = 2, 'Sepal'),
      th(colspan = 2, 'Petal')),
    tr(
      lapply(rep(c('Length', 'Width'), 2), th)
    )) )) 

  DT::datatable( rownames = FALSE, container = sketch,
              extensions = 'Buttons',
                 options = list(dom = 'Bfrtip',
                             buttons = 
                               list('colvis', list(
                                 extend = 'collection',
                                 buttons = list(list(extend='csv',
                                                     filename = 'hitStats'),
                                                list(extend='excel',
                                                     filename = 'hitStats'),
                                                list(extend='pdf',
                                                     filename= 'hitStats'),
                                                list(extend='copy',
                                                     filename = 'hitStats'),
                                                list(extend='print',
                                              filename = 'hitStats')),

                                 text = 'Download' ))),
               {

                data<-iris

                if(input$Species != 'All'){
                  data<-data[data$Species == input$Species,]
                }    

                data<-data[,c("Species",input$columns),drop=FALSE]   

                data   
              }) })    }

shinyApp(ui = ui, server = server)

[jcheng]

I used a little dplyr to accomplish this. It's still a bit buggy, in that if you deselect all the checkboxes, the heading rows disappear; I think you should be able to figure out how to fix that, with a separate if/else branch if nothing else.

library(shiny)
library(DT)
library(dplyr)

iris<-iris[,c(5,1:4)]

ui =basicPage(
  tags$head(
    tags$style(type = "text/css",
      HTML("th { text-align: center; }")  )),
  
  selectInput(inputId = "Species", 
    label = "Species:",
    choices = c("All",
      unique(as.character(iris$Species)))),
  
  checkboxGroupInput(inputId = "columns", label = "Select Variable:",
    choices =c("Sepal.Length", "Sepal.Width", "Petal.Length", 
      "Petal.Width"),
    selected = c("Sepal.Length", "Sepal.Width", "Petal.Length", 
      "Petal.Width")),
  
  h2('Iris Table'),
  DT::dataTableOutput('mytable') )

server = function(input, output) {
  output$mytable = DT::renderDataTable({
    
    #### BEGIN JOE'S CHANGES
    validate(need(all(grepl("[Sepal|Petal]\\.[Length|Width]", input$columns)), "Invalid choices"))
    
    header_df <- tibble(part = character(), dimension = character())
    
    if (!is.null(input$columns)) {
      header_df <- strsplit(input$columns, ".", fixed = TRUE) %>%
        lapply(function(x) tibble(part = x[1], dimension = x[2])) %>%
        dplyr::bind_rows()
    }
    
    sepal_dims <- header_df %>% filter(part == "Sepal") %>% pull(dimension)
    petal_dims <- header_df %>% filter(part == "Petal") %>% pull(dimension)
    
    # a custom table container
    sketch = htmltools::withTags(table(
      class = 'display',
      thead(
        tr(
          th(rowspan = 2, 'Species'),
          if (length(sepal_dims))
            th(colspan = length(sepal_dims), 'Sepal'),
          if (length(petal_dims))
            th(colspan = length(petal_dims), 'Petal')),
        tr(
          lapply(sepal_dims, th),
          lapply(petal_dims, th)
        )) )) 

    #### END JOE'S CHANGES

    DT::datatable( rownames = FALSE, container = sketch,
      extensions = 'Buttons',
      options = list(dom = 'Bfrtip',
        buttons = 
          list('colvis', list(
            extend = 'collection',
            buttons = list(list(extend='csv',
              filename = 'hitStats'),
              list(extend='excel',
                filename = 'hitStats'),
              list(extend='pdf',
                filename= 'hitStats'),
              list(extend='copy',
                filename = 'hitStats'),
              list(extend='print',
                filename = 'hitStats')),
            
            text = 'Download' ))),
      {
        
        data<-iris
        
        if(input$Species != 'All'){
          data<-data[data$Species == input$Species,]
        }    
        
        data<-data[,c("Species",input$columns),drop=FALSE]   
        
        data   
      }) })    }

shinyApp(ui = ui, server = server)

[Saad]

Great work mate, thanks a lot
Just one more thing, is it possible to download the data including headers as well?
Because currently when i download this output, the headers doesn't display in excel