Multiple header in R Dataframe

Question

I have a function that return the following dataframe

(code for toy example below)

df <- data.frame(
      var = c("var1 ------", "mod1", "mod2", "var2 ------","mod1", "mod2", "mod3"),
      X1_Y1 = c(NA,0,1,NA,1,3,5),
      X1_Y2 = c(NA,2,5,NA,2,4,10),
      X2_Y1 = c(NA,8,8,NA,3,3,1),
      X2_Y2 = c(NA,9,3,NA,0,6,2))

For context, these are just weighted statistics of one variable of interest (Y with values Y1 and Y2) crossed by explanatory variables (var1 and var2) and stratified by another variable (X with values X1 and X2).

What I would like is to have a double row header such as :

My constraint is that it has to be done on specific objects : either directly on R dataframe or possibly on DT::datatable. But I am not sure this is possible, and if so, really don't know how.

I found solutions using flextable or raw html but it does not suit really well my goal. (EDIT : also tried the kableExtra::add_header_above which works but prevents me from keeping my DT::datatable object in my rmd)

EDIT : the folowing solutions almost do the job BUT it seems to me that I need to leave aside the DT::datatable represensation.

Answer 1

Thanks to @Friede and @Limey answers, plus section 2.6 of this doc, plus this thread that I missed at first, I came up with this solution, that should work for every df passed as long as column names follow the pattern ValueOfStratifyingVariable_ValueOfInterestVariable

f <- function(df) {
  # get names for both rows of header
  values <- matrix(unlist(strsplit(names(df)[-1], "_")),
                 ncol=2,
                 byrow=TRUE)

  head_row1 <- table(values[,1])
  head_row2 <- values[,2]

  # create custom table container
  sketch = htmltools::withTags(table(
    class = 'display',
    thead(
      tr(
        th(rowspan = 2, 'Var'),
        lapply(names(head_row1),
               function(x) {th(colspan = head_row1[[x]],
                               x, class = 'dt-center')})
      ),
      tr(
        lapply(head_row2,  th)
      )
    )
  ))
  
  # apply container to DT::datatable
  DT::datatable(df, container = sketch, rownames = FALSE)
}

f(df)

This produces the expected output :

Answer 2

Too long for a comment.

You might reshape your data a bit and investigate the container-argument in DT::datatable(), cp. section 2.6 Custom Table Container. Further refinement should get you close to your expected output.

df = data.frame(
  # var name changed from var to mod 
  mod = c("var1 ------", "mod1", "mod2", "var2 ------","mod1", "mod2", "mod3"),
  X1_Y1 = c(NA,0,1,NA,1,3,5),
  X1_Y2 = c(NA,2,5,NA,2,4,10),
  X2_Y1 = c(NA,8,8,NA,3,3,1),
  X2_Y2 = c(NA,9,3,NA,0,6,2))
df = cbind(grp = c(rep("var1", 2), rep("var2", 3)), df[-c(1, 4), ])
spans = c("Grouping", unique(sub("_.*", "", colnames(df)))[3:4])
cnms = sub(".*_", "", colnames(df))

library(DT)
library(htmltools)

sketch = withTags(table(
  class = 'display',
  thead(
    tr(
      lapply(spans, th, colspan = 2, class = "dt-center")
      ),
    tr(
      lapply(cnms, th)
      )
    )
  )
)
datatable(df, container = sketch, rownames = FALSE)

which gives