conditional formatting of gt table traffic light system

Here is my current dataset:

 A tibble: 9 x 6
  Analyte                 Units        Category            Value  ADWG      AGWR
  <fct>                   <fct>        <fct>               <dbl> <dbl>     <dbl>
1 1,2,3,4,6,7,8-HpCDD     pg/Kg        Dioxins             0.1      NA  0.016   
2 Bromoacetic Acid        ug/L         DBP                 0.5      NA  0.35    
3 E.coli                  Orgs / 100mL Microbiological  1600         1 NA       
4 Estriol                 ug/L         Pharmaceutical      0.125    NA  0.05    
5 Estrone                 ug/L         Pharmaceutical      0.125    NA  0.03    
6 Mestranol               ug/L         Pharmaceutical      0.125    NA  0.0025  
7 N-Nitrosomorphline      ng/L         organic compound    5        NA  1       
8 Octachlorodibenzodioxin pg/Kg        Dioxins             0.5      NA  0.016   
9 PCB-105                 ug/L         Pesticide           0.005    NA  0.000016

I want to create a gt() table where the guideline exceedances are formatted based on how close/far they are from the guideline values.

Something like:

<=10% of guideline - green
Values >10 and <50% guideline - yellow
Values >50 and <100% guideline - orange
Values >= guideline - red

So far my code is as follows:

gt(final) %>%
  tab_options(
    heading.title.font.size = "medium",
    heading.subtitle.font.size = "small",
    table.font.size = "small",
    table.font.names = "Arial") %>%
  cols_align(align = "left", columns = everything()) %>%
  cols_label(Value = 'Result') %>%
  tab_spanner(label = "Results",columns = c(Analyte, Units, Category, Value)) %>%
  tab_spanner(label = "Guidelines", columns = c(ADWG, AGWR)) %>%
  fmt_missing(columns = everything(), missing_text = "-") %>%
  fmt_number(columns = where(is.numeric), n_sigfig = 2) %>%
  tab_style(style = list(
    cell_fill(color = "#F8766D"),
    cell_text(weight = "bold")),
    locations = cells_body(columns = Value, rows = Value >= AGWR | Value >= ADWG))

and the table currently looks like this, as I've only figured out how to format based on one condition (i.e. below/above the guideline). my current data all exceeds the guidelines but I'd like to apply it to a larger dataset.

Any help would be appreciated. Thanks

Solution

You could try something like this.

library(tidyverse)
library(gt)

tibble(
  Result = runif(50, min = 0, max = 1.2)
  ) %>%
  gt() %>%
  tab_style(
    style = list(
      cell_fill(color = "green")
    ),
    locations = cells_body(
      columns = Result,
      rows = Result <= 0.1
    )
  ) %>%
    tab_style(
      style = list(
        cell_fill(color = "yellow")
      ),
      locations = cells_body(
        columns = Result,
        rows = Result > 0.1 & Result <= 0.5
      )
    ) %>%
  tab_style(
    style = list(
      cell_fill(color = "orange")
    ),
    locations = cells_body(
      columns = Result,
      rows = Result > 0.5 & Result <= 1
    )
  ) %>%
  tab_style(
    style = list(
      cell_fill(color = "red")
    ),
    locations = cells_body(
      columns = Result,
      rows = Result > 1
    )
  )

You could also define a helper function to avoid some code copy pasting.

library(tidyverse)
library(gt)

fce_col <- function(gt_obj, filtering_numbers, color){
  gt_obj %>%
    tab_style(
      style = list(
        cell_fill(color = color)
      ),
      locations = cells_body(
        columns = Result,
        rows = Result > filtering_numbers[1] & Result <= filtering_numbers[2]
      )
    ) 
}

tibble(
  Result = runif(50, min = 0, max = 1.2)
) %>%
  gt() %>%
  fce_col(c(0, 0.1), "green") %>%
  fce_col(c(0.1, 0.5), "yellow") %>%
  fce_col(c(0.5, 1), "orange") %>%
  fce_col(c(1, 1.2), "red")