R语言 我需要做什么来修改我的图(ggplot2)到一个gt表?

sg3maiej  于 2023-11-14  发布在  其他
关注(0)|答案(1)|浏览(115)

编辑:看过https://rfortherestofus.com/2023/10/ggplots-in-gt-tables的教程后,我认为问题应该是“如何在gt中将多个变量传递到text_transform()中?
下面是教程示例,其中Distribuition包含物种名称,并且是绘图所需的全部内容。

penguin_weights |>
  mutate(Distribution = species) |>
  gt() |>
  tab_spanner(
    label = 'Penguin\'s Weight',
    columns = -species
  ) |> 
  cols_label_with(fn = str_to_title) |> 
  fmt_number(decimals = 2) |> 
  cols_align('left', columns = species) |> 
  text_transform(
    locations = cells_body(columns = 'Distribution'), # this contains 1 value, how do I pass multiple?
    fn = function(column) {
      map(column, plot_violin_species) |>
        ggplot_image(height = px(50), aspect_ratio = 3)
    }
  )

字符串
OP:我知道在一个线程中问多个问题通常是不受欢迎的,但我想确保我的子步骤是正确的。
我想将下面的ggplot添加到这里列出的gt表中。

此图显示了选定的球员的目标,每90率(0.89)沿着与每个球员在会议(紫色)和所有其余的球员灰色。
这是鸡和蛋的问题,我不知道如何开始。
1.我想为选定数量的个体添加这些图表,但我需要整个数据集来创建整个图表。这是否意味着我需要将两个不同的数据集传递到函数中?一个将包含我要绘制的个体,另一个包含数据集中的所有个体?
1.这很可能需要我将功能从输入个人、他们的团队和会议更改为能够覆盖列表,这取决于从上面传递的方式。
如果这没有意义,希望这能更好地解释:

library(tidyverse)
library(patchwork)

# Custom function
zscore_plot <- function(df, player_name, team, conference, conference_color = "steelblue", raw_value) {
  
  # Create z_scores for the supplied stat
  df <- df |>
    mutate(z_score = scale({{raw_value}})[,1])
  
  # Find the mean, sd, min, and max for the raw scores in order to set the x-axis limits
  this_mean <- df |> pull({{raw_value}}) |> mean()
  this_sd <- df |> pull({{raw_value}}) |> sd()
  scale_max <- (4 * this_sd) + this_mean
  scale_min <- (-4 * this_sd) + this_mean
  
  # Plot the z_score
  plot <- ggplot() +
    geom_point(data = df, aes(x = z_score, y = 0), alpha = 0.25, color = "grey", size = 3) +
    geom_point(data = df |>
                 filter(conference == {{conference}}),
               aes(x = z_score, y = 0),
               alpha = 0.25,
               color = conference_color,
               size = 3
    ) +
    # geom_vline(xintercept = 0, color = "lightgrey", lwd = 0.25) +
    geom_segment(aes(x = 0, xend = 0, y = -0.05, yend = 0.05), color = "lightgrey", lwd = 0.25) +
    geom_point(data = 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 = df |>
                 filter(player == player_name,
                        team == team),
               aes(x = z_score,
                   y = 0,
                   label = {{raw_value}}),
               alpha = 1,
               color = "red",
               fill = "white",
               size = 3,
               nudge_y = 0.05) +
    scale_y_continuous(breaks = NULL) +
    xlim(-4, 4) +
    # ylim(0,0.5) +
    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_fixed(ratio = 2)
    coord_cartesian(ylim = c(0,0.75),
                    clip = "off")
  
  # Plot the secondary (raw value) axis
  value_axis <- ggplot(data = df, aes(x = {{raw_value}}, 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())
  
  # Combine the two plots
  plot / value_axis
}

# Data
df <- structure(list(player = c('A. Anderson', 'B. Brown', 'C. Carter', 'D. Davis', 'E. Evans', 'F. Foster',
                                'G. Garcia', 'H. Hernandez', 'I. Johnson', 'K. Kelly'),
                     team = c('Rabbits', 'Pandas', 'Dolphins', 'Rabbits', 'Gorillas', 'Buffaloes', 'Elephants',
                              'Zebras', 'Elephants', 'Armadillos'),
                     conference = c('AAC', 'ABC', 'ACC', 'AAC', 'ADC', 'AEC', 'AFC', 'AGC', 'AFC', 'AHC'), 
                     minutes_played = c(1676, 1483, 809, 1133, 1373, 583, 720, 1148, 1022, 1556), 
                     non_penalty_goals_per_90 = c(1.13, 1.03, 0.89, 0.87, 0.85, 0.77, 0.75, 0.71, 0.7, 0.69), 
                     shots_on_target_per_90 = c(3.06, 2.91, 2.34, 2.07, 1.77, 1.39, 1.5, 2.12, 1.67, 1.33), 
                     xg_per_90 = c(1.02,5.16, 3.56, 3.81, 3.02, 3.09, 3, 4.86, 3.87, 2.37), 
                     touches_in_box_per_90 = c(6.98, 7.34, 5.01, 6.43, 3.28, 3.86, 5, 7.06, 5.99, 3.3), 
                     successful_attacking_actions_per_90 = c(8.27, 7.53, 4.12, 4.61, 4.59, 2.93, 3.38, 7.45, 7.57, 7.81), 
                     offensive_duels_per_90 = c(18.04, 12.5, 10.01, 12.71, 10.16, 12.66, 9.5, 14.27, 18.85, 17.99), 
                     received_long_passes_per_90 = c(2.2, 2.67, 4.67, 1.67, 0.98, 2.93, 1.75, 3.53, 2.91, 1.91), 
                     deep_completions_per_90 = c(1.66, 1.4, 1.33, 1.59, 0.79, 0.15, 0.75, 1.41, 0.62, 0.75), 
                     key_passes_per_90 = c(0.81, 0.61, 0.22, 0.48, 0.13, 0.15, 0.25, 0.94, 0.26, 0.87), 
                     offensive_duels_won_per_90 = c(6.55, 4.61, 3.34, 3.57, 4.13, 3.24, 3.25, 5.96, 6.96, 7.75),
                     ribbles_per_90 = c(8.22, 5.7, 2.11, 3.97, 3.93, 3.09, 3.25, 8.15, 7.84, 8.16)),
                class = c("tbl_df", "tbl", "data.frame"), row.names = c(NA, -10L))

# Working example of a single plot
df |>
  zscore_plot("A. Anderson", "Rabbits", conference = "ACC", conference_color = "#4f2d7f", raw_value = non_penalty_goals_per_90)

# What I need help sorting out...
df |>
  select(player, team, conference, non_penalty_goals_per_90) |>
  # Select the top 3 players.... but I need the entire data frame to pass to the zscore_plot function... !!!!!!!!!!!
  arrange(desc(non_penalty_goals_per_90)) |>
  slice_head(n = 3) |>
  mutate(plot = player) |>
  gt() +
  # Add custom plot to cells via text_transform
  text_transform(
    locations = cells_body(columns = 'plot'),
    fn = zscore_plot()
  )


所以重申一下,我想创建一个gt表,其中包含non_penalty_goals_per_90的前3个个体,但需要包括整个数据框来创建图。此外,我需要修改自定义函数,以便对gt表中的任何个体进行逐行处理。

vs3odd8k

vs3odd8k1#

这里有一种方法可以让你的代码工作,它基本上遵循了你参考的教程中的步骤。与教程的主要区别是,你的函数需要来自表中三列的输入。为此,我将三条信息作为一个字符串传递,并由";"分隔。
注意事项:我还对你的绘图功能做了一些调整,比如我用coord_fixed(clip = "off", ratio = 3)代替了coord_cartesian(),并将标签的大小增加到了48 / .pt。但是我担心你的绘图功能需要更多的调整才能使所有的细节都可见,比如增加点的大小和轴文本的字体大小。

library(ggplot2)
library(gt)
library(dplyr, warn = FALSE)
library(purrr)
library(patchwork)

df |>
  select(player, team, conference, goals = non_penalty_goals_per_90) |>
  arrange(desc(goals)) |>
  slice_head(n = 3) |>
  mutate(plot = paste(player, team, conference, sep = ";")) |>
  gt() |>
  text_transform(
    locations = cells_body(columns = "plot"),
    fn = function(column) {
      map(
        column,
        \(x) {
          x <- strsplit(x, split = ";")[[1]]
          zscore_plot(
            df, x[[1]], x[[2]], x[[3]],
            raw_value = non_penalty_goals_per_90
          )
        }
      ) |>
        ggplot_image(height = 25, aspect_ratio = 3)
    }
  )

字符串

绘图功能

zscore_plot <- function(df, player_name, team, conference,
                        conference_color = "steelblue", raw_value) {
  # Create z_scores for the supplied stat
  df <- df |>
    mutate(z_score = scale({{ raw_value }})[, 1])

  # Find the mean, sd, min, and max for the raw scores in order to set the x-axis limits
  this_mean <- df |>
    pull({{ raw_value }}) |>
    mean()
  this_sd <- df |>
    pull({{ raw_value }}) |>
    sd()
  scale_max <- (4 * this_sd) + this_mean
  scale_min <- (-4 * this_sd) + this_mean

  # Plot the z_score
  plot <- ggplot() +
    geom_point(
      data = df, aes(x = z_score, y = 0), alpha = 0.25,
      color = "grey", size = 3
    ) +
    geom_point(
      data = 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 = 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 = df |>
        filter(
          player == player_name,
          team == team
        ),
      aes(
        x = z_score,
        y = 0,
        label = {{ raw_value }}
      ),
      alpha = 1,
      color = "red",
      fill = "white",
      size = 48 / .pt,
      nudge_y = 0.05
    ) +
    scale_y_continuous(breaks = NULL) +
    xlim(-4, 4) +
    theme(
      panel.background = element_blank(),
      axis.ticks = element_blank(),
      plot.margin = margin()
    ) +
    labs(x = NULL, y = NULL) +
    coord_fixed(ratio = 3, clip = "off")

  # Plot the secondary (raw value) axis
  value_axis <- ggplot(data = df, aes(x = {{ raw_value }}, 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 = margin()
    ) +
    labs(x = NULL, y = NULL)

  # Combine the two plots
  plot / value_axis
}

相关问题