NorbertoP7
commented
2 years ago Agrego una nueva variable al ciclo for y un condicional mas para un modelo de regresion logistica, considarando empates y luego elimnandolos para ver como mejora el modelo
dif_goles <- c();avgU <- NULL;avgO<- NULL; w<- NULL;l <- NULL;e<- NULL for (i in 1:3800) { if(data$home.score[i] > data$away.score[i]) { tw[i] = data$home.team[i] tl[i] = data$away.team[i] w[i] = data$home.score[i] l[i] = data$away.score[i] dif_goles[i] = data$home.score[i] - data$away.score[i] ca[i] = 1 avgO[i] = data$Avg.2.5.O[i]; avgU[i] = data$Avg.2.5.U[i] e[i] = 0 } else if(scores$home.score[i] < scores$away.score[i]) { tl[i] = scores$home.team[i] tw[i] = scores$away.team[i] w[i] = scores$away.score[i] l[i] = scores$home.score[i] dif_goles[i] = scores$away.score[i]-scores$home.score[i] ca[i] = 0 avgO[i] = data$Avg.2.5.O[i]; avgU[i] = data$Avg.2.5.U[i] e[i] = 0 } else if(scores$home.score[i] == scores$away.score[i]) { ca[i] = 0 e[i] = 1 dif_goles[i] = 0 } }
logic <- data.frame(ca,dif_goles,e) logic2 <- subset(logic, e!= 1) home_away <- glm(ca ~ dif_goles, data=logic, family = "binomial") #Ca #Dif en goles. Logistic Model summary(home_away) #El modelo mejora considerablemente cuando eliminamos los empates.
Entre menor sea el AIC, NULL Deviance y Residual Dev, mejor el modelo
AIC 3775 #Sin Empates
NULL 3809
Res 3771
AIC 4547 #Con Empates
Null 5259
Res 4543
ggplot(logic, aes(x=dif_goles,y=ca))+ geom_point(alpha=.2)+ geom_smooth(method = "glm", method.args=list(family="binomial"))+ labs( title="R. Logistica ~ Con Empates", x = "Dif En Goles", y = "Probabilidad de ganar en Casa" )
ggplot(logic2, aes(x=dif_goles,y=ca))+ geom_point(alpha=.2)+ geom_smooth(method = "glm", method.args=list(family="binomial"))+ labs( title="R. Logistica ~ Sin Empates", x = "Dif En Goles", y = "Probabilidad de ganar en Casa" )
ca <- c() #Casa / Away; tw <- c() #Team that Won tl <- c() #Team that lost dif_goles <- c();avgU <- NULL;avgO<- NULL; w<- NULL;l <- NULL for (i in 1:3800) { if(data$home.score[i] > data$away.score[i]) { tw[i] = data$home.team[i] tl[i] = data$away.team[i] w[i] = data$home.score[i] l[i] = data$away.score[i] dif_goles[i] = data$home.score[i] - data$away.score[i] ca[i] = 1 avgO[i] = data$Avg.2.5.O[i]; avgU[i] = data$Avg.2.5.U[i] } else if(scores$home.score[i] < scores$away.score[i]) { tl[i] = scores$home.team[i] tw[i] = scores$away.team[i] w[i] = scores$away.score[i] l[i] = scores$home.score[i] dif_goles[i] = scores$away.score[i]-scores$home.score[i] ca[i] = 0 avgO[i] = data$Avg.2.5.O[i]; avgU[i] = data$Avg.2.5.U[i] } } winner <- data.frame(team=tw,w,avgO,avgU) #Datos de partidos ganados losser <- data.frame(team=tl,l,avgO,avgU) #Datos de partidos perdidos winner <- winner %>% drop_na(team) losser <- losser %>% drop_na(team) winner <- winner %>% group_by(team) %>% summarise(avg_gw = mean(w),avgUw = mean(avgU), avgOw=mean(avgO), g = n()) losser <- losser %>% group_by(team) %>% summarise(avg_gl = mean(l),avgUl = mean(avgU), avgOl=mean(avgO), p = n()) dim(losser)#2884
Se hara un cluster analisis para determinar las caracteristicas que conforman
a los equipos ganadores, tanto como perdedores.
wins <- data.frame(winner[,-c(1)]) wkc <- kclustering(wins) loses <- data.frame(losser[,-c(1)]) lkc <- kclustering(loses)
Graficos para determinar la cantidad de clusters a usar
plot(wkc) plot(lkc)
En base a las graficas se toma la decision de hacerlo por 6 clusters
La linea azul presente en el grafico, es el rendimiento general de todos los equipos.
La roja indica que tan bien/mal lo hace un grupo.
lkc2 <- kclustering(loses,k=6,labels = losser$team) plot(lkc2,profiles =T)
wkc2 <- kclustering(wins,k=6,labels = winner$team) plot(wkc2, profiles =T)
De estos graficos se observa que tanto el barcelona como el real madrid
Son los que presentan diferecias mas remarcadas.
lhc <- hclustering(loses,k=6,labels = losser$team) plot(lhc, rect = T, colored.branches = T)
whc <- hclustering(wins,k=6,labels = winner$team) plot(whc, rect = T, colored.branches = T)
Se unen los datos para determinar a los mejores equipos.
wls <- inner_join(winner,losser, by ="team") wls <- mutate(wls, win_rate = g/(p+g)) wls %>% arrange(desc(win_rate)) wls2 <- data.frame(wls[,-c(1)]) wlkc <- kclustering(wls2) plot(wlkc)
Con 6 clusters se observa que los clusters mas explosivos estan conformados por
El numero 1 y el numero 3, donde p (perdidos) es menor al promedio,
g(ganados) es mayor al promedio asi como win rate.
En base a este analisis se puede determinar, quienes pueden ganar el campeonato
La siguiente temporada.
wlkc2 <- kclustering(wls2,k=6,labels = wls$team) plot(wlkc2,profiles =T)
Aqui podemos observar de forma mas clara quienes conforman cada cluster, donde
aquellos grupos que se unen mas pronto presentan mas similitudes que aquellos
que se integran mas tarde.
Por ejemplo, en este caso, el cluster 5 es el ultimo en agruparse
Mientras que el cluster 4 y 3 se unen primero.
wlhc <- hclustering(wls2,k=6,labels = wls$team) plot(wlhc, rect = T, colored.branches = T)