Color Code Cells of xtable

泄露秘密 提交于 2019-12-02 05:13:18
\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}

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}

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} 
标签
易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!