rconditional-formattingflextable

Flextable conditional formatting based on a variable not shown in the output


I have a flextable that I am trying to conditionally format based on a variable that will not be shown in the output. Here are some dummy data:

library(tidyverse)
library(flextable)

set.seed(12345)

# Dummy data
dat <- tibble(year = c(rep(2022, 3), rep(2023,3), rep(2024, 3)) %>% as.character(.),
              age = rep(1:3, 3),
              mortality = rnorm(n = 9, mean = 1, sd = 0.5) %>% round(.,2),
              is_red = c(T,T,F,F,F,F,F,T,F))
dat

  year    age mortality is_red
  <chr> <int>     <dbl> <lgl>    
1 2022      1      1.29 TRUE     
2 2022      2      1.35 TRUE     
3 2022      3      0.95 FALSE    
4 2023      1      0.77 FALSE    
5 2023      2      1.3  FALSE    
6 2023      3      0.09 FALSE    
7 2024      1      1.32 FALSE    
8 2024      2      0.86 TRUE     
9 2024      3      0.86 FALSE 

dat is showing mortality according to year and age. In the flextable output, I want certain values to be colored red based on the is_red variable.

This is what I tried so far:

dat %>% 
  select(-is_red) %>%
  pivot_wider(names_from = "age", names_prefix = "Age ", values_from = "mortality") %>% 
  flextable() %>% 
  color(i = c(1,1,3), j = c(2,2,3), color = "red")

Here is what the table looks like:

flextable output

Here, the color() function does not produce what I intended as the 1.32 value of year-age 2024-1 is also colored red. Moreover, it would be difficult to manually set the i/j arguments of this function with a considerably larger dataset (with way more years and ages).

Could someone please help me with this?


Solution

  • If you have a small table, it's ok to use one color for each cell, but here's a general solution.

    library(tidyverse)
    library(flextable)
    set.seed(12345)
    
    # Dummy data --------------------------------------------------------------
    my_df <- tibble(
      year      = c(rep(2022, 3), rep(2023,3), rep(2024, 3)) %>% as.character(.),
      age       = rep(1:3, 3),
      mortality = rnorm(n = 9, mean = 1, sd = 0.5) %>% round(.,2),
      is_red    = c(T,T,F,F,F,F,F,T,F))
    
    # Code --------------------------------------------------------------------
    
    # "Raw" table
    my_ft <- my_df %>% 
      pivot_wider(
        id_cols      = year, 
        names_from   = age, 
        names_prefix = "Age ", 
        values_from  = mortality) %>% 
      flextable()
    
    # Color info
    my_red_cells <- my_df %>% 
      pivot_wider(
        id_cols      = year, 
        names_from   = age, 
        names_prefix = "Age ", 
        values_from  = is_red)
    
    # Coloring..
    walk(                                       # From first to last row
      1:nrow_part(my_ft, part = "body"),        # From second to last column 
      \(ii) walk(                               # Must use double "[["   
        2:ncol_keys(my_ft),                     # Must use "<<-" inside the function
        \(jj) if(my_red_cells[[ii, jj]]){ 
          my_ft <<- color(my_ft, i = ii, j = jj, color = "red", part = "body") 
        }
      )
    )
    

    The output:

    flextable

    Created on 2024-07-19 with reprex v2.1.0