Conditional coloring in the Flextable in R

I have tibble (data frame) in R called table_factors that at the end will be a flextable. I want to conditionally color the columns Results based on multiple and complex condition.

For example the first value (source[1]) if it in the range of 18.5 <=PIR<25 then the NUMBER ONLY to be colored green, otherwise red (the rest of the text to be black).

Regarding the second row of column 3 if the source[2] is less than 10 then NUMBER ONLY to be colored green otherwise red (the rest of the text to be black).

Regarding the third row of column 3 , if the NUMBER ONLY is less than 55 to be colored red otherwise green (the rest of the text to be black).

Regarding the fourth row the NUMBER ONLY must be red regardless of the value of source[4].

Regarding the fifth row the number and the part "of those above 30 " to be red if the value of source[5] is less that 50, other wise all green.



source = c(pir_report= 22,users_per = 33,
           usage_report = 75, r30 = 40,pyth35  = 75
           )

table_factors = tibble(
  Factor = c(
    "A","B","C","D","E"
  ),
  Target = c(
    "18.5 ≤ PIR < 25",
    "Users less than 10%",
    "Minimum 150 min/week",
    "R users age",
    "Python users age"
  ),
  Results = c(
    paste(source[1], "% Within normal range"),
    paste(source[2], "% Are R users"),
    paste(source[3], "% use R 40 hours/week or more"),
    paste(source[4], "% of those above 30 years old use R."),
    paste(source[5], "% of those above 30 use Python and C++")
  )
)%>%
  dplyr::rename("Results" = "Results",
                "Target"= "Target",
                "Factor" ="Factor")



table_factors%>%
  flextable::flextable()%>%
  flextable::width(j = 1, width = 1) %>%   
  flextable::width(j = 2, width = 3) %>%   
  flextable::width(j = 3, width = 7) %>%
  flextable::bg(i = 1, j = 1:ncol(table_factors), bg = "#0070C0", part = "header") %>% 
  flextable::color(i = 1, j = 1:ncol(table_factors), color = "white", part = "header") %>%  
  flextable::bg(i = 1:nrow(table_factors), j = 1, bg = "#0070C0", part = "body") %>%  
  flextable::color(i = 1:nrow(table_factors), j = 1, color = "white", part = "body")%>%
  flextable::bg(i = seq(2, nrow(table_factors), by = 2), j = 2:ncol(table_factors), bg = "#F2F2F2", part = "body") %>%  
  flextable::bg(i = seq(1, nrow(table_factors), by = 2), j = 2:ncol(table_factors), bg = "#E6E6FA", part = "body")

How can I accomplish this in R using flextable library?

Solution

According to flextable::compose{} you can use as_paragraph together with colorize and as_chunk + some if_else logic to produce your

Desired table

Code

I added the functionality to provide a number of digits after the comma. Since you make after-comma-precision-checks with 18.5 %, the first digit should be visible!

library(dplyr); library(flextable)

source = c(pir_report= 22,users_per = 33, usage_report = 75, r30 = 40,pyth35  = 75)

table_factors = tibble(
  Factor = c("A","B","C","D","E"),Target = c( "18.5 ≤ PIR < 25","Users less than 10%","Minimum 150 min/week", "R users age","Python users age"),
  Results = c(
    paste(source[1], "% Within normal range"),
    paste(source[2], "% Are R users"),
    paste(source[3], "% use R 40 hours/week or more"),
    paste(source[4], "% of those above 30 years old use R."),
    paste(source[5], "% of those above 30 use Python and C++")
  )
)
digits <- 1 # adjust number of digits after comma

table_factors %>%
  flextable() %>%
  width(j = 1, width = 1) %>%   
  width(j = 2, width = 3) %>%   
  width(j = 3, width = 7) %>%
  bg(i = 1, j = 1:ncol(table_factors), bg = "#0070C0", part = "header") %>% 
  color(i = 1, j = 1:ncol(table_factors), color = "white", part = "header") %>%  
  bg(i = 1:nrow(table_factors), j = 1, bg = "#0070C0", part = "body") %>%  
  color(i = 1:nrow(table_factors), j = 1, color = "white", part = "body") %>%
  bg(i = seq(2, nrow(table_factors), by = 2), j = 2:ncol(table_factors), bg = "#F2F2F2", part = "body") %>%  
  bg(i = seq(1, nrow(table_factors), by = 2), j = 2:ncol(table_factors), bg = "#E6E6FA", part = "body") %>%
  # Row 1: 18.5 <= PIR < 25
  mk_par(
    j = "Results",
    i = 1,
    value = as_paragraph(
      colorize(sprintf(paste0("%.",digits,"f"), source[1]), 
               color = if(source[1] >= 18.5 && source[1] < 25) "darkgreen" else "red"),
      as_chunk(" % Within normal range")
    )
  ) %>%
  # Row 2: Users less than 10%
  mk_par(
    j = "Results",
    i = 2,
    value = as_paragraph(
      colorize(sprintf(paste0("%.",digits,"f"), source[2]), 
               color = if(source[2] < 10) "darkgreen" else "red"),
      as_chunk(" % Are R users")
    )
  ) %>%
  # Row 3: Less than 55
  mk_par(
    j = "Results",
    i = 3,
    value = as_paragraph(
      colorize(sprintf(paste0("%.",digits,"f"), source[3]), 
               color = if(source[3] < 55) "red" else "darkgreen"),
      as_chunk(" % use R 40 hours/week or more")
    )
  ) %>%
  # Row 4: Always red number
  mk_par(
    j = "Results",
    i = 4,
    value = as_paragraph(
      colorize(sprintf(paste0("%.",digits,"f"), source[4]), color = "red"),
      as_chunk(" % of those above 30 years old use R.")
    )
  ) %>%
  # Row 5: Special case with part of text colored
  mk_par(
    j = "Results",
    i = 5,
    value = as_paragraph(
      colorize(sprintf(paste0("%.",digits,"f"), source[5]), 
               color = if(source[5] >= 50) "darkgreen" else "red"),
      colorize(" % of those above 30 ", 
               color = if(source[5] >= 50) "darkgreen" else "red"),
      as_chunk("use Python and C++")
    )
  )