Render player headshots in gt tables

NAMESPACE

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

R/gt_nfl_logos.R → R/gt_nfl.R

@@ -121,3 +121,79 @@ get_image_uri <- function(team_abbr, type = c("logos", "wordmarks")) {
     }
   )
 }
+
+
+#' Render Player Headshots in 'gt' Tables
+#'
+#' @description Translate NFL player gsis IDs to player headshots and
+#'   render these images in html tables with the 'gt' package.
+#'
+#' @inheritParams gt_nfl_logos
+#'
+#' @return An object of class `gt_tbl`.
+#' @export
+#' @section Output of below example:
+#' \if{html}{\figure{headshot_tbl.png}{options: width=75\%}}
+#' @examples
+#' \donttest{
+#' library(nflplotR)
+#' library(gt)
+#' # Silence an nflreadr message that is irrelevant here
+#' old <- options(nflreadr.cache_warning = FALSE)
+#' df <- data.frame(
+#'   player_gsis = c("00-0033873",
+#'                   "00-0026498",
+#'                   "00-0035228",
+#'                   "00-0031237",
+#'                   "00-0036355",
+#'                   "00-0019596",
+#'                   "00-0033077",
+#'                   "00-0012345",
+#'                   "00-0031280"),
+#'   player_name = c("P.Mahomes",
+#'                   "M.Stafford",
+#'                   "K.Murray",
+#'                   "T.Bridgewater",
+#'                   "J.Herbert",
+#'                   "T.Brady",
+#'                   "D.Prescott",
+#'                   "Non.Match",
+#'                   "D.Carr")
+#' )
+#'
+#' # Replace player IDs with headshot images
+#' table <- gt(df) %>%
+#'   gt_nfl_headshots("player_gsis")
+#'
+#' # Restore old options
+#' options(old)
+#' }
+gt_nfl_headshots <- function(gt_object,
+                             columns,
+                             height = 30,
+                             locations = NULL){
+  rlang::check_installed("gt (>= 0.8.0)", "to render images in gt tables.")
+
+  if(is.null(locations)){
+    locations <- gt::cells_body({{ columns }})
+  }
+
+  gt::text_transform(
+    data = gt_object,
+    locations = locations,
+    fn = function(gsis){
+      headshot_map <- load_headshots()
+      image_urls <- vapply(
+        gsis,
+        FUN.VALUE = character(1),
+        USE.NAMES = FALSE,
+        FUN = function(id) {
+          ret <- headshot_map$headshot_nfl[headshot_map$gsis_id == id]
+          if(length(ret) == 0) ret <- na_headshot()
+          ret
+        }
+      )
+      gt::web_image(image_urls, height = height)
+    }
+  )
+}

pkgdown/_pkgdown.yml

@@ -91,12 +91,17 @@ reference:
   contents:
   - starts_with("scale")
 
+- title: Tables
+  desc: >
+    Utility functions that work with the gt package to create html tables.
+  contents:
+  - starts_with("gt_nfl")
+
 - title: Utilities
   desc: >
     Various helper functions.
   contents:
   - ggpreview
-  - starts_with("gt_nfl")
   - nfl_team_factor
   - nfl_team_tiers
   - valid_team_names