根据另一列中的值有条件地用颜色填充特定列中的单元格

Question

我有以下数据框：

col1 <- rep(c("A","B","C","D"),10)
col2 <- rep(c(1,0),10)
col3 <- rep(c(0,1),10)
col4 <- rep(c(1,0),10)
col5 <- rep(c(0,1),10)

test_df <- data.frame(col1, col2, col3, col4, col5, stringsAsFactors = F)

我想根据 col1 中的值为多列中的特定行单元格着色，并在表中的两列之间添加一条垂直线（表示限制）（基于 col1 中的相同值）

例如，如果 col1 == "A"，那么我想将 col2 和 col5 中的单元格着色为灰色，与 col1 == A 在同一行。

在虚拟代码中：

if col1 == A: color columns(col2, col5), vert.line between col3 and col4
if col1 == B: color columns(col2, col3, col5), vert.line between col4 and col5
if col1 == C: color columns(col2, col4, col5), vert.line between col3 and col4
if col1 == D: color columns(col2, col5), vert.line between col2 and col3

我想指定这些规则，以便在必要时可以轻松更改它们。

我想得到这样的结果（星号表示单元格着色）：

col1   col2   col3   col4   col5
A      *1*     0   | 1      *0*
B      *0*    *1*    0    | *1*
C      *1*    *0*  | 1      *0*
D      *0*  |  1     0      *1*
A      *1*     0   | 1      *0*
B      *0*    *1*    0    | *1*
C      *1*    *0*  | 1      *0*
D      *0*  |  1     0      *1*

我在一个闪亮的应用程序和降价文档的表格中展示了这个。有什么办法可以用 f. ex xtable 还是 dplyr？

Answer 1

这是一个部分（不做列之间的自定义行分隔）解决方案。

对于以下内容，我利用包formattable。

使用的数据框是您问题中定义的df。

library(formattable)
library(dplyr)

## Function that create the formula for the coloring of each row
## You could also personalize the color
color_row <- function(r,
                      c,
                      color = 'gray') {

  return(area(row = r, col = c) ~ color_tile(color, color))
}

## Create database that containes info on coloring pattern
df_color <- data_frame(col1 = c('A', 'B', 'C', 'D'),
                       limits = list(c(2,5), c(2,3,5), c(2,4,5), c(2,5)))


## Join it to original data.frame
df_join <- df %>% left_join(df_color) 

## Create list with all the appropriate formulas to color data frame
format_list <- mapply(color_row, r = 1:nrow(df), c = df_join$limits, color = 'gray')

## Pass it to formattable
df_final <- formattable(df,format_list) 

结果如下所示：

这可以在 RNotebook 和 Shiny 中轻松使用。以下每个示例代码（为了使下面的代码工作，您需要之前代码 df_final 的结果在您的环境中）：

---
title: "R Notebook"
output: html_notebook
---

```{r}
library(dplyr)
library(formattable)
format_table(df_final)
```

闪亮：

library(shiny)
library(formattable)
  # table example
  shinyApp(
    ui = fluidPage(
      fluidRow(
        column(12,
               formattableOutput('table')
        )
      )
    ),

    server = function(input, output) {


      output$table <- renderFormattable(df_final)
    }
  )

Answer 2

有一个解决方案使用tableHTML 结合两个函数来复制逻辑。

首先，您需要为每列创建 CSS，以提供应该应用于表格的样式信息。我把它分成了 2 个函数，一个用于背景，一个用于列之间的线。

library(tableHTML)

第一个函数根据col1 中的值更改单元格的颜色。您可以通过在函数的参数中提供不同的颜色来更改它们。

get_background_column_css <- function(col1,
                                   a_col = "lightgray",
                                   b_col = "steelblue",
                                   c_col = "lightgreen",
                                   d_col = "indianred",
                                   default = "white") {
  # create css for col2
  background_color_col2 <- ifelse(col1 == "A", a_col, 
                      ifelse(col1 == "B", b_col,
                      ifelse(col1 == "C", c_col,
                      ifelse(col1 == "D", d_col, default
                             ))))
  css_col2 <- setNames(list(list(c("background-color"),
                     list(background_color_col2))), "col2")

  # create css for col3
  background_color_col3 <- ifelse(col1 == "B", b_col,
                                  ifelse(col1 == "C", c_col, default))
  css_col3 <- setNames(list(list(c("background-color"),
                                 list(background_color_col3))), "col3")
  # create css for col4
  background_color_col4 <- rep("", length(col1))
  css_col4 <- setNames(list(list(c("background-color"),
                                 list(background_color_col4))), "col4")
  # create css for col5
  background_color_col5 <- ifelse(col1 == "A", a_col, 
                                  ifelse(col1 == "B", b_col,
                                         ifelse(col1 == "C", c_col,
                                                ifelse(col1 == "D", d_col, default
                                                ))))
  css_col5 <- setNames(list(list(c("background-color"),
                                 list(background_color_col5))), "col5")

  list(css_col2, css_col3, css_col4, css_col5)
}

第二个函数在列之间添加边框。

get_border_column_css <- function(col1) {
  # create css for col2
  border_col2 <- ifelse(col1 == "D", "1px solid black", "0px")
  css_col2 <- setNames(list(list(c("border-right"),
                                 list(border_col2))), "col2")
  # create css for col3
  border_col3 <- ifelse(col1 == "C", "1px solid black", "0px")
  css_col3 <- setNames(list(list(c("border-right"),
                                 list(border_col3))), "col3")
  # create css for col4
  border_col4 <- ifelse(col1 == "B", "1px solid black", "0px")
  css_col4 <- setNames(list(list(c("border-right"),
                                 list(border_col4))), "col4")
  # create css for col5
  border_col5 <- rep("0px", length(col1))
  css_col5 <- setNames(list(list(c("border-right"),
                                 list(border_col5))), "col5")

  list(css_col2, css_col3, css_col4, css_col5)
}

为了测试功能，我只使用了前 4 行（因为它们具有所有可能性的组合）：

test_df <- head(test_df, 4)

接下来，我为 background-color 创建 1 个 css 列表，为 border 创建 1 个 css 列表，可以提供给 add_css_conditional_column()

css_background = get_background_column_css(test_df$col1)
css_border = get_border_column_css(test_df$col1)

接下来，我创建一个tableHTML 对象。

tableHTML <- tableHTML(test_df,
                       rownames = FALSE,
                       border = 0) 

接下来，我将背景 css 循环添加到每一列：

for (i in 1:4) {
  tableHTML <- tableHTML %>%
    add_css_conditional_column(conditional = "colour_rank",
                               colour_rank_css = css_background[[i]],
                               columns = names(test_df)[i + 1])
}

还有边框css：

for (i in 1:4) {
  tableHTML <- tableHTML %>%
    add_css_conditional_column(conditional = "colour_rank",
                               colour_rank_css = css_border[[i]],
                               columns = names(test_df)[i + 1])
}

这是结果：

tableHTML