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:
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?
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:
Created on 2024-07-19 with reprex v2.1.0