RED
16/8/2019
En el taller de Estadística Deportiva utilizando R vamos a hacer un análisis exploratorio de datos de la Liga Pro 2019.
Los datos son obtenidos de un servicio proporcionado por la empresa Datafactory contratado por el programa deportivo TRIBUNA ELECTRICA www.tribunaelectrica.com
http://tribunaelectrica.datafactory.la/xml/es/ecuador/deportes.futbol.ecuador.posiciones.xml
Nassib Nehme nos llamó y nos dijo que necesita un científico de datos para ayudarlo al ténico a ganar el campeonato.
Y por supuesto nosotros le dijimos manos a la obra
Cargar las librerías
#Ficha de los jugadoresxEquipo
jugadores <- read_excel("DATA/jugadores.xlsx",
col_types = c("text", "text", "numeric",
"text", "text", "text", "text", "numeric",
"numeric", "numeric", "text", "text",
"text", "numeric", "text", "text",
"text", "text", "text", "numeric",
"numeric", "text", "text", "text",
"text"))
#Descripción del rol en la cancha
rol <- read_excel("DATA/rol.xlsx", col_types = c("text",
"text"))
#Tabla de País
pais <- read_excel("DATA/pais.xlsx", col_types = c("text","text"))
#Tabla de Equipo
equipo <- read_excel("DATA/equipo.xlsx",
col_types = c("text", "text", "text"))
#tota de goles marcados por jugador, por Equipo, por tipo
golesTotal <- read_excel("DATA/golesTotal.xlsx",
col_types = c("text", "text", "text",
"text", "numeric","numeric","numeric","numeric", "numeric", "text", "text"))
#Tabla de Posiciones
posiciones23 <- read_excel("DATA/posiciones23.xlsx",
col_types = c("text", "numeric", "text",
"numeric", "numeric", "numeric",
"numeric", "numeric", "numeric",
"numeric", "numeric", "numeric",
"numeric", "numeric", "numeric",
"numeric", "numeric", "numeric",
"numeric", "numeric", "numeric",
"numeric", "numeric", "numeric",
"numeric", "numeric", "numeric",
"numeric", "numeric", "numeric",
"numeric", "numeric", "numeric",
"numeric", "numeric"))## # A tibble: 6 x 25
## campeonato idEquipo JugadoresActivos IdJugador NombreJugador
## <chr> <chr> <dbl> <chr> <chr>
## 1 Ecuador -~ 5615 40 113835 Jhonner Joel
## 2 Ecuador -~ 112 38 86063 Miguel Enriq~
## 3 Ecuador -~ 112 38 42551 Yilmar Steven
## 4 Ecuador -~ 895 38 24375 Juan Carlos
## 5 Ecuador -~ 895 38 20410 Roberto Mich~
## 6 Ecuador -~ 894 37 56508 Christian An~
## # ... with 20 more variables: ApellidoJugador <chr>,
## # FechaNacimiento <chr>, edad <dbl>, peso <dbl>, altura <dbl>,
## # idRol <chr>, camiseta <chr>, IdPaisJugador <chr>,
## # JugadoresFuera <dbl>, IdJugadorFuera <chr>, NombreJugadorFuera <chr>,
## # ApellidoJugadorFuera <chr>, FechaBaja <chr>,
## # FechaNacimientoJugadorFuera <chr>, PesoJugadorFuera <dbl>,
## # AlturaJugadorFuera <dbl>, IdRolJugadorFuera <chr>,
## # IdPaisJugadorFuera <chr>, IdClubActual <chr>, IdPaisClubActual <chr>
## # A tibble: 6 x 11
## fechaActual idJugador nombreCompleto idEquipo goles jugada cabeza
## <chr> <chr> <chr> <chr> <dbl> <dbl> <dbl>
## 1 20190810 105810 Luis A. Amari~ 894 15 11 4
## 2 20190810 124556 Michael S. Es~ 267 14 11 1
## 3 20190810 46603 Raúl O. Becer~ 91 13 8 1
## 4 20190810 42548 Fidel F. Mart~ 217 12 8 1
## 5 20190810 75517 Bruno L. Vides 894 12 7 0
## 6 20190810 45205 Carlos J. Gar~ 4716 11 6 1
## # ... with 4 more variables: tirolibre <dbl>, penal <dbl>, pais <chr>,
## # idPais <chr>
## # A tibble: 6 x 35
## id orden Nombre puntos jugados jugadoslocal jugadosvisitante ganados
## <chr> <dbl> <chr> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 267 1 Macará 46 21 11 10 13
## 2 894 2 U. Ca~ 44 21 11 10 14
## 3 4716 3 Delfín 40 21 11 10 12
## 4 980 4 Indep~ 39 21 10 11 11
## 5 217 5 Barce~ 36 20 10 10 11
## 6 216 6 Aucas 32 20 10 10 9
## # ... with 27 more variables: empatados <dbl>, perdidos <dbl>,
## # ganadoslocal <dbl>, empatadoslocal <dbl>, perdidoslocal <dbl>,
## # ganadosvisitante <dbl>, empatadosvisitante <dbl>,
## # perdidosvisitante <dbl>, golesfavorlocal <dbl>,
## # golescontralocal <dbl>, golesfavorvisitante <dbl>,
## # golescontravisitante <dbl>, golesfavor <dbl>, golescontra <dbl>,
## # difgol <dbl>, puntoslocal <dbl>, puntosvisitante <dbl>,
## # puntosactual <dbl>, difgolactual <dbl>, am <dbl>, rojas <dbl>,
## # rojaX2am <dbl>, faltasPen <dbl>, manoPen <dbl>, faltasCom <dbl>,
## # faltasRec <dbl>, faltasPenRec <dbl>
En este gráfico vamos a ver un panorama general de las características de los jugadores de la Liga Pro
jugadores %>% select(edad,peso,altura,idRol) %>% filter(idRol !=5) %>%
filter(idRol !=1) %>% ggpairs(mapping = aes(colour = idRol))NJugadores <- merge(x=jugadores,y=equipo)
NJugadores <- NJugadores %>% group_by(Nombre) %>% summarise(JugadoresActivos = n()) %>%
arrange(desc(JugadoresActivos))
p <- ggplot(data = NJugadores,aes(x=reorder(Nombre,-JugadoresActivos),y=JugadoresActivos))
p <- p + geom_bar(stat = "identity",fill="lightgreen")
p <- p + geom_hline(yintercept=as.numeric(summary(NJugadores$JugadoresActivos)[4]), size=1, linetype="solid", color="blue")
p <- p + geom_text(aes(label=JugadoresActivos),size=4,col="white",vjust=2,hjust=0.5)
p <- p + ggtitle("Nomina de Jugadores por Equipo") +
labs(x = "", y = "Total de Jugadores")
p <- p + theme_bw()
p <- p + theme(axis.text.x = element_text(angle = 90, hjust = 1))
pNJugadoresEdad <- merge(x=jugadores,y=equipo)
NJugadoresEdad <- NJugadoresEdad %>% filter(!is.na(edad)) %>%
filter(idRol!=5)
NJugadoresEdad1 <- NJugadoresEdad %>% group_by(Nombre) %>%
summarise(MediaEdad=round(mean(edad)))
p <- ggplot(data = NJugadoresEdad1,aes(x=reorder(Nombre,-MediaEdad),y=MediaEdad))
p <- p + geom_bar(stat = "identity",fill="lightgreen")
p <- p + geom_hline(yintercept=as.numeric(summary(NJugadoresEdad$edad)[4]), size=1, linetype="solid", color="blue") # linetype
p <- p + geom_text(aes(label=MediaEdad),size=4,col="white",vjust=2,hjust=0.5)
p <- p + ggtitle("Edad Media de los Jugadores") +
labs(x = "", y = "Edad(años)")
p <- p + theme_bw()
p <- p + theme(axis.text.x = element_text(angle = 90, hjust = 1,vjust=0.3))
pNJugadoresEdadBox <- merge(x=jugadores,y=equipo)
NJugadoresEdadBox %>% filter(!is.na(edad)) %>%
filter(idRol!=5) %>% select(Nombre,edad) %>%
ggplot(aes(x=Nombre,y=edad, fill=Nombre)) +
geom_boxplot() + geom_jitter(width=0.1,alpha=0.2) +
theme(axis.text.x = element_text(angle = 90, hjust = 1,vjust=0.3))+
ggtitle("Edades de los jugadores") +
labs(x = "", y = "Edad(años)")NJugadoresEdad %>%
ggplot(aes(edad)) +
geom_histogram(breaks=seq(min(NJugadoresEdad$edad),max(NJugadoresEdad$edad),by=1),
col="red",
fill="green",
alpha = .2) +
labs(title="Histograma para Edad") +
labs(x="Edad(años)", y="Cantidad de jugadores") +
theme_bw() +
theme(axis.text.x = element_text(hjust = 1,vjust=0.3,size=10)) +
scale_y_continuous(breaks = seq(1,50,3))#BoxPlot Altura por Equitpo
NJugadoresAlturaBox <- merge(x=jugadores,y=equipo)
NJugadoresAlturaBox %>% filter(!is.na(altura)) %>%
filter(idRol!=5) %>% select(Nombre,altura) %>%
ggplot(aes(x=Nombre,y=altura, fill=Nombre)) +
geom_boxplot() + geom_jitter(width=0.1,alpha=0.2) +
theme(axis.text.x = element_text(angle = 90, hjust = 1,vjust=0.3))+
ggtitle("Altura de los jugadores") +
labs(x = "", y = "Altura (cm) de los jugadores")NJugadoresAlturaBox %>%filter(!is.na(altura)) %>%
filter(idRol!=5) %>%
group_by(Nombre) %>%
summarise(MediaAltura=round(mean(altura))) %>%
ggplot(aes(x=reorder(Nombre,-MediaAltura),y=MediaAltura)) +
geom_bar(stat = "identity",fill="lightgreen") +
geom_hline(yintercept=as.numeric(summary(NJugadoresAlturaBox$altura)[4]), size=1, linetype="solid", color="blue")+ # linetype
geom_text(aes(label=MediaAltura),size=4,col="white",vjust=2,hjust=0.5) +
ggtitle("Altura Promedio de los Jugadores") + labs(x = "", y = "Altura(cm)") +
theme_bw() +
theme(axis.text.x = element_text(angle = 90, hjust = 1,vjust=0.3))NJugadoresAlturaBox %>%filter(!is.na(altura)) %>% filter(idRol!=5) %>%
ggplot(aes(altura)) +
geom_histogram(col="red",
fill="green",
alpha = .2) +
labs(title="Histograma para Altura") +
labs(x="Altura(cm)", y="Cantidad")## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
NJugadoresPesoBox <- merge(x=jugadores,y=equipo)
NJugadoresPesoBox %>% filter(!is.na(peso)) %>%
filter(idRol!=5) %>% select(Nombre,peso) %>%
ggplot(aes(x=Nombre,y=peso, fill=Nombre)) +
geom_boxplot() + geom_jitter(width=0.1,alpha=0.2) +
theme(axis.text.x = element_text(angle = 90, hjust = 1,vjust=0.3))+
labs(title="Diagrama de Cajas Peso por Equipo") +
labs(x="", y="Peso(kg)")NJugadoresPesoBox %>%filter(!is.na(peso)) %>%
filter(idRol!=5) %>%
group_by(Nombre) %>%
summarise(MediaPeso=round(mean(peso))) %>%
ggplot(aes(x=reorder(Nombre,-MediaPeso),y=MediaPeso)) +
geom_bar(stat = "identity",fill="lightgreen") +
geom_hline(yintercept=as.numeric(summary(NJugadoresPesoBox$peso)[4]), size=2, linetype="solid", color="blue")+ # linetype
geom_text(aes(label=MediaPeso),size=4,col="white",vjust=2,hjust=0.5) +
ggtitle("Peso Promedio de los Jugadores") + labs(x = "", y = "Peso(kg)") +
theme_bw() +
theme(axis.text.x = element_text(angle = 90, hjust = 1,vjust=0.3))NJugadoresPesoBox %>%filter(!is.na(peso)) %>% filter(idRol!=5) %>%
ggplot(aes(peso)) +
geom_histogram(col="red",
fill="green",
alpha = .2) +
labs(title="Histograma para Peso") +
labs(x="Peso", y="Cantidad")## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
golesxequipo <- golesTotal %>%select(idEquipo,jugada,cabeza,tirolibre,penal) %>%
group_by(idEquipo) %>% summarise(jugada=sum(jugada),cabeza=sum(cabeza),
tirolibre = sum(tirolibre), penal = sum(penal))
golesxequipo<- merge(x=golesxequipo,y=equipo)
golesxequipo<- golesxequipo %>% select(-idEquipo,-Sigla)
golesxequipo<- gather(golesxequipo,key="tipogol",value = "numero",-Nombre)
p2 <- ggplot(data = golesxequipo,aes(x = Nombre,y=numero,fill=tipogol))
p2 <- p2 + geom_bar(stat = "identity")
p2 <- p2 + geom_text(aes(label=numero),position=position_stack(0.5),size=3,col="white")
p2 <- p2 + ggtitle("Tipo de gol por equipo") +
labs(x = "Equipos", y = "Total de Goles")
p2 <- p2 + theme_bw() +
theme(plot.title = element_text(size = 15),
axis.title.x = element_text(size = 12),
axis.title.y = element_text(size = 12),
axis.text.x = element_text(angle = 90, hjust = 1,vjust=0.3))
p2Goles <- merge(x=jugadores,y=equipo)
GolesxEdad <- Goles %>% select(IdJugador,edad,idRol,IdPaisJugador,Nombre) %>%
filter(idRol !=5) %>% filter(!is.na(edad))
names(GolesxEdad)[names(GolesxEdad) == "IdJugador"] <- "idJugador"
GolesxEdad <- merge(x = GolesxEdad,y=golesTotal)
ggplot(GolesxEdad, aes(x=goles, y=edad,color=idRol,shape=idRol)) +
geom_point() + labs(title="Goles por Edad y Posición",
x="# Goles", y = "Edad")+
theme_gray()+
geom_hline(yintercept=as.numeric(summary(GolesxEdad$edad)[4]), size=2, linetype="solid", color="blue") +
scale_x_continuous(breaks = seq(max(GolesxEdad$goles),
min(GolesxEdad$goles))) +
scale_y_continuous(breaks=seq(max(GolesxEdad$edad),min(GolesxEdad$edad)))GolesxPeso <- Goles %>% select(IdJugador,peso,idRol,IdPaisJugador,Nombre) %>%
filter(idRol !=5) %>% filter(!is.na(peso))
names(GolesxPeso)[names(GolesxPeso) == "IdJugador"] <- "idJugador"
GolesxPeso <- merge(x = GolesxPeso,y=golesTotal)
ggplot(GolesxPeso, aes(x=goles, y=peso,color=idRol,shape=idRol)) +
geom_point() + labs(title="Goles por Peso y Posición",
x="# Goles", y = "Peso")+
theme_gray()+
geom_hline(yintercept=as.numeric(summary(GolesxPeso$peso)[4]), size=2, linetype="solid", color="blue") +
scale_x_continuous(breaks = seq(max(GolesxPeso$goles),
min(GolesxPeso$goles)))GolesxAltura <- Goles %>% select(IdJugador,altura,idRol,IdPaisJugador,Nombre) %>%
filter(idRol !=5) %>% filter(!is.na(altura))
names(GolesxAltura)[names(GolesxAltura) == "IdJugador"] <- "idJugador"
GolesxAltura <- merge(x = GolesxAltura,y=golesTotal)
ggplot(GolesxAltura, aes(x=goles, y=altura,color=idRol,shape=idRol)) +
geom_point() + labs(title="Goles por Altura y Posición en la cancha",
x="Número de Goles", y = "Altura (cm)")+
theme_gray()+
geom_hline(yintercept=as.numeric(summary(GolesxAltura$altura)[4]), size=2, linetype="solid", color="blue") +
scale_x_continuous(breaks = seq(max(GolesxAltura$goles),
min(GolesxAltura$goles)))GolesxPais <- golesTotal %>% filter(pais !="Ecuador") %>% group_by(pais) %>%
summarise(TotalGoles=sum(goles), TotalJugada = sum(jugada),TotalCabeza = sum(cabeza),TotalLibre = sum(tirolibre),TotalPenal=sum(penal)) %>% arrange(TotalGoles)
GolesxPais <- GolesxPais %>% select(-TotalGoles) %>% gather(key="TipoGol",value = "numero",-pais)
p2 <- ggplot(data = GolesxPais,aes(x = pais,y=numero,fill=TipoGol))
p2 <- p2 + geom_bar(stat = "identity")
p2 <- p2 + geom_text(aes(label=numero),position=position_stack(0.5),size=3,col="white")
p2 <- p2 + ggtitle("Tipo de gol por Pais") + coord_flip() +
labs(x = "Pais", y = "Total de Goles") + facet_wrap(TipoGol ~. , scales="free")
p2 <- p2 + theme_bw() +
theme(plot.title = element_text(size = 15),
axis.title.x = element_text(size = 12),
axis.title.y = element_text(size = 12),
axis.text.x = element_text(angle = 90, hjust = 1,vjust=0.3))
p2GolesxEcuador <- golesTotal %>% group_by(pais) %>%
summarise(TotalGoles=sum(goles), TotalJugada = sum(jugada),TotalCabeza = sum(cabeza),TotalLibre = sum(tirolibre),TotalPenal=sum(penal)) %>% arrange(TotalGoles)
GolesxEcuador <- GolesxEcuador %>% select(-TotalGoles) %>% filter(pais=="Ecuador") %>% gather(key="TipoGol",value = "numero",-pais)
p2 <- ggplot(data = GolesxEcuador,aes(x = pais,y=numero,fill=TipoGol))
p2 <- p2 + geom_bar(stat = "identity")
p2 <- p2 + geom_text(aes(label=numero),position=position_stack(0.5),size=3,col="white")
p2 <- p2 + ggtitle("Tipo de gol por Pais") + coord_flip() +
labs(x = "Pais", y = "Total de Goles") + facet_wrap(TipoGol ~. , scales="free")
p2 <- p2 + theme_bw() +
theme(plot.title = element_text(size = 15),
axis.title.x = element_text(size = 12),
axis.title.y = element_text(size = 12),
axis.text.x = element_text(angle = 90, hjust = 1,vjust=0.3))
p2