Handle NA gsis IDs in headshot functions

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: nflplotR
 Title: NFL Logo Plots in 'ggplot2'
-Version: 1.2.0
+Version: 1.2.0.9001
 Authors@R: 
     person("Sebastian", "Carl", , "mrcaseb@gmail.com", role = c("aut", "cre"))
 Description: A set of functions to visualize National Football League

NEWS.md

@@ -1,3 +1,8 @@
+# nflplotR (development version)
+
+* The functions `geom_nfl_headshots()` and `gt_nfl_headshots()` better handle `NA` gsis IDs. (#48)
+* The functions `gt_nfl_logos()` and `gt_nfl_wordmarks()` now keep non team name matches to allow the user to call `gt::sub_missing()`. (#48)
+
 # nflplotR 1.2.0
 
 ## New Features

R/build_grobs.R

@@ -15,6 +15,7 @@ build_grobs <- function(i, alpha, colour, data, type = c("teams", "headshots", "
     image_to_read <- data$path[i]
   } else {
     gsis <- data$player_gsis[i]
+    if (is.na(gsis)) make_null <- TRUE
     headshot_map <- load_headshots()
     image_to_read <- headshot_map$headshot_nfl[headshot_map$gsis_id == gsis]
     if(length(image_to_read) == 0) image_to_read <- na_headshot()

R/gt_nfl.R

@@ -95,7 +95,11 @@ gt_nflplotR_image <- function(gt_object,
       # Create the image URI
       uri <- get_image_uri(team_abbr = team_abbr, type = type)
       # Generate the Base64-encoded image and place it within <img> tags
-      paste0("<img src=\"", uri, "\" style=\"height:", height, ";\">")
+      out <- paste0("<img src=\"", uri, "\" style=\"height:", height, ";\">")
+      # If the image uri returns NA we didn't find a match. We will return the
+      # actual value then to allow the user to call gt::sub_missing()
+      out[is.na(uri)] <- x[is.na(uri)]
+      out
     }
   )
 
@@ -115,6 +119,8 @@ get_image_uri <- function(team_abbr, type = c("logos", "wordmarks")) {
     FUN.VALUE = character(1),
     USE.NAMES = FALSE,
     FUN = function(team) {
+      # every non match will return NULL which is when we want NA
+      if (is.null(lookup_list[[team]])) return(NA_character_)
       paste0(
         "data:", "image/png",
         ";base64,", base64enc::base64encode(lookup_list[[team]])
@@ -191,12 +197,18 @@ gt_nfl_headshots <- function(gt_object,
         FUN.VALUE = character(1),
         USE.NAMES = FALSE,
         FUN = function(id) {
+          if(is.na(id) | !is_gsis(id)) return(NA_character_)
           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)
+      img_tags <- gt::web_image(image_urls, height = height)
+      # gt::web_image inserts a placeholder for NAs
+      # We want the actual input instead because users might call
+      # gt::sub_missing which defaults to "---"
+      img_tags[is.na(image_urls)] <- gsis[is.na(image_urls)]
+      img_tags
     }
   )
 }

R/utils.R

@@ -45,6 +45,8 @@ headshot_html <- function(player_gsis, type = c("height", "width"), size = 25){
 
 is_installed <- function(pkg) requireNamespace(pkg, quietly = TRUE)
 
+is_gsis <- function(id) grepl("00-00[0-9]{5}", id, perl = TRUE)
+
 load_headshots <- function() nflreadr::rds_from_url("https://github.com/nflverse/nflplotR/releases/download/nflplotr_infrastructure/headshot_gsis_map.rds")
 
 na_headshot <- function() "https://static.www.nfl.com/image/private/t_player_profile_landscape_2x/f_auto/league/rfuw3dh4aah4l4eeuubp.png"