Search code examples
rdplyrkablekableextra

conditionally highlighting cells based on statistical significance using kableExtra


Say I have this tibble:


d <- tibble::tribble(
             ~dimension, ~albania, ~georgia, ~croatia, ~slovakia, ~czechia,  ~albania_stat_sig, ~georgia_stat_sig,  ~croatia_stat_sig, ~slovakia_stat_sig,  ~czechia_stat_sig,
              "beaches",       1L,       3L,       4L,        6L,       4L,  "positive, small",  "positive_large",  "positive, small", "positive, medium",        "no change",
                "coast",       5L,       1L,       4L,        2L,       2L,        "no change", "positive_medium",  "positive, large",  "positive, small",        "no change",
               "forest",       2L,       2L,       2L,        5L,       1L,  "positive, small",       "no change", "negative, medium",  "positive, small", "positive, medium",
       "cost of living",       1L,       7L,       3L,        8L,       5L, "positive, medium",       "no change",        "no change", "positive, medium",  "positive, small",
        "public safety",       6L,       9L,       1L,        2L,       7L,  "negative, large", "negative, small",        "no change",  "negative, large",  "negative, small"
       )

I want to take columns d[1:6] and all rows and turn this into a table that highlights each cell in the country columns based on the value in the corresponding _stat_sig column for the same country.

This is what i've tried so far:

library(kableExtra)
library(dplyr)

d[1:5, 1:6] %>%
    kbl() %>%
    kable_paper(full_width = F) %>%
    column_spec(1:6, color = "white",
                background = spec_color(d[1:5, 7:11], end = 0.7))

But I am getting the error message:

Error in UseMethod("rescale") : 
  no applicable method for 'rescale' applied to an object of class "c('tbl_df', 'tbl', 'data.frame')"

I would end up with a table that looks something like this:

enter image description here

So, when the cell in the country__stat_sig column is 'negative' the corresponding cell for that row and country, it is one of three shades of red (where a deeper shade of red is for 'negative, large' and a lighter shade of red for 'negative, small'); and when the country__stat_sig column is 'positive' the corresponding cell in the country column is one of three shades of green.

Can anyone help me out here? Would be immensely grateful for any pointers!

Edit to question:

As you can see in the example image above, I also want the numbers to be white for the two deepest shades of red and green, but to remain black/whatever the default is for the lightest shades of red and green.


Solution

  • One option would be to use purrr::reduce or Reduce to assign the background colors to each column separately like so:

    library(kableExtra)
    library(dplyr)
    library(purrr)
    
    pal_color <- function(x) {
      case_when(
        x %in% "positive, small" ~ "#9AFF9A",
        x %in% c("positive_medium", "positive, medium") ~ "#7CCD7C",
        x %in% c("positive_large", "positive, large") ~ "#548B54",
        x %in% "negative, small" ~ "#FF6A6A",
        x %in% c("negative, medium") ~ "#CD5555",
        x %in% c("negative, large") ~ "#8B3A3A",
        TRUE ~ "white"
      )
    }
    
    pal_textcolor <- function(x) {
      case_when(
        x %in% c("positive_medium", "positive, medium") ~ "white",
        x %in% c("positive_large", "positive, large") ~ "white",
        x %in% c("negative, large") ~ "white",
        TRUE ~ "black"
      )
    }
    
    d %>%
      select(1:6) %>%
      kbl() %>%
      kable_paper(full_width = F) %>%
      purrr::reduce(
        2:6, function(.x, .y) {
          col <- names(d)[[.y]]
          column_spec(.x, .y,
                      background = pal_color(d[[paste0(col, "_stat_sig")]]),
                      color = pal_textcolor(d[[paste0(col, "_stat_sig")]])
          )  
        },
        .init = .
      )
    

    enter image description here