将标签属性包含到 xtable header

Question

可重现的例子：

我有一个数据框，自 v0.4.2 起使用 sjmisc package, which works nicely together with 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 toolchain as pdf using 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}

问题：

很遗憾，这些标签未用作 header 中的第二行。

问题：

如何将 "carat" 下方的 "Kt" 和 "price" 下方的 "EUR" 作为第二行 header？

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

Answer 1

这就是 R 社区的伟大之处：David Scott, the maintainer of the 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, ...)

  }

}

将标签属性包含到 xtable header

Include label attribute into xtable header

r

label

latex

knitr

xtable