Creating R tables with embedded graphics

Question

I'd like to be able to create a table with one of the columns being graphical, others text. Ideally, I'd create an excel spreadsheet, but I'm pretty sure that none of the R to Excel packages can write PDFs into cells. I think I can hack something together using Knittr or Sweave, though I don't know how, exactly. Any advice?

Answer 1

I've tried to reproduce your example :

So I've looked into the R dataset, and used a baseball dataset, though I have the nagging doubt that for baseball players, the g-r might look really stupid...

Anyway I produced two examples of the use of the get_bar_df function, and tried to comment my script as much as possible to help you use it.

The script is a standalone sweave script that you need to run using knitr or 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}

Some of the code comes from this excellent post : https://tex.stackexchange.com/questions/81994/partially-coloring-cell-background-with-histograms