Include label attribute into xtable header

Question

Reproducible example:

I have a data frame which has labelled variables using the sjmisc package, which works nicely together with dplyr since v0.4.2.

library(dplyr)
library(sjmisc)
library(ggplot2)
data("diamonds")

df= tbl_df(diamonds) %>%
  select(cut, carat, price) %>%
  set_label(c("", "Kt", "EUR")) %>%
  slice(1:10)

As str(df) shows it properly contains for two columns the labels:

Classes ‘tbl_df’, ‘tbl’ and 'data.frame':   10 obs. of  3 variables:
 $ cut  : Ord.factor w/ 5 levels "Fair"<"Good"<..: 5 4 2 4 2 3 3 3 1 3
 $ carat: atomic  0.23 0.21 0.23 0.29 0.31 0.24 0.24 0.26 0.22 0.23
  ..- attr(*, "label")= Named chr "Kt"
  .. ..- attr(*, "names")= chr "carat"
 $ price: atomic  326 326 327 334 335 336 336 337 337 338
  ..- attr(*, "label")= Named chr "EUR"
  .. ..- attr(*, "names")= chr "price"

Also with the R-Studio IDE I can see the labels "Kt" and "EUR" with View(df).

Now I want to print this data frame via the knitr/rmarkdown/LaTeX toolchain as pdf using xtable.

library(xtable)
print(xtable(df), comment=F)

which leads to

\begin{table}[ht]
\centering
\begin{tabular}{rlrr}
  \hline
 & cut & carat & price \\ 
  \hline
1 & Ideal & 0.23 & 326 \\ 
  2 & Premium & 0.21 & 326 \\ 
  3 & Good & 0.23 & 327 \\ 
  4 & Premium & 0.29 & 334 \\ 
  5 & Good & 0.31 & 335 \\ 
  6 & Very Good & 0.24 & 336 \\ 
  7 & Very Good & 0.24 & 336 \\ 
  8 & Very Good & 0.26 & 337 \\ 
  9 & Fair & 0.22 & 337 \\ 
  10 & Very Good & 0.23 & 338 \\ 
   \hline
\end{tabular}
\end{table}

Problem:

So unfortunately, the labels are not used as second line in the header.

Question:

How can I get the "Kt" below the "carat" and "EUR" below the "price" as a second header row ?

I am looking for a solution without manually adding the labels by hand to the second line, it should automatically apply the labels to the printed table. When possible the labels shall have a bit smaller font size than the first row header line.

Answer 1

This is what makes the R community great: David Scott, the maintainer of the xtable package, provided the complete solution and also key ingredients for a new function which does the job:

#' Create LaTeX code for xtable output of a labelled dataframe
#'
#' This function helps to print the unit labels as second line via xtable.
#' 
#' @param x A dataframe object.
#' @param include.rownames A logical, which indicates whether rownames are printed.
#' @param booktabs A logical, which indicates whether the booktabs environment shall be used.
#' @param comment A logical, which indicates whether the xtable comment shall be printed.
#' @param vspace A interline space between the header names und units in cex units.
#' @return LaTeX code for output.
#' @export
#' @examples
#' iris %>%
#'   head() %>%
#'   set_label(c(rep("cm", 4), "")) %>%
#'   toLatex_labelled(include.rownames = FALSE)
#'
toLatex_labelled= function(x, vspace = -0.8, include.rownames = TRUE, booktabs = FALSE, comment = TRUE, ...){

  # Check
  assert_that(is.data.frame(x))

  # First setup the xtable oject
  x= xtable(x)

  # Find out labels
  labels= sjmisc::get_label(x)

  # Do the formatting before calling toLatex when labels are provided
  # otherwise just return x via toLatex
  if(! is.null(labels)){

    alignment= tail(align(x), -1)
    small= function(x,y){ paste0('\\multicolumn{1}{',y,'}{\\tiny ', x, '}')}

    labels= unlist(mapply(function(x,y) small(x,y), x = labels, y = alignment))

    add.to.row= list(pos = list(0), command = NULL)
    command= paste(labels, collapse = "&\n")
    if(isTRUE(include.rownames)) { command= paste("&", command) }

    linetype= ifelse(isTRUE(booktabs), "\\midrule", "\\hline")
    command= paste0("[", vspace, "ex]\n", command, "\\\\\n", linetype, "\n")
    add.to.row$command= command

    toLatex(x,
            hline.after = c(-1, nrow(x)),
            add.to.row = add.to.row,
    comment = comment,
    include.rownames = include.rownames,
    booktabs = booktabs, ...)

  } else {

    toLatex(x,
    comment = comment,
    include.rownames = include.rownames,
    booktabs = booktabs, ...)

  }

}