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

[jasonpott]

Prework

• [x] Read and abide by gt's code of conduct and contributing guidelines.
• [x] 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
      ))
    })

[MatthewAngulo]

The fill_colors argument is still duplicating icons when provided a list!

The example within the documentation is exactly what I am attempting to do - conditionally color icons based on the icon. However, when I try to run the code for the example or my own code with personal data, the icons are duplicated and have each of the colors within the list.

For me the below code generates duplicate arrows per row.

sp500 |> dplyr::slice_head(n = 10) |> dplyr::select(date, open, close) |> dplyr::arrange(-dplyr::row_number()) |> gt(rowname_col = "date") |> cols_add(week = date, .after = date) |> cols_add(dir = ifelse(close > open, "arrow-up", "arrow-down")) |> cols_merge(columns = c(date, week), pattern = "{1} ({2})") |> fmt_date(columns = date, date_style = "m_day_year") |> fmt_datetime(columns = week, format = "w", pattern = "W{x}") |> fmt_currency() |> fmt_icon( columns = dir, fill_color = c("arrow-up" = "green", "arrow-down" = "red") ) |> cols_label( open = "Opening Value", close = "Closing Value", dir = "" ) |> opt_stylize(style = 1, color = "gray")

[rich-iannone]

@MatthewAngulo When I run that code (with the dev version of gt) I get this table:

I'm running this with R4.2.3 (I downgraded recently to test some things).

Could you provide your session information (and update to the latest dev version of gt with devtools::install_github())?

[MatthewAngulo]

@rich-iannone Thanks for the quick reply!

I'm running this on R version 4.3.2 (2023-10-31).

And I'm unfortunately unable to install the dev version from github because I'm running this code on a server at work that doesn't allow access to github or installing packages from github :(

[rich-iannone]

@MatthewAngulo Ah, I understand. There will be a release of gt soon, and this likely won't be a problem once you get the CRAN version.

[MatthewAngulo]

@rich-iannone Exciting! I'll keep an eye out for it then. Thanks again