Render images in gt column labels (#52)

* allow non matches in team abbrs
to be able to plot the NFL logo

* catch non matches

* update example with NFL logo

* bump version

* news bullet

* add wordmark urls to sysdata

* add function to render images in column labels

* bump version and document

* update gt article with support for column labels

* news bullet

* forgot height argument

* unify argument names

* fix failing article

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: nflplotR
 Title: NFL Logo Plots in 'ggplot2'
-Version: 1.2.0.9004
+Version: 1.2.0.9005
 Authors@R: 
     person("Sebastian", "Carl", , "[email protected]", role = c("aut", "cre"))
 Description: A set of functions to visualize National Football League
@@ -43,4 +43,4 @@ Suggests:
 Config/testthat/edition: 3
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.0

NAMESPACE

@@ -20,6 +20,7 @@ export(geom_nfl_headshots)
 export(geom_nfl_logos)
 export(geom_nfl_wordmarks)
 export(ggpreview)
+export(gt_nfl_cols_label)
 export(gt_nfl_headshots)
 export(gt_nfl_logos)
 export(gt_nfl_wordmarks)

NEWS.md

@@ -5,6 +5,7 @@
 * The functions `gt_nfl_logos()` and `gt_nfl_wordmarks()` now correctly render images in gt row group labels. (#49)
 * Deprecated the functions `scale_x_nfl`, `scale_y_nfl`, `scale_x_nfl_headshots`, `scale_y_nfl_headshots`, `theme_x_nfl`, `theme_y_nfl`. These function are slow and require a possibly unstable dependency. Please use the far superior `element_nfl_logo()` and friends instead. (#50)
 * The function `geom_nfl_logos()` now plots the NFL logo, if `team_abbr == "NFL"`. (#51)
+* Added the new function `gt_nfl_cols_label()` that renders logos and wordmarks in column labels of {gt} tables. (#52)
 
 # nflplotR 1.2.0
 

R/gt_nfl.R

@@ -13,9 +13,13 @@
 #'   [gt::cells_column_labels()], and [gt::cells_row_groups()] helper functions
 #'   can be used here. We can enclose several of these calls within a `list()`
 #'   if we wish to make the transformation happen at different locations.
+#' @param type One of `"logo"` or `"wordmark"` selecting whether to render
+#'    a team's logo or wordmark image.
 #'
 #' @return An object of class `gt_tbl`.
 #' @seealso The player headshot rendering function [gt_nfl_headshots()].
+#' @seealso The article that describes how nflplotR works with the {gt} package
+#'    <https://nflplotr.nflverse.com/articles/gt.html>
 #' @export
 #' @section Output of below example:
 #' \if{html}{\figure{logo_tbl.png}{options: width=75\%}}
@@ -69,6 +73,34 @@ gt_nfl_wordmarks <- function(gt_object,
   )
 }
 
+
+#' @rdname gt_nfl_logos
+#' @export
+gt_nfl_cols_label <- function(gt_object,
+                              columns = gt::everything(),
+                              height = 30,
+                              type = c("logo", "wordmark")){
+
+  type <- rlang::arg_match(type)
+
+  lookup <- switch (
+    type,
+    "logo" = logo_urls,
+    "wordmark" = wordmark_urls
+  )
+
+  gt::cols_label_with(
+    data = gt_object,
+    columns = {{ columns }},
+    fn = function(team_abbrs){
+      image_urls <- lookup[team_abbrs]
+      img_tags <- gt::web_image(image_urls, height = height)
+      img_tags[is.na(image_urls)] <- team_abbrs[is.na(image_urls)]
+      gt::html(img_tags)
+    }
+  )
+}
+
 gt_nflplotR_image <- function(gt_object,
                               columns,
                               height = 30,

data-raw/build_logo_list.R

@@ -18,12 +18,19 @@ logo_list <- rlang::set_names(logo_list, teams_colors_logos$team_abbr)
 
 primary_colors <- teams_colors_logos$team_color
 names(primary_colors) <- teams_colors_logos$team_abbr
+primary_colors <- primary_colors[!is.na(primary_colors)]
 
 secondary_colors <- teams_colors_logos$team_color2
 names(secondary_colors) <- teams_colors_logos$team_abbr
+secondary_colors <- secondary_colors[!is.na(secondary_colors)]
 
 logo_urls <- teams_colors_logos$team_logo_espn
 names(logo_urls) <- teams_colors_logos$team_abbr
+logo_urls <- logo_urls[!is.na(logo_urls)]
+
+wordmark_urls <- teams_colors_logos$team_wordmark
+names(wordmark_urls) <- teams_colors_logos$team_abbr
+wordmark_urls <- wordmark_urls[!is.na(wordmark_urls)]
 
 # Save raw logos in internal data for more speed
 wordmarks <- nflreadr::load_teams() |> dplyr::select(team_abbr, team_wordmark)
@@ -33,4 +40,4 @@ wordmark_list <- lapply(wordmarks$team_wordmark, function(url){
 
 wordmark_list <- rlang::set_names(wordmark_list, wordmarks$team_abbr)
 
-usethis::use_data(logo_list, primary_colors, secondary_colors, logo_urls, wordmark_list, internal = TRUE, overwrite = TRUE)
+usethis::use_data(logo_list, primary_colors, secondary_colors, logo_urls, wordmark_urls, wordmark_list, internal = TRUE, overwrite = TRUE)

vignettes/articles/gt.Rmd

@@ -121,74 +121,39 @@ example_table |>
 
 ### How about Column Labels?
 
-Well...it's complicated because [gt behaves inconsistent in my opinion](https://github.com/rstudio/gt/issues/1433). Currently, the nflplotR gt helpers fail to render images in column labels. 
+Well...it's complicated, because [gt behaves inconsistent in my opinion](https://github.com/rstudio/gt/issues/1433).
 
-Until a better solution has been found, the following code is recommended for the implementation of logos and wordmarks in column labels. 
+The actually correct way would be a call to `nflplotR::gt_nfl_logos` or `nflplotR::gt_nfl_wordmarks` with the `locations` argument set to `gt::cells_column_labels()`. Currently, this wouldn't render any images in column labels as discussed in the above linked issue. 
+
+However, as a convenient workaround, nflplotR supports logos and wordmarks in column labels through `gt_nfl_cols_label()`. 
 
 LOGOS:
 
 ```{r}
-data.frame(
-  BUF = 1:2,
-  LAC = 11:12
-) |> 
-  gt::gt() |> 
-  gt::cols_label_with(
-    fn = function(team_abbrs){
-      teams <- nflreadr::load_teams(current = FALSE)
-      image_urls <- vapply(
-        team_abbrs,
-        FUN.VALUE = character(1L),
-        USE.NAMES = FALSE,
-        FUN = function(abbr) {
-          if(!abbr %in% nflplotR::valid_team_names()) return(NA_character_)
-          ret <- teams$team_logo_espn[teams$team_abbr == abbr]
-          ret
-        }
-      )
-      img_tags <- gt::web_image(image_urls, height = 30)
-      gt::html(img_tags)
-    }
-  ) |> 
+teams <- nflplotR::valid_team_names() |> head(6)
+df <- cbind(1, 2, 3, 4, 5, 6) |> 
+  as.data.frame() |> 
+  rlang::set_names(teams)
+
+gt::gt(df) |> 
+  nflplotR::gt_nfl_cols_label() |> 
   # align the complete table left
   gt::tab_options(
     table.align = "left"
   )
 ```
 
-WORDMARKS:
+WORDMARKS (note how non matches remain unchanged):
 
 ```{r}
-data.frame(
-  BUF = 1:2,
-  LAC = 11:12
-) |> 
-  gt::gt() |> 
-  gt::cols_label_with(
-    fn = function(team_abbrs){
-      teams <- nflreadr::load_teams(current = FALSE)
-      image_urls <- vapply(
-        team_abbrs,
-        FUN.VALUE = character(1L),
-        USE.NAMES = FALSE,
-        FUN = function(abbr) {
-          if(!abbr %in% nflplotR::valid_team_names()) return(NA_character_)
-          ret <- teams$team_wordmark[teams$team_abbr == abbr]
-          ret
-        }
-      )
-      img_tags <- gt::web_image(image_urls, height = 30)
-      gt::html(img_tags)
-    }
-  ) |> 
+gt::gt(df) |> 
+  nflplotR::gt_nfl_cols_label(type = "wordmark") |> 
   # align the complete table left
   gt::tab_options(
     table.align = "left"
   )
 ```
 
-
-
 ### Logos and Wordmarks Rendered by nflplotR
 
 This example creates a table that renders all team logos and wordmarks. We split the table into 2 x 16 rows to avoid an overly long table and convert all variables starting with "logo" to logos and all variables starting with "wordmark" to wordmarks.