使用 styleInterval 根据选定列的值仅对特定行着色

Question

我正在尝试根据存在的值为数据表中的每一行着色。例如，如果使用

iris

数据集：

萼片长度	萼片宽度	花瓣.长度	花瓣.宽度	物种
5.1	3.5	1.4	0.2	setosa
4.9	3	1.4	0.2	setosa

如果单元格值低于 2（在任何列中），我希望第 1 行中的值显示为红色，否则显示为黑色。最后一列 (

Species

) 将被排除。

这将是第 2、3 行等的不同阈值。例如，如果单元格中的值低于 4，则第 2 行将为红色。

我可以按如下方式更改给定行（不包括 Species 列）的颜色：

datatable(iris, options = list(pageLength = 5)) %>% 
  formatStyle(colnames(iris)[-5], target = "cell", color = styleRow(1, 'red')) 

但是如果我尝试将 styleInterval 添加到格式中以实现我需要的效果，则不再有任何颜色。如下：

datatable(iris, options = list(pageLength = 5)) %>% 
  formatStyle(colnames(iris)[-5], target = "cell", color = styleRow(1, styleInterval(2, c('red','black')))) %>%
  formatStyle(colnames(iris)[-5], target = "cell", color = styleRow(2, styleInterval(4, c('red','black'))))

值得注意的是，我也尝试过

target = "row"

没有成功。

我可以用它来正常给列着色，例如，使用 iris 数据集转置：

datatable(as.data.frame(t(iris))) %>% formatStyle("V1", color = styleInterval(2, c('red','black'))) %>% formatStyle("V2", color = styleInterval(4, c('red','black')))

但是，我找不到将彩色数据表转回显示的方法。

最后，在我的实际数据表中，我必须根据每行的不同值间隔对多行执行此操作。这也需要适用于不同列数的不同数据集。所以我认为手动更改每个单元格的 CSS 颜色是不可行的。

Answer 1

library(DT)

datatable(iris, options = list(pageLength = 5)) %>% 
  formatStyle(colnames(iris)[-5], target = "cell", 
              color = styleInterval(2, c('red','black')))  %>% 
  formatStyle(colnames(iris)[-5], target = "cell", 
              color = styleRow(2:nrow(iris), 'black')) 

更新：

如果您有多行而不是只有一行要修改，那么我们可以根据所需条件创建一个包含所有颜色的矩阵/数据框，并相应地设置颜色； （有关原始回调函数，请参阅此答案https://stackoverflow.com/a/60093182/6461462）。

library(tidyverse)

data.frame(cl = 1:ncol(iris), nm = names(iris)) -> match_vec

iris %>% 
  mutate(across(-Species,
                   list(clr = ~case_when(row_number() == 1 & .x <= 2 ~ "red",
                                         row_number() == 2 & .x > 3 ~ "blue",
                                         row_number() == 3 & .x > 2.5 ~ "orange",
                                         TRUE ~ "black"),
                        cn = ~with(match_vec, 
                                   match_vec[nm == unique(cur_column()), "cl"]),
                        rn = ~row_number()),
                   .names = "{col}_{fn}")) %>% 
  dplyr::select(-names(iris)) %>% 
  split.default(., sub('_.*', '', names(.))) %>% 
  map(~ setNames(., c("col","cn","rn"))) %>% 
  bind_rows() %>% 
  as_tibble() -> col_df

library(DT)

changeCellsColor <- function(colors, cols, rows) {
  stopifnot(length(rows) == length(cols))
  c(
    "function(row, data, num, index){",
    sprintf("  var rows = [%s];", paste0(rows - 1, collapse = ",")),
    sprintf("  var cols = [%s];", paste0(cols, collapse = ",")),
    sprintf("  var colors = [%s];", paste0("'", colors, "'", collapse = ",")),
    "  for(var i = 0; i < rows.length; ++i){",
    "    if(index == rows[i]){",
    "      $('td:eq(' + cols[i] + ')', row)",
    "        .css({'color': colors[i]});",
    "    }",
    "  }",
    "}"
  )
}


datatable(iris,
          options = list(
            dom = "t",
            rowCallback = JS(changeCellsColor(col_df$col, col_df$cn, col_df$rn))
          )
)