Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

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

I would like to use conditional formatting in kable / kableExtra to color the values based on the range in the row. I have found plenty of examples for how to do it by values in the column, but am struggling to do it by row.

Here is an example by column values:

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)

enter image description here

However, I would like the color to be determined by the range of values in each row. In this example of course the first column is always largest and last is smallest, so they would all go in that direction, but in my actual data the location of highest and lowest values is in different columns for each row.

like image 521
jzadra Avatar asked Oct 14 '25 04:10

jzadra


2 Answers

You can use apply on the values, row-wise

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)

enter image description here

like image 77
dww Avatar answered Oct 16 '25 16:10

dww


You can modify spec_color and spec_font_size functions in order to work on rows instead of columns (just type F2 in RStudio to get their original source code) :

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

After this, you should define the columns you want to use and calculate the maximum and minimum for each row.
In the example below all numeric columns are used :

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

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

Then you can use mutate and across to calculate font size & color.

For this to work you'll need to install 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)

EDIT : following your last question, this can be further improved/compacted using rowwise and the new c_across function :

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)

However I didn't yet manage to get fully rid of rowmin / rowmax intermediate calculations, because column manipulations are easier as row manipulations in dplyr. That's why I liked @dww solution to transpose the dataframe to overcome this difficulty.

enter image description here

like image 38
Waldi Avatar answered Oct 16 '25 17:10

Waldi



Donate For Us

If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!