rggplot2facet-wrapgganimate

Replace x axis text with image for faceted graph ggplot2

I am working with facet_wrap() to plot probabilities for three discrete variables.

Below is the faceted graph I have managed to do:

enter image description here Now I want to add the logo of the corresponding teams instead of the axis text.

Here is a sample of my dataframe:

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"))

I already have created a image_file variable in my dataframe with the corresponding paths of the logos for each team.

So I add a label column first:

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

Then I plot as follows:

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

As you can see, this doesn't get the corresponding team's logo but instead the first three rows of the labels column I added. And also it repeats the same for the second graph below.

enter image description here

How could I get the right logos corresponding to each team so that I have in the x axis: "Logo 1" - "Nul" -"Logo2" and the same sequence with different logos for the second graph? Thank you for your help.

Solution

  • Here is one option to achieve your desired result which uses a helper variable to be mapped on x which ensures that you get your desired order for the categories, a named vector to assign the labels to the categories of the helper column and finally uses 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