Colouring cells in a gt tables across multiple columns using a column name pattern

Question

Is there any way to colour individual cells in according their values using something like tidyselect syntax? Here I have some chicken_* columns and some ox_*. Right now I would colour separately in tab_style calls:

set.seed(42)
library(tibble)
library(gt)

df <- tibble(
  chicken_mm = runif(10),
  chicken_g = runif(10),
  ox_mm = runif(10),
  ox_g = runif(10)
)


df %>% 
  gt() %>% 
  tab_style(
    style = cell_fill(color = "#2dc937", alpha = 0.5),
    locations = cells_body(
      columns = chicken_mm,
      rows = chicken_g >= 0.5
    )
  ) %>% 
  tab_style(
    style = cell_fill(color = "#2dc937", alpha = 0.5),
    locations = cells_body(
      columns = ox_mm,
      rows = ox_g >= 0.5
    )
  ) 

This works fine but if you have multiple columns it can get really long with a lot of manual steps. Ultimately what I am hoping for is something like this:

df %>% 
  gt() %>% 
  tab_style(
    style = cell_fill(color = "#2dc937", alpha = 0.5),
    locations = cells_body(
      columns = ends_with("_mm"),
      rows = ends_with("_g") >= 0.5
    )
  ) 

Can anyone recommend a good strategy here?

Answer 1

We could use a for loop and update the object

library(gt)
library(dplyr)
library(tibble)
dfgt <- df %>% 
  gt() 
mm_cols <- grep("_mm$", names(df), value = TRUE)
g_cols <- sub("_mm", "_g", mm_cols)
for(i in seq_along(mm_cols)) {

dfgt <- dfgt %>% 
  tab_style(
    style = cell_fill(color = "#2dc937", alpha = 0.5),
    locations = cells_body(
      columns = mm_cols[i],
      rows = !! rlang::sym(g_cols[i]) >= 0.5
    )
  ) 
  

}
dfgt

-output

Answer 2

I just solved this without a loop and want to share. I used map2 to create a list of cells_body objects.

set.seed(42)
library(tibble)
library(gt)

df <- tibble(
  chicken_mm = runif(10),
  chicken_g = runif(10),
  ox_mm = runif(10),
  ox_g = runif(10)
)

dfgt <- df %>% 
  gt() 

dfgt2 <- dfgt %>% 
  tab_style(
    style = cell_fill(color = "#2dc937", alpha = 0.5),
    locations = select(df,matches(".*_g")) %>%
      map2(.y = names(select(df,matches(".*_mm"))),
           .f = function(.x,.y) {cells_body(columns = .y,
                                            rows = which(.x >= .5 ))
                                 }
      )
   )
dfgt2

Output: