首页 / 技术问答 / R问答列表 / 问答详情

R 如何将网站图像添加到带有极坐标的面包裹条形图

我已经创建了一个圆形(极)条形图与方面，并希望把两个棒球运动员的头像在每个情节的中心.我已经try 了几种方法，包括annotation_custom(只适用于Carnival图，而不是coord_polar)和一个类似的，有问题的解决方案:Trying to add an image to a polar plot gives "Error: annotation_custom only works with Cartesian coordinates".

Would be grateful for any and all help. The headshot links for the two players are included in the org column of the my_data_long data frame. Also attaching a screenshot of the existing plot (sans headshots, of course) below for context.enter image description here

my_data_long <- structure(data.frame(player = c("Jackson Holliday", "Jackson Holliday", 
                                          "Jackson Holliday", "Jackson Holliday", "Jackson Holliday", "Jackson Holliday", 
                                          "Jackson Holliday", "James Wood", "James Wood", "James Wood", 
                                          "James Wood", "James Wood", "James Wood", "James Wood", "Jackson Holliday", 
                                          "Jackson Holliday", "Jackson Holliday", "Jackson Holliday", "Jackson Holliday", 
                                          "Jackson Holliday", "Jackson Holliday", "James Wood", "James Wood", 
                                          "James Wood", "James Wood", "James Wood", "James Wood", "James Wood"
), names = c("hit", "raw_power", "game_power", "spd", "fld", 
             "bat_ctrl", "pitch_sel", "hit", "raw_power", "game_power", "spd", 
             "fld", "bat_ctrl", "pitch_sel", "hit", "raw_power", "game_power", 
             "spd", "fld", "bat_ctrl", "pitch_sel", "hit", "raw_power", "game_power", 
             "spd", "fld", "bat_ctrl", "pitch_sel"), variable = structure(c(1L, 
              1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 
              2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L), levels = c("current", 
"future"), class = "factor"), value = c(45, 50, 25, 50, 40, 60, 
60, 30, 70, 55, 60, 45, 40, 50, 60, 60, 60, 50, 50, 60, 60, 35, 
80, 80, 50, 50, 40, 50), org = c("https://img.mlbstatic.com/mlb-photos/image/upload/c_fill,g_auto/w_360/v1/people/702616/headshot/milb/current", 
"https://img.mlbstatic.com/mlb-photos/image/upload/c_fill,g_auto/w_360/v1/people/702616/headshot/milb/current", 
"https://img.mlbstatic.com/mlb-photos/image/upload/c_fill,g_auto/w_360/v1/people/702616/headshot/milb/current", 
"https://img.mlbstatic.com/mlb-photos/image/upload/c_fill,g_auto/w_360/v1/people/702616/headshot/milb/current", 
"https://img.mlbstatic.com/mlb-photos/image/upload/c_fill,g_auto/w_360/v1/people/702616/headshot/milb/current", 
"https://img.mlbstatic.com/mlb-photos/image/upload/c_fill,g_auto/w_360/v1/people/702616/headshot/milb/current", 
"https://img.mlbstatic.com/mlb-photos/image/upload/c_fill,g_auto/w_360/v1/people/702616/headshot/milb/current", 
"https://img.mlbstatic.com/mlb-photos/image/upload/c_fill,g_auto/w_360/v1/people/695578/headshot/milb/current", 
"https://img.mlbstatic.com/mlb-photos/image/upload/c_fill,g_auto/w_360/v1/people/695578/headshot/milb/current", 
"https://img.mlbstatic.com/mlb-photos/image/upload/c_fill,g_auto/w_360/v1/people/695578/headshot/milb/current", 
"https://img.mlbstatic.com/mlb-photos/image/upload/c_fill,g_auto/w_360/v1/people/695578/headshot/milb/current", 
"https://img.mlbstatic.com/mlb-photos/image/upload/c_fill,g_auto/w_360/v1/people/695578/headshot/milb/current", 
"https://img.mlbstatic.com/mlb-photos/image/upload/c_fill,g_auto/w_360/v1/people/695578/headshot/milb/current", 
"https://img.mlbstatic.com/mlb-photos/image/upload/c_fill,g_auto/w_360/v1/people/695578/headshot/milb/current", 
"https://img.mlbstatic.com/mlb-photos/image/upload/c_fill,g_auto/w_360/v1/people/702616/headshot/milb/current", 
"https://img.mlbstatic.com/mlb-photos/image/upload/c_fill,g_auto/w_360/v1/people/702616/headshot/milb/current", 
"https://img.mlbstatic.com/mlb-photos/image/upload/c_fill,g_auto/w_360/v1/people/702616/headshot/milb/current", 
"https://img.mlbstatic.com/mlb-photos/image/upload/c_fill,g_auto/w_360/v1/people/702616/headshot/milb/current", 
"https://img.mlbstatic.com/mlb-photos/image/upload/c_fill,g_auto/w_360/v1/people/702616/headshot/milb/current", 
"https://img.mlbstatic.com/mlb-photos/image/upload/c_fill,g_auto/w_360/v1/people/702616/headshot/milb/current", 
"https://img.mlbstatic.com/mlb-photos/image/upload/c_fill,g_auto/w_360/v1/people/702616/headshot/milb/current", 
"https://img.mlbstatic.com/mlb-photos/image/upload/c_fill,g_auto/w_360/v1/people/695578/headshot/milb/current", 
"https://img.mlbstatic.com/mlb-photos/image/upload/c_fill,g_auto/w_360/v1/people/695578/headshot/milb/current", 
"https://img.mlbstatic.com/mlb-photos/image/upload/c_fill,g_auto/w_360/v1/people/695578/headshot/milb/current", 
"https://img.mlbstatic.com/mlb-photos/image/upload/c_fill,g_auto/w_360/v1/people/695578/headshot/milb/current", 
"https://img.mlbstatic.com/mlb-photos/image/upload/c_fill,g_auto/w_360/v1/people/695578/headshot/milb/current", 
"https://img.mlbstatic.com/mlb-photos/image/upload/c_fill,g_auto/w_360/v1/people/695578/headshot/milb/current", 
"https://img.mlbstatic.com/mlb-photos/image/upload/c_fill,g_auto/w_360/v1/people/695578/headshot/milb/current")))


library(tidyverse)

ggplot(data=my_data_long, aes(x=names, y=value, fill=variable, color=variable, alpha=variable))+ 
  geom_hline(
    aes(yintercept = y), 
    data.frame(y = c(4:8) * 10),
    color = "lightgrey"
  ) + 
  
  geom_bar(stat="identity", position ="identity") +
  scale_colour_manual(values=c("lightblue4", "red")) +
  scale_fill_manual(values=c("lightblue", "pink")) +
  scale_alpha_manual(values=c(.8, .3)) +
  scale_y_continuous(limits = c(-40,82),
                     expand = c(0,0), 
                     breaks = c(40,50,60,70,80)) +
  theme_bw() +
  facet_wrap(~player) +
  coord_polar() +
  
  annotate(
    x = 4, 
    y = 40, 
    label = "40", 
    geom = "text", 
    color = "gray12", 
    family = "Trebuchet MS"
  ) +
  
  annotate(
    x = 4, 
    y = 60, 
    label = "60", 
    geom = "text", 
    color = "gray12", 
    family = "Trebuchet MS"
  ) +
  
  annotate(
    x = 4, 
    y = 80, 
    label = "80", 
    geom = "text", 
    color = "gray12", 
    family = "Trebuchet MS"
  ) +
  
  labs(title = "Top MLB Prospect Tools",
    subtitle = "Using 20-80 Scouting Scale",
    caption = "Data: FanGraphs") +
  # Customize general theme
  theme(
    
    # Set default color and font family for the text
    text = element_text(color = "gray12", family = "Trebuchet MS"),
    
    # Customize the text in the title, subtitle, and caption
    plot.title = element_text(face = "bold", hjust = 0.0, size = 20),
    plot.subtitle = element_text(hjust = 0.0, size = 14),
    plot.caption = element_text(size = 12),
    axis.title = element_blank(),
    axis.text.y = element_blank(), 
    axis.ticks.y = element_blank(),
    axis.text.x = element_text(size = 10),
    strip.text = element_text(size = 16),
    legend.title = element_blank(),
    
    # Make the background white and remove extra grid lines
    panel.background = element_rect(fill = "white", color = "white"),
    panel.grid = element_blank(),
    panel.grid.major.x = element_blank()
  )

推荐答案

一种 Select 是使用ggimage

library(tidyverse)
library(ggimage)

images <- my_data_long |>
  distinct(player, org)

ggplot(data = my_data_long, aes(
  x = names, y = value, fill = variable,
  color = variable, alpha = variable
)) +
  geom_hline(
    aes(yintercept = y),
    data.frame(y = c(4:8) * 10),
    color = "lightgrey"
  ) +
  geom_bar(stat = "identity", position = "identity") +
  geom_image(
    data = images, aes(image = org), x = 4, y = -40, size = .1,
    inherit.aes = FALSE
  ) +
  scale_colour_manual(values = c("lightblue4", "red")) +
  scale_fill_manual(values = c("lightblue", "pink")) +
  scale_alpha_manual(values = c(.8, .3)) +
  scale_y_continuous(
    limits = c(-40, 82),
    expand = c(0, 0),
    breaks = c(40, 50, 60, 70, 80)
  ) +
  theme_bw() +
  facet_wrap(~player) +
  coord_polar() +
  geom_text(
    data = data.frame(x = 4, y = c(40, 60, 80)),
    aes(x = x, y = y, label = y),
    color = "gray12",
    family = "Trebuchet MS",
    inherit.aes = FALSE
  ) +
  labs(
    title = "Top MLB Prospect Tools",
    subtitle = "Using 20-80 Scouting Scale",
    caption = "Data: FanGraphs"
  ) +
  # Customize general theme
  theme(
    # Set default color and font family for the text
    text = element_text(color = "gray12", family = "Trebuchet MS"),
    # Customize the text in the title, subtitle, and caption
    plot.title = element_text(face = "bold", hjust = 0.0, size = 20),
    plot.subtitle = element_text(hjust = 0.0, size = 14),
    plot.caption = element_text(size = 12),
    axis.title = element_blank(),
    axis.text.y = element_blank(),
    axis.ticks.y = element_blank(),
    axis.text.x = element_text(size = 10),
    strip.text = element_text(size = 16),
    legend.title = element_blank(),
    # Make the background white and remove extra grid lines
    panel.background = element_rect(fill = "white", color = "white"),
    panel.grid = element_blank(),
    panel.grid.major.x = element_blank()
  )

UPDATE也许一个更好的方法是额外使用cropcircles包:

library(cropcircles)

images <- my_data_long |>
  distinct(player, org) |>
  mutate(
    img_circle = circle_crop(org, border_size = 12, border_colour = "black")
  )

  ... +
  geom_image(
    data = images, aes(image = img_circle), x = 4, y = -40, size = .2,
    inherit.aes = FALSE
  ) +
  ...

enter image description here

R相关问答推荐

通过绘图 Select 线串几何体并为其着色

无法在我的情节中表现出显着的差异

为什么当我try 在收件箱中使用合并功能时会出现回收错误？

随机森林回归：下拉列重要性

为什么在ggplot2中添加geom_text这么慢？

如何动态更新selectizeInput？

Rplotly中的Sankey Diagram：意外连接&

非线性混合效应模型(NLME)预测变量的置信区间

以更少间隔的较小表中的聚合离散频率表

有效识别长载体中的高/低命中

使用rest从header(h2，h3，table)提取分层信息

更改STAT_VALLES/STAT_PEAKS中的箭头线宽/大小

按时间顺序对不同事件进行分组

从多面条形图中删除可变部分

按组计算列中1出现的间隔年数

如何计算增加10米(0.01公里)的行？

创建在文本字符串中发现两个不同关键字的实例的数据框

当由base：：限定时，`[.factor`引发NextMethod错误

使用列名和r中的前缀 Select 列的CREATE函数

随机生成样本，同时在R内的随机样本中至少包含一次所有值

实用课程推荐
相关教程推荐
休闲君评测 |  TOOLFK工具网 |  古诗文网 |  良许Linux教程网 |  Python之禅 |  红色石头 |  入党申请书 | 

© 2020 Hi LearnFk 意见反馈 免责声明 关于我们 桂ICP备11002319号-3 友链&广告位+QQ: 1963612630