How to extend a table cell across multiple columns when rendered in R Shiny?

问题

I have a dataframe of values that I'm attempting to render as a table in R Shiny. There are certain values which I want to extend to take up multiple columns in the same way in which you'd use the HTML rowspan attribute. However, if I were to do that I'd have to create the whole table from scratch, and I would much prefer to use the DT library for easy conversion from my datatable.

As an example I've created the following script:

# ui.R

fluidPage(
  DT::dataTableOutput("table")
)

# server.R

library(DT)

function(input, output) {

  output$table <- DT::renderDataTable({
    df <- data.frame(A = c("Trial 1", 1, 1, 1), B = c("", 1, 1, 1), C = c("", 1, 1, 1),
                     D = c("Trial 2", 2, 2, 2), E = c("", 2, 2, 2), F = c("", 2, 2, 2),
                     G = c("Trial 3", 3, 3, 3), H = c("", 3, 3, 3), I = c("", 3, 3, 3))

    DT::datatable(df,
                  options = list(dom = "t",
                                 ordering = FALSE))
  })

}

This script renders the following UI:

How can I expand out the cells containing "Trial 1", "Trial 2", and Trial 3" so that they each take up three columns?

回答1:

We could use a custom container to add the column group names as real column headers:

# ui.R

ui <- fluidPage(
  DT::dataTableOutput("table")
)

# server.R

library(DT)
df <- data.frame(A = c(1, 1, 1), B = c(1, 1, 1), C = c(1, 1, 1),
                 D = c(2, 2, 2), E = c(2, 2, 2), F = c(2, 2, 2),
                 G = c(3, 3, 3), H = c(3, 3, 3), I = c(3, 3, 3))

myContainer <- htmltools::withTags(table(
  class = 'display',
  thead(
    tr(
      th(),
      th(colspan = 3, 'Trial 1', class = "dt-center"),
      th(colspan = 3, 'Trial 2', class = "dt-center"),
      th(colspan = 3, 'Trial 3', class = "dt-center")
    ),
    tr(
      th(),
      lapply(names(df), th)
    )
  )
))

server <- function(input, output) {

  output$table <- DT::renderDataTable({
    DT::datatable(df, container = myContainer,
                  options = list(dom = "t", ordering = FALSE,
                                 columnDefs = list(list(className = "dt-center", targets = "_all"))
                  ))
  })

}

runApp(list(ui = ui, server = server))

Output:

Alternativly, if you really want that first row to have colspans we can use the initComplete option to call a JavaScript function when the table is rendered. Here is the server part only:

jsc <- '
function(settings, json) {
  $("td:contains(\'Trial\')").attr("colspan", "3").css("text-align", "center");
  $("tbody > tr:first-child > td:empty").remove();
}'

server <- function(input, output) {
  output$table <- DT::renderDataTable({
    df <- data.frame(A = c("Trial 1", 1, 1, 1), B = c("", 1, 1, 1), C = c("", 1, 1, 1),
                     D = c("Trial 2", 2, 2, 2), E = c("", 2, 2, 2), F = c("", 2, 2, 2),
                     G = c("Trial 3", 3, 3, 3), H = c("", 3, 3, 3), I = c("", 3, 3, 3))
    DT::datatable(df, options = list(dom = "t", ordering = FALSE, initComplete = JS(jsc)))
  })

}

In the first row of the JS function we select all cells that contain the word Trial and add the corresponding attributes and styles. Afterwards we select all empty cells, that are a direct descendant of a row element which in turn is the first child of the body of the table and remove them from the DOM. Here you find a general reference on CSS selectors like >.

Output:

来源：https://stackoverflow.com/questions/49803975/how-to-extend-a-table-cell-across-multiple-columns-when-rendered-in-r-shiny

标签

html-table

Shiny