Multi-Column Conditional Highlighting with KableExtra and ifelse statement

Question

Solution Below

Original Question: I am attempting to highlight the text of a KableExtra table to indicate where group observations increase or decrease by year. However, I am receiving an error about attempting to replicate a closure. I understand that the issue may be with the function that I created, but apart from this issue; in other attempts, the output would indicate that nothing in the ifelse statement is true.

        set.seed(1)
    
        # create tibble
        test <- tibble(year = c(replicate(3, c(2010, 2015, 2020))), # replicate 2010, 2015, and 2020 three times
                   location = c(replicate(3, c(1, 2, 3))),
                   a = sample(0:500000, 9), # random sample of 9 numbers
                   b = sample(0:500000, 9),
                   c = sample(0:500000, 9),
                   d = sample(0:500000, 9)) %>%
            mutate(across(1:2, as_factor)) %>%
        # create table
            kbl("html", # table output
                escape = F) %>% # do not escape
            kable_material_dark() # use dark theme
    
        # column_spec across test [, 3:6]
        # color with function(x)
        column_spec(test, 3:6, color = function(x) {
          ifelse(isTRUE(x > dplyr::lag(x)), "green", # increased numbers = green
                 ifelse(isTRUE(x < dplyr::lag(x)), "red", x)) # decreased = red, no decrease/increase remains as is
        })
    
    test
    
    ## Attempt with ifelse that returns only false
    
    set.seed(1)
    
    # create tibble
    test <- tibble(year = c(replicate(3, c(2010, 2015, 2020))), # replicate 2010, 2015, and 2020 three times
                   location = c(replicate(3, c(1, 2, 3))),
                   a = sample(0:500000, 9), # random sample of 9 numbers
                   b = sample(0:500000, 9),
                   c = sample(0:500000, 9),
                   d = sample(0:500000, 9)) %>%
      mutate(across(1:2, as_factor),
             across(3:6, as.numeric)) %>%
      kbl(escape = F) %>%
      kable_material_dark() %>%
      column_spec(3:6, background = ifelse(isTRUE(dplyr::lead(.) > dplyr::lag(.)), "green", "red"))
    
        test

Solution:

library(tidyverse)
library(kableExtra)

set.seed(1)

# test 
# create year var with 2010, 2015, and 2020 replicated three times
tibble(year = c(replicate(3, c(2010, 2015, 2020))),
       # locations 1 three times and so on
       location = c(1, 1, 1, 2, 2, 2, 3, 3, 3),
       # create four vars with random sample of 9 numbers
       a = sample(0:500000, 9),
       b = sample(0:500000, 9),
       c = sample(0:500000, 9),
       d = sample(0:500000, 9)) %>%
  
  # change var types       
  mutate(
    # change cols 1 and 2 to character
    across(1:2, as.character),
    # change cols 1 and 2 to numeric
    across(3:6, as.numeric)) %>%
  # group by location
  group_by(location) %>%
  # mutate columns
  mutate(
    # mutate across 3:5 (not to 6 because of grouping variable not being included by across)
    # deselect year (it isn't a grouping variable)
    # nested ifelse statement to account for different locations and backgrounds
    # if year is in 2010, just retain as is
    across(c(-year, 3:5), ~ ifelse(year %in% "2010", .,
                                   # if year is "1" and the value is greater than the previous value, change the background to green
                                   ifelse(location %in% "1" &
                                            . > dplyr::lag(.), cell_spec(., background = "green"),
                                          # if year is "1" and the value is less than the previous value, change the background to red
                                          ifelse(location %in% "1" &
                                                   . < dplyr::lag(.), cell_spec(., background = "red"),
                                                 # if year is "2" and the value is greater than the previous value, change the background to green
                                                 ifelse(location %in% "2" &
                                                          . > dplyr::lag(.), cell_spec(., background = "green"),
                                                        # if year is "2" and the value is less than the previous value, change the background to red
                                                        ifelse(location %in% "2" &
                                                                 . < dplyr::lag(.), cell_spec(., background = "red"),
                                                               # if year is "3" and the value is greater than the previous value, change the background to green
                                                               ifelse(location %in% "3" &
                                                                        . > dplyr::lag(.), cell_spec(., background = "green"),
                                                                      # if year is "3" and the value is less than the previous value, change the background to red
                                                                      ifelse(location %in% "3" &
                                                                               . < dplyr::lag(.), cell_spec(., background = "red"),
                                                                             # else retain value and background
                                                                             .))))))))) %>%
  # no escape to only take colors and not styling code from column_spec function
  kbl(escape = F)
  # use dark theme
  kable_material_dark()

Multi-Column Conditional Highlighting with KableExtra and ifelse statement

Answers (1)

Related Questions