R гибкое условное форматирование на основе пар строк

Question

Я пытаюсь изменить цвет bg некоторых ячеек в flextable в зависимости от того, превышают ли значения в строках, помеченных Act (для фактических), значения в соответствующих строках (то есть одинаковые KPI) с маркировкой Plan. Те, которые превышают, должны получить зеленый фон, в то время как значения, которые ниже Plan, должны получить красный фон.

(В идеальном мире я мог бы изменить цвет фона, если бы ячейка была большечем или меньше, в зависимости от списка, который я настроил, чтобы указать, в каком направлении идти, но что будет дальше.)

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")

Изображение, которое он создает, ниже. В данный момент я застрял, потому что не могу понять, как добавить второе условие, то есть все, что будет в позиции (value > lag(value)). Кто-нибудь знает, или мне сначала нужно spread и gather? Любая помощь будет принята с благодарностью.

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

Answer 1

Я уверен, что есть более элегантный способ решить эту проблему, и, если есть, я надеюсь, что кто-то опубликует его. Но в то же время я нашел пробку. Сначала разбейте df на плановые значения и фактические значения, а затем используйте эти различия, чтобы определить соответствующий цвет для каждой ячейки:

library(gdata)

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

Это создает список красных / зеленых цветов для каждой ячейки:

> 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 

Теперь создайте еще один df для цветов для группы планов, затем постройте таблицу:

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

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

И оттуда вы можетедобавьте больше гибкости, чтобы сделать стол красивее:

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