Enable fmt_icon color argument to accept a named vector of icon names with associated colors

[jasonpott]

Prework

• Read and abide by gt's code of conduct and contributing guidelines.
• Search for duplicates among the existing issues (both open and closed).

Proposal

Thank you for the work on this package.

I have been working on a table to describe attributes that are present in datasets.

model_order <- c(
  "24Hr Blood tests",
  "Arrival Obs, PRBC vol, AIS, ISS & mechanism",
  "Arrival Obs + PRBC vol & AIS & mechanism",
  "Arrival Obs + PRBC vol & ISS & mechanism",
  "Arrival Obs + PRBC vol & ISS",
  "Arrival labs with PRBC vol",
  "Arrival Obs + Labs + PRBC vol",
  "Arrival Obs with PRBC vol",
  "Arrival OBs & Blood tests",
  "Arrival Blood tests",
  "Arrival Observations",
  "Pre-Hospital Obs with blood vol",
  "Pre-Hospital Observations"
  )

data.frame("Model Dataset" = factor(model_order, levels = model_order),
           "Pre-hospital Observations" = c("NO","NO","NO","NO","NO","NO","NO","NO","NO","NO","NO","YES","YES"),
           "ED Observations" = c("NO","YES","YES","YES","YES","YES","YES","YES","YES","YES","YES","NO","NO"),
           "Lab results at Baseline" = c("NO","NO","NO","NO","NO","YES","YES","NO","YES","YES","NO","NO","NO"),
           "Change in Lab results at 24 hrs" = c("YES","NO","NO","NO","NO","NO","NO","NO","NO","NO","NO","NO","NO"),
           "Blood Product administration" = c("NO", "YES", "YES", "YES", "YES","YES","YES","YES","NO","NO","NO","YES","NO"),
           "ISS" = c("NO","YES","NO","YES","YES","NO","NO","NO","NO","NO","NO","NO","NO"),
           "AIS" = c("NO","YES","YES","NO","NO","NO","NO","NO","NO","NO","NO","NO","NO"),
           "Mechanism" = c("NO", "YES","YES","YES","NO","NO","NO","NO","NO","NO","NO","NO","NO")
           ) %>% 
    mutate(
        across(`Pre.hospital.Observations`:Mechanism, ~ ifelse(.x == "YES", "circle-check", .x)),
        across(`Pre.hospital.Observations`:Mechanism, ~ ifelse(.x == "NO", "circle-xmark", .x))
           ) %>% 
    clean_names(case = "sentence") %>%
	gt() %>% 
     gt::tab_options(
            table.font.size = 12,
            table.font.style = "Calibri",
            data_row.padding = gt::px(1),
            summary_row.padding = gt::px(2),
            grand_summary_row.padding = gt::px(1),
            footnotes.padding = gt::px(1),
            source_notes.padding = gt::px(1),
            row_group.padding = gt::px(1),
            row_group.font.weight = "bold"
          ) %>% 
    fmt_icon(columns = `Pre hospital observations`:Mechanism,
             height = "2em")

producing a table as below

I was hoping to format the check and xmark green and red for legibility.

I created a named vector to apply the palette as below:

check_colours <- c(
    "circle-check" = "#056206",
    "circle-xmark" = "#A31111"
)
... %>%
fmt_icon(columns = `Pre hospital observations`:Mechanism,
             height = "2em",
             fill_color = check_colours)

The output was correctly coloured icons but duplicated in each cell.

I can't see a method within the function reference to apply a selection of colors to the icons. Would this be possible to implement?

Similar functionality is reported in gtExtra but this does not work as described for which I will report an issue separately.

[jasonpott]

I was able to come up with a work around where I create the icons externally using fontawesome then use the text transform function with a map function I found on stack overflow.

I thought it would be helpful to add this to the suggestion in case another user was looking for a solution in the interim.

fa_png(name = "circle-check",fill = "#056206",)
fa_png(name ="circle-xmark", fill = "#A31111")

data.frame("Model Dataset" = factor(model_order, levels = model_order),
           "Pre-hospital Observations" = c("NO","NO","NO","NO","NO","NO","NO","NO","NO","NO","NO","YES","YES"),
           "ED Observations" = c("NO","YES","YES","YES","YES","YES","YES","YES","YES","YES","YES","NO","NO"),
           "Lab results at Baseline" = c("NO","NO","NO","NO","NO","YES","YES","NO","YES","YES","NO","NO","NO"),
           "Change in Lab results at 24 hrs" = c("YES","NO","NO","NO","NO","NO","NO","NO","NO","NO","NO","NO","NO"),
           "Blood Product administration" = c("NO", "YES", "YES", "YES", "YES","YES","YES","YES","NO","NO","NO","YES","NO"),
           "ISS" = c("NO","YES","NO","YES","YES","NO","NO","NO","NO","NO","NO","NO","NO"),
           "AIS" = c("NO","YES","YES","NO","NO","NO","NO","NO","NO","NO","NO","NO","NO"),
           "Mechanism" = c("NO", "YES","YES","YES","NO","NO","NO","NO","NO","NO","NO","NO","NO")
           ) %>% 
    mutate(
        across(`Pre.hospital.Observations`:Mechanism, ~ ifelse(.x == "YES",  "circle-check.png", .x)),
        across(`Pre.hospital.Observations`:Mechanism, ~ ifelse(.x == "NO", "circle-xmark.png", .x))
           ) %>% 
    clean_names(case = "sentence")-> ft_table


ft_table %>% 
    gt() %>% 
     gt::tab_options(
            table.font.size = 12,
            table.font.style = "Calibri",
            data_row.padding = gt::px(1),
            summary_row.padding = gt::px(2),
            grand_summary_row.padding = gt::px(1),
            footnotes.padding = gt::px(1),
            source_notes.padding = gt::px(1),
            row_group.padding = gt::px(1),
            row_group.font.weight = "bold"
          ) %>% 
    text_transform(
    locations = cells_body(vars(`Pre hospital observations`:Mechanism,)),
    fn = function(x) {
      # loop over the elements of the column
      map_chr(x, ~ local_image(
        filename = paste0(.x),
        height = 20
      ))
    })