Previsão UFC

Objetivo
Variaveis a serem usadas
Base de dados
Análise Exploratória
Os maiores ganham mais?
Selecionando Variáveis
Modelagem
- Logístico
- Confusion Matrix

Objetivo

Esse projeto tem como objetivo prever ganhadores/perdedores do UFC usando Regressão Logística e Knn.

Variaveis a serem usadas

R_Fighter and B_Fighter
Referee
date
location
Winner
Height_cms
Reach_cms
Weight_lbs
age
current_lose_streak
current_win_streak
draw
wins
losses

Base de dados

A base de dados está disponibilizada no kaggle, você pode baixa - la aqui

library(tidyverse)
library(gghighlight)
library(ggthemes)
library(DT)

# Definindo diretório

setwd("/cloud/project/UFC")

# Importando dados

df1 <- read_csv("data.csv")

# Visualizando

datatable(head(df1,10))

Análise Exploratória

Primeiro iremos analisar alguns dados por pura curiosidade :)

Qual lado do ring tem mais vitórias?

## Qual lado do Ring tem mais vitórias

df1 %>%
  count(Winner,name = "Total") %>%
  ggplot(aes(reorder(Winner,Total),Total,fill = Winner)) +
  geom_bar(stat = "identity") +
  gghighlight(Winner == "Red") +
  theme_fivethirtyeight()

Não se sabe muito bem a causa, mas os lutadores da cor vermelha são os mais vitóriosos no UFC

Quais juizes mais apitaram

df1 %>%
  count(Referee,name = "Total") %>%
  arrange(desc(Total)) %>%
  slice(1:10) %>%
  ggplot(aes(reorder(Referee,Total),Total)) +
  geom_bar(stat = "identity") +
  coord_flip()  +
  theme_fivethirtyeight() +
  gghighlight(Referee == "Herb Dean")

O árbitro Herb Dean, na qual ja até foi Lutador, foi o que mais apitou lutas até o momento. Você pode saber um pouco mais de sua carreia clicando aqui

Número de eventos por ano

library(lubridate)

df1$Ano <- year(df1$date) %>% as.numeric()

df1 %>% 
  count(Ano,name = "Total") %>%
  ggplot(aes(Ano,Total)) +
  geom_bar(stat = "identity") +
  scale_x_continuous(breaks = seq(from = 1993,to = 2019,by = 5)) +
  gghighlight(Ano == 2014)

Nós podemos ver o grande crescimento do evento a partir ano de 2006, na qual chegou no recorde de eventos em um mesmo ano em 2014.

Lugares com maior número de eventos

### Criando novas colunas

lugares <- df1 %>%
  select(location) %>%
  separate(location,c("Cidade","Estado","Pais"),sep = ",")

### Preenchendo coluna paises 

lugares <- lugares %>% 
  mutate(Pais = ifelse(is.na(Pais) == T,Estado,Pais))

### Contando o numero de eventos por país

lugares <- lugares %>% 
  count(Pais,name = "Total") %>%
  arrange(desc(Total)) 


# Removendo espaços e branco
lugares$Pais <- str_trim(lugares$Pais)


library(highcharter)  

# Renomeando EUA
lugares[1,1] <- "United States of America"

# Fazendo mapa
hcmap(map = "custom/world",data = lugares,
      value = "Total",joinBy = c("name","Pais"))

O centro mundial de eventos do UFC claramente seria no país de origem. Os EUA lideram com folga o número de eventos realizados seguidos por Brasil e Canadá.

Lutadores com mais vitórias

## Criando coluna de vencedores
df2 <- df1 %>% mutate(name_winner = case_when(Winner == "Red" ~ R_fighter,
                                       Winner == "Blue" ~ B_fighter,
                                       Winner == "Draw" ~ "Empate"))

## Maior vencedor de todos os tempos

df2 %>% count(name_winner,name = "Total") %>%
  arrange(desc(Total)) %>%
  filter(name_winner != "Empate") %>%
  slice(1:10) %>%
  ggplot(aes(reorder(name_winner,Total),Total)) +
  geom_bar(stat = "identity") +
  coord_flip() +
  theme_fivethirtyeight() +
  gghighlight(name_winner == "Donald Cerrone")

O americano Donald Cerrone leva até agora o título de maior vencedor do UFC.

Distribuição de idade dos lutadores

df1 %>% select(B_age,R_age) %>%
  unite("Age",B_age:R_age,sep = ",") %>%
  separate_rows(Age,convert = T) %>%
  ggplot(aes(x = Age)) +
  geom_histogram() +
  theme_fivethirtyeight() +
  scale_x_continuous(breaks = seq(from = 15, to = 50,by = 5)) +
  gghighlight(Age %in% 28:29)

Esse gráfico nos mostra que a maioria dos lutadores do UFC situam - se na faixa de 28 a 29 anos de idade. É interessante notar que essa faixa de idade se destoa das demais, o que é um caso interessante a se analisar futuramente.

Os maiores ganham mais?

Nesta secção iremos levar em consideração três atributos importantes de um lutador:

Sua Altura
Seu Peso
Seu Span (Envergadura)

E iremos analisar se os maiores em cada variavel levam vantagem nas lutas.

Exemplificando: Iremos contar o total das lutas na qual os mais altos venceram e comparar com o total na qual os mais baixos venceram. Isso se repete para peso e span.

Comparando Alturas

df1 %>% mutate(Maior = ifelse(R_Height_cms > B_Height_cms,"Red","Blue"),
               Altura = ifelse(Winner == Maior,"Maior","Menor")) %>%
  count(Altura,name = 'Total') %>% na.omit() %>%
  mutate(Prop = (Total/sum(Total)*100)) %>%
  datatable()

Podemos ver que os baixinhos levam uma pequena vantagem em relação aos maiores no histórico do UFC, na qual venceram em 52% das vezes.

Comparando Pesos

df1 %>% mutate(Maior = ifelse(R_Weight_lbs > B_Weight_lbs,"Red","Blue"),
               Peso = ifelse(Winner == Maior,"Maior","Menor")) %>%
  count(Peso,name = 'Total') %>% na.omit() %>%
  mutate(Prop = (Total/sum(Total)*100)) %>%
  datatable()

Aqui os mais Menores ou se você quiser chamar de mais Magros levam um pouco mais de vantagem em relação aos Maiores ou mais Gordos

Comparando Spans

df1 %>% mutate(Maior = ifelse(R_Reach_cms > B_Reach_cms,"Red","Blue"),
               Span = ifelse(Winner == Maior,"Maior","Menor")) %>%
  count(Span,name = 'Total') %>% na.omit() %>%
  mutate(Prop = (Total/sum(Total)*100)) %>%
  datatable()

Aqui há quase um empate técnico. Ou seja, me parece que a envergadura não faz muita diferença na hora da luta.

Selecionando Variáveis

As últimas três perguntas foram interessantes para saber se essas variaveis davam algum indicativo para saber quem teria mais chances de ganhar uma luta. Porém era algo ainda muito cru, digamos. Por isso resolvi testar essas hipóteses desenvolvendo um modelo de regressão logística, na qual vai ser baseado na diferença entre essas variaveis para cada lutador. Vejamos um exemplo para alguma luta:

Lutador 1: Peso = 10,Altura = 20, Span = 30, idade = 25 Lutador 2: Peso = 20,Altura = 15, Span = 30, idade = 30

Logo nossos dados de entrada para o nosso modelo fircaria:

Lutador 1: Diferença do Peso: - 10, Diferença da Altura = + 5, Diferença do Span = 0, idade = -5 Lutador 2: Diferença do Peso: + 10, Diferença da Altura = - 5, Diferença do Span = 0, idade = +5

Ainda adicionaremos também sequencias de vitória e derrota, mas não iremos modificá - las.

Todo o processo de trasnformação e selecão está exposto abaixo

Selecionando Colunas

Primeiro iremos selecionar as colunas na qual iremos trabalhar. Ainda não selecionaremos os dados das sequencias de vitória e derrota.

dados <- df1 %>% 
  filter(Winner != "Draw") %>%
  mutate(Red = ifelse(Winner == "Red","Vencedor","Perdedor"),
         Blue = ifelse(Winner == "Blue","Vencedor","Perdedor")) %>%
      select(R_age,B_age,
               R_Weight_lbs,B_Weight_lbs,
               R_Height_cms,B_Height_cms,
               R_Reach_cms,B_Reach_cms,
               Red,Blue)

Tirando diferenças entre as variaveis

Agora iremos tirar as diferenças entre as variáveis preditoras dos lutadores para cada luta realizada.

dados <- dados %>%
  mutate(Idade = R_age - B_age,
         Peso = R_Weight_lbs - B_Weight_lbs,
         Altura = R_Height_cms - B_Height_cms,
         Span = R_Reach_cms - B_Reach_cms) %>%
  select(Idade,Peso,Altura,Span,Red,Blue) %>%
  unite("Resultado",Red,Blue) %>%
  separate_rows(Resultado) %>%
  rowid_to_column(var = "Indice")

Espelhamento

Como a diferença das variaveis dos lutadores são simétricas, iremos utilizar esse pequeno hack para completar o dataframe.

dados <-  dados  %>%
  mutate(Idade = ifelse(Indice %% 2 == 0,-Idade,Idade),
         Peso = ifelse(Indice %% 2 == 0,-Peso,Peso),
         Altura = ifelse(Indice %% 2 == 0,-Altura,Altura),
         Span = ifelse(Indice %% 2 == 0,-Span,Span),
         Resultado = as.factor(ifelse(Resultado == "Vencedor",1,0)))

Pegando dados de sequencia

Pegaremos agora os dados de sequencia de vitórias e derrotas que não foram processados.

sequencias <- df1 %>%
  select(R_current_win_streak,B_current_win_streak,
         R_current_lose_streak,B_current_lose_streak) %>%
  unite("Seq_Vitoria",R_current_win_streak:B_current_win_streak) %>%
  unite("Seq_Derrota",R_current_lose_streak:B_current_lose_streak) %>%
  separate_rows(Seq_Vitoria,Seq_Derrota) %>%
  rowid_to_column(var = "Indice")

Join das tabelas

Agora iremos juntar os dados da sequencia com os dados das variaveis que tinhamos calculado as diferenças

dados <- left_join(dados,sequencias,by = "Indice")

Transformando dados

Transformando os dados de sequencia que eram strings para numerics

dados$Seq_Vitoria <- as.numeric(dados$Seq_Vitoria)
dados$Seq_Derrota <- as.numeric(dados$Seq_Derrota)

Tirando coluna de indice

dados <- dados %>%
  select(-Indice)

Removendo missing values

Alguns valores missing apareceram com a transformação dos dados. Optamos por tirar as linhas que continham - os.

dados <- dados %>% na.omit()

Fazendo spliting dos dados

Com os dados prontos, iremos divi-los em dados de treino e dados de teste para utiliza-los no modelo logístico.

library(caret)
y = createDataPartition(dados$Resultado, p = 0.80, list = FALSE)

Teste = dados[-y, ]
Treino = dados[y, ]

Modelagem

O modelo logístico é um modelo de classificação, ou seja, ele nos fornece respostas binárias como Sim ou Não, e isso é exatamente o que queremos, saber se um lutador vence ou não vence.

Logístico

# Criando o modelo

logistico_1 = train(Resultado ~ .,data = Treino,method = "glm",family = "binomial")


# Vendo o modelo

summary(logistico_1)


Call:
NULL

Deviance Residuals: 
     Min        1Q    Median        3Q       Max  
-1.74293  -1.15072  -0.05862   1.15419   1.73536  

Coefficients:
             Estimate Std. Error z value Pr(>|z|)    
(Intercept) -0.118020   0.038063  -3.101 0.001931 ** 
Idade       -0.054677   0.004854 -11.265  < 2e-16 ***
Peso         0.012217   0.002292   5.330 9.84e-08 ***
Altura      -0.014964   0.005094  -2.938 0.003306 ** 
Span         0.014862   0.003900   3.811 0.000138 ***
Seq_Vitoria  0.063231   0.018392   3.438 0.000586 ***
Seq_Derrota  0.109547   0.033867   3.235 0.001218 ** 
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 9587.6  on 6915  degrees of freedom
Residual deviance: 9385.4  on 6909  degrees of freedom
AIC: 9399.4

Number of Fisher Scoring iterations: 4

Apenas as variaveis Idade,Altura e Span foram significativas, porém como queremos prever e não inferir, iremos manter todas as variaveis no modelo.

Confusion Matrix

# Predizendo com o modelo

confusionMatrix(logistico_1)

Bootstrapped (25 reps) Confusion Matrix 

(entries are percentual average cell counts across resamples)
 
          Reference
Prediction    0    1
         0 28.2 22.2
         1 21.7 27.8
                            
 Accuracy (average) : 0.5609

O modelo gerado tem acurácia de 56%, ou seja, é um pouco melhor do que jogar uma moeda para cima e dizer quem vai vencer uma luta. No futuro, há de se usar outras variaveis e modelos que se adequem melhor a esse projeto. Por enquanto, vou vendo um pouco mais de UFC para tentar saber o que faz alguém ganhar uma luta!