rdataframedatatablenamesmultirow

Multiple header in R Dataframe

I have a function that return the following dataframe

enter image description here

(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 : enter image description here

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.

enter image description here

Solution

  • 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 : enter image description here