Search code examples
rpurrrgtrasterstats

How to apply multiple colors to multiple columns in gt R Package

I use the {gt} package a lot at work; however, I have to apply multiple colors to multiple columns in several reports. So, I need your assistance in automating this with the {purrr} package. Below is an example dataset similar to what I am working on monthly.

Thank you for your kind assistance!

data_tbl <- tibble(
  name = c('deng', 'alier',  'atem', 'garang', 'akuien'), 
  english = c(87, 57, 76, 98, 79), 
  mathematics = c(88, 98, 87, 69, 88), 
  statistics = c(76, 99, 58,  84,  90)
)

# Tabulate the data with gt

my_gt <- data_tbl %>% 
  
  # Initialize a gt table
  gt() %>% 
  
  # Formatting
  tab_style(
    style = list(
      cell_fill(color = "#1dab48")
      # cell_text(color = "white")
    ),
    locations = cells_body(
      columns = english,
      rows = english >= 80
    )
  ) %>% 
  
  tab_style(
    style = list(
      cell_fill(color = "#1dab48")
      # cell_text(color = "white")
    ),
    locations = cells_body(
      columns = mathematics,
      rows = mathematics >= 80
    )
  ) %>% 
  
  tab_style(
    style = list(
      cell_fill(color = "#1dab48")
      # cell_text(color = "white")
    ),
    locations = cells_body(
      columns = statistics,
      rows = statistics >= 80
    )
  ) %>% 
  
  
  # Formatting - yellow
  tab_style(
    style = list(
      cell_fill(color = "#c97928")
      # cell_text(color = "white")
    ),
    locations = cells_body(
      columns = english,
      rows = english >= 70 & english < 80
    )
  ) %>% 
  
  tab_style(
    style = list(
      cell_fill(color = "#c97928")
      # cell_text(color = "white")
    ),
    locations = cells_body(
      columns = mathematics,
      rows = mathematics >= 70 & mathematics < 80
    )
  ) %>% 
  
  tab_style(
    style = list(
      cell_fill(color = "#c97928")
      # cell_text(color = "white")
    ),
    locations = cells_body(
      columns = statistics,
      rows = statistics >= 70 & statistics < 80
    )
  ) %>% 
  
  # Formatting - red
  tab_style(
    style = list(
      cell_fill(color = "#c94e28")
      # cell_text(color = "white")
    ),
    locations = cells_body(
      columns = english,
      rows = english < 70 
    )
  ) %>% 
  
  tab_style(
    style = list(
      cell_fill(color = "#c94e28")
      # cell_text(color = "white")
    ),
    locations = cells_body(
      columns = mathematics,
      rows = mathematics < 70 
    )
  ) %>% 
  
  tab_style(
    style = list(
      cell_fill(color = "#c94e28")
      # cell_text(color = "white")
    ),
    locations = cells_body(
      columns = statistics,
      rows = statistics < 70
    )
  )

my_gtenter image description here

Solution

  • Here is one way using a for loop:

    library(dplyr)
library(gt)

tbl1 <- data_tbl %>%
  # Initialize a gt table
  gt()

nm1 <- names(data_tbl[,2:4])

for(i in seq_along(nm1)) {

  tbl1 <- tbl1 %>%
    tab_style(
      style = list(
        cell_fill(color = "#1dab48")
      ),
      locations = cells_body(
        columns = nm1[i],
        rows = tbl1$`_data`[[nm1[i]]] >= 80
      )
    ) %>%

    tab_style(
      style = list(
        cell_fill(color = "#c97928")

      ),
      locations = cells_body(
        columns = nm1[i],

        rows = tbl1$`_data`[[nm1[i]]] >= 70 & tbl1$`_data`[[nm1[i]]] < 80
      )
    ) %>%

    tab_style(
      style = list(
        cell_fill(color = "#c94e28")

      ),
      locations = cells_body(
        columns = nm1[i],

        rows = tbl1$`_data`[[nm1[i]]] < 70
      )
    )
}

    Output

    enter image description here