Color Code Cells of xtable

Question

I've used R, sweave (but not knitr, and xtable, to create a table, where 1 column is an identifier, and the other three columns are "flag" columns that are either blank or contain a 1 (the flag).

I want to be able to shad the last three columns so each cell is either green (if it is blank) or red (if it contains a 1).

<<xtable3, results=tex>>=
id <- c("1_1", "1_2", "2_1")
a <- c(1,"","")
b <- c("", 1, "")
c <- c("", "", 1)
d <- data.frame(id, a,b,c)
dx <- xtable(d)
align(dx) <- "|c|c|c|c|c|"
print(dx, hline.after=-1:3)
@

Edit: This is the output I get via Sumatra PDF Viewer:

I have made several attempts, unfortunately I didn't save them before posting this question and I cannot recall any of the attempts exactly.

Even if someone could just point me in the right directions I would really appreciate it. I've been able to find information on R and LaTeX, but not information that is for R/Sweave and Latex.

Answer 1

I'm sure there's a clever way to do this with xtable, but I'm notoriously bad at getting xtable to do what I want. Here's an approach using pixiedust that may give you what you need. (The tricky part here is identifying the coordinates of the table that you want to shade).

EDIT: I apologize, my original answer didn't satisfy all the requirements you laid out. This has the proper colors with red in the cells with a 1, and green otherwise.

---
title: "Untitled"
author: "Author"
date: "May 25, 2016"
output: pdf_document
header-includes: 
  - \usepackage{amssymb} 
  - \usepackage{arydshln} 
  - \usepackage{caption} 
  - \usepackage{graphicx} 
  - \usepackage{hhline} 
  - \usepackage{longtable} 
  - \usepackage{multirow} 
  - \usepackage[dvipsnames,table]{xcolor} 
  - \makeatletter 
  - \newcommand*\vdashline{\rotatebox[origin=c]{90}{\$\dabar@\dabar@\dabar@\$}} 
  - \makeatother
---

```{r}
library(pixiedust)
id <- c("1_1", "1_2", "2_1")
a <- c(1,"","")
b <- c("", 1, "")
c <- c("", "", 1)
d <- data.frame(id, a,b,c)

cols <- apply(d[, -1], 1, function(x) which(x == 1)) + 1
rows <- apply(d[, -1], 2, function(x) which(x == 1))

dust(d,
 float = FALSE,
 hhline = TRUE) %>%
  medley_all_borders() %>%
  sprinkle(cols = 2:4,
           bg = "green") %>%
  sprinkle(rows = rows,
           cols = cols,
           fixed = TRUE,
           bg = "red")

```

Sweave Adaptation

The same code can be used in Sweave, but requires a couple of adaptations. The equivalent code is:

\documentclass{article}
\usepackage{amssymb} 
\usepackage{arydshln} 
\usepackage{caption} 
\usepackage{graphicx} 
\usepackage{hhline} 
\usepackage{longtable} 
\usepackage{multirow} 
\usepackage[dvipsnames,table]{xcolor} 
\makeatletter 
\newcommand*\vdashline{\rotatebox[origin=c]{90}{\$\dabar@\dabar@\dabar@\$}} 
\makeatother

\begin{document}
\SweaveOpts{concordance=TRUE}

<<chunk1, results = tex>>=
library(pixiedust)
options(pixiedust_print_method = "latex")

id <- c("1_1", "1_2", "2_1")
a <- c(1,"","")
b <- c("", 1, "")
c <- c("", "", 1)
d <- data.frame(id, a,b,c)

cols <- apply(d[, -1], 1, function(x) which(x == 1)) + 1
rows <- apply(d[, -1], 2, function(x) which(x == 1))

dust(d,
 float = FALSE,
 hhline = TRUE) %>%
  medley_all_borders() %>%
  sprinkle(cols = 1,
           sanitize = TRUE) %>%
  sprinkle(cols = 2:4,
           bg = "green") %>%
  sprinkle(rows = rows,
           cols = cols,
           fixed = TRUE,
           bg = "red") %>%
  print(asis = FALSE) %>%
  cat()

@


\end{document}

Answer 2

\documentclass{article}
\usepackage[table]{xcolor}

\begin{document}

<<results='asis'>>=
library('xtable')
library('dplyr')

id <- c("1\\_1", "1\\_2", "2\\_1")
a <- c(1,"","")
b <- c("", 1, "")
c <- c("", "", 1)
d <- data.frame(id, a,b,c)

d %>% mutate_each(funs(paste0(ifelse(.=='', '\\cellcolor{red!25} ','\\cellcolor{green!25} '),.)), a:c) -> d

dx <- xtable(d)
align(dx) <- "|c|c|c|c|c|"
print(dx, hline.after=-1:3,
      sanitize.text.function=identity)
@


\end{document}

Answer 3

Here's a Sweave file that will conditionally color xtable cells red or green. The conditional formatting of each cell is accomplished with the LaTeX colortbl and xcolor packages.

Coloring xtable cells with Sweave involves pasting together an escape character ("\"), the LaTeX "\cellcolor" function, an HTML argument, your color choice, and your cell value. You'll want to have columns that look something like this before you convert the data.frame to xtable:

c("\\cellcolor[HTML]{FF0600}{1}", 
"\\cellcolor[HTML]{2DB200}{}", 
"\\cellcolor[HTML]{2DB200}{}")

Here is the full Sweave file. I am compiling this in RStudio using knitr and pdfLaTeX, and I'm previewing it in Sumatra.

\documentclass{article}

\usepackage[table]{xcolor}

\begin{document}

<<xtable1, results = 'asis', echo = FALSE, warning = FALSE>>=
library(xtable)

# build your data.frame
id <- c("1_1", "1_2", "2_1")
a <- c("1", "", "")
b <- c("", "1", "")
c <- c("", "", "1")
d <- data.frame(id, a, b, c)

# define function that will color blank cells green and not blank cells red
color_cells <- function(df, var){
  out <- ifelse(df[, var]=="", 
                      paste0("\\cellcolor[HTML]{2DB200}{", df[, var], "}"),
                      paste0("\\cellcolor[HTML]{FF0600}{", df[, var], "}"))
}

# apply coloring function to each column you want
d$a <- color_cells(df = d, var= "a")
d$b <- color_cells(df = d, var= "b")
d$c <- color_cells(df = d, var= "c")

# convert data.frame to xtable and print it with sanitization
dx <- xtable(d)
align(dx) <- "|c|c|c|c|c|"
print(dx, 
      hline.after=-1:3,
      sanitize.text.function = function(x) x)
@

\end{document}

Edit

Here is the code for compiling with Sweave, not knitr:

\documentclass{article}

\usepackage[table]{xcolor}

\begin{document}
\SweaveOpts{concordance=TRUE}

<<xtable1, results = tex, echo = FALSE, warning = FALSE>>=
library(xtable)

# build your data.frame
id <- c("1_1", "1_2", "2_1")
a <- c("1", "", "")
b <- c("", "1", "")
c <- c("", "", "1")
d <- data.frame(id, a, b, c)

# define function that will color NA cells green and not-NA cells red
color_cells <- function(df, var){
  out <- ifelse(df[, var]=="", 
                      paste0("\\cellcolor[HTML]{2DB200}{", df[, var], "}"),
                      paste0("\\cellcolor[HTML]{FF0600}{", df[, var], "}"))
}

# apply coloring function to each column you want
d$a <- color_cells(df = d, var= "a")
d$b <- color_cells(df = d, var= "b")
d$c <- color_cells(df = d, var= "c")

# convert data.frame to xtable and print it with sanitization
dx <- xtable(d)
align(dx) <- "|c|c|c|c|c|"
print(dx, 
      hline.after=-1:3,
      sanitize.text.function = function(x) x)
@

\end{document}