如何在分面ggplot中正确添加MLB球员头像？解决单色剪影问题

问题 #

我正在尝试创建分面散点图，展示三位MLB投手的球路运动数据，但在为每位投手的子图添加球员头像时遇到两个问题：

1. 仅需加载3张头像却耗时数分钟；
2. 头像显示为红色剪影。

代码 #

library(baseballr)
library(dplyr)
library(tidyverse)
library(grid)
library(mlbplotR)
library(ggplot2)

# pull data for three different pitchers
senga <- baseballr::statcast_search_pitchers(start_date = "2023-03-30",
                                             end_date = "2023-04-03",
                                             pitcherid = 673540)
strider <- baseballr::statcast_search_pitchers(start_date = "2023-03-30",
                                               end_date = "2023-04-03",
                                               pitcherid = 675911)
kirby <- baseballr::statcast_search_pitchers(start_date = "2023-03-30",
                                             end_date = "2023-04-03",
                                             pitcherid = 669923)
# bind to one df
df <- rbind(senga,strider,kirby) %>%
  filter(pitch_type != 'PO')

# 注：原代码中all_data未定义，应改为df
player_cleaned_data <- df %>% 
  # Only keep rows with pitch movement readings and during the regular season
  filter(!is.na(pfx_x), !is.na(pfx_z),
                game_type == "R") %>% 
  mutate(pfx_x_in_pv = -12*pfx_x,
                pfx_z_in = 12*pfx_z)

# Make a named vector to scale pitch colors with
pitch_colors <- c("4-Seam Fastball" = "red",
                  "2-Seam Fastball" = "orange",
                  "Sinker" = "cyan",
                  "Cutter" = "firebrick",
                  "Fastball" = "gray",
                  "Curveball" = "blue",
                  "Knuckle Curve" = "pink",
                  "Slider" = "orange",
                  "Changeup" = "#4cbb17",
                  "Forkball" = "hotpink",
                  "Split-Finger" = "#FC6C85",
                  "Sweeper" = "coral",
                  "Knuckleball" = "black")

# Find unique pitch types to not have unnecessary pitches in legend
pitch_types <- unique(player_cleaned_data$pitch_name)

player_cleaned_data %>% 
  ggplot(aes(x = pfx_x_in_pv, y = pfx_z_in, color = pitch_name)) +
  geom_vline(xintercept = 0) +
  geom_hline(yintercept = 0) +
  geom_point(size = 2, alpha = 0.45) +
  # Scale the pitch colors to match what we defined above
  scale_color_manual(values = pitch_colors,
                     limits = pitch_types) +
  # Scale axes and add " to end of labels to denote inches
  scale_x_continuous(limits = c(-25,25),
                     breaks = seq(-20,20, 5),
                     labels = scales::number_format(suffix = "\"")) +
  scale_y_continuous(limits = c(-25,25),
                     breaks = seq(-20,20, 5),
                     labels = scales::number_format(suffix = "\"")) +
  theme(text = element_text(family = "Trebuchet MS"),
        plot.title = element_text(size = 20, face = 'bold'),
        axis.title = element_text(size = 12),
        legend.title = element_blank(),
        legend.text = element_text(size = 11),
        plot.caption = element_text(size = 10),
        legend.key = element_rect(fill = NA)) +
  coord_equal() +
  labs(title = "Pitch Movement Profiles",
       subtitle = "2023 MLB Season | Pitcher's POV",
       caption = "Data: Baseball Savant via baseballr", 
       x = "Horizontal Break",
       y = "Induced Vertical Break", color = "Pitch Name") +
  facet_wrap(~full_name) +
  mlbplotR::geom_mlb_headshots(aes(player_id = pitcher), x = 17, y = 17, width = .2)

输出效果图 #

原因分析与修复方案 #

问题1：头像加载耗时过长 #

原因：geom_mlb_headshots默认继承ggplot的全局数据和映射，原数据中每个投手有数百条投球记录，导致函数为每一行数据都发起一次头像请求，重复加载了数百次相同的3张头像，严重拖慢速度。

修复：

1. 创建仅包含唯一投手ID和对应分面字段（full_name）的小数据框；
2. 在geom_mlb_headshots中指定这个小数据框，并设置inherit.aes = FALSE，避免继承全局的颜色映射和重复数据请求。

问题2：头像显示为红色剪影 #

原因：全局ggplot设置了color = pitch_name的映射，geom_mlb_headshots继承了这个颜色设置，把头像的填充/轮廓颜色替换成了投球类型的颜色（红色是4-Seam Fastball的颜色），导致显示为红色剪影。

修复：通过设置inherit.aes = FALSE，让头像图层不继承全局的颜色映射，恢复正常显示。

修复后的完整代码 #

library(baseballr)
library(dplyr)
library(tidyverse)
library(grid)
library(mlbplotR)
library(ggplot2)

# pull data for three different pitchers
senga <- baseballr::statcast_search_pitchers(start_date = "2023-03-30",
                                             end_date = "2023-04-03",
                                             pitcherid = 673540)
strider <- baseballr::statcast_search_pitchers(start_date = "2023-03-30",
                                               end_date = "2023-04-03",
                                               pitcherid = 675911)
kirby <- baseballr::statcast_search_pitchers(start_date = "2023-03-30",
                                             end_date = "2023-04-03",
                                             pitcherid = 669923)
# bind to one df
df <- rbind(senga,strider,kirby) %>%
  filter(pitch_type != 'PO')

player_cleaned_data <- df %>% 
  filter(!is.na(pfx_x), !is.na(pfx_z), game_type == "R") %>% 
  mutate(pfx_x_in_pv = -12*pfx_x,
         pfx_z_in = 12*pfx_z)

# 创建仅包含唯一投手信息的数据框，用于加载头像
unique_pitchers <- player_cleaned_data %>%
  distinct(full_name, pitcher)

pitch_colors <- c("4-Seam Fastball" = "red",
                  "2-Seam Fastball" = "orange",
                  "Sinker" = "cyan",
                  "Cutter" = "firebrick",
                  "Fastball" = "gray",
                  "Curveball" = "blue",
                  "Knuckle Curve" = "pink",
                  "Slider" = "orange",
                  "Changeup" = "#4cbb17",
                  "Forkball" = "hotpink",
                  "Split-Finger" = "#FC6C85",
                  "Sweeper" = "coral",
                  "Knuckleball" = "black")

pitch_types <- unique(player_cleaned_data$pitch_name)

player_cleaned_data %>% 
  ggplot(aes(x = pfx_x_in_pv, y = pfx_z_in, color = pitch_name)) +
  geom_vline(xintercept = 0) +
  geom_hline(yintercept = 0) +
  geom_point(size = 2, alpha = 0.45) +
  scale_color_manual(values = pitch_colors, limits = pitch_types) +
  scale_x_continuous(limits = c(-25,25),
                     breaks = seq(-20,20, 5),
                     labels = scales::number_format(suffix = "\"")) +
  scale_y_continuous(limits = c(-25,25),
                     breaks = seq(-20,20, 5),
                     labels = scales::number_format(suffix = "\"")) +
  theme(text = element_text(family = "Trebuchet MS"),
        plot.title = element_text(size = 20, face = 'bold'),
        axis.title = element_text(size = 12),
        legend.title = element_blank(),
        legend.text = element_text(size = 11),
        plot.caption = element_text(size = 10),
        legend.key = element_rect(fill = NA)) +
  coord_equal() +
  labs(title = "Pitch Movement Profiles",
       subtitle = "2023 MLB Season | Pitcher's POV",
       caption = "Data: Baseball Savant via baseballr", 
       x = "Horizontal Break",
       y = "Induced Vertical Break", color = "Pitch Name") +
  facet_wrap(~full_name) +
  # 修改后的头像图层：指定唯一投手数据，关闭继承全局映射
  mlbplotR::geom_mlb_headshots(data = unique_pitchers,
                               aes(player_id = pitcher),
                               x = 17, y = 17, width = .2,
                               inherit.aes = FALSE)

内容的提问来源于stack exchange，提问作者Violin125