Adding images to group headers using text_transform in a gt table

Question

I am producing a table of cities grouped by country and with the following code and Liam Bailey's example I am able to create a table with country flags to represent the country in which each of my cities is based.

 set.seed(1)

# gt table with flags

city_dat <- data.frame(
  country = rep(c("United States", "United Kingdom", "Canada"), times = 1, each = 3),
  city = c("New York", "Washington", "Los Angeles",
           "London", "Manchester", "Liverpool",
           "Toronto", "Vancouver", "Halifax"),
  some_data = sample(10:40, size =9))

country_flags <- data.frame(
  country = c("United States", "United Kingdom", "Canada"),
  flag_URL = c("https://upload.wikimedia.org/wikipedia/en/a/a4/Flag_of_the_United_States.svg", 
               "https://upload.wikimedia.org/wikipedia/commons/a/ae/Flag_of_the_United_Kingdom.svg",
               "https://upload.wikimedia.org/wikipedia/en/c/cf/Flag_of_Canada.svg"))

city_dat <- city_dat %>% left_join(country_flags) %>% select(4, 1:3)

city_dat_gt <-
  city_dat %>%
  gt(
    rowname_col = "city",
    groupname_col = "country"
  ) %>% 
  gt::text_transform(
    #Apply a function to a column
    locations = cells_body(c(flag_URL)),
    fn = function(x) {
      #Return an image of set dimensions
      web_image(
        url = x,
        height = 12
      )
    }
  ) %>% 
  #Hide column header flag_URL and reduce width
  cols_width(c(flag_URL) ~ px(30)) %>% 
  cols_label(flag_URL = "")
 

However the figure this gives me places the flag in the body cells and repeats them for each city where what I really want to do it place them in the group headers alongside the relevant country name.

I can get most of the way there by changing the location argument and also the group names.

city_dat_gt <-
  city_dat %>%
  gt(
    rowname_col = "city",
    groupname_col = "flag_URL"
  ) %>% 
  gt::text_transform(
    #Apply a function to a column
    locations = cells_row_groups(),
    fn = function(x) {
      #Return an image of set dimensions
      web_image(
        url = x,
        height = 12
      )
    }
  ) %>% 
  #Hide column header flag_URL and reduce width
  cols_width(c(flag_URL) ~ px(30)) %>% 
  cols_label(flag_URL = "")

However, I cannot work out why the images fail to render when moved to the row groups. Changing the group names also means I loose the country names from the header and I am not sure if there is a way to concatenate these back in.

Answer 1

Adapting my answer on this post which makes use of gt::html to your case you could achieve your desired result like so:

Note:

1. There is no need to add the flags as a column. Instead you could use country as the group column and get the URL of the flags from your country flags df or as I do by converting it to a named vector or list.

2. Also note that it's important to use lapply so that the function returns a list.

set.seed(1)

# gt table with flags

city_dat <- data.frame(
  country = rep(c("United States", "United Kingdom", "Canada"), times = 1, each = 3),
  city = c("New York", "Washington", "Los Angeles",
           "London", "Manchester", "Liverpool",
           "Toronto", "Vancouver", "Halifax"),
  some_data = sample(10:40, size =9))

country_flags <- data.frame(
  country = c("United States", "United Kingdom", "Canada"),
  flag_URL = c("https://upload.wikimedia.org/wikipedia/en/a/a4/Flag_of_the_United_States.svg", 
               "https://upload.wikimedia.org/wikipedia/commons/a/ae/Flag_of_the_United_Kingdom.svg",
               "https://upload.wikimedia.org/wikipedia/en/c/cf/Flag_of_Canada.svg"))

library(gt)
library(dplyr)

flags <- country_flags %>% tibble::deframe()

city_dat %>%
  gt(
    rowname_col = "city",
    groupname_col = "country"
  ) %>% 
  gt::text_transform(
    locations = cells_row_groups(),
    fn = function(x) {
      lapply(x, function(x) {
        gt::html(paste(
          web_image(
            url = flags[[x]],
            height = 12
          ),
          "<span>", x, "</span>"
        ))
      })
    }
  )