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

我有以下数据框：

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)

我想详细说明这些规则，以便在必要时可以轻松更改

我想以这样的方式结束（星号表示细胞颜色）：

我在一个闪亮的应用程序和降价文档的表格中展示了这一点。有没有办法用f来做这件事。ex-xtable或dplyr？

这里是一个局部（不在列之间进行自定义行分隔）解决方案

对于以下内容，我将利用该包

使用的数据帧是您问题中定义的

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) 

闪亮的：

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

    server = function(input, output) {


      output$table <- renderFormattable(df_final)
    }
  )

库（闪亮）
库（格式化表）
#表格示例
shinyApp(
ui=fluidPage(
fluidRow(
第（12）栏，
formattableOutput（'表'）
)
)
),
服务器=功能（输入、输出）{
输出$table有一个解决方案，它使用
tableHTML
结合两个函数来复制逻辑

首先，您需要为每个列创建css，该列提供应应用于表的样式信息

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

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

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

为了获得单元格着色，您必须生成一个HTML表。R没有单元格着色，这一点您可以从电子表格程序中了解。@RomanLuštrik我明白了！您建议我如何做到这一点？是否可以直接在shiny中显示HTML表？在shiny中，函数renderDataTable使用javascript库创建表。它有很多。这是一个查看的好地方。这在我们的待办事项列表中，有@clemens添加到
tableHTML
包中。我们已经实现了列条件格式，我们希望很快也能实现行条件格式。也许可以看看我们的，看看是否有什么可以使用的。该包与th.@thepule不幸的是，我不想要一个交互式表格，只想要一个普通的表格。但是，它确实给了我想要的formatStyle（backgroundcolor=styleEqual（col2，“灰色”））命令。我不知道如何在列之间添加行，但谢谢你提供了一个绝妙的解决方案！正是我在寻找的。不知怎的，当我在for循环期间在数据帧上尝试此操作时，在if（条件[I-1]）{：参数的长度为零。
for（I in 1:4）
指示行是否正确？我读了一些有关错误的信息，并运行了
is.null（data$列）
test，返回FALSE。有什么建议吗？我正在循环这里的列，行数不会改变代码，它在较长的数据帧上运行，而不会改变循环。我使用的原始数据帧有我想包含在表中的其他列，但是我相信这些列可能会在for lo中产生错误op？或者它们也包括在内了吗？或者我只需要指定for循环只包括第5:23列（例如）（在
for（I In 5:23）
语句中）如果要将条件格式应用于更多列，则需要调整创建自定义css和for循环的函数。如果只想在tableHTML中包含更多列，则无需更改。
library(tableHTML)

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

test_df <- head(test_df, 4)

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

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

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])
}

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