将标签属性包含在xtable标头中

Question

可重复示例：

我有一个数据框，其中使用sjmisc包标记了变量，从v0.4.2开始，它与dplyr很好地配合使用。

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

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

正如str(df)所示，它正确包含两列标签：

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"

同样使用R-Studio IDE我可以看到带有View(df)的标签“Kt”和“EUR”。

现在，我想使用knitr/rmarkdown/LaTeX通过xtable工具链以PDF格式打印此数据框。

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

导致

\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}

问题：

所以遗憾的是，标题不会在标题中用作第二行。

问题：

如何将“Karat”下方的“Kt”和“价格”下方的“EUR”作为第二个标题行？

我正在寻找一种解决方案而无需手动将标签手动添加到第二行，它应该自动将标签应用于打印的表格。如果可能，标签的字体大小应比第一行标题行小一点。

Answer 1

这就是R社区的伟大之处：David Scott，xtable package的维护者，提供了完整的解决方案，也是完成这项工作的新功能的关键要素：

#' 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, ...)

  }

}