包括标签属性到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)。

现在我想通过knitr/rmarkdown/LaTeX工具链为PDF使用xtable打印该数据帧。

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} 

问题：

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

问：

我怎样才能获得“千吨”下面的“克拉”和“欧元”下面的“价格”作为第二个标题行？

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

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

    } 

}