Estadísticas Deportivas en R

RED

16/8/2019

Introducción

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

Puntos a Tratar

Formato Original del archivo

http://tribunaelectrica.datafactory.la/xml/es/ecuador/deportes.futbol.ecuador.posiciones.xml

Proceso de Transformación

Emelec nos contrató para Analizar los datos d la Liga Pro 2019

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

¿ Qué hacemos primero ?

Cargar las librerías

library(dplyr)
library(ggplot2)
library(magrittr)
library(tidyr)
library(purrr)
library(factoextra)
library(readxl)
library(fmsb)
library(plotly)
library(GGally)

Luego importamos los datos

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

Revisamos la información que tenemos en las bases

head(jugadores)
## # 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>
head(golesTotal)
## # 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>
head(posiciones23)
## # 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>

Ahora si venga Rescalvo le voy a contar que sucede en la Liga Pro

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

Y si hacemos un análisis más profundo

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

Edad Promedio de los jugadores por Equipo

NJugadoresEdad <- 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))
p

Gráfico de Cajas ( BOXPLOT ) por edad de los jugadores de los equipo

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

Histograma de Edad

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

Ahora vamos a analizar la altura de los jugadores

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

Gráfico de Barras de la Media de Altura por Equipo

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

Histograma de la altura

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`.

BoxPlot Peso por Equipo

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

Gráfico de Barras de la Media de Peso por Equipo

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

Histograma del Peso

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`.

Grafico Barras Apilado tipo Goles

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

p2

Edad de los jugadores vs goles

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

Relación entre el peso de los jugadores y los goles anotados

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

Relación entre la altura de los jugadores y goles convertidos

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

Total de Goles Anotados por la nacionalidad de los jugadores

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

p2

Total de Goles Anotados por Ecuatorianos

GolesxEcuador <- 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