How to extend DT datatable cells across multiple columns inside table and in header

问题

I'm having extreme difficulty trying to make a character string spread out across multiple columns in a DT:datatable header & in the table itself. I found these solutions: Extend a table cell across multiple columns, merge columns in DT:datatable

but can't seem to get them to work for my own purposes.

This is what I am getting:

This is what I want:

Sample Data:

df<-structure(list(`AQS ID` = c(NA, "AQS ID", "340071001", "340170006", 
"340010006", "340070002", "340273001", "340150002", "340290006", 
"340410007", "340190001", "340030006", "340110007", "340250005", 
"340130003", "340315001", "340210005", "340230011", "340219991"
), State = c(NA, "State", "NJ", "NJ", "NJ", "NJ", "NJ", "NJ", 
"NJ", "NJ", "NJ", "NJ", "NJ", "NJ", "NJ", "NJ", "NJ", "NJ", "NJ"
), Site = c(NA, "Site", "Ancora State Hospital", "Bayonne", "Brigantine", 
"Camden Spruce St", "Chester", "Clarksboro", "Colliers Mills", 
"Columbia", "Flemington", "Leonia", "Millville", "Monmouth University", 
"Newark Firehouse", "Ramapo", "Rider University", "Rutgers University", 
"Washington Crossing"), `4th Max (ppb)` = c("AQS AMP450 (4-10-19)", 
"2015", "72", "77", "64", "79", "70", "76", "75", "66", "73", 
"76", "68", "77", "72", "71", "73", "77", "75"), ...5 = c(NA, 
2016, 64, 68, 63, 76, 67, 74, 71, 65, 73, 73, 68, 68, 68, 68, 
71, 75, 74), ...6 = c(NA, 2017, 68, 67, 63, 76, 70, 73, 74, 64, 
72, 74, 63, 60, 64, 66, 69, 75, 71), ...7 = c(NA, 2018, 68, 78, 
63, 75, 73, 77, 74, 67, 72, 79, 63, 68, 71, 69, 76, 76, 77), 
    ...8 = c("Envista", "2019", "67", "65", "59", "70", "62", 
    "68", "68", "58", "66", "71", "68", "67", "65", "64", "66", 
    "70", "67"), `Design Value 2017` = c("2017", "68", "70", 
    "63", "77", "69", "74", "73", "65", "72", "74", "66", "68", 
    "68", "68", "71", "75", "73", NA), `Design Value 2018` = c(2018, 
    66, 71, 63, 75, 70, 74, 73, 65, 72, 75, 64, 65, 67, 67, 72, 
    75, 74, NA), `Design Value 2019` = c(2019, 67, 70, 61, 73, 
    68, 72, 72, 63, 70, 74, 64, 65, 66, 66, 70, 73, 71, NA)), row.names = c(NA, 
-19L), class = c("tbl_df", "tbl", "data.frame"))

Sample Code:

   library(shiny)
library(shinydashboard)

ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(),
  dashboardBody(DT::dataTableOutput("dailytable")))


server <- function(input, output) { 

  jsc <- '
      function(settings, json) {
      $("td:contains(\'AQS AMP450\')").attr("colspan", "4").css("text-align", "center");
      $("tbody > tr:fifth-child > td:empty");
      }'


  output$dailytable<-renderDataTable({

    DT::datatable(df,filter = 'top',options = list(dom = "t", ordering = FALSE, initComplete = JS(jsc)),
                  class = 'cell-border stripe')


  })



}

shinyApp(ui, server)

As you can see, columns are getting pushed over to the right which is not what I want. I would appreciate any help or guidance. Thanks.

回答1:

Not exactly what you want, but close:

library(htmltools)
sketch <- withTags(
  table(
    class = "display",
    thead(
      tr(
        th(colspan = 3, "2019", style = "border-right: solid 2px;"),
        th(colspan = 5, "4th Max ppb", style = "border-right: solid 2px;"),
        th(colspan = 3, "Design Values")
      ),
      tr(
        th(colspan = 3, "", style = "border-right: solid 2px;"),
        th(colspan = 4, "AQS AMP450 (4-10-19)", style = "border-right: solid 2px;"),
        th("Envista", style = "border-right: solid 2px;"),
        th(colspan = 3, "")
      ),
      tr(
        th("AQS ID"),
        th("State"),
        th("Site", style = "border-right: solid 2px;"),
        th("2015"),
        th("2016"),
        th("2017"),
        th("2018", style = "border-right: solid 2px;"),
        th("2019", style = "border-right: solid 2px;"),
        th("2017"),
        th("2018"),
        th("2019")
      )
    )
  )
)

dat <- cbind(df[3:nrow(df),1:8], df[2:(nrow(df)-1), 9:11])

library(DT)
datatable(dat, rownames = FALSE, container = sketch, 
          options = list(
            columnDefs = list(
              list(targets = "_all", className = "dt-center")
            )
          )) %>%
  formatStyle(c(3,7,8), `border-right` = "solid 2px")

来源：https://stackoverflow.com/questions/58770838/how-to-extend-dt-datatable-cells-across-multiple-columns-inside-table-and-in-hea

标签

datatable

Shiny