library(gt)
library(dplyr)
library(data.table)

# Guidelines
guide.df <- data.frame(standards = LETTERS[7:9],
                      foo = c("3", "2", "1"),
                      bar = c("0.5", "5", NA))

# Create a data frame to exemplify issue
test.df <- data.frame(name = LETTERS[1:6],
                      foo = c("10", "3", "< 0.01", "0.05", "<0.1", NA),
                      bar = c("<0.15", "3", "1", "<0.4", NA, "< 0.001"))

# Determine which cells have a '<' character in them
grep.mat <-
  apply(X = test.df,
        MARGIN = c(1,2),
        FUN = function(x) grepl("<", x))

colnum <- which(grep.mat, arr.ind = T)[,"col"]
rownum <- which(grep.mat, arr.ind = T)[,"row"]

# View the gt output
test.df %>%
  gt() %>%
  tab_style(style = cell_fill(color = "grey"),
            locations = cells_body(
              rows = rownum,
              columns = colnum))

# Convert data.frame into gt
rolling.gt <- test.df %>%
  gt()

# apply a function to independently add coloured cells
invisible(mapply(function(i,j){
  rolling.gt <<- tab_style(data = rolling.gt,
                           style = cell_fill(color = "grey"),
                           locations = cells_body(
                             rows = j,
                             columns = i))
}, i = colnum, j = rownum)) #invisible used to prevent printing to console

# Generate a guidelines df that can be mapped to the results df
colours <- data.frame(standards = LETTERS[7:9], color = RColorBrewer::brewer.pal(3, name = "Set1"))

guide.form <- guide.df %>%
  as.data.table() %>%
  data.table::melt(id.vars = "standards") %>%
  group_by(variable) %>%
  left_join(colours)

test.df.melt <- test.df %>%
  as.data.table() %>%
  data.table::melt(id.vars = "name", value.name = "result")

merged.data <- guide.form %>%
  full_join(test.df.melt) %>%
  filter(as.numeric(result) > value) %>%
  group_by(name, variable) %>%
  filter(value == max(value)) %>%
  ungroup() %>%
  as.data.table() %>%
  data.table::melt(id.vars = c("color", "name", "variable"), measure.vars = "result")


test <- sapply(colnames(test.df)[2:length(colnames(test.df))], function(y) {
  int <- 0
  apply(X = as.data.frame(test.df[, y]),
        MARGIN = 1,
        FUN = function(x) {
          int <<- int+1
          as.numeric(x) == as.numeric(merged.data[merged.data$name == test.df[int, "name"] & merged.data$variable == y, "value"])
        })
  }, USE.NAMES = T)

array.index <- which(test, arr.ind = T) %>% as.data.frame()
array.index[,"col"] <- array.index[,"col"]+1 #Get around the name problem

array.index$colour <- as.vector(mapply(function(x,y) {
  merged.data[merged.data$value == test.df[x,y] &
              merged.data$name == test.df[x,"name"] &
              merged.data$variable == test.df %>% select(y) %>% colnames, "color"]
},
x = as.numeric(array.index[,"row"]),
y = as.numeric(array.index[,"col"]), SIMPLIFY = T))

# Now apply the indices to the tab style
invisible(mapply(function(i,j, colour){
  rolling.gt <<- tab_style(data = rolling.gt,
                           style = cell_fill(color = colour),
                           locations = cells_body(
                             rows = i,
                             columns = j))
}, i = array.index[,"row"], j = array.index[,"col"], colour = array.index[,"colour"])) #invisible used to prevent printing to console

#View the properly formatted gt
rolling.gt