R 数据 table 列 headers 多行

Question

我有一个问题过去以某种方式被问过，但不是我需要的方式。我有以下 R 数据框：

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

现在，我需要像这样显示数据框：

我阅读了 https://rstudio.github.io/DT/ 第 2.6 节，但是，其中的示例没有针对每一列 header 的多行。同样的问题：Center custom data table container column headers in Shiny 我发现解决方案 Rstudio shiny renderDataTable headers multi line? 在某种意义上很有趣，也许使用 html
可以让我使用一个单列 header 但显示在多行上，但它不会似乎工作。这是我的输出代码。请注意，我使用了 extensions = "Buttons"，因为实际的数据帧要大得多，这允许用户将数据导出到 csv 和 excel。谢谢

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

Answer 1

作为一个完全 HTML/CSS 无知的新手，我发现很难做到这一点，并提出了一个解决方案，我确信这不是最优雅的解决方案，但它确实有效！我在这里分享了一个脚本的完整代码，人们可以简单而完整地复制和粘贴这些代码，以便在他们的机器上看到这个例子。希望对你有帮助。

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 数据 table 列 headers 多行

R data table column headers over multiple rows

datatable

r

datatables

shiny