Как расширить ячейки с данными DT по нескольким столбцам внутри таблицы и в заголовке - PullRequest
0 голосов
/ 08 ноября 2019

Я испытываю огромные трудности при попытке разбить строку символов на несколько столбцов в заголовке DT: datatable и в самой таблице. Я нашел следующие решения: Расширить ячейку таблицы на несколько столбцов , объединить столбцы в DT: datatable

, но не могу заставить их работать на меняцели.

Вот что я получаю:

enter image description here

Это то, что я хочу:

enter image description here

Данные образца:

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)

Как видите, столбцы смещаются вправо, а это не то, чего я хочу. Буду признателен за любую помощь или руководство. Спасибо.

1 Ответ

1 голос
/ 10 ноября 2019

Не совсем то, что вы хотите, но закройте:

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

enter image description here

...