且构网

分享程序员开发的那些事...
且构网 - 分享程序员编程开发的那些事

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

更新时间:2023-09-19 23:19:58

这是使R社区出色的原因: David Scott xtable的维护者包,提供了完整的解决方案以及新功能的关键要素:

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

  }

}