R Markdown pdf部分彩色单元格背景（数据栏）

Excel 有一个称为“数据栏”的功能，它允许根据具有相应长度的单元格值进行条件格式设置。此功能可以通过 R 中的“formattable”使用格式化程序和 color_bar 来完成。然而，这样做的结果是一个 html 小部件，无法在 pdf 中显示。

这是我尝试过的一些选项：

1. webshot：截取小部件的屏幕截图，然后我可以将其作为图像导入到 pdf 中。效率不高，formattable 也不是最好的选择，因为它不允许嵌套表

2. xtable/pander - 不允许我添加条件格式

3. 电缆 + 电缆额外：

这是我最成功的一个。从这段代码（xtable如何进行单元格着色 https://stackoverflow.com/questions/40895829/how-can-xtable-do-cell-coloring），我可以进行条件格式设置，但它不是颜色栏选项，也不允许我更改列的宽度或进行任何更改，因为它成为 pdf 文档中 html 和 Latex 之间的混合体。

然而，我真正想做的是：https://tex.stackexchange.com/questions/81994/partially-coloring-cell-background-with-histograms https://tex.stackexchange.com/questions/81994/partially-coloring-cell-background-with-histograms

本质上，我希望能够有一个 pdf 文档，它将显示一个表格，该表格将允许嵌套表格功能+数据栏，其中它基于单元格值，并且表格可以调整列宽，或者表格可以缩小以适应在一页上。

这是我现在根据其他代码的答案得到的： 我想知道如何将乳胶代码插入lapply函数中，以便它看起来像第二个链接中的答案~

library(knitr)
library(tidyr)
library(kableExtra)
#options(knitr.table.format="latex")
data(mtcars)
tab =mtcars
tab$mpg<-tab$mpg/100

f <- function(x) cut(x, c(0, 0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7,0.8,0.9,1.0), labels=c( "white","green!10", "green!20", "green!30", "green!40", "green!50", "green!60", "green!70","green!80","green!90"),
                  include.lowest = FALSE, right = TRUE)

 tab["mpg"] <- lapply(tab["mpg"], function(x)
                                        paste0("\\cellcolor{", f(x), "}", x))
kable(tab)

感谢您发布如此美好而详细的问题。 这get_databar函数用于用新值替换其中一列，例如

> get_databar(1:5)
[1] "\\databar[white]{1}"    "\\databar[green!30]{2}" "\\databar[green!50]{3}"
[4] "\\databar[green!70]{4}" "\\databar[green!90]{5}"

只是按照您的评论，我已经调整了数据栏https://tex.stackexchange.com/questions/81994/partially-coloring-cell-background-with-histograms https://tex.stackexchange.com/questions/81994/partially-coloring-cell-background-with-histograms，因为它非常棒，而且有点超出了我的乳胶编码能力。

我制作了两个使用 databar 函数的示例

独立的 sweave/knitr 脚本在这里

\documentclass{article}
\usepackage[table,dvipsnames]{xcolor}% http://ctan.org/pkg/xcolor
\usepackage[nomessages]{fp}% http://ctan.org/pkg/
\begin{document}
<<load_libraries, echo = FALSE, eval = TRUE, results ="hide">>=
library(knitr) 
library(xtable)
@
<<get_databar, echo = FALSE, eval = TRUE, results ="hide">>=
#' @title get_databar creates labels for xtable
#' @description colors labels and assigns max_value to .GlobalEnv
#' @param values the vector of values to cut
#' @param color one color that is interpretable by the xcolor dvips
#' one of 68 standard colors known to dvips  \link{https://en.wikibooks.org/wiki/LaTeX/Colors}, Default: 'green'
#' @param min_value min value in the vector, Default: NULL
#' @param max_value max value in the vector, Default: NULL
#' @param column_width the with of the colum to produce
#' @param transparent, do you want transparent labels for low values, Default: TRUE
#' @return A vector to replace orignial column
get_databar <- function(values,
    color = "green",
    min_value=NULL,
    max_value=NULL,
    column_width=10,
    transparent=TRUE)
{
  if (!is.numeric(values)) stop("values should be a numeric")
  if (is.null(min_value)) min_value <- min(values,na.rm=TRUE)-diff(range(values, na.rm=TRUE))/10
  if (is.null(max_value)) max_value <- max(values,na.rm=TRUE)
  # assign max_value in .GlobalEnv
  maxnum <<- max_value
  # sequence of breaks
  mybreaks <- seq(min_value, max_value, length.out=10)
  if (transparent){
      cols <- c(paste0(color,"!",seq(10, 90, by=10)))
      color_cut_factor <- cut(x=values, 
              breaks = mybreaks,
              labels = cols,
              include.lowest = FALSE,
              right = TRUE)
      color_cut <- as.character(color_cut_factor)
  } else {
      color_cut=rep(color, length(values))
  }
  edited_values <- paste0("\\databar[", color_cut,"]{", values,"}")
  return(as.character(edited_values))
} 
@
<<test, echo = FALSE, eval = TRUE, results ="hide">>=
data(mtcars) 
tab = mtcars 
tab0<-tab[1:10,1:3]
tab2<-tab[1:10,1:3]
tab0[,1]<-get_databar(tab0[,1])
tab2[,1]<-get_databar(tab2[,1],
    color="BlueViolet",
    min_value=0, 
    max_value=max(tab2[,1]),
    transparent = FALSE)
print(xtable(tab0, 
        align = c("l","l","l","l"),
        caption = "standard example"), 
    sanitize.text.function = identity, 
    file="table0_with_bar_colors.tex")
print(xtable(tab2, 
        align = c("l","l","l","l"),
        caption = "example with dvips color BlueViolet and transparent = FALSE"),
    sanitize.text.function = identity,
    file="table2_with_bar_colors.tex")
@
%--------------------------------
% This is the new commands blocks
% The first \maxnum will read from R to get the maximum number in the table
% The second creates the databar command, with two parameters, the first default
% parameter is the color, set to green!25
%--------------------------------------
\newcommand{\maxnum}
{%
    \Sexpr{maxnum}
}
\newlength{\maxlen}
% databar[color]{value}
\newcommand{\databar}[2][green!25]
{%
    \settowidth{\maxlen}{\maxnum}%
    \addtolength{\maxlen}{\tabcolsep}%
     \FPeval\result{round(#2/\maxnum:4)}% 
     \rlap{\color{#1}\hspace*{-.5\tabcolsep}\rule[-.05\ht\strutbox]{\result\maxlen}{.95\ht\strutbox}}%
     \makebox[\dimexpr\maxlen-\tabcolsep][r]{#2}%
}
%--------------------------------------
\input{table0_with_bar_colors.tex}
\input{table2_with_bar_colors.tex}
\end{document}

如果您需要放置两个表，那么我有必要在下一个块之后和之前添加\input对于该表，以下命令（\renewcommand代替\newcommand)

\renewcommand{\maxnum}
{%
    \Sexpr{maxnum}
}