创建带有嵌入式图形的 R 表

Question

我希望能够创建一个表格，其中一列是图形，其他列是文本。理想情况下，我会创建一个 Excel 电子表格，但我很确定 R 到 Excel 包中没有一个可以将 PDF 写入单元格。我想我可以使用 Knittr 或 Sweave 一起破解一些东西，虽然我不知道如何，确切地说。有什么建议吗？

Answer 1

我试图重现你的例子：

所以我研究了 R 数据集，并使用了棒球数据集，尽管我一直怀疑对于棒球运动员来说，g-r 可能看起来真的很愚蠢......

无论如何，我制作了两个使用get_bar_df函数的例子，并尽可能多地评论我的脚本以帮助您使用它。

该脚本是一个独立的 sweave 脚本，您需要使用 knitr 或 sweave 运行它

\documentclass{article}
\usepackage[table,dvipsnames]{xcolor}% http://ctan.org/pkg/xcolor
\usepackage[nomessages]{fp}% http://ctan.org/pkg/
\newlength{\maxlen}
\newcommand{\databarright}[2][gray!25]
{%
    \settowidth{\maxlen}{\maxnum}%
    \addtolength{\maxlen}{\dimexpr2\tabcolsep-\arrayrulewidth}%
    \FPeval\result{round(#2/\maxnum:4)}%
    \rlap{\color{#1}\hspace*{\dimexpr-\tabcolsep+0.1\arrayrulewidth}\rule[-.05\ht\strutbox]{\result\maxlen}{.95\ht\strutbox}}%
    \makebox[\dimexpr\maxlen-2\tabcolsep+\arrayrulewidth][r]{\phantom{XXX}}%
}

\newcommand{\databarleft}[2][red!25]
{%
    \settowidth{\maxlen}{\maxnum}%
    \addtolength{\maxlen}{\dimexpr2\tabcolsep-\arrayrulewidth}%
    \FPeval\result{round(#2/\maxnum:4)}%
    \makebox[\dimexpr\maxlen-2\tabcolsep+\arrayrulewidth][r]{\phantom{XXX}}%
    \llap{\color{#1}\rule[-.05\ht\strutbox]{\result\maxlen}{.95\ht\strutbox}\hspace*{\dimexpr-\tabcolsep-4\arrayrulewidth}}%    
}
\begin{document}
<<load_libraries, echo = FALSE, eval = TRUE, results ="hide">>=
library(knitr) 
library(xtable)
@
<<get_bar_df, echo = FALSE, eval = TRUE, results ="hide">>=
#' @title get_databar creates labels for xtable in a dataframe
#' @description It will create two new columns and fill them with values for xtable, it will use the last column
#' @param data the dataframe
#' @param colorpos one color for positive values that is interpretable by the xcolor dvips
#' one of 68 standard colors known to dvips  \link{https://en.wikibooks.org/wiki/LaTeX/Colors}, default "grey"
#' @param colorneg one color for negative values default "red"
#' @param transparent, the percentage of transparency passed to labels default 50 use zero for no transparency
#' @param caption, caption passed to xtable. 
#' @param vline, add a vertical line at the end of the table  default FALSE
#' @return A dataframe with the last two columns edited for xtable
get_bar_df <- function(data,
    colorpos = "grey",
    colorneg="red",
    transparent=50,
    caption="",
    vline=FALSE)
{
  if (transparent!=0){
    colorpos <- paste0(colorpos,"!",transparent)
    colorneg <- paste0(colorneg,"!",transparent)
  }
  the_col <- ncol(bsb)
  idxneg <- data[,the_col] < 0
  idxpos <- data[,the_col] > 0
  data[idxneg,"\\phantom{neg}"] <- paste0("\\databarleft[",colorneg,"]{", -data[idxneg,the_col],"}")
  data[idxpos,"\\phantom{pos}"] <- paste0("\\databarright[",colorpos,"]{", data[idxpos,the_col],"}")
  maxnum <<- max(abs(data[,the_col])) # value assigned in .GlobalEnv for later use by latex
  if (!vline) {
  xdata <-xtable(data, align = rep("l",ncol(data)+1), caption = caption)  
  } else {
      xdata <-xtable(data, align = c(rep("l",ncol(data)),"|l"), caption = caption)    
  }
  return(xdata)
} 
@
<<test, echo = FALSE, eval = TRUE, results ="hide">>=
library(plyr)
library(dplyr)
bsb <- select(baseball, id, year, g, r) %>% filter(year == 1872) %>% transform(gr = g - 
            r)
bsb1 <- select(baseball, id, year, g, r) %>% filter(year == 1873) %>% transform(gr = g - 
            r)
xbsb <- get_bar_df(data = bsb, caption="example with default values")
xbsb1 <- get_bar_df(data = bsb1, 
    colorpos = "MidnightBlue",
     colorneg = "Goldenrod", 
    transparent = 60, 
    caption = "Another example with MidnightBlue, Goldenrod, transparent= 60, vline=TRUE",
    vline=TRUE)
print.xtable(xbsb, sanitize.text.function = identity, file = "bsb.tex", hline.after = NULL, include.rownames =FALSE)
print(xbsb1, sanitize.text.function = identity, file = "bsb1.tex", hline.after = NULL, include.rownames =FALSE)
@
% this must come after the chunk (maxnum is defined in the chunk)
\newcommand{\maxnum}
{%
    \Sexpr{maxnum}
}

\input{bsb.tex}
\input{bsb1.tex}  
\end{document}

部分代码来自这篇优秀的帖子： https://tex.stackexchange.com/questions/81994/partially-coloring-cell-background-with-histograms