jthomasmock / gtExtras

A Collection of Helper Functions for the gt Package.
https://jthomasmock.github.io/gtExtras/
Other
195 stars 27 forks source link

Feature request: Allow missing values in `gt_fa_column` #25

Closed elipousson closed 2 years ago

elipousson commented 2 years ago

Thanks creating this helpful package!

I have a similar request to #13 after running into a small issue with gt_fa_column() for a table where I needed to show icons in some rows but not others. Here is a reproducible example that shows the error:

tibble::tibble(
  "num" = c(1,2,3),
  "icon" = c("check", NA, "circle")
) |>
  gt::gt() |> 
  gtExtras::gt_fa_column(
    column = icon
  )
#> Error in factor(xy, levels = fct_lvl, labels = pal_filler): invalid 'labels'; length 3 should be 1 or 2

Created on 2021-11-23 by the reprex package (v2.0.1)

I came up with a modified version of gt_fa_column that makes this work although it likely isn't the most elegant solution:

gt_fa_column <- function(gt_object, column, ..., palette = NULL,
                         align = "left", direction = 1){

  stopifnot("Table must be of class 'gt_tbl'" = "gt_tbl" %in% class(gt_object))

  text_transform(
    gt_object,
    locations = cells_body(columns = {{ column }}),
    fn = function(x){

      x[is.na(x)] <- "NA"

      if(is.null(palette)){
        pal_filler <- rev(c("#CC79A7", "#D55E00", "#0072B2",
                            "#F0E442", "#009E73", "#56B4E9",
                            "#E69F00", "#000000"))[seq_along(unique(x))]
      } else if(length(palette) == 1){
        pal_filler <- palette %>% rep(length(unique(x)))
      } else {
        pal_filler <- palette
      }

      lapply(X = x, FUN = function(xy){

        fct_lvl <- unique(x)
        stopifnot("The length of the unique elements must match the palette length" = length(fct_lvl) == length(pal_filler))

        if(!is.null(names(pal_filler))){
          fct_x <- factor(xy, levels = names(pal_filler), labels = pal_filler) %>%
            as.character()
        } else {
          fct_x <- factor(xy, levels = fct_lvl, labels = pal_filler) %>%
            as.character()
        }

        if (!(xy %in% c("NA", ""))) {
          my_fa <- list(fontawesome::fa(xy, ..., fill = fct_x, height = "20px", a11y = "sem") %>% gt::html())
        } else {
          my_fa <- list("<svg></svg>" %>% gt::html())
        }
        htmltools::div(title = xy, "aria-label" = xy, role = "img", my_fa, style = "padding:0px")
      })
    }
  ) %>%
    cols_align(align = align, columns = {{ column }})

}

Hope this is an addition you can consider!

jthomasmock commented 2 years ago

So my previous attempt had a lot of handling of NULL, NA, etc...

In retrospect, this is a large burden on the function to handle disparate text/NA etc. There simply shouldn't be any NA's passed to this function. As such, I've changed it so that if any rows are missing (ie: "") then it will ignore them.

elipousson commented 2 years ago

That works well for me! Thanks for jumping on this so quickly.