Can you color an adjacent cell in gt table in r?

r gt

a1 and b1 are colored based on their values. I would like a2 to be the same color as a1 and b2 the same color as b1. Is this possible?

gt table with colored cells

library(dplyr)
library(gt)
library(viridis)

set.seed(123)
df <- data.frame(exp = (LETTERS[1:5]),
           a1 = sample(x = 1:20, size  = 5),
           a2 = sample(x = 1:10, size  = 5),
           b1 = sample(x = 1:20, size  = 5),
           b2 = sample(x = 1:10, size  = 5))

df %>% 
  gt() %>% 
  data_color(
        columns = c(a1,b1),
        colors = scales::col_numeric(
          palette = viridis(20, direction = 1, option ="D"), #color from viridis package
          domain = NULL)
      )

Many thanks!!

My first intuition was to grab the colors for a1 and b1 in the gt object:

But it was not possible to find them there, so

Next I created a vector of the colors like

#install.packages("colourvalues")
library(colourvalues)
colors <- color_values(df$a1)

and wanted to apply it to colors parameter in data_color for column a2

But this is not possible according to this issue https://github.com/rstudio/gt/issues/633.

On the same site @jthomasmock provided a solution with an own html before gt.

But this raised problems according to the text font on dark background, which

I could solve with the help of @stefan here: How to use INLINE HTML to make text white on dark background automatically after setting background from palette

#install.packages("prismatic")
library(dplyr)
library(purrr)
library(gt)
library(viridis)
library(prismatic)

df %>% 
  mutate(
    color = scales::col_numeric(
      palette = viridis(20, direction = 1, option ="D"), #color from viridis package
      domain = NULL)(a1),
    a1 = glue::glue(
      '<span style=\"display: inline-block; direction: ltr; border-radius: 5px; padding-right: 2px;',
      'color: {prismatic::best_contrast(color, c("white", "black"))}; background-color: {color}; width: 100%\"> {a1} </span>'
      ),
    a1 = map(a1, ~gt::html(as.character(.x))),
    a2 = glue::glue(
      '<span style=\"display: inline-block; direction: ltr; border-radius: 5px; padding-right: 2px;',
      'color: {prismatic::best_contrast(color, c("white", "black"))}; background-color: {color}; width: 100%\"> {a2} </span>'
    ),
    a2 = map(a2, ~gt::html(as.character(.x))),
  ) %>% 
  mutate(
    color = scales::col_numeric(
      palette = viridis(20, direction = 1, option ="D"), #color from viridis package
      domain = NULL)(b1),
    b1 = glue::glue(
      '<span style=\"display: inline-block; direction: ltr; border-radius: 5px; padding-right: 2px;',
      'color: {prismatic::best_contrast(color, c("white", "black"))}; background-color: {color}; width: 100%\"> {b1} </span>'
      ),
    b1 = map(b1, ~gt::html(as.character(.x))),
    b2 = glue::glue(
      '<span style=\"display: inline-block; direction: ltr; border-radius: 5px; padding-right: 2px;',
      'color: {prismatic::best_contrast(color, c("white", "black"))};background-color: {color}; width: 100%\"> {b2} </span>'
      ),
    b2 = map(b2, ~gt::html(as.character(.x))),
  ) %>%
  select(-color) %>% 
  gt()

enter image description here

Can you color an adjacent cell in gt table in r?

Related

Recent Posts