Color code cells of a tableGrob based on whether a value falls outside a certain range

I have a tableGrob object. I am looking to fill cells red when a value falls outside a certain threshold (specified by UDL and LDL in the dataframe below).

The data I'm working with:

structure(list(StationName = c("TUV0019", "TUV0034", "HEC0012", 
"XDN0146", "XDN2438", "XDN2340", "XDN2340", "TUV0011", "MKL0010", 
"XDN3445", "XDN3445", "TUV0034", "XDN3445", "XDN3445", "TUV0011"
), ParameterCode = c("PHEO", "PHEO", "PHEO", "PHEO", "PHEO", 
"PHEO", "PHEO", "PHEO", "PHEO", "PHEO", "PHEO", "PHEO", "PHEO", 
"PHEO", "PHEO"), ParameterValue = c(1.346, 0.071, 0.876, 3.247, 
2.82, 1.965, 2.713, 0.737, 0.854, 0.352, 0.352, 0.74, 0.74, 0.74, 
0.74), LayerCode = c("S", "S", "S", "S", "S", "S", "B", "S", 
"S", "S", "S", "S", "S", "S", "S"), RepNumber = c(1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 1L, 1L, 2L, 1L), LDL = c(0.74, 
0.74, 0.74, 0.74, 0.74, 0.74, 0.74, 0.74, 0.74, 0.74, 0.74, 0.74, 
0.74, 0.74, 0.74), UDL = c(NA_real_, NA_real_, NA_real_, NA_real_, 
NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, 
NA_real_, NA_real_, NA_real_, NA_real_), ymin = c(0, 0, 0, 0, 
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), ymax = c(7, 7, 7, 7, 7, 7, 
7, 7, 7, 7, 7, 7, 7, 7, 7), colors = c("white", "red", "white", 
"white", "white", "white", "white", "red", "white", "red", "red", 
"white", "white", "white", "white")), row.names = c(NA, -15L), class = "data.frame")

Color was mutated into the df using the following code:

df <- df %>%
  mutate(colors = case_when(ParameterValue < LDL | ParameterValue > UDL ~ "red",
                            TRUE ~ "white"))

And this is the tableGrob formatting code that I'm working with.

df_table <- df %>%
  select(StationName, ParameterValue, LayerCode, RepNumber) %>%
  arrange(StationName, LayerCode, RepNumber)%>%
  group_by(StationName, LayerCode) %>%
  mutate(TrueRep = 1:n()) %>%
  ungroup() %>%
  select(StationName, ParameterValue, LayerCode, TrueRep) %>%
  unite("Layer", LayerCode, TrueRep, sep="-") %>%
  spread(key=StationName, value=ParameterValue) %>%
  arrange(desc(Layer))

df_labels <- df_table[c(1)] #grab the layer code for formatting later
df_table <- df_table[-c(1)] #remove the layer column to align the plots
df_table <- round(df_table, digits = 4)

#theme formatting
tbl_theme <- ttheme_minimal(base_size = 13, base_family = 'inter') 

#table formatting
tbl <- tableGrob(df_table, row=NULL, theme= tbl_theme)
tbl <- gtable_add_grob(tbl, grobs = rectGrob(gp = gpar(fill = NA, lwd = 2)),
                       t = 2, b = nrow(tbl), l = 1, r = ncol(tbl))
tbl <- gtable_add_grob(tbl, grobs = rectGrob(gp = gpar(fill = NA, lwd = 2)),
                       t = 1, l = 1, r = ncol(tbl))
tbl$widths <- unit(rep(1, ncol(tbl)), "null")
tbl$heights <- unit(rep(1, nrow(tbl)), "null")
tbl <- ggplot() +
  theme_void()+
  annotation_custom(tbl)
tbl

I originally tried to code the theme like so, as I have the colors saved in the df:

tbl_theme <- ttheme_minimal(base_size = 13, base_family = 'inter', core=list(bg_params = list(fill = df$colors)))) 

But I realized in reformatting the df to df_table, I totally get rid of my color codes. I have looked at using ggpubr's table_cell_bg(), however I have the tableGrob formatted particularly to line up with a ggplot later in the code (and also ran into the issue of my colors being reformatted away). I also was trying to see if conditional formatting might work like here, though my issue is I don't have a vector of colors. The coding is simply either red if the value is outside the range, or white if it's inside the range. I can definitely go back to the drawing board if there is a different table package (kable, ggtexttable or something else) that might work better, but I would prefer to keep it in tableGrob so I can keep my plot alignment code. Thanks for any help and guidance you all can give!

It seems like a lot of work to wrangle your data into the correct format, create a table grob, format it, then wrap your table grob as a ggplot.

Why not just wrangle your data and plot it with ggplot directly to look like a table? That way, you can calculate all the aesthetics you like in advance.

library(tidyverse)

df %>%
  group_by(StationName, LayerCode) %>%
  mutate(level = row_number()) %>%
  ungroup() %>%
  mutate(level = as.numeric(factor(paste0(LayerCode, level)))) %>%
  select(StationName, level, colors, ParameterValue) %>%
  complete(StationName, level, fill = list(colors = "gray90")) %>%
  mutate(text_color = ifelse(colors == "gray90", "gray50", "black"),
         text_color = ifelse(colors == "red", "white", text_color)) %>%
  mutate(label = ifelse(is.na(ParameterValue), "NA",
                        round(ParameterValue, 2))) %>%
  ggplot(aes(StationName, level)) +
  geom_tile(aes(fill = I(colors)), color = "gray50") +
  geom_text(aes(label = label, color = I(text_color)), size = 5) +
  scale_x_discrete(position = "top") +
  coord_cartesian(expand = FALSE) +
  theme_void() +
  theme(axis.text.x.top = element_text(size = 5 * .pt, face = 2,
                                       margin = margin(30, 10, 30, 10)),
        axis.line.x.top = element_line())