如何在表内和标题中的多个列之间扩展DT数据表单元格

Question

我很难使字符串分布在DT：datatable标头和表本身的多列中。我找到了以下解决方案： Extend a table cell across multiple columns， merge columns in DT:datatable

但似乎无法让它们为我自己的目的而工作。

这就是我得到的：

这就是我想要的：

样本数据：

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

示例代码：

   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)

如您所见，列被推到右侧，这不是我想要的。我将不胜感激任何帮助或指导。谢谢。

Answer 1

不完全是您想要的，而是关闭：

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