Search code examples
rdplyrkableextra

Change cell colour in kableExtra across multiple columns using conditional statements (case_when)


I have a table with multiple character variables (named First, Second etc.) Each of these variables contain a number of possible strings (e.g. "DBP", "Low PA"). I want to assign a background colour to each of these strings (e.g. "DBP" or "SBP = red, "Low PA" = blue).

I'd like to be able to this is one mutate statement, rather than writing seperate case_when statements for each column:

df1 = data.frame(year = c(2014, 2015, 2011, 2013),
                 outcome = c("decline", "death", "death or decline", "decline"),
                 "First" = c("DBP", "Cholesterol", "Low PA", "CRP"),
                 "Second" =  c("SBP", "CRP",NA ,NA ),
                  "Third" = c("Low PA", "SBP", NA, NA))
df1 = data.frame(lapply(df1, as.character), stringsAsFactors=FALSE)
df1[is.na(df1)] = ""
df1%>%
  kbl("latex", longtable = TRUE, escape = F, booktabs =  T)%>%
  mutate(across(c(3:5)), column_spec (., background = case_when(. == "SBP" ~ "red",
                                                                    . == "Low PA" ~ "blue",
                                                                    . =="CRP" ~ "gray",
                                                                    TRUE ~ "white")) )%>%
  kable_styling(latex_options= c( "repeat_header"), font_size =10,repeat_header_method =  "replace")

This is one example that I have tried. For this I get error: Error in UseMethod("mutate") : no applicable method for 'mutate' applied to an object of class "knitr_kable".

The following code works for one column ("First")

df1%>%
  kbl("latex", longtable = TRUE, escape = F, booktabs =  T)%>%
  column_spec(3 , background = case_when(df1$First == "DBP" ~ "red",
                                                df1$First == "SBP" ~ "red",
                                                df1$First == "Low PA" ~ "blue",
                                                df1$First =="CRP" ~ "gray",
                                                TRUE ~ "white"))%>%
  kable_styling(latex_options= c( "repeat_header"), font_size =10, repeat_header_method =  "replace")

Solution

  • One option to achieve your desired result would be to make use of purrr::reduce (or Reduce from base R) like so:

    df1 %>%
      kbl("latex", longtable = TRUE, escape = F, booktabs = T) %>%
      purrr::reduce(3:5, function(x, y) {
        col <- df1[, y]
        column_spec(x, y, background = case_when(
          col == "SBP" ~ "red",
          col == "Low PA" ~ "blue",
          col == "CRP" ~ "gray",
          TRUE ~ "white"))
      }, .init = .) %>%
      kable_styling(latex_options = c("repeat_header"), font_size = 10, repeat_header_method = "replace")
    
    

    enter image description here