Search code examples
rr-markdowndplyrkableextra

Shade table with extraKable in RMarkdown for pdf using dplyr mutate?


I am wanting to apply different color shading to a table based on different value sets. I am creating this table in Rmarkdown using kableExtra. I want values between 0 and <.10 to be left alone. Values >=.10 and <.20 to be shaded yellow. and values >=.20 to be shaded red.

  df
  name    category 1    categry 2    category a   category b
  ab          .01         .45           .19          .09
  410         .12         .01           .05          .66
  NW 5th      .25         .22           .01          .16

This is what I have been making my existing table with:

 library(knitr)
 library(dplyr)

 kable(df, caption = "warning values", digits = 2, format = "latex", 
 booktabs = T)%>%
 kable_styling(latex_options = c("striped"))%>%
 landscape()%>%
 row_spec(0, angle = 45)

I'm not sure how to use the mutate and cel_spec functions to apply to the entire table. The table columns and row names change dynamically with every report fyi.

EDIT: Martin's answer works great. Until I tried to clean up my numbers. My actual input file has more digits, like Martin's answer. It also has file and row names that include an underscore. (That caused issues when using this answer, but I found a workaround.)

 #replace any "_" with escaped "\\_" for magrittR/latex compatability
 names(df) <- gsub(x = names(df), pattern = "\\_", replacement = 
 "\\\\_") 
 df$name <- gsub('\\_', '\\\\_', df$name)

 #format numbers
 df <- format(df, digits=0, nsmall=3, scientific = FALSE)

The replacement works fine, its the number formatting that breaks the answer. Everything still executes just fine, but I lose the colorized table. Thoughts?


Solution

  • Here is way to do this. Notice that I used the compund assignment operator from magrittr.

    ---
    title: test
    output: pdf_document
    ---
    
    ```{r, echo = F, warning = F, message = F}
    library(knitr)
    library(dplyr)
    library(kableExtra)
    library(magrittr)
    df <- data.frame(A = runif(4, 0, 1), B = runif(4, 0, 1), row.names = letters[1:4])
    
    paint <- function(x) {  # our painting function
      ifelse(x < 0.1, "white", ifelse(x < 0.2, "yellow", "red"))
    }
    
    df %<>%. # compound assignment operator
      mutate_if(is.numeric, function(x) {  # conditional mutation, if the column type is numeric
       cell_spec(x, background = paint(x), format = "latex") 
      })
    
    kable(df, caption = "warning values", digits = 2, format = "latex", 
          booktabs = T, escape = F) %>%
      landscape()%>%
      row_spec(0, angle = 45)
    ```
    

    enter image description here