Цветовой код Ячейки xtable

Я использовал R, sweave (но не knitr и xtable) для создания таблицы, в которой 1 столбец является идентификатором, а остальные три столбца являются столбцами "flag", которые либо пустые, либо содержат 1 (флаг).

Я хочу иметь возможность заштриховать последние три столбца, чтобы каждая ячейка была зеленой (если она пуста) или красной (если она содержит 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)
@

Редактировать: это вывод, который я получаю с помощью Sumatra PDF Viewer:

Я сделал несколько попыток, к сожалению, я не сохранил их до публикации этого вопроса, и я не могу точно вспомнить ни одну из попыток.

Даже если бы кто-то мог просто указать мне правильное направление, я был бы очень благодарен. Я смог найти информацию о R и LaTeX, но не информацию о R/Sweave и Latex.

Источник

3 ответа

Я уверен, что есть умный способ сделать это с xtableно я, как известно, плохо получаю xtable делать то, что я хочу. Вот подход с использованием pixiedust это может дать вам то, что вам нужно. (Сложная часть здесь - это определение координат таблицы, которую вы хотите заштриховать).

РЕДАКТИРОВАТЬ: Я прошу прощения, мой первоначальный ответ не соответствует всем требованиям, которые вы изложили. Это имеет правильные цвета с красным в ячейках с 1 и зеленым в противном случае.

---
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 Адаптация

Тот же самый код может использоваться в Sweave, но требует нескольких адаптаций. Эквивалентный код:

\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}
Источник 
\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}
Источник

Вот файл Sweave, который условно раскрасит xtable ячейки красным или зеленым. Условное форматирование каждой ячейки выполняется с помощью пакетов LaTeX colortbl и xcolor.

Раскраска ячеек xtable с помощью Sweave включает в себя вставку escape-символа ("\"), функции LaTeX "\cellcolor", аргумента HTML, выбора цвета и значения вашей ячейки. Вы захотите, чтобы столбцы выглядели примерно так, прежде чем конвертировать data.frame в xtable:

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

Вот полный файл Sweave. Я компилирую это в RStudio, используя knitr и pdfLaTeX, и я предпочитаю это на Суматре.

\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}

введите описание изображения здесь

редактировать

Вот код для компиляции с Sweave, а не 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}
Источник
Другие вопросы по тегам