How to group columns using DT?

Question

I want to group my columns in this way as shown in this post - 2.6 Custom Table Container.

I tried this:

library(DT)

set.seed(1234)

DT <- data.frame(
  "Col1" = c(1:40),
  "Col2" = sample(1:100, size = 40),
  "Col3" = sample(1:100, size = 40),
  "Col4" = sample(1:100, size = 40),
  "Col5_n" = sample(1:100, size = 40),
  "Col5_25%" = sample(1:100, size = 40),
  "Col5_median" = sample(1:100, size = 40),
  "Col5_75%" = sample(1:100, size = 40)
)

inputPick <- list("Col5")

sketch = htmltools::withTags(table(
  class = 'display',
  thead(
    tr(
      th(rowspan = 2, "Col1"),
      th(rowspan = 2, "Col2"),
      th(rowspan = 2, "Col3"),
      th(rowspan = 2, "Col4"),
      lapply(inputPick,th,colspan=4,rowspan=1)
    ),
  ),
  tr(
    th(colspan = 1, "", rowspan=2),
    th(colspan = 1, "", rowspan=2),
    th(colspan = 1, "", rowspan=2),
    th(colspan = 1, "", rowspan=2),
    lapply(rep(c("n","25%","median","75%"),length(inputPick)),th)
  )
)
)


print(sketch)

datatable(DT, container = sketch, rownames = FALSE)

This is how it looks:

As you can see, the table is empty and Col1, Col2, Col3, and Col4 should be on the same level as the subheaders (n,25%,median,75%). If I change the sketch code to rowspan = 1 for columns 1 to 4 the datatable is filled, but then I lose the subheaders for column 5:

sketch = htmltools::withTags(table(
  class = 'display',
  thead(
    tr(
      th(rowspan = 1, "Col1"),
      th(rowspan = 1, "Col2"),
      th(rowspan = 1, "Col3"),
      th(rowspan = 1, "Col4"),
      lapply(inputPick,th,colspan=4,rowspan=1)
    ),
  ),
  tr(
    th(colspan = 1, "", rowspan=2),
    th(colspan = 1, "", rowspan=2),
    th(colspan = 1, "", rowspan=2),
    th(colspan = 1, "", rowspan=2),
    lapply(rep(c("n","25%","median","75%"),length(inputPick)),th)
  )
)
)

It is important to add that this will be included in a reactive function using Shiny, so the number of variables in DT and the corresponding variable names in inputPick will change. This is an example:

set.seed(1234)

DT <- data.frame(
  "Col1" = c(1:40),
  "Col2" = sample(1:100, size = 40),
  "Col3" = sample(1:100, size = 40),
  "Col4" = sample(1:100, size = 40),
  "Col5_n" = sample(1:100, size = 40),
  "Col5_25%" = sample(1:100, size = 40),
  "Col5_median" = sample(1:100, size = 40),
  "Col5_75%" = sample(1:100, size = 40),
  "Col6_n" = sample(1:100, size = 40),
  "Col6_25%" = sample(1:100, size = 40),
  "Col6_median" = sample(1:100, size = 40),
  "Col6_75%" = sample(1:100, size = 40)
)

inputPick <- list("Col5","Col6")

sketch = htmltools::withTags(table(
  class = 'display',
  thead(
    tr(
      th(rowspan = 1, "Col1"),
      th(rowspan = 1, "Col2"),
      th(rowspan = 1, "Col3"),
      th(rowspan = 1, "Col4"),
      lapply(inputPick,th,colspan=4,rowspan=1)
    ),
  ),
  tr(
    th(colspan = 1, "", rowspan=2),
    th(colspan = 1, "", rowspan=2),
    th(colspan = 1, "", rowspan=2),
    th(colspan = 1, "", rowspan=2),
    lapply(rep(c("n","25%","median","75%"),length(inputPick)),th)
  )
)
)


print(sketch)

datatable(DT, container = sketch, rownames = FALSE)

Having said all of that, does anyone know how to go about fixing this problem?

Thanks in advance!

Answer 1

The DT post demonstrates it clearly. However, the post section was not very transparent about parameter descriptions in the container. See description below.

library(DT)

set.seed(1234)

DT <- data.frame(
    "Col1" = c(1:40),
    "Col2" = sample(1:100, size = 40),
    "Col3" = sample(1:100, size = 40),
    "Col4" = sample(1:100, size = 40),
    "Col5_n" = sample(1:100, size = 40),
    "Col5_25%" = sample(1:100, size = 40),
    "Col5_median" = sample(1:100, size = 40),
    "Col5_75%" = sample(1:100, size = 40),
    "Col6_n" = sample(1:100, size = 40),
    "Col6_25%" = sample(1:100, size = 40),
    "Col6_median" = sample(1:100, size = 40),
    "Col6_75%" = sample(1:100, size = 40)
)

sketch = htmltools::withTags(table(
    class = 'display',
    thead(
        tr(
            th(rowspan = 2, 'Col1'),
            th(rowspan = 2, 'Col2'),
            th(rowspan = 2, 'Col3'),
            th(rowspan = 2, 'Col4'),
            th(colspan = 4, 'Col5'),
            th(colspan = 4, 'Col6')
        ),
        tr(
            lapply(rep(c('n', '25%', 'median', '75%'), 2), th)
        )
    )
))

datatable(DT, container = sketch, rownames = FALSE)

Note that within sketch,
th(rowspan = 2, 'Col1') means that "Col1" column title takes up two rows. I did the same for "Col2" through "Col4".
th(colspan = 4, 'Col5') means that "Col5" column title is overtop four columns. I did the same for "Col6".