如何在gt的text_transform()中传多变量并结合全量数据生成ggplot图表

1. 调整自定义绘图函数 #

先修改zscore_plot函数，让它能接收单条球员记录和完整数据集，同时保留对目标统计列的支持：

library(tidyverse)
library(patchwork)
library(gt)

zscore_plot <- function(full_df, player_row, raw_col, conference_color = "steelblue") {
  # 从单条记录提取球员信息
  player_name <- player_row$player
  team <- player_row$team
  conference <- player_row$conference
  raw_value_sym <- sym(raw_col)
  
  # 基于完整数据集计算z分数
  full_df <- full_df %>%
    mutate(z_score = scale(!!raw_value_sym)[,1])
  
  # 计算原始值的轴范围
  this_mean <- full_df %>% pull(!!raw_value_sym) %>% mean()
  this_sd <- full_df %>% pull(!!raw_value_sym) %>% sd()
  scale_max <- (4 * this_sd) + this_mean
  scale_min <- (-4 * this_sd) + this_mean
  
  # 绘制主图
  plot <- ggplot() +
    geom_point(data = full_df, aes(x = z_score, y = 0), alpha = 0.25, color = "grey", size = 3) +
    geom_point(data = full_df %>% filter(conference == !!conference),
               aes(x = z_score, y = 0),
               alpha = 0.25, color = conference_color, size = 3) +
    geom_segment(aes(x = 0, xend = 0, y = -0.05, yend = 0.05), color = "lightgrey", lwd = 0.25) +
    geom_point(data = full_df %>% filter(player == !!player_name, team == !!team),
               aes(x = z_score, y = 0), alpha = 1, color = "red", fill = "white", shape = 21, size = 3) +
    geom_label(data = full_df %>% filter(player == !!player_name, team == !!team),
               aes(x = z_score, y = 0, label = !!raw_value_sym),
               alpha = 1, color = "red", fill = "white", size = 3, nudge_y = 0.05) +
    scale_y_continuous(breaks = NULL) +
    xlim(-4, 4) +
    theme(panel.background = element_blank(),
          axis.ticks = element_blank(),
          plot.margin = unit(c(0, 0, 0, 0), "cm")) +
    ylab(element_blank()) +
    xlab(element_blank()) +
    coord_cartesian(ylim = c(0,0.75), clip = "off")
  
  # 绘制原始值轴
  value_axis <- ggplot(data = full_df, aes(x = !!raw_value_sym, y = 0)) +
    scale_y_continuous(breaks = NULL) +
    xlim(scale_min, scale_max) +
    theme(panel.background = element_blank(),
          axis.ticks = element_blank(),
          axis.line.x = element_line(),
          aspect.ratio = 1e-8,
          plot.margin = unit(c(0, 0, 0, 0), "cm")) +
    ylab(element_blank()) +
    xlab(element_blank())
  
  # 组合图表
  plot / value_axis
}

2. 在gt中实现逐行绘图 #

利用purrr::pmap遍历每一行的球员信息，同时传入完整数据集，解决text_transform()传递多个变量的问题：

# 准备top3球员数据
top_players <- df %>%
  select(player, team, conference, non_penalty_goals_per_90) %>%
  arrange(desc(non_penalty_goals_per_90)) %>%
  slice_head(n = 3) %>%
  mutate(plot = "") # 新增空列用于放置图表

# 创建带图表的gt表格
top_players %>%
  gt() %>%
  text_transform(
    locations = cells_body(columns = plot),
    fn = function(x) {
      pmap(
        .l = list(player_row = split(top_players, 1:nrow(top_players))),
        .f = function(player_row) {
          zscore_plot(
            full_df = df,
            player_row = player_row,
            raw_col = "non_penalty_goals_per_90",
            conference_color = "#4f2d7f"
          ) %>%
            ggplot_image(height = px(80), aspect_ratio = 4)
        }
      )
    }
  ) %>%
  cols_label(
    player = "球员",
    team = "球队",
    conference = "联盟",
    non_penalty_goals_per_90 = "每90分钟非点球进球数",
    plot = "对比图表"
  ) %>%
  fmt_number(columns = non_penalty_goals_per_90, decimals = 2)

关键说明 #

• 多变量传递：通过pmap把每一行的完整记录（包含player、team、conference）作为参数传入绘图函数，避免单列传递的限制。
• 完整数据集复用：在text_transform内部直接引用完整的df，确保绘图时能调用所有球员的数据。
• 准引用处理：用sym()和!!将字符串列名转换为语法符号，兼容ggplot的表达式要求。

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