R data table column headers over multiple rows

Question

I have a question that has been somehow asked in the past but not exactly in the way I need. I have the following R dataframe:

df <- data.frame(Identifier=c(1,2,3,4), STATE=c('NY','CA','TX','FL'), STATE_NAME=c("New York","California","Texas","Florida"),CRIME_RATE=c(0.2, 0.3, 0.35, 0.4), EMPLOYMENT=c(0.8,0.8,0.7,0.5))

Now, I would need to display the dataframe like this:

I read https://rstudio.github.io/DT/ section 2.6 however, the example there doesn't have multiple rows for each individual column header. Same problem here: Center custom data table container column headers in Shiny I found solution Rstudio shiny renderDataTable headers multi line? interesting in the sense that perhaps using html
could have allowed me to use one single column header but displayed over multiple rows, however it doesn't seem to work. This is my output code. Notice I use extensions = "Buttons", because the actual dataframe is way bigger and this allows users to export the data to csv and excel. Thanks

output$output_table <- renderDataTable({
df <- data.frame(Identifier=c(1,2,3,4), STATE=c(NY,CA,TX,FL), STATE_NAME=c("New York","California","Texas","Florida"),CRIME_RATE=c(0.2, 0.3, 0.35, 0.4), EMPLOYMENT=c(0.8,0.8,0.7,0.5))

df <- datatable(df, 
                  rownames= F,
                  filter = 'top',
                  extensions = "Buttons",
                  options = list(scrollX = TRUE
                                 , autoWidth = TRUE
                                 , pageLength = 66
                                 , dom = 'Blfrtip'
                                 ,buttons = c('copy', 'csv', 'excel', 'pdf')
                  ))  
return(df)
                        
})

Those were supposed to be strings, sorry about that, I just amended the code. — Angelo, Mar 23 '21 at 14:52

score 0 · Accepted Answer · answered Mar 24 '21 at 13:37

Being a newbie and completely HTML/CSS ignorant, I found it hard to achieve this and came up with a solution that I'm sure is not the most elegant one but it does work! I'm sharing here the entire code of a script that people can simply and entirely copy and paste in order to see this example working from their machines. I hope it may be of help.

library(shiny)
library(shinydashboard)
library(shinyBS)
library(dplyr)
library(lubridate)
library(DT)

ui <- fluidPage(
  
  mainPanel(
    h3("Table:"),
    dataTableOutput("sample_table1"),
    br(),
    dataTableOutput("sample_table2"),
    br(),
    dataTableOutput("sample_table3")
  )
  
)

server <- function(input, output, session) {   
  
      output$sample_table1 <- renderDataTable({  #
              df <- head(mtcars, 5)
              
              cat("\n\n* IN THIS EXAMPLE,WE TEST SHOWING A TABLE WITH COLUMN HEADERS THAT CONSIST IN MULTIPLE ROWS")
              # https://rstudio.github.io/DT/  -->  table container
              
              sketch = htmltools::withTags(table(
                class = 'display',
                thead(
                  tr(
                    th(rowspan = 2, 'Metric'),
                    th(colspan = 1, 'mpg'),
                    th(colspan = 1, 'cyl'),
                    th(colspan = 1, 'disp'),
                    th(colspan = 1, 'hp'),
                    th(colspan = 1, 'drat'),
                    th(colspan = 1, 'wt'),
                    th(colspan = 1, 'qsec'),
                    th(colspan = 1, 'vs'),
                    th(colspan = 1, 'am'),
                    th(colspan = 1, 'gear'),
                    th(colspan = 1, 'carb')
                  ),
                  tr(
                    lapply(rep(colnames(df), 1), th)
                  )
                )
              ))
              
              datatable(df, container = sketch, rownames = T)
      })
      
      
      output$sample_table2 <- renderDataTable({  #
            df <- head(mtcars, 5)
            
            cat("\n\n* IN THIS EXAMPLE,WE TEST SHOWING A TABLE WITH COLUMN HEADERS THAT CONSIST IN 2 rows, WITH THE COL NAMES TAKEN DIRECTLY FROM THE DATAFRAME")
            # https://rstudio.github.io/DT/  -->  table container
            
            v_col_names_lowest_labels <- c("",colnames(df))
            
            sketch = htmltools::withTags(table(
              class = 'display',
              thead(
                      th(
                          lapply(colnames(df), th)
                      ),
                      
                      tr(
                          lapply(v_col_names_lowest_labels, th)
                      )
                   )
            ))
            
            datatable(df, container = sketch, rownames = T)
        
      })
      
      
      output$sample_table3 <- renderDataTable({  #
            df <- head(mtcars, 5)
            
            cat("\n\n* IN THIS EXAMPLE,WE TEST SHOWING A TABLE WITH COLUMN HEADERS THAT CONSIST IN MULTIPLE ROWS")
            # https://rstudio.github.io/DT/  -->  table container
            
            v_col_names_lowest_labels <- c("",colnames(df))
            
            sketch = htmltools::withTags(table(
              class = 'display',
              thead(
                tr(
                  lapply(v_col_names_lowest_labels, th)
                ),
                tr(
                  lapply(v_col_names_lowest_labels, th)
                ),
                tr(
                  lapply(v_col_names_lowest_labels, th)
                )
              )
            ))
            
            datatable(df, container = sketch, rownames = T)
        
      })
}


cat("\nLaunching   'shinyApp' ....")
shinyApp(ui, server)

R data table column headers over multiple rows

1 Answers1