R flextable conditional formatting based on pairs of rows

Question

I am trying to change the bg color of some cells in a flextable based on whether the values in the rows labeled Act (for actual) exceed the values in the corresponding rows (that is, same KPI) labeled Plan. Those that exceed should get a green background, while those values that are below Plan should get a red background.

(In a perfect world, I would be able to change the background color whether the cell was greater than or less than, depending upon a list I configured to say which direction to go, but that will come next.)

df <- structure(list(KPI = c("Quality", "Quality", "On Time", "On Time", 
"Attrition", "Attrition", "Growth 1", "Growth 1", "Growth 2", 
"Growth 2", "WCT", "WCT", "ROI", "ROI"), Type = c("Plan", "Act", 
"Plan", "Act", "Plan", "Act", "Plan", "Act", "Plan", "Act", "Plan", 
"Act", "Plan", "Act"), JAN = c(1, 1, NA, NA, 0.05, 0.09, NA, 
NA, NA, NA, 4, -1.8, NA, NA), FEB = c(1, 0.98, NA, NA, 0.05, 
0.08, NA, NA, NA, NA, -0.2, -1.3, NA, NA), MAR = c(1, 1, 0.79, 
0.81, 0.05, 0.08, 0.1, 0.08, 116, 199, -0.7, -0.2, NA, NA), APR = c(1, 
1, NA, NA, 0.05, 0.08, NA, NA, NA, NA, -0.2, -0.3, NA, NA), MAY = c(1, 
1, NA, NA, 0.05, 0.09, NA, NA, NA, NA, -0.2, -0.6, NA, NA), JUN = c(1, 
1, 0.79, 0.8, 0.05, 0.08, 0.12, 0.03, -33, 22, 0.1, 1.1, NA, 
NA), JUL = c(1, 1, NA, NA, 0.05, 0.09, NA, NA, NA, NA, 0.3, 0.2, 
NA, NA), AUG = c(1, 1, NA, NA, 0.05, 0.09, NA, NA, NA, NA, 0.3, 
0.8, NA, NA), SEP = c(1, 1, 0.79, 0.78, 0.05, 0.09, 0.2, 0.14, 
173, 303, 1.5, 2.1, NA, NA), OCT = c(1, NA, NA, NA, 0.05, NA, 
NA, NA, NA, NA, 2.3, NA, NA, NA), NOV = c(1, NA, NA, NA, 0.05, 
NA, NA, NA, NA, NA, 2, NA, NA, NA), DEC = c(1, NA, NA, NA, 0.05, 
NA, NA, NA, NA, NA, 0.2, NA, NA, NA)), row.names = c(NA, -14L
), class = c("tbl_df", "tbl", "data.frame"))

library(regulartable)
library(magrittr)

df %>% regulartable() %>% bg(i = ~ Type %in% "Act", j = 3:14, bg="#cceecc")

The image it produces is below. I am currently stuck because I can not figure out how to add a second condition, that is, whatever would go in the (value > lag(value)) position. Does anyone know, or do I need to spread and gather first? Any help would be greatly appreciated.

df %>% regulartable() %>% bg(i = ~ Type %in% "Act" && (value > lag(value)), j = 3:14, bg="#cceecc")

Liquefy

Answer 1

I'm sure there is a more elegant way to solve this, and if there is, I hope someone posts it. But in the meantime I found a stopgap. First split the df into plan values and actual values, and then use those differences to determine appropriate color for each cell:

library(gdata)

df %>% group_split(Type) -> plan.act
ifelse(plan.act[[1]][,3:14]-plan.act[[2]][,3:14]>=0, "#cceecc", "#eecccc") -> colorgrid 

This creates a list of red/green colors for each cell:

> colorgrid
     JAN       FEB       MAR       APR       MAY       JUN       JUL       AUG       SEP       OCT NOV DEC
[1,] "#cceecc" "#eecccc" "#cceecc" "#cceecc" "#cceecc" "#cceecc" "#cceecc" "#cceecc" "#cceecc" NA  NA  NA 
[2,] NA        NA        "#cceecc" NA        NA        "#cceecc" NA        NA        "#eecccc" NA  NA  NA 
[3,] "#cceecc" "#cceecc" "#cceecc" "#cceecc" "#cceecc" "#cceecc" "#cceecc" "#cceecc" "#cceecc" NA  NA  NA 
[4,] NA        NA        "#eecccc" NA        NA        "#eecccc" NA        NA        "#eecccc" NA  NA  NA 
[5,] NA        NA        "#cceecc" NA        NA        "#cceecc" NA        NA        "#cceecc" NA  NA  NA 
[6,] "#eecccc" "#eecccc" "#cceecc" "#eecccc" "#eecccc" "#cceecc" "#eecccc" "#cceecc" "#cceecc" NA  NA  NA 
[7,] NA        NA        NA        NA        NA        NA        NA        NA        NA        NA  NA  NA 

Now create another df for colors for the Plan group, then plot the table:

blankgrid <- colorgrid
blankgrid[!is.na(blankgrid)] <- NA_character_

df %>% regulartable() %>% bg(j = 3:14, bg=interleave(blankgrid,colorgrid))

And from there you can add more flextable goodness to make table prettier:

df %>% regulartable() %>% bg(j = 3:14, bg=interleave(blankgrid,colorgrid)) %>%
     merge_v(j=1) %>% border_inner_v(border = fp_border(color="gray", width=1))

Liquefy