如何根据行中其他值的比例对值使用条件格式

How to use conditional formatting for values based on scale in other values in the row

我想在 kable / kableExtra 中使用条件格式根据行中的范围为值着色。我已经找到了很多关于如何按列中的值进行操作的示例,但我很难按行进行操作。

这是一个列值示例:

require(tidyverse)
  require(knitr)
  require(kableExtra)
  iris[1:10, ] %>%
    mutate_if(is.numeric, function(x) {
      cell_spec(x, bold = T, 
                color = spec_color(x, end = 0.9),
                font_size = spec_font_size(x))
    }) %>%
    mutate(Species = cell_spec(
      Species, color = "white", bold = T,
      background = spec_color(1:10, end = 0.9, option = "A", direction = -1)
    )) %>%
    kable(escape = F, align = "c") %>%
    kable_styling(c("striped", "condensed"), full_width = F)

但是,我希望颜色由每行中的值范围决定。在这个例子中,第一列当然是最大的,最后一列是最小的,所以它们都会朝那个方向移动,但在我的实际数据中,最高值和最低值的位置在每一行的不同列中。

您可以修改 spec_colorspec_font_size 函数以处理行而不是列(只需在 RStudio 中键入 F2 以获取其原始源代码):

# Define row colors
spec_color_row <-  function (x,
                             rowmin,
                             rowmax,
                             alpha = 1,
                             begin = 0,
                             end = 1,
                             direction = 1,
                             option = "D",
                             na_color = "#BBBBBB")
  {
    x <- pmin(round((x - rowmin) / (rowmax - rowmin) * 255) + 1, 256)
    
    color_code <- viridisLite::viridis(256, alpha, begin, end,
                                       direction, option)[x]
    color_code[is.na(color_code)] <- na_color
    return(color_code)
  }

# Define row font sizes
spec_font_size_row <- function (x,
                                rowmin,
                                rowmax,
                                begin = 8,
                                end = 16,
                                na_font_size = 12)
  {
    x <- pmin(round((end - begin) * (x - rowmin) / (rowmax - rowmin)) + begin, end)
    x[is.na(x)] <- na_font_size
    return(x)
  }

在此之后,您应该定义要使用的列并计算每行的最大值和最小值。
在下面的示例中,使用了所有数字列:

iris_cols <- iris %>% select_if(is.numeric) %>% names()

data <- iris %>% mutate(rowmax = pmax(!!!rlang::syms(iris_cols)),
                        rowmin = pmin(!!!rlang::syms(iris_cols))) 

然后你可以使用mutateacross来计算字体大小和颜色。

为此你需要安装 dplyr >= 1.0.0

data %>%  mutate(across(iris_cols,
                        ~cell_spec(., bold = T, 
                                      color = spec_color_row(.,rowmin, rowmax, end = 0.9),
                                      font_size = spec_font_size_row(.,rowmin ,rowmax)))) %>%  
  kable(escape = F, align = "c") %>%
  kable_styling(c("striped", "condensed"), full_width = F)

编辑:根据你的最后一个问题,这可以进一步 improved/compacted 使用 rowwise 和新的 c_across 函数:

iris[1:10,] %>%  rowwise() %>% 
                 mutate(rowmin = min(c_across(is.numeric)),
                        rowmax = max(c_across(is.numeric))) %>%
                 mutate(across(is.numeric,
                        ~cell_spec(., bold = T, 
                                   color = spec_color_row(.,rowmin, rowmax, end = 0.9),
                                   font_size = spec_font_size_row(.,rowmin ,rowmax)))) %>%  
                 select(-rowmin,-rowmax) %>%
                 kable(escape = F, align = "c") %>%
                 kable_styling(c("striped", "condensed"), full_width = F)

但是我还没有设法完全摆脱 rowmin / rowmax 中间计算,因为列操作比 dplyr 中的行操作更容易。这就是为什么我喜欢@dww 解决方案来转置数据帧以克服这个困难。

您可以按行对值使用 apply

df = head(iris,10)
fn = function(x) cell_spec(x, bold = T, color = spec_color(x, end = 0.9),
                          font_size = spec_font_size(x))    
df[, 1:4] = t(apply(df[,1:4], 1, fn))    
df %>%
  kable(escape = F, align = "c") %>%
  kable_styling(c("striped", "condensed"), full_width = F)