library(DT)Ejercicio 1
Seleccionar un data set de: https://www.kaggle.com/datasets
Se selecciona la tabla de datos athlete_events disponible en kaggle aquí.
Esta tabla contiene información acerca de cada participación de cada atleta en los olímpicos desde Athenas 1896 hasta Río 2016. Las filas es cada combinación atleta-partipación. Las columnas son las características: Edad, Peso, Altura, …
datos = read.csv('C:/Users/wsand/Dropbox/2021-II/Ulibertadores/Mineria de datos/athlete_events.csv')
head(datos)## ID Name Sex Age Height Weight Team NOC
## 1 1 A Dijiang M 24 180 80 China CHN
## 2 2 A Lamusi M 23 170 60 China CHN
## 3 3 Gunnar Nielsen Aaby M 24 NA NA Denmark DEN
## 4 4 Edgar Lindenau Aabye M 34 NA NA Denmark/Sweden DEN
## 5 5 Christine Jacoba Aaftink F 21 185 82 Netherlands NED
## 6 5 Christine Jacoba Aaftink F 21 185 82 Netherlands NED
## Games Year Season City Sport
## 1 1992 Summer 1992 Summer Barcelona Basketball
## 2 2012 Summer 2012 Summer London Judo
## 3 1920 Summer 1920 Summer Antwerpen Football
## 4 1900 Summer 1900 Summer Paris Tug-Of-War
## 5 1988 Winter 1988 Winter Calgary Speed Skating
## 6 1988 Winter 1988 Winter Calgary Speed Skating
## Event Medal
## 1 Basketball Men's Basketball <NA>
## 2 Judo Men's Extra-Lightweight <NA>
## 3 Football Men's Football <NA>
## 4 Tug-Of-War Men's Tug-Of-War Gold
## 5 Speed Skating Women's 500 metres <NA>
## 6 Speed Skating Women's 1,000 metres <NA>DT::datatable(head(datos, n=20))dim(datos)## [1] 271116 15- La base tiene 271116 filas y 15 columnas
Ahora vamos a realizar un resumen de las variables:
summary(datos)## ID Name Sex Age
## Min. : 1 Length:271116 Length:271116 Min. :10.00
## 1st Qu.: 34643 Class :character Class :character 1st Qu.:21.00
## Median : 68205 Mode :character Mode :character Median :24.00
## Mean : 68249 Mean :25.56
## 3rd Qu.:102097 3rd Qu.:28.00
## Max. :135571 Max. :97.00
## NA's :9474
## Height Weight Team NOC
## Min. :127.0 Min. : 25.0 Length:271116 Length:271116
## 1st Qu.:168.0 1st Qu.: 60.0 Class :character Class :character
## Median :175.0 Median : 70.0 Mode :character Mode :character
## Mean :175.3 Mean : 70.7
## 3rd Qu.:183.0 3rd Qu.: 79.0
## Max. :226.0 Max. :214.0
## NA's :60171 NA's :62875
## Games Year Season City
## Length:271116 Min. :1896 Length:271116 Length:271116
## Class :character 1st Qu.:1960 Class :character Class :character
## Mode :character Median :1988 Mode :character Mode :character
## Mean :1978
## 3rd Qu.:2002
## Max. :2016
##
## Sport Event Medal
## Length:271116 Length:271116 Length:271116
## Class :character Class :character Class :character
## Mode :character Mode :character Mode :character
##
##
##
## str(datos)## 'data.frame': 271116 obs. of 15 variables:
## $ ID : int 1 2 3 4 5 5 5 5 5 5 ...
## $ Name : chr "A Dijiang" "A Lamusi" "Gunnar Nielsen Aaby" "Edgar Lindenau Aabye" ...
## $ Sex : chr "M" "M" "M" "M" ...
## $ Age : int 24 23 24 34 21 21 25 25 27 27 ...
## $ Height: int 180 170 NA NA 185 185 185 185 185 185 ...
## $ Weight: num 80 60 NA NA 82 82 82 82 82 82 ...
## $ Team : chr "China" "China" "Denmark" "Denmark/Sweden" ...
## $ NOC : chr "CHN" "CHN" "DEN" "DEN" ...
## $ Games : chr "1992 Summer" "2012 Summer" "1920 Summer" "1900 Summer" ...
## $ Year : int 1992 2012 1920 1900 1988 1988 1992 1992 1994 1994 ...
## $ Season: chr "Summer" "Summer" "Summer" "Summer" ...
## $ City : chr "Barcelona" "London" "Antwerpen" "Paris" ...
## $ Sport : chr "Basketball" "Judo" "Football" "Tug-Of-War" ...
## $ Event : chr "Basketball Men's Basketball" "Judo Men's Extra-Lightweight" "Football Men's Football" "Tug-Of-War Men's Tug-Of-War" ...
## $ Medal : chr NA NA NA "Gold" ...Se observan los siguientes hallazgos:
- Hay 135571 atletas con ID único. En promedio: 271116/135571 = 2 participaciones por atleta.
- Hay 4 variables cuantitativas:
Age,Height,WeightyYear. Las demás son cualitativas. - Las variables con mayor cantidad de valores nulos son
HeightyWeight, aproximadamente el 20% de valores son nulos.
Ejercicio 2
El mismo debe contener mínimo 10000 observaciones, mínimo 10 variables y mínimo 10% de NAs.
- El número de observaciones es mayor a 10000.
num_filas = nrow(datos)
num_filas## [1] 271116- El número de variables es mayor a 10
num_columnas = ncol(datos)
num_columnas## [1] 15- total de NAs en la base de datos
sum(is.na(datos))## [1] 363853número de NAs por columna
colSums(is.na(datos))## ID Name Sex Age Height Weight Team NOC Games Year Season
## 0 0 0 9474 60171 62875 0 0 0 0 0
## City Sport Event Medal
## 0 0 0 231333Porcentaje de NAs que tienen cada variable
apply(is.na(datos),2,FUN="mean")*100## ID Name Sex Age Height Weight Team NOC
## 0.000000 0.000000 0.000000 3.494445 22.193821 23.191180 0.000000 0.000000
## Games Year Season City Sport Event Medal
## 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000 85.326207Ejercicio 3
Hacer imputación de datos con las siguientes opciones:
- Omitir las filas con observaciones NA
library(tidyr)
library(dplyr)Datos considerando la variable Medal
datos_omitiendo_nas_con_medalla <- na.omit(datos)
nrow(datos_omitiendo_nas_con_medalla)## [1] 30181Unicamente nos quedariamos con 30181 observaciones
100-nrow(datos_omitiendo_nas_con_medalla)/nrow(datos)*100## [1] 88.86786Cerca del 89% de observaciones con al menos un valor nulo son eliminadas. Lo cual no es muy buena estrategia.
Solo las variables Age, Height, Weight
datos_omitidos = datos%>% drop_na(c("Age", "Height", "Weight"))
dim(datos_omitidos)## [1] 206165 15- Imputar con la media
datos_imputados_media = datos %>% mutate_at(c("Age", "Height", "Weight"),
~replace(., is.na(.), mean(., na.rm=TRUE))
)- Imputar con la mediana
datos_imputados_mediana = datos %>% mutate_at(c("Age", "Height", "Weight"),
~replace(., is.na(.), median(., na.rm=TRUE))
)- Reemplazar NAs por cero
datos_imputados_cero = datos %>% mutate_at(c("Age", "Height", "Weight"),
~replace(., is.na(.), 0)
)Como era de esperarse esta última estrategia hace que la media disminuya su valor fuertemente.
Ejercicio 4
Analizar, empleando la función summary(), los estadísticos resultantes para cada opción de imputación. Seleccionar la mejor opción.
- Resumern Omitiendo las filas con
NA
summary(datos_omitidos)## ID Name Sex Age
## Min. : 1 Length:206165 Length:206165 Min. :11.00
## 1st Qu.: 35194 Class :character Class :character 1st Qu.:21.00
## Median : 68629 Mode :character Mode :character Median :24.00
## Mean : 68616 Mean :25.06
## 3rd Qu.:102313 3rd Qu.:28.00
## Max. :135571 Max. :71.00
## Height Weight Team NOC
## Min. :127.0 Min. : 25.00 Length:206165 Length:206165
## 1st Qu.:168.0 1st Qu.: 60.00 Class :character Class :character
## Median :175.0 Median : 70.00 Mode :character Mode :character
## Mean :175.4 Mean : 70.69
## 3rd Qu.:183.0 3rd Qu.: 79.00
## Max. :226.0 Max. :214.00
## Games Year Season City
## Length:206165 Min. :1896 Length:206165 Length:206165
## Class :character 1st Qu.:1976 Class :character Class :character
## Mode :character Median :1992 Mode :character Mode :character
## Mean :1990
## 3rd Qu.:2006
## Max. :2016
## Sport Event Medal
## Length:206165 Length:206165 Length:206165
## Class :character Class :character Class :character
## Mode :character Mode :character Mode :character
##
##
## - Resumen de imputación con media:
summary(datos_imputados_media[,c("Age", "Height", "Weight")])## Age Height Weight
## Min. :10.00 Min. :127.0 Min. : 25.0
## 1st Qu.:22.00 1st Qu.:170.0 1st Qu.: 63.0
## Median :25.00 Median :175.3 Median : 70.7
## Mean :25.56 Mean :175.3 Mean : 70.7
## 3rd Qu.:28.00 3rd Qu.:180.0 3rd Qu.: 75.0
## Max. :97.00 Max. :226.0 Max. :214.0- Resumen de imputación con mediana:
summary(datos_imputados_mediana[,c("Age", "Height", "Weight")])## Age Height Weight
## Min. :10.0 Min. :127.0 Min. : 25.00
## 1st Qu.:22.0 1st Qu.:170.0 1st Qu.: 63.00
## Median :24.0 Median :175.0 Median : 70.00
## Mean :25.5 Mean :175.3 Mean : 70.54
## 3rd Qu.:28.0 3rd Qu.:180.0 3rd Qu.: 75.00
## Max. :97.0 Max. :226.0 Max. :214.00- Resumen de imputación con cero:
summary(datos_imputados_cero[,c("Age", "Height", "Weight")])## Age Height Weight
## Min. : 0.00 Min. : 0.0 Min. : 0.00
## 1st Qu.:21.00 1st Qu.:157.0 1st Qu.: 47.00
## Median :24.00 Median :171.0 Median : 64.00
## Mean :24.66 Mean :136.4 Mean : 54.31
## 3rd Qu.:28.00 3rd Qu.:180.0 3rd Qu.: 75.00
## Max. :97.00 Max. :226.0 Max. :214.00- ¿Cuál opción es la mejor?
Definitivamente reemplazar por cero no es la mejor opción. Se observa del anterior resultado que la media disminuye considerablemente. Se observa que la mediana es la mejor opción porque preserva la distribución de los datos. Por ejemplo la edad tiene la media menor que la mediana sin imputar los datos (evidencia que hay sesgo a la izquierda). Cuando se imputa por la mediana continúa esta relación, mientras que por la media se destruye esta relación.
Ejercicio 5
Con la librería tidyverse, el operador %>% y las funciones filter() y ggplot () realizar un análisis descriptivo del dataset seleccionado en el numeral 4 considerando:
- La combinación de tres (3) variables entre si
library(tidyverse)
library(ggplot2)
library(GGally)
library(plotly)ggpairs(datos_imputados_mediana %>% select("Age", "Weight", "Height"))
- 4 variables
ggpairs(datos_imputados_mediana, columns=c("Age", "Weight", "Height"),
ggplot2::aes(colour=Sex))
ggpairs(datos_imputados_mediana, columns=c("Age", "Weight", "Height"),
ggplot2::aes(colour=Season))
p=ggplot(datos_imputados_mediana, aes(y=Age, col=Sex))+
geom_boxplot()+
ggtitle("Boxplot- Edad de los atletas")
ggplotly(p)En el anterior gráfico se visualizan lo siguiente
- Hay varios datos atípicos tanto para Femenino como masculino según los datos hay deportistas que tenian 97, 96 años
- Hay una pequeña diferencia en las medianas Para el sexo masculino es de 25 años y para el femenino es de 23 años
p1=ggplot(datos_imputados_mediana, aes(y=Height, col=Sex))+
geom_boxplot()+
ggtitle("Boxplot- Altura de los atletas")
ggplotly(p1)df1=datos_imputados_mediana %>% group_by(Year) %>% summarize(mediaAge=mean(Age))ggplot(data = df1,aes(x=Year, y=mediaAge)) +
geom_line(color = "steelblue", size = 1) +
geom_point(color = "red") +
ggtitle("Edad Media a traves de los años")
df2=datos_imputados_mediana %>% group_by(Year, Season) %>% summarize(meanHeight=mean(Height))ggplot(data = df2,aes(x=Year, y=meanHeight)) +
geom_line(color = "steelblue", size = 1) +
geom_point(color = "steelblue") +
facet_wrap(~Season)+
ggtitle("Edad Media a traves de los años")
df3=datos_imputados_mediana %>% group_by(Year, Season) %>%
summarise(participantes=table(Year))
df3## # A tibble: 51 x 3
## # Groups: Year [35]
## Year Season participantes
## <int> <chr> <table>
## 1 1896 Summer 380
## 2 1900 Summer 1936
## 3 1904 Summer 1301
## 4 1906 Summer 1733
## 5 1908 Summer 3101
## 6 1912 Summer 4040
## 7 1920 Summer 4292
## 8 1924 Summer 5233
## 9 1924 Winter 460
## 10 1928 Summer 4992
## # ... with 41 more rowsll=ggplot(df3, aes(Year, participantes, col=Season))+
geom_line()+
ggtitle("Particantes en las oLimpiadas a través del tiempo")+
labs(x="Año", y="No Participantes")
ggplotly(ll)- En el anterior gráfico se observa que a medido que transcurren los años ha ido aumentando el número de participantes en las olimpiadas tanto de verano como de invierno
Colombia
Colombia=datos_imputados_mediana %>% filter(NOC=="COL") %>% group_by(Year, Sex, Season) %>%
summarize(Participantes=table(Year))par=ggplot(Colombia, aes(x=Year, Participantes, col=Sex))+
geom_point()+
ggtitle("Participante de Colombia Por genero 1900-2016")
ggplotly(par)Cantidad de medallas
df4=datos_imputados_mediana %>% group_by(NOC, Medal) %>% summarize(medallas=table(Medal))
df5=df4 %>% filter(Medal=="Gold") %>% arrange(desc(medallas))
df6=df5[1:10,]
df6$NOC<-factor(df6$NOC,levels = df6$NOC)
levels(df6$NOC)## [1] "USA" "URS" "GER" "GBR" "ITA" "FRA" "SWE" "CAN" "HUN" "GDR"or=ggplot(df6, aes(x=NOC, y=medallas))+
geom_bar(stat = "identity", fill="steelblue")+
ggtitle("Los 10 países con más Medallas de Oro acumuladas")
ggplotly(or)## Don't know how to automatically pick scale for object of type table. Defaulting to continuous.