Evolución y curiosidades de los Juegos Olímpicos

---

Trabajo elaborado para la asignatura “Programación y manejo de datos en la era del Big Data” de la Universitat de València durante el curso 2020-2021. La página web de la asignatura puede verse aquí: https://perezp44.github.io/intro-ds-20-21-web/. Los trabajos de mis compañeros de curso pueden verse aquí.

---

1. Introducción

Los Juegos Olímpicos, son el mayor evento deportivo del mundo. En él participan atletas de diversas partes del mundo y son considerados como el evento deportivo con más participantes, con más de doscientas naciones participantes. Existen dos tipos, los de verano y los de invierno, sin embargo, nosotros vamos a centrarnos en los de verano.

La primera edición de los llamados Juegos Olímpicos de la era moderna se llevó a cabo en Atenas, capital de Grecia en 1896. Desde entonces se han realizado cada 4 años excepto las ediciones de 1916, 1940 y 1944, debido al estallido de la Primera y Segunda Guerra Mundial; y la de 2020 que ha sido postergada a 2021, por la pandemia de COVID-19.

Cargar paquetes

library(tidyverse)
library(highcharter)
library(gganimate)
library(ggplot2)
library(RColorBrewer)
library(patchwork)
library(plotly)
library(robservable)
library(gt)
library(ggthemes)
library(gghighlight)

Limpieza de los datos

Primero para buscar ideas de trabajos miramos en https://www.kaggle.com/ donde nos topamos con dos datasets muy interesantes, los cuales hemos utilizado para el trabajo. Son 120 years of Olympic history: athletes and results y Olympic Track & Field Results. En el primero tenemos datos de los atletas que han participado en los olimpiadas desde 1896 y en el segundo tenemos los tiempos y marcas en algunas de las pruebas para los tres primeros clasificados.

A continuación procedemos a la limpieza del dataset 120 years of Olympic history: athletes and results.

#Pesaban demasiado los datos originales como para subirlo al GitHub

# athletes <- rio::import(here::here("datos", "athlete_events.csv"))
# regions <- rio::import(here::here("datos", "noc_regions.csv"))

#unimos los datasets

#df <- left_join(athletes, regions)

#tratamos los datos

# df_summer_medals <- df %>% filter(!is.na(Medal)) %>% filter(Season == "Summer")

#ya lo tenemos para más tarde

# rio::export(df_summer_medals, "./datos/df_summer_medals.csv")

# ath <- athletes %>% select(ID, Name, Sex, Age, Weight, NOC, Year, Season, Sport, Medal, Team)

# rio::export(ath, "./datos/ath.csv")

#importamos 
athletes <- rio::import("./datos/ath.csv")

#importamos directamente el dataset con datos de verano y medallas
df_summer_medals <- rio::import(here::here("datos", "df_summer_medals.csv"))

str(df_summer_medals)
#> 'data.frame':    34088 obs. of  17 variables:
#>  $ ID    : int  4 15 15 17 17 17 17 17 21 25 ...
#>  $ Name  : chr  "Edgar Lindenau Aabye" "Arvo Ossian Aaltonen" "Arvo Ossian Aaltonen" "Paavo Johannes Aaltonen" ...
#>  $ Sex   : chr  "M" "M" "M" "M" ...
#>  $ Age   : int  34 30 30 28 28 28 28 32 27 24 ...
#>  $ Height: int  NA NA NA 175 175 175 175 175 163 NA ...
#>  $ Weight: num  NA NA NA 64 64 64 64 64 NA NA ...
#>  $ Team  : chr  "Denmark/Sweden" "Finland" "Finland" "Finland" ...
#>  $ NOC   : chr  "DEN" "FIN" "FIN" "FIN" ...
#>  $ Games : chr  "1900 Summer" "1920 Summer" "1920 Summer" "1948 Summer" ...
#>  $ Year  : int  1900 1920 1920 1948 1948 1948 1948 1952 2008 1920 ...
#>  $ Season: chr  "Summer" "Summer" "Summer" "Summer" ...
#>  $ City  : chr  "Paris" "Antwerpen" "Antwerpen" "London" ...
#>  $ Sport : chr  "Tug-Of-War" "Swimming" "Swimming" "Gymnastics" ...
#>  $ Event : chr  "Tug-Of-War Men's Tug-Of-War" "Swimming Men's 200 metres Breaststroke" "Swimming Men's 400 metres Breaststroke" "Gymnastics Men's Individual All-Around" ...
#>  $ Medal : chr  "Gold" "Bronze" "Bronze" "Bronze" ...
#>  $ region: chr  "Denmark" "Finland" "Finland" "Finland" ...
#>  $ notes : chr  "" "" "" "" ...

2. Evolución de las medallas por país

Para empezar vamos a observar la evolución de las medallas ganadas por país a lo largo del tiempo.

Durante toda la historia, el deporte ha sido el ejército simbólico de los países. Es por esto, por lo que estar alto en el medallero olímpico es una muestra de poder.

df_1 <- df_summer_medals %>% mutate(M = case_when(
                               is.na(Medal) ~ 0,
                               TRUE ~ 1)) %>%
                           select(Year, M, region) %>%
                           group_by(region, Year) %>%
                           summarise(Medallas_anyo = sum(M))%>%
                           arrange(region)


#grafica con robservable de https://observablehq.com/@juba/bar-chart-race

df_race <- df_1  %>% mutate(value = cumsum(Medallas_anyo)) %>%
                     rename(id = region, date = Year) %>%
                     arrange(date) %>%
                     select(-Medallas_anyo)

#añadimos años del boicot y alemania
z <- data.frame(id = c("USA","Russia","Germany", "Germany", "Germany"),
              date = c(1980, 1984, 1920, 1924, 1948),
              value = c(2626,1780, 197, 197, 541))

datos <- rbind(df_race,z)

df_race_1 <- datos %>% arrange(date)


robservable(
  "https://observablehq.com/@juba/bar-chart-race",
  include = c("viewof date", "chart", "draw", "styles"),
  hide = "draw",
  input = list(
    data = df_race_1, 
    title = "Evolución de las medallas",
    subtitle = "Juegos Olímpicos de verano de 1896 a 2016",
    source = "Fuente: 120 years of Olympic history: athletes and results"
  ),
  width = 700,
  height = 710
)

Podemos observar como desde 1920 ningún país ha logrado quitarle la delantera a Estados Unidos en el total de medallas. Para observar este fenómeno más de cerca podemos mirar la evolución de los 5 países con más medallas.

Evolución top 5 paises

a_top<- df_1%>% group_by(region) %>% summarise(n = sum(Medallas_anyo)) %>% arrange(desc(n)) %>% ungroup() %>% slice_max(n, n=5)

df_top <- df_1 %>% filter(region %in% c("USA","Russia","UK", "France", "Germany"))



p <- ggplot(df_top, aes(Year, Medallas_anyo, color = region)) + geom_line() + theme_solarized() + facet_grid(rows = vars(region)) +
labs(title = "Evolución de los top 5 Países con más medallas",
    subtitle = "Juegos Olímpicos de verano de 1896 a 2016",
    caption = "Fuente: 120 years of Olympic history: athletes and results",
    x = "Años",
    y = "Número de Medallas por año") + theme(legend.position = "none")

p

Podemos observar como Francia y Reino Unido, a pesar de haber empezado con buen pie en algunas de las primeras Olimpiadas, desde entonces han seguido un ritmo constante, mientras que los casos de Estado Unidos, Rusia y Alemania se caracterizan por periodos de crecimiento más elevados. Algunos ejemplos son las Olimpiadas de de 1936 que se celebraron en Berlin cuando Hitler estaba en el poder.

Juegos Olímpicos Berlín 1936

df_nazis <- df_summer_medals %>% filter(Year == 1936, region == "Germany") %>%
                                 mutate(Total = n()) %>%
                                 select(Total,Year, region, Medal) %>%
                                 mutate(Bronce = case_when(
                               Medal == "Bronze" ~ 1,
                               TRUE ~ 0)) %>%
                                mutate(Plata = case_when(
                               Medal == "Silver" ~ 1,
                               TRUE ~ 0)) %>%
                                mutate(Oro = case_when(
                               Medal == "Gold" ~ 1,
                               TRUE ~ 0)) %>%
                                mutate(Total_oro = sum(Oro)) %>%
                                mutate(Total_plata = sum(Plata))%>%
                                mutate(Total_bronce = sum(Bronce))%>%
                                distinct(region, .keep_all = TRUE)%>%
                              dplyr::relocate(Total, .after = Total_bronce) %>%
                                select(-c(Medal, Bronce, Plata, Oro))



urls_nazis <- "https://upload.wikimedia.org/wikipedia/commons/7/7e/Flag_variant_of_Nazi_Party_%281923%29.svg"
nazis_con_urls <- df_nazis %>% add_column(urls_nazis)

nazis_con_urls %>% gt() %>%
  gt::text_transform(locations = cells_body(columns = vars(urls_nazis)),
                     fn = function(x) {gt::web_image(x, height = 50)}) %>%
  data_color(columns = vars(Total_oro),
    colors = "yellow")%>%
   data_color(columns = vars(Total_plata),
    colors = "grey")%>%
   data_color(columns = vars(Total_bronce),
    colors = "sienna")

Year	region	Total_oro	Total_plata	Total_bronce	Total	urls_nazis
1936	Germany	93	70	61	224

Boicot EEUU - URSS

Durante la Guerra Fría las dos superpotencias, decidieron boicotearse. Fue en 1980 en los Juegos Olímpicos de Moscú, cuando Estados Unidos decidió no asistir. Cuatro años más tarde, en 1984 fue la URSS quien decidió no acudir a las Olimpiadas de Los Ángeles.En el siguiente mapa podemos ver como fue la distribución de las medallas durante esos Juegos Olímpicos.

#mapa boicot 1980 y 1984
world <- rnaturalearth::ne_countries(scale = "medium", returnclass = "sf")

#- quito Antarctica y Groenlandia
world <- world %>% filter(subregion != "Antarctica") %>% filter(admin != "Greenland")


df_mapa_boicot <- df_summer_medals %>% filter(Year %in% c("1980", "1984")) %>%
                                group_by(region, Year) %>%
                                summarise(n = n())

world_3 <- world %>% mutate(admin = case_when(
  admin == "The Bahamas" ~ "Bahamas",
  admin == "Republic of Serbia" ~ "Serbia",
  admin == "Trinidad and Tobago" ~ "Trinidad",
  admin == "United Kingdom" ~ "UK",
  admin == "United States of America" ~ "USA",
  TRUE  ~  admin ))

df_join_2 <- left_join(df_mapa_boicot , world_3, by = c("region" = "admin"))

df_world_3 <- df_join_2 %>% select(region, n, Year, geometry)

ggplot() + geom_sf(data = world, mapping = aes(geometry = geometry)) + geom_sf(df_world_3, mapping = aes(geometry = geometry, fill = n)) + facet_grid(rows = vars(Year))  + theme_light() + theme( panel.background = element_rect(fill = "aliceblue")) +
  labs(title = "Medallas conseguidas durante el Boicot Americano y el Ruso",
    subtitle = "Juegos Olímpicos de verano de 1896 a 2016",
    caption = "Fuente: 120 years of Olympic history: athletes and results",
    color = "Medallas") + scale_fill_viridis_c(option="plasma")

Podemos observar como en ambos Juegos Olímpicos el país anfitrión fue el claro vencedor. Más tarde veremos las consecuencias de albergar unos Juegos Olímpicos.

3. Atletas y resultados

Atletas con más medallas

Si ganar una medalla olímpica es complicado, no me quiero imaginar tenerlas a montones. Esto es lo que le sucede a los siguientes deportistas. La siguiente lista son los 30 atletas con más medallas. Son unos extreterrestres en lo suyo!

#atletas más medallas
aa <- df_summer_medals %>% select(-c( Weight, Team, NOC, Season, notes)) %>%          group_by(ID)%>%
            mutate(Medallas = n())%>%
            arrange(desc(Medallas))%>%
            distinct(Name, .keep_all = TRUE)%>%
            ungroup() %>%
            slice_max(Medallas, n = 30)

aa <- aa %>% mutate(Name = forcats::as_factor(Name)) %>%
             mutate(Name = forcats::fct_reorder(Name,Medallas))

ggplot(aa,aes(Name,Medallas,color = Name,fill= Name)) +
  geom_bar(position = "stack",  width =.6,stat="identity") +
  coord_flip()+
  geom_text(aes(label= Medallas ,hjust=-.03,  colour="black"),size=3) +
  geom_text(aes(label= region), position = position_stack(vjust= 0.5),
            colour = "grey30", size = 3) +
  theme(axis.line = element_line(color = "green",size=1))+
      theme(panel.background=element_blank())+
      scale_x_discrete() +
    xlab("Atleta")+ylab("Medallas")+
  theme(legend.position = "none",
                     axis.text = element_text(size = 8,face="bold"),
        plot.title = element_text(size=16,face = "bold")) +
  ggtitle("Atletas con más medallas olímpicas " ,subtitle = "Juegos Olímpicos de verano de 1896 a 2016")

Cargamos dataframe con los tiempos

Para ver los tiempos utilizamos los datos de Olympic Track & Field Results que con la ayuda de nuestro profesor Pedro J. Pérez pudimos limpiarlos y utilizarlos en el análisis.

#realizado por Pedro J. Pérez
df_json <- jsonlite::fromJSON("./datos/results.json")
zz1 <- unnest_longer(df_json, col = games) #- con esto debería bastar pero ....

#------------- a mano
zz1 <- zz1 %>% rename(prueba = name) #- xq luego aparecerá otra variable llamada name

 ii <- 1
 location <- zz1[[1]][[1]][ii]
 year <- zz1[[1]][[3]][ii]
 gender <- zz1[[2]][ii]
 prueba <- zz1[[3]][ii]
 resultaditos <- zz1[[1]][[2]][ii]
 re <- as.data.frame(resultaditos)
 re <- re %>% add_column(location, year, gender, prueba)
 df <- re
 for (ii in 2:nrow(zz1)) {
   location <- zz1[[1]][[1]][ii]
   year <- zz1[[1]][[3]][ii]
   gender <- zz1[[2]][ii]
   prueba <- zz1[[3]][ii]
   resultaditos <- zz1[[1]][[2]][ii]
   re <- as.data.frame(resultaditos)
   re <- re %>% mutate(result = as.character(result))
   re <- re %>% add_column(location, year, gender, prueba)
   df <- bind_rows(df, re)
 }

#- df tiene 2.396 filas y 8 columnas
#- arreglar algunas cosas

df <- df %>% mutate(prueba = stringr::str_remove(prueba, " Men$") )     #- quitar Men de prueba
df <- df %>% mutate(prueba = stringr::str_remove(prueba, " Women$") )   #- quitar Women de prueba


#- arreglar el resltado (result)
#- hay distintos tipos de pruebas: carreras, lanzamientos y concursos(decathlon, heptalon).
df <- df %>% rename(mark = result) %>% relocate(mark, .after = last_col())


 #- la mark de las carreras quiero q este medido en segundos, pero esta en formato texto y no estandar: ARREGLARLO:
#- el código de bajo lo hice para un trabajo mio y estaba adaptado a los pb's de codificación de mis datos, no está adaptado a vuestros datos. Vuestros datos he visto que tienen pbs de codificacion  especificicos; por ejemplo en la marathon y supongo que en mas sitios, asi que lo de abajo funcionara hasta cierto punto
 library(stringr)
 #- 1) quitar letras
 df <- df %>% mutate(mark_x = ifelse(str_detect(mark, "[[:alpha:]]"), str_replace_all(mark, "[[:alpha:]]", "0"), mark))
  #- 3) si el tiempo es 11, pasarlo a 11.00
 df <- df %>% mutate(mark_x = ifelse( str_detect(mark_x, "^[[:digit:]]{2}$"), paste0(mark_x, ".00"), mark_x) )
  #- 4) si el tiempo es 12.1 le he de poner un 0 al final
 df <- df %>% mutate(mark_x = ifelse( str_detect(mark_x, "^[[:digit:]]{2}.[[:digit:]]{1}$"), paste0(mark_x, "0"), mark_x) )
 #- 5) si el tiempo empieza con 9.91 pues ponerle 09.91
 df <- df %>% mutate(mark_x = ifelse( str_detect(mark_x, "^[[:digit:]]{1}.[[:digit:]]{2}"), paste0("0", mark_x), mark_x) )
 #- 6) si el tiempo esta x debajo del minuto, entonces:
 df <- df   %>% mutate(mark_x = ifelse( str_detect(mark_x, "^[[:digit:]]{2}.[[:digit:]]{2}$"), paste0("00:00:", mark_x), mark_x) )
 #- 7) si el tiempo son minutos (forzarles a que tenga 2 digitos de minutos). P.ej: 7:22.44  pasarlo a 07:22.44
 df <- df %>% mutate(mark_x = ifelse( str_detect(mark_x, "^[[:digit:]]{1}:[[:digit:]]{2}.[[:digit:]]{2}$"), paste0("0", mark_x), mark_x) )
 #- 8) 44:44.44 pasa a 00:44:44.44
 df <- df %>% mutate(mark_x = ifelse( str_detect(mark_x, "^[[:digit:]]{2}:[[:digit:]]{2}.[[:digit:]]{2}$"), paste0("00:", mark_x), mark_x) )
 #- 8) 44:44.44 pasa a 00:44:44.44
 df <- df %>% mutate(mark_x = ifelse( str_detect(mark, "^[[:digit:]]{2}:[[:digit:]]{2}:[[:digit:]]{2}$"), paste0(mark, ".00"), mark_x) )


#- funcion para pasar "02:44:33.22" a segundos ----
 my_f_tt_to_seconds <- function(xx) {
   #- meto un character con formato hh::mm:ss.dd
   aa <- stringr::str_extract(xx, "^..:..") #- extraigo las horas y minutos
   aa_1 <- stringr::str_extract(aa, "^..") %>% as.numeric(.)*60*60  #- extraigo las horas
   aa_2 <- stringr::str_extract(aa, "..$") %>% as.numeric(.)*60     #- extraigo las minutos
   cc <- stringr::str_extract(xx, "..\\...$")  #- estrae 22.55
   dd <- as.numeric(cc)
   ee <- aa_1 + aa_2 + dd
   ee
 }

 #- usamos la f. para  poner en segundo la marca de las carreras (faltaria arreglar los lanzamientos y concursos)
 #- en realidad esto solo habria que hacerlo para las carreras, no para lanzamientos, saltos y concursos
 df <- df %>% mutate(mark_xx = my_f_tt_to_seconds(mark_x))
 df <- df %>% mutate(mark_unidades = "segundos")

 rm(list = setdiff(ls(), "df"))
 #- Ademas... los datos parecen q tienen fallos. Al menos la primera fila. No puede ser que en la carrera de 10.000 en Rio FARAH le sacase dos minutos al segundo. Igual solo es ese fallo, pero ...

df_results <- rio::import(here::here("datos", "df_results.csv"))

100 metros

Puede que esta sea la disciplina olímpica más conocida, pero desgraciadamente, también la más corta.

Distribución

df_100M <- df_results%>% filter(prueba == "100M", gender == "M") %>% arrange(year)

df_100M_muj_y_hom <- df_results %>% filter(prueba == "100M")

ggplot(df_100M_muj_y_hom, aes(x = mark_xx, fill = gender)) +
        geom_histogram(aes(y = ..count..), position="identity", alpha=0.6) + scale_x_continuous(name = "Tiempo") +
  scale_y_continuous(name = "Número de atletas") +
  ggtitle("Distribución de los tiempos en 100 metros") +
  theme_bw() +
  theme(axis.line = element_line(size=1, colour = "black"),
              panel.grid.major = element_line(colour = "#d3d3d3"),
              panel.grid.minor = element_blank(),
              panel.border = element_blank(), panel.background = element_blank(),
              plot.title = element_text(size = 14, family = "Tahoma", face = "bold"),
              text=element_text(family="Tahoma"),
              axis.text.x=element_text(colour="black", size = 9),
              axis.text.y=element_text(colour="black", size = 9)) +
        scale_fill_brewer(palette="Accent") + labs(color = "Género")

Evolución de los atletas que han ganado oro

df_100M_oro <- df_100M_muj_y_hom %>% filter(medal == "G") %>% mutate(gender = case_when(
  gender == "M" ~ "Hombre",
  gender == "W" ~ "Mujer"))

p1 <- ggplot(df_100M_oro, aes(year, mark_xx, color = gender)) + geom_line() + geom_point(aes (color = name)) + theme_light() +
labs(title = "Evolución de los tiempos de los ganadores de 100 metros",
    subtitle = "Juegos Olímpicos de verano de 1896 a 2016",
    caption = "Fuente:Olympic Track & Field Results",
    x = "Año",
    y = "Tiempo",
    color = "Género y Atleta",
    tag = "Plot 1") +
  scale_fill_distiller(palette = "RdYlBu") + theme(axis.line = element_line(colour = "blue4"),
    axis.ticks = element_line(colour = "blue4"),
    panel.grid.major = element_line(colour = "ivory1"),
    legend.title = element_text(colour = "brown"),
    panel.background = element_rect(fill = "antiquewhite",
        colour = "antiquewhite1"), plot.background = element_rect(fill = "wheat2"),
    legend.background = element_rect(colour = "antiquewhite1"))


ggplotly(p1)

Gracias a estos gráficos observamos como en un siglo, los tiempos han ido cayendo en picado, además de la superioridad de los atletas hombres en esta disciplina. De momento el record olímpico lo tiene el bueno de Usain Bolt.

Peso y martillo y disco

Otra de las disciplinas más antiguas y características de esta competición deportiva, es el lanzamiento de disco y de martillo.

Cuando pensamos en lanzadores de disco y de martillo normalemente nos imaginamos personas muy fuertes y grandes, por ese motivo nos pareció interesante comprobar cuál es la relación entre el peso y las marcas en estas disciplinas.

Lanzamiento de Disco

#fusionando para ver peso en pruebas de disco
df_summer_medals <- rio::import(here::here("datos", "df_summer_medals.csv"))

aa_1 <- df_results %>% filter(prueba %in% c("Discus Throw"), gender == "M") %>% arrange(year) %>%
                       mutate(medal = case_when(
  medal == "G" ~ "Gold",
  medal == "S" ~ "Silver",
  medal == "B" ~ "Bronze",
  TRUE  ~  name ))

bb_1 <- df_summer_medals %>% filter(Event %in% c("Athletics Men's Discus Throw"))%>% arrange(Year)

df_disco <- left_join(aa_1, bb_1, by = c("nationality" = "NOC", "medal" = "Medal", "year" = "Year"))


p_2 <- ggplot(df_disco, aes(x = mark_xx, y = Weight, color = year )) +
  geom_point() +
  geom_smooth(color = "cyan4") +
  theme_bw() +
  labs(title = "Peso y Lanzamiento de Disco",
    subtitle = "Juegos Olímpicos de verano de 1896 a 2016",
    caption = "Fuente: Olympic Track & Field Results",
    x = "Marca",
    y = "Peso",
    color = "Año") + scale_color_gradient(low = "yellow", high = "red", na.value = NA) + theme(axis.line = element_line(colour = "blue4"),
    axis.ticks = element_line(colour = "blue4"),
    panel.grid.major = element_line(colour = "ivory1"),
    legend.title = element_text(colour = "brown"),
    panel.background = element_rect(fill = "antiquewhite",
        colour = "antiquewhite1"), plot.background = element_rect(fill = "wheat2"),
    legend.background = element_rect(colour = "antiquewhite1"))


ggplotly(p_2)

Lanzamiento de Martillo

#fusionando para ver peso y martillo

aa_2 <- df_results %>% filter(prueba %in% c("Hammer Throw"), gender == "M") %>% arrange(year) %>%
                       mutate(medal = case_when(
  medal == "G" ~ "Gold",
  medal == "S" ~ "Silver",
  medal == "B" ~ "Bronze",
  TRUE  ~  name ))

bb_2 <- df_summer_medals %>% filter(Event %in% c("Athletics Men's Hammer Throw"))%>% arrange(Year)

df_mart <- left_join(aa_2, bb_2, by = c("nationality" = "NOC", "medal" = "Medal", "year" = "Year"))


df_mart <- df_mart[-c(39), ]

p_3 <- ggplot(df_mart, aes(x = mark_xx, y = Weight, color = year )) +
  geom_point() +
  geom_smooth(color = "cyan4") +
  theme_bw() +
  labs(title = "Peso y Lanzamiento de Martillo",
    subtitle = "Juegos Olímpicos de verano de 1896 a 2016",
    caption = "Fuente: Olympic Track & Field Results",
    x = "Marca",
    y = "Peso",
    color = "Año") + scale_color_gradient(low = "yellow", high = "red", na.value = NA) + theme(axis.line = element_line(colour = "blue4"),
    axis.ticks = element_line(colour = "blue4"),
    panel.grid.major = element_line(colour = "ivory1"),
    legend.title = element_text(colour = "brown"),
    panel.background = element_rect(fill = "antiquewhite",
        colour = "antiquewhite1"), plot.background = element_rect(fill = "wheat2"),
    legend.background = element_rect(colour = "antiquewhite1")) + annotate(geom = "text", x = 82.91, y = 98, label = "record", hjust = "up") 

ggplotly(p_3)

Combinando gráficos

#combinando gráficos disco y martillo
p_2 + p_3 + plot_layout(ncol = 2)

Podemos observar como en el caso de lanzamiento de disco ha habido una correlación más fuerte a través de los años entre el peso y las marcas. En el caso del lanzamiento de martillo es menos obvia esa realación. Cabe destacar que el record mundial olímpico que está en 82.91 metros y que fue realizado por el japonés Koji Murofushi en 2004 cuando él pesaba menos de 100 kg, siendo de los lanzadores de martillo con menor peso.

4. URSS: Antes y después

Ya que este trabajo pretende destacar aspectos interesantes y curiosos de los Juegos Olímpicos, teníamos la necesidad de hacer algún gráfico a la otra superpotencia, a la URSS. Estábamos interesados en averiguar, que era más “rentable” deportivamente hablando, que los territorios fueran juntos y cada uno por su cuenta. Ahí está el gráfico.

#URSS BUENA

df_summer_medals <- rio::import(here::here("datos", "df_summer_medals.csv"))

df_urss <- df_summer_medals %>% filter(NOC %in% c("URS","EUN")) %>%
  arrange(Year) %>%
  group_by(Year) %>%
  summarise(nn = n())

p <- ggplot(df_urss, aes(x =Year, y= nn, fill= "red")) + geom_col() + ylim(c(NA, 500))+ labs(title = "Gráfico URSS: Medallas totales de la URSS",
       subtitle = "(antes de su disolución en 1992)",
       x = "Años",
       y = "Medallas totales")

df_urss_post <- df_summer_medals %>% filter(NOC %in% c("EST", "RUS", "UKR", "GEO", "BLR", "AZE", "UZB", "TJK", "POL", "LTU", "ROU", "ARM" )) %>%
  filter(Year > 1992) %>%
  arrange(Year) %>%
  group_by(Year, NOC) %>%
  summarise(n = n()) %>%
  group_by(Year) %>%
  mutate(nn = sum(n))

p2 <- ggplot(df_urss_post, aes(x =Year, y= nn, fill = "red")) + stat_summary(geom="bar", position=position_stack()) + ylim(c(NA, 500)) +
  labs(title = "Gráfico URSS: Medallas totales de la URSS",
       subtitle = "(antes de su disolución en 1992)",
       x = "Años",
       y = "Medallas totales")

#fusionando dataframes
df_urss_tot <- full_join(df_urss, df_urss_post)

p3 <- ggplot(df_urss_tot, aes(x =Year, y= nn, fill = "red")) + stat_summary(geom="bar", position=position_stack())

p3 +  ylim(c(NA, 500)) + labs(title = "Gráfico URSS: Medallas totales de la URSS", subtitle = "Año 1900 hasta 2016", x = "Años",
                              y = "Medallas totales")+ theme(axis.line = element_line(color = "orange",size=1))+ theme(legend.position = "none")+ theme_solarized()+ theme(legend.position = "none") + geom_vline(xintercept = 1994)

5.Mujeres

Participación

El siglo XXI es sin duda el siglo de las mujeres, y es por esto por lo que pretendíamos en esta parte, observar como su participación ha ido creciendo. Nosotros creemos que lo seguirá haciendo mucho más. También hemos intentado mostrar, como esa participación no está distribuida de igual manera entre los continentes.

library(ggthemes)

athletes <- rio::import(here::here("datos", "ath.csv"))

df_mujeres <- athletes %>% 
  filter(Sex=="F")%>%
  group_by(Season, Year) %>%
  summarise(nn = n())

p <- ggplot(df_mujeres, aes(Year,nn, color= Season))+ geom_point()+ geom_line()

  
p + labs(title = "Participación mujeres atletas en JJOO",
       subtitle = "Desde 1990 hasta 2016" ,
       x = "Años",
       y = "Participación")+ theme(axis.line = element_line(color = "orange",size=1))+ theme(panel.background=element_blank())+ 
  theme(legend.position = "none",
        axis.text = element_text(size = 8,face="bold"),
        plot.title = element_text(size=16,face = "bold"))+ theme_solarized()

Comparación continentes

athletes <- rio::import(here::here("datos", "ath.csv"))

df_mujeres <- athletes %>% 
  filter(Sex=="F")%>%
  select(Sex, Year, Team, Season)

df_mujeres2 <- athletes %>% 
  filter(Sex=="F")%>%
  group_by(Season, Year,Team) %>%
  summarise(nn = n())


df_mujeres3 <- df_mujeres2 %>% filter(Team %in% c("Spain", "Netherlands", "Finland", "Italy", "Portugal","Canada","Cuba","Brazil","United States","Colombia","China","India","Japon","South Korea","North Korea","Australia","New Zealand","Fiji","Papua New Guinea","Samoa","Egypt","South Africa", "Nigeria", "   
Kenya","Cameroon"))

df_mujeres4 <- df_mujeres3 %>%  mutate(CONTINENTES= case_when(
  Team == "Spain" ~ "Europa",
  Team == "Netherlands" ~ "Europa",
  Team == "Finland" ~ "Europa",
  Team == "Italy" ~ "Europa",
  Team =="Portugal"~ "Europa",
  Team == "Canada" ~ "America",
  Team == "Cuba" ~ "America",
  Team == "Brazil" ~ "America",
  Team == "United States"~ "America",
  Team == "Colombia"~ "America",
  Team == "India" ~ "Asia",
  Team == "Japon" ~ "Asia",
  Team == "South Korea" ~ "Asia",
  Team == "North Korea" ~ "Asia",
  Team == "China" ~ "Asia",
  Team == "Australia"  ~ "Oceanía",
  Team == "New Zealand"~ "Oceanía",
  Team == "Fiji"~ "Oceanía",
  Team == "Papua New Guinea"~ "Oceanía",
  Team == "Samoa" ~ "Oceanía",
  Team == "Cameroon" ~ "Africa",
  Team == "Kenya" ~ "Africa",
  Team == "Egypt"~ "Africa", 
  Team == "South Africa"~ "Africa",
  Team == "Nigeria"~ "Africa"))


library(gghighlight)

ggplot(df_mujeres4 , aes(x = Year,  y = nn, color= CONTINENTES))+ geom_point() + ylim(c(NA, 500)) + 
  labs(title = "Participacion de la mujer por continentes", subtitle = "Año 1900 hasta 2016", x = "Años",
       y = "Atletas")+ theme(axis.line = element_line(color = "orange",size=1))+
  theme(panel.background=element_blank())+
  theme(axis.text = element_text(size = 8,face="bold"),
        plot.title = element_text(size=16,face = "bold"))+  gghighlight::gghighlight() + 
  facet_wrap(vars(CONTINENTES))+ theme_solarized()

6.Curiosidades

Paises organizadores

Cuando estábamos haciendo el trabajo leímos un artículo que comentaba que los países organizadores de los Juegos Olímpicos, a parte de que cuando compiten en casa obtienen sus mejores resultados, provocan la visibilización de ciertos deportes minoritarios, haciendo que los resultados olímpicos posteriores continúen siendo buenos.

Esto hemos intentado mostrar en este gráfico, con resultados dispares.

df_2 <- df_summer_medals %>%
  filter(Year > 1948) %>% mutate(M = case_when(
  is.na(Medal) ~ 0,
  TRUE ~ 1)) %>%
  select(Year, M, region) %>%
  group_by(region, Year) %>%
  summarise(Medallas_anyo = sum(M))%>%
  arrange(region)

Mediterráneo <- df_2 %>% filter(region %in% c("Spain", "Portugal", "Italy", "Greece"))


mediterrania <- ggplot(Mediterráneo, aes(x=Year, y=Medallas_anyo, group=region, color=region)) +
  geom_point() +
  geom_line() +
  scale_color_manual(values=c("darkblue","red", "gold", "green"))  +
  theme(plot.title = element_text(hjust = 0.5)) +
  labs(title="Como han crecido nuestro compañeros")

mediterrania + geom_vline(aes(xintercept=1960), color="#990000", linetype="dashed")+ geom_vline(aes(xintercept=1992), color="brown", linetype="dashed") + geom_vline(aes(xintercept=2004), color="brown", linetype="dashed")

Korea

No sé si sabrán que el gobierno norcoreano le suele decir a sus compatriotas que siempre obtienen más medallas que sus vecinos del sur. Pero, nada más lejos de la realidad. Desde que se separaron, a Corea del Sur cada vez le va mejor, mientras que a Corea del Norte, peor.

korea <- df_summer_medals %>%
  filter(Year > 1970) %>% mutate(M = case_when(
  is.na(Medal) ~ 0,
  TRUE ~ 1)) %>%
  group_by(region, Year) %>%
  summarise(Medallas_anyo = sum(M))%>%
  arrange(region)

koreas <- korea %>% filter(region %in% c("North Korea","South Korea"))

ggplot(koreas, aes(x=Year, y=Medallas_anyo, group=region, color=region)) +
  geom_point(alpha=0.6) +
  geom_abline(intercept=0, slope=1, linetype="dashed") +
  geom_smooth(method="lm", se=FALSE) +
  labs(title = "Crecimiento medallero de las dos Coreas") +
  theme(plot.title = element_text(hjust = 0.5)) +
  guides(color=guide_legend(reverse=TRUE))

Distribucion por edad y olimpiada

Para ir acabando el trabajo, nos apetecía observar los cambios en las edades de los participantes. En muchas otras disciplinas ocurre que precocidad está a la orden del día. Queríamos verlo si aquí también.

athletes <- rio::import(here::here("datos", "ath.csv"))

age_1896 <- athletes%>%filter(Sex=="M",Season=='Summer',Year==1896)%>%group_by(Sport)%>%summarize(avg=round(mean(Age,na.rm = TRUE),1))

age_1936 <- athletes%>%filter(Sex=="M",Season=='Summer',Year==1936)%>%group_by(Sport)%>%summarize(avg=round(mean(Age,na.rm = TRUE),1))

age_1972 <- athletes%>%filter(Sex=="M",Season=='Summer',Year==1972)%>%group_by(Sport)%>%summarize(avg=round(mean(Age,na.rm = TRUE),1))

age_1992 <- athletes%>%filter(Sex=="M",Season=='Summer',Year == 1992)%>%group_by(Sport)%>%summarize(avg=round(mean(Age,na.rm = TRUE),1))

age_2016 <- athletes%>%filter(Sex=="M",Season=='Summer',Year == 2016)%>%group_by(Sport)%>%summarize(avg=round(mean(Age,na.rm = TRUE),1))


age_y = athletes%>%filter(Season=='Summer')%>%group_by(Sport)%>%summarize(Y=unique(Sport))



highchart(height = "700px") %>%
  hc_title(text = "Media de Edad por Deporte en distintas Olimpiada") %>%
  hc_subtitle(text = "Juegos Olímpicos de verano de 1896 a 2016") %>%
  hc_credits(enabled = TRUE, text = "Fuente: 120 years of Olympic history: athletes and results",
             style = list(fontSize = "10px")) %>%
  hc_add_theme(hc_theme_ft()) %>%
  hc_xAxis(categories = age_y$Y,title = list(text = "Deporte")) %>%
  hc_add_series(name = "1896", data = age_1896$avg)%>%
  hc_add_series(name = "1936",data = age_1936$avg)%>%
  hc_add_series(name = "1972",data = age_1972$avg)%>%
  hc_add_series(name = "1992", data = age_1992$avg) %>%
  hc_add_series(name = "2016",data = age_2016$avg)%>%

 hc_yAxis(title = list(text = "Media de edad"),
           labels = list(format = "{value}"), max = 50) %>%
   hc_legend(enabled = T, align= "left", verticalAlign = "bottom")

Es interesante observar como la media de edad en Alpinismo en los Juegos de 1936 estaba en 49 años o como en el caso de Badminton en 1896 o Patinaje Artístico en 1972 sobrepasan por poco la mayoría de edad.

7.Conclusión

A modo de conclusión, destacar, como hemos dicho al comienzo, que sin ningún tipo de duda, los Juegos Olímpicos son el mayor evento deportivo del mundo. Es más, creemos que este acontecimiento trasciende lo puramente deportivo, llegando a convertirse en un evento tanto social como cultural y por supuesto político. Para finalizar consideramos que los Juegos Olímpicos tanto en la Antigua Grecia como en la actualidad, son un instrumento que transcurren en paralelo con la historia de la humanidad y, a través de ellos, podemos aprender y entender todo lo sucedido en el último siglo.

Bibliografía

De aquí sacamos los datos de 120 years of Olympic history: athletes and results.

Trabajos que nos han inspirado:

• Olympic history data: thorough analysis

• Holding an Olympic Games means evoking history

De aquí sacamos los datos de Olympic Track & Field Results

De aquí sacamos el diseño del histograma de 100 metros.