TP2 - ggplot2 olímpico

En este práctico vamos a usar los paquetes del {tidyverse} (en especial {ggplot2}) para explorar y generar visualizaciones informativas a partir de los datos históricos de los Juegos Olímpicos.

Para saber cómo cargar los datos o qué estructura tienen les recomendamos volver al TP1 - tidyverse olímpico

Las consignas

Si bien existen formas alternativas de generar visualizaciones utilizando R, el objetivo del presente práctico es que lo hagan utilizando el paquete del {ggplot2}.

En este práctico vamos a utilizar muchos de los tibbles que creamos en el TP1: tidyverse olímpico.

Vamos a leer los datos:

library(tidyverse)
library(here)

dictionary_tbl <- read_csv(here("docs/Practicos/tp1-tidyverse/data/dictionary.csv"))

summer_tbl <- read_csv(here("docs/Practicos/tp1-tidyverse/data/summer.csv"))

summer_por_disciplina_tbl <- summer_tbl %>% 
    group_by(Year, City, Sport, Country, Discipline, Event, Gender, Medal) %>%
    summarise() # No hace ninguna operación

winter_tbl <- read_csv(here("docs/Practicos/tp1-tidyverse/data/winter.csv"))

winter_por_disciplina_tbl <- winter_tbl %>% 
    group_by(Year, City, Sport, Country, Discipline, Event, Gender, Medal) %>%
    summarise() # No hace ninguna operación

Retomemos summer_por_disciplina_tbl y grafiquemos la cantidad de medallas de oro de los 10 países con más medallas usando barras.

# Solución
summer_por_disciplina_tbl %>%
  group_by(Country) %>%
  filter(Medal == "Gold") %>%
  summarise(Medallas = n()) %>%
  arrange(desc(Medallas)) %>%
  slice_head(n = 10) %>%
  ggplot(aes(x = reorder(Country, Medallas),
             y = Medallas)) +
  geom_col(colour = "white",
           fill = "#1380A1") +
  labs(x = "País",
       y = "Medallas de oro acumuladas",
       title = "Top 10 países con más medallas de oro aculumadas") +
  coord_flip(clip = 'off') +
  theme_minimal()

Ahora veamos la distribución de las medallas de oro acumuladas por país ¿Qué podemos decir al respecto?

# Solución
labels_outliers <- tibble(x = c(979, 396),
                          y = c(2, 2),
                          label = c("USA", "URSS"))

summer_por_disciplina_tbl %>%
  group_by(Country) %>%
  filter(Medal == "Gold") %>%
  summarise(Medallas = n()) %>%
  ggplot(aes(x = Medallas)) +
  geom_histogram(colour = "white",
                 fill = "#1380A1") +
  labs(x = "Medallas de oro acumuladas",
       y = "Cuenta",
       title = "Distribución de medallas de oro") +
  geom_label(data = labels_outliers,
             aes(x = x,
                 y = y,
                 label = label),
             vjust = 0) +
  theme_minimal()

¿Y si queremos ver las distribuciones de los tres tipos de medallas?

Pista: Podemos codificar el tipo de medalla utilizando la estética fill.

# Solución
summer_por_disciplina_tbl %>%
  group_by(Country, Medal) %>%
  summarise(Medallas = n()) %>%
  ggplot(aes(x = Medallas,
             fill = Medal)) +
  geom_histogram(position = "dodge") +
  labs(x = "Medallas acumuladas",
       y = "Cuenta",
       fill = NULL,
       title = "Distribución de medallas acumuladas") +
  scale_fill_manual(breaks = c("Gold", "Silver", "Bronze"),
                    values = c("#BC9B69", "#C4C5C7", "#B88748")) +
  theme_minimal() +
  theme(legend.position = "top")

Tratemos de hacer algo más informativo utilizando utilizando facet_grid().

# Solución
summer_por_disciplina_tbl %>%
  group_by(Country, Medal) %>%
  summarise(Medallas = n()) %>%
  ggplot(aes(x = Medallas,
             fill = Medal)) +
  geom_histogram(position = "dodge") +
  labs(x = "Medallas acumuladas",
       y = "Cuenta",
       fill = NULL,
       title = "Distribución de medallas acumuladas") +
  scale_fill_manual(breaks = c("Gold", "Silver", "Bronze"),
                    values = c("#BC9B69", "#C4C5C7", "#B88748")) +
  theme_minimal() +
  facet_grid(Medal ~ .) +
  theme(legend.position = "top")

¿Y si queremos ver la distribución de medallas de oro entre países a lo largo de la historia de los juegos de invierno?

Pista: Cuando tenemos muchos paneles, es conveniente usar la funcion facet_wrap().

# Solución
winter_por_disciplina_tbl %>%
  filter(Medal == "Gold") %>%
  group_by(Country, Year) %>%
  summarise(Medallas = n()) %>%
  ggplot(aes(x = Medallas)) +
  geom_histogram(fill = "#BC9B69",
                 position = "dodge") +
  labs(x = "Medallas de oro por juego",
       y = "Cuenta",
       fill = NULL,
       title = "Distribución de medallas acumuladas") +
  theme_minimal() +
  facet_wrap(. ~ Year) +
  theme(legend.position = "top")

Vayamos de nuevo a algo un poquito más complicado. Usemos dictionary_tbl para hacer una figura que nos muestre la relación entre las medallas de oro acumuladas por país entre juegos de invierno y de verano y su PBI per cápita.

# Solución
summer_por_disciplina_tbl %>% 
  rbind(winter_por_disciplina_tbl) %>% 
  filter(Medal == "Gold") %>%
  group_by(Country) %>%
  summarise(Medallas = n()) %>%
  rename("Code" = "Country") %>%
  left_join(dictionary_tbl) %>%
  drop_na() %>%
  ggplot(aes(x = log(`GDP per Capita`),
             y = log(Medallas))) +
  labs(x = "PBI per cápita",
       y = "Medallas de oro acumuladas",
       title = "Medallas de oro acumuladas vs. PBI per cápita") +
  geom_point(color = "#1380A1") +
  theme_minimal()

¿Y si queremos ver si hay diferencias entre juegos de invierno y de verano?

# Solución
summer_por_disciplina_tbl %>% 
  mutate(Season = "Summer") %>%
  rbind(winter_por_disciplina_tbl %>% mutate(Season = "Winter")) %>% 
  filter(Medal == "Gold") %>%
  group_by(Country, Season) %>%
  summarise(Medallas = n()) %>%
  rename("Code" = "Country") %>%
  left_join(dictionary_tbl) %>%
  drop_na() %>%
  #filter(Code != "USA") %>% Si queremos filtrar a USA que caga todo
  ggplot(aes(x = log(`GDP per Capita`),
             y = log(Medallas),
             color = Season)) +
  labs(x = "PBI per cápita",
       y = "Medallas de oro acumuladas",
       color = NULL,
       title = "Medallas de oro acumuladas vs. PBI per cápita") +
  scale_color_manual(values = c("#FAAB18","#1380A1")) +
  geom_point() +
  theme_minimal() +
  theme(legend.position = "top")

Ahora veamos los tres tipos de medallas acumuladas para los juegos de verano vs. el PBI per cápita y agreguemos una capa de geom_smooth() ¿Qué pasa si sacamos a USA?

# Solución
summer_por_disciplina_tbl %>% 
  group_by(Country, Medal) %>%
  summarise(Medallas = n()) %>%
  rename("Code" = "Country") %>%
  left_join(dictionary_tbl) %>%
  drop_na() %>%
  #filter(Code != "USA") %>% #Si queremos filtrar a USA que caga todo
  ggplot(aes(x = log(`GDP per Capita`),
             y = log(Medallas),
             color = Medal)) +
  geom_point(size = 2,
             alpha = .7) +
  geom_smooth(method = lm,
              se = FALSE) +
  labs(x = "PBI per cápita",
       y = "Medallas de oro acumuladas",
       color = NULL,
       title = "Medallas de oro acumuladas vs. PBI per cápita") +
  scale_color_manual(breaks = c("Gold", "Silver", "Bronze"),
                    values = c("#BC9B69", "#C4C5C7", "#392916")) +
  theme_minimal() +
  #facet_grid(Medal ~ .) +
  theme(legend.position = "top")

Ahora concentrémonos en Argentina🇦🇷. Veamos el histórico de medallas de Argentina en los Juegos Olímpicos de verano.

# Solución
summer_por_disciplina_tbl %>% 
  filter(Country == "ARG") %>%
  mutate(Juego = paste0(Year, " - ", City),
         Medal = factor(Medal, levels=c("Gold","Silver","Bronze"))) %>%
  group_by(Juego, Medal) %>%
  summarise(Medallas = n()) %>%
  ggplot(aes(x = Juego,
             y = Medallas,
             color = Medal,
             group = Medal)) +
  geom_point(size = 4) +
  geom_line() +
  labs(x = NULL,
       y = "# Medallas",
       color = NULL,
       title = "Medallero histórico de Argentina") +
  scale_x_discrete(limits=rev) +
  coord_flip() +
  scale_color_manual(breaks = c("Gold", "Silver", "Bronze"),
                    values = c("#BC9B69", "#C4C5C7", "#392916")) +
  theme_minimal() +
  facet_grid(. ~ Medal) +
  theme(legend.position = "top",
        plot.title.position = "plot")

Grafiquemos el nombre de los paises que forman el podio del medallero para todos los Juegos Olímpicos de Verano.

Pista: Para graficar un texto podemos usar la geometría geom_text().

# Solución
library(ggpubr)

summer_por_disciplina_tbl %>% 
  mutate(Juego = paste0(Year, " - ", City),
         Medal = factor(Medal, levels=c("Gold","Silver","Bronze"))) %>%
  filter(Medal == "Gold") %>%
  group_by(Juego, Country) %>%
  summarise(Medallas = n()) %>%
  arrange(desc(Medallas), .by_group = TRUE) %>%
  slice_head(n = 3) %>%
  mutate(Posicion = 1:3,
         label = paste0(Country, " ", Medallas)) %>%
  ggplot(aes(x = Juego,
             y = Posicion,
             color = factor(Posicion))) +
  geom_text(aes(label = label)) +
  labs(x = NULL,
       y = NULL,
       color = NULL,
       title = "Medallero histórico") +
  scale_x_discrete(limits = rev) +
  scale_y_continuous(breaks = 1:3,
                   labels = c("Primero", "Segundo", "Tercero")) +
  coord_flip(clip = "off") +
  scale_color_manual(breaks = 1:3,
                    values = c("#BC9B69", "#C4C5C7", "#392916")) +
  theme_pubclean() +
  theme(legend.position = "none",
        plot.title.position = "plot",
        axis.ticks.y = element_blank())

¿Podremos reemplazar los nombres en el medallero por sus banderas?

Pista: Investigar el paquete {ggflags}📦.

# Solución
library(ggflags)
library(countrycode)

summer_por_disciplina_tbl %>% 
  mutate(Juego = paste0(Year, " - ", City),
         Country = case_when(Country == "URS" ~ "RUS",
                             Country == "GDR" ~ "GER",
                             Country == "ROU" ~ "ROM",
                             Country == "FRG" ~ "GER",
                             Country == "EUN" ~ "RUS",
                             TRUE ~ Country)) %>%
  filter(Medal == "Gold") %>%
  group_by(Juego, Country) %>%
  summarise(Medallas = n()) %>%
  arrange(desc(Medallas), .by_group = TRUE) %>%
  slice_head(n = 3) %>%
  rename("Code" = "Country") %>% 
  left_join(dictionary_tbl %>% select(all_of(c("Code", "Country")))) %>%
  mutate(Posicion = 1:3,
         country_id = countrycode(Country,
                                  origin = "country.name",
                                  destination = "genc2c") %>% tolower()) %>%
  ggplot(aes(x = Juego,
             y = Posicion,
             color = factor(Posicion))) +
  geom_flag(aes(country = country_id),
            size = 8) +
  labs(x = NULL,
       y = NULL,
       color = NULL,
       title = "Medallero histórico") +
  scale_x_discrete(limits = rev) +
  scale_y_continuous(breaks = 1:3,
                   labels = c("Primero", "Segundo", "Tercero")) +
  coord_flip(clip = "off") +
  scale_color_manual(breaks = 1:3,
                    values = c("#BC9B69", "#C4C5C7", "#392916")) +
  theme_pubclean() +
  theme(legend.position = "none",
        axis.ticks.y = element_blank())