将 x 轴文本替换为多面图 ggplot2 的图像

Question

我正在与

facet_wrap()

一起绘制三个离散变量的概率。

下面是我成功制作的多面图：

现在我想添加相应团队的徽标而不是轴文本。

这是我的数据框的示例：

structure(list(ID = c(1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 
2L, 2L), type = structure(c(1L, 1L, 2L, 2L, 3L, 3L, 1L, 1L, 2L, 
2L, 3L, 3L), levels = c("Domicile", "Nul", "Extérieur"), class = "factor"), 
    prob = c(0, 0, 0, 0, 0, 0, 0.3343, 0.1349, 0.3009, 0.2453, 
    0.3648, 0.6197), team = c("Reims", "Toulouse", "Nul", "Nul", 
    "Rennes", "Brest", "Reims", "Toulouse", "Nul", "Nul", "Rennes", 
    "Brest"), image_file = c("~/teamlg/Reims.png", "~/teamlg/Toulouse.png", 
    "Nul", "Nul", "~/teamlg/Rennes.png", "~/teamlg/Brest.png", 
    "~/teamlg/Reims.png", "~/teamlg/Toulouse.png", "Nul", "Nul", 
    "~/teamlg/Rennes.png", "~/teamlg/Brest.png"), game = c("Reims - Rennes", 
    "Toulouse - Brest", "Reims - Rennes", "Toulouse - Brest", 
    "Reims - Rennes", "Toulouse - Brest", "Reims - Rennes", "Toulouse - Brest", 
    "Reims - Rennes", "Toulouse - Brest", "Reims - Rennes", "Toulouse - Brest"
    ), frame = c("a", "a", "a", "a", "a", "a", "b", "b", "b", 
    "b", "b", "b"), frame2 = c("a", "a", "b", "b", "c", "c", 
    "d", "d", "e", "e", "f", "f")), row.names = c(NA, -12L), class = c("tbl_df", 
"tbl", "data.frame"))

我已经在数据框中创建了一个

image_file

变量，其中包含每个团队徽标的相应路径。

所以我先添加一个

label

列：

fr$labels<- labels <- ifelse(fr$type != "Nul", sprintf("<img src='%s' width='50' height='50'/>", fr$image_file),"Nul")

然后我绘制如下：

f <- ggplot(fr, aes(x = type, y = prob,fill = type, group = type))
f<-f+geom_col() +
  geom_text(aes(label = ifelse(prob > 0,paste0(" ",
                                             scales::percent(prob, accuracy = 0.01)),""),
                color = type),fontface = "bold",family = "Oswald", size = 4,vjust = -1)+
  scale_y_continuous(labels = scales::percent_format(accuracy = 1),expand = expansion(add = c(0,0.25)))+
  ##adding the labels variable in the scale to get the logos###
  scale_x_discrete(name = NULL, label = labels) +
  theme(
    axis.text.x = ggtext::element_markdown()
  )+
  facet_wrap(~game, scale = "fixed",axes = "all_x",as.table = TRUE,ncol=1)+
  labs(subtitle = "Estimations après simulation de Monte Carlo sur un paramètre interne")+
  transition_states(frame2, wrap = FALSE)+
  shadow_mark(past = TRUE)+
  enter_fly(y_loc = 0)
f

如您所见，这并没有获得相应团队的徽标，而是获得了我添加的

labels

列的前三行。对于下面的第二张图也重复相同的操作。

如何获得与每个团队相对应的正确徽标，以便在 x 轴上具有：“Logo 1”-“Nul”-“Logo2”以及第二张图的相同序列和不同徽标？ 谢谢您的帮助。

Answer 1

这里是实现所需结果的一个选项，它使用要映射到

x

的辅助变量，确保您获得所需的类别顺序，一个命名向量将标签分配给辅助列的类别，最后使用

scales="free_x"´ in 

facet_wrap`:

library(tidyverse)
library(gganimate)
library(ggtext)

# Download logos and store in a temp dir
path <- tempdir()

logos <- list(
  Rennes = "https://upload.wikimedia.org/wikipedia/de/thumb/b/b6/Stade_Rennais_Football_Club.svg/201px-Stade_Rennais_Football_Club.svg.png",
  Brest = "https://upload.wikimedia.org/wikipedia/de/thumb/c/cb/Stade_Brestois_29.svg/193px-Stade_Brestois_29.svg.png",
  Toulouse = "https://upload.wikimedia.org/wikipedia/de/thumb/0/0a/FC_Toulouse_Logo.svg/239px-FC_Toulouse_Logo.svg.png",
  Reims = "https://upload.wikimedia.org/wikipedia/de/thumb/9/9e/Stade_Reims_Logo.svg/237px-Stade_Reims_Logo.svg.png"
)

purrr::iwalk(logos, ~ download.file(.x, file.path(path, paste0(.y, ".png"))))
 
fr <- fr |>
  mutate(
    logo = ifelse(type != "Nul",
      sprintf("<img src='%s' width='50' height='50'/>", file.path(path, basename(image_file))),
      "Nul"
    )
  ) |>
  # Create a properly ordered variable to be mapped on x
  arrange(game, type) |>
  mutate(
    type_logo = paste(game, type, gsub("\\.png", "", basename(image_file)), sep = "."),
    type_logo = fct_inorder(type_logo)
  )

# Create named vector of labels
labels <- fr |>
  distinct(
    type_logo, logo
  ) |> 
  tibble::deframe()

f <- ggplot(fr, aes(x = type_logo, y = prob, fill = type, group = type))
f <- f + geom_col() +
  geom_text(aes(
    label = ifelse(prob > 0, paste0(
      " ",
      scales::percent(prob, accuracy = 0.01)
    ), ""),
    color = type
  ), fontface = "bold", family = "sans", size = 4, vjust = -1) +
  scale_y_continuous(
    labels = scales::percent_format(accuracy = 1),
    expand = expansion(add = c(0, 0.25))
  ) +
  ## adding the labels variable in the scale to get the logos###
  scale_x_discrete(name = NULL, labels = labels) +
  theme(
    axis.text.x = ggtext::element_markdown()
  ) +
  facet_wrap(~game, scale = "free_x", axes = "all_x", as.table = TRUE, ncol = 1) +
  labs(subtitle = "Estimations après simulation de Monte Carlo sur un paramètre interne")

f <- f +
  transition_states(frame2, wrap = FALSE) +
  shadow_mark(past = TRUE) +
  enter_fly(y_loc = 0)

f