Seminário2 - Machine Learning

Introdução

O conjunto de dados de jogadores de futebol do jogo fifa 24 desenvolvido pela famosa empresa EA SPORTS é uma coleção abrangente de informações sobre jogadores de futebol de todo o mundo. Este conjunto de dados oferece uma riqueza de atributos relacionados a cada jogador, tornando-o um recurso valioso para diversas análises e insights sobre o mundo do futebol, tanto para entusiastas de jogos quanto para entusiastas de esportes do mundo real.

What’s the purpose/ Qual o nosso objetivo???

O objetivo é encontrar padrões de comportamento nos jogadores brasileiros do fifa 24 da EA SPORTS e encontrar o melhor modelo que possa fazer uma boa predição do salário em dolár deles.

Quais variáveis foram escolhidas???

No banco original tinha 41 variáveis e 5682 linhas que correspondem aos diferentes jogadores mas resolvemos fazer a análise com apenas 223 jogadores brasileiros do fifa 24 e as 29 variáveis que seguem:

Height: The height of the player in centimeters.
Weight: The weight of the player in kilograms.
Age: The age of the player.
Ball Control: Player’s skill in controlling the ball.
Dribbling: Player’s dribbling ability.
Slide Tackle: Player’s ability to perform slide tackles.
Stand Tackle: Player’s ability to perform standing tackles.
Aggression: Player’s aggression level.
Reactions: Player’s reaction time.
Attacking Position: Player’s positioning for attacking plays.
Interceptions: Player’s skill in intercepting passes.
Vision: Player’s vision on the field.
Crossing: Player’s ability to deliver crosses.
Short Pass: Player’s short passing accuracy.
Long Pass: Player’s ability in long passing.
Acceleration: Player’s acceleration on the field.
Stamina: Player’s stamina level.
Strength: Player’s physical strength.
Sprint Speed: Player’s speed in sprints.
Agility: Player’s agility in maneuvering.
Jumping: Player’s jumping ability.
Heading: Player’s heading skills.
Shot Power: Player’s power in shooting.
Finishing: Player’s finishing skills.
Long Shots: Player’s ability to make long-range shots.
Curve: Player’s ability to curve the ball.
Penalties: Player’s penalty-taking skills.
Volleys: Player’s volleying skills.
Value: The estimated value of the player in dollars.

Análise Exploratória

Pacotes utilizados

pacman::p_load("tidyverse", "readxl", "glmnet", "psych", "caret", "readxl", "DT", "knitr", "GGally", "ggplot2", "embed", "umap", "ggcorrplot2", "sqldf", "factoextra","Hmisc")

Overview do banco de dados

ourdata = read_excel("fifa_24_brazil.xlsx")
ourdata = data.frame(ourdata)
DT::datatable(ourdata)

Estrutura do banco de dados

str(ourdata)

## 'data.frame':    223 obs. of  29 variables:
##  $ height       : num  172 177 182 172 186 183 188 185 186 183 ...
##  $ weight       : num  60 73 70 69 80 75 80 78 74 76 ...
##  $ age          : num  34 34 30 23 31 31 29 27 24 23 ...
##  $ ball_control : num  66 65 73 71 66 73 19 69 60 62 ...
##  $ dribbling    : num  70 66 72 72 64 74 13 66 45 52 ...
##  $ slide_tackle : num  54 15 26 30 42 35 14 42 70 63 ...
##  $ stand_tackle : num  55 27 28 35 33 37 14 39 70 71 ...
##  $ aggression   : num  67 74 54 51 56 50 28 58 63 76 ...
##  $ reactions    : num  64 68 60 64 58 63 53 65 62 58 ...
##  $ att_position : num  72 70 67 58 72 71 4 72 28 48 ...
##  $ interceptions: num  56 20 24 31 39 41 7 32 66 66 ...
##  $ vision       : num  64 58 58 61 43 52 38 68 29 52 ...
##  $ crossing     : num  62 59 60 58 49 68 13 37 27 62 ...
##  $ short_pass   : num  63 63 68 66 58 50 17 63 63 65 ...
##  $ long_pass    : num  55 45 52 51 45 49 23 51 59 53 ...
##  $ acceleration : num  87 70 75 72 51 83 24 69 63 65 ...
##  $ stamina      : num  74 52 71 65 62 71 22 71 69 73 ...
##  $ strength     : num  69 71 64 53 71 70 58 74 73 71 ...
##  $ sprint_speed : num  90 71 74 70 67 80 22 73 55 59 ...
##  $ agility      : num  78 69 77 73 41 73 34 72 45 50 ...
##  $ jumping      : num  80 73 88 59 70 68 53 67 72 67 ...
##  $ heading      : num  53 66 59 40 71 46 10 65 68 62 ...
##  $ shot_power   : num  64 85 68 62 74 50 53 58 48 71 ...
##  $ finishing    : num  62 72 63 65 70 77 7 70 24 41 ...
##  $ long_shots   : num  64 68 62 63 60 73 5 62 21 56 ...
##  $ curve        : num  45 62 64 66 46 45 10 47 26 54 ...
##  $ penalties    : num  60 71 57 63 61 63 13 61 42 62 ...
##  $ volleys      : num  53 70 62 53 67 67 7 59 34 47 ...
##  $ value        : num  1000000 1000000 1000000 1000000 1000000 1000000 1100000 1100000 1100000 1100000 ...

Comentário: Todas as variáveis presentes no banco de dados são numéricas quantitativas contínuas

Detecção de missings data (dados faltantes) ???

missings_vector = sapply(ourdata, function(x) sum(is.na(ourdata)))

names(missings_vector) = names(ourdata)

missings_vector |> print()

##        height        weight           age  ball_control     dribbling 
##             0             0             0             0             0 
##  slide_tackle  stand_tackle    aggression     reactions  att_position 
##             0             0             0             0             0 
## interceptions        vision      crossing    short_pass     long_pass 
##             0             0             0             0             0 
##  acceleration       stamina      strength  sprint_speed       agility 
##             0             0             0             0             0 
##       jumping       heading    shot_power     finishing    long_shots 
##             0             0             0             0             0 
##         curve     penalties       volleys         value 
##             0             0             0             0

Comentário: Não tem presença de nenhum dado faltante no banco obtido.

Descritivas do banco de dados

standard_desviation = numeric(0)
variance = numeric(0)
min_var = numeric(0)
max_var = numeric(0)
mediana_var = numeric(0)
media_var = numeric(0)

for (i in (1:29)){
  
  standard_desviation = append(standard_desviation, sd(ourdata[,i]))
  variance = append(variance, var(ourdata[,i]))
  min_var = append(min_var, min(ourdata[,i]))
  max_var = append(max_var, max(ourdata[,i]))
  mediana_var = append(mediana_var, median(ourdata[,i]))
  media_var = append(media_var, mean(ourdata[,i]))}



Desvio_padrao = standard_desviation
Variancia = variance
Minimo = min_var
Maximo = max_var
Mediana = mediana_var
Media = media_var

banco_summary = rbind(Desvio_padrao, Variancia, Minimo, Maximo, Mediana, Media)

rownames(banco_summary) = c("Desvio_Padrão", "Variância", "Mínimo", "Máximo", "Mediana", "Média")
colnames(banco_summary) = names(ourdata)



knitr::kable(banco_summary)

	height	weight	age	ball_control	dribbling	slide_tackle	stand_tackle	aggression	reactions	att_position	interceptions	vision	crossing	short_pass	long_pass	acceleration	stamina	strength	sprint_speed	agility	jumping	heading	shot_power	finishing	long_shots	curve	penalties	volleys	value
Desvio_Padrão	7.148488	7.062387	4.374788	14.97296	17.47348	22.77781	22.94537	16.95636	7.448882	19.32247	22.34332	13.63287	17.73532	13.04029	13.67454	14.72324	13.68716	12.43989	13.95006	14.60047	12.87711	16.86337	12.00169	19.37083	18.58055	17.95708	15.52879	17.70823	9.343031e+06
Variância	51.100877	49.877308	19.138771	224.18963	305.32243	518.82855	526.49020	287.51800	55.485840	373.35769	499.22385	185.85509	314.54143	170.04925	186.99293	216.77376	187.33830	154.75086	194.60405	213.17364	165.81994	284.37337	144.04052	375.22894	345.23694	322.45655	241.14342	313.58155	8.729222e+13
Mínimo	164.000000	60.000000	19.000000	11.00000	7.00000	8.00000	8.00000	20.00000	48.000000	4.00000	6.00000	15.00000	8.00000	14.00000	16.00000	15.00000	21.00000	30.00000	20.00000	21.00000	31.00000	9.00000	23.00000	4.00000	5.00000	8.00000	12.00000	6.00000	1.500000e+01
Máximo	197.000000	92.000000	39.000000	94.00000	95.00000	87.00000	87.00000	94.00000	88.000000	86.00000	86.00000	90.00000	84.00000	85.00000	83.00000	92.00000	94.00000	93.00000	94.00000	93.00000	91.00000	91.00000	88.00000	86.00000	83.00000	88.00000	91.00000	86.00000	9.950000e+07
Mediana	180.000000	75.000000	27.000000	70.00000	68.00000	59.00000	62.00000	63.00000	69.000000	61.00000	60.00000	61.00000	62.00000	68.00000	62.00000	71.00000	71.00000	69.00000	71.00000	69.00000	68.00000	62.00000	65.00000	55.00000	60.00000	57.00000	57.00000	53.00000	2.100000e+06
Média	180.318386	75.278027	27.565022	65.65919	62.36323	50.25112	52.17937	60.00448	68.269058	56.14350	51.51570	59.09865	56.88789	65.43946	59.25561	68.66368	68.67265	67.86099	68.65919	66.91928	66.31390	57.97758	63.99552	52.17937	54.61883	54.05381	54.97309	49.67265	5.174574e+06

Histogramas

for (i in (1:29)){

  hist(ourdata[, i], col = "blue", xlab = names(ourdata)[i],  main = paste0("Histograma da variável", " ",  names(ourdata)[i]))

}

Comentário: Parece que nenhuma variável está seguindo uma distribuição normal. Fora as variáveis Altura e Tempo de reação do jogador que apresentaram uma distribuição um pouco menos assimétrica, as outras variáveis, apresentaram uma distribuição fortemente assimétrica.

Boxplots

boxplot(ourdata, col = "blue", main = "Boxplot de todas as variáveis do banco" )

Boxplots - ZOOM1

boxplot(ourdata, col = "blue", main = "Boxplot de todas as variáveis do banco -  ZOOM1" , ylim = c(0, 200))

Boxplots - ZOOM2

boxplot(ourdata, col = "blue", main = "Boxplot de todas as variáveis do banco - ZOOM2" , ylim = c(0, 90))

ggpairs(ourdata, aes(alpha=0.8), lower=list(continuous="points"),
        upper=list(continuous="blank"),
        axisLabels="none", switch="both")

ggcorrplot::ggcorrplot(cor(ourdata),
                       hc.order = TRUE,
                       type = "lower",
                       lab = TRUE,
                       lab_size = 1.5) 

Comentário:Podemos reparar que obtivemos fortes correlações lineares entre algumas variáveis como por exmplo as variáveis Habilidade do jogador para driblar e Habilidade do jogador a controlar a bola (0,93). Porém, tem várias variáveis que parecem não ter uma relação linear como por exemplo as variáveis Agilidade do jogador nas manobras e o Nível de agressão do jogador (0).

Redução de Dimensionalidade

Antes de ter aplicado o método de redução de dimensionalidade UMAP, as variáveis têm sido padronizadas

# Semente definida 
set.seed(00316695)
umap_fit <- ourdata %>%
  select(where(is.numeric)) %>%
  scale() %>% 
  umap()



umap_df <- umap_fit$layout %>%
  as.data.frame() %>% 
  round(5)
 


DT::datatable(umap_df)

Interpretação: Inicialmente tinhamos 29 variáveis mas o método UMAP retornou duas variáveis que são combinações das variáveis originais. É importante salientar que as variáveis foram padronizadas antes de aplicar o método UMAP.

Clusterização

fviz_nbclust(umap_df, kmeans,method = "silhouette", linecolor = "blue")

Interpretação: Olhando o gráfico acima parece que seria melhor agrupar os dados em exatamente 3 (três) clusters (grupos). A localização da curva (joelho/cotovelo) na plotagem é geralmente considerada como um indicador do número apropriado de agrupamentos. A função R fviz_nbclust() parece fornecer uma solução conveniente para estimar o número ideal de clusters.

Visualização dos dados clusterizados::

set.seed(00316695)

dataKmeans <- kmeans(umap_df,3)

clusterized <- fviz_cluster(dataKmeans,
 data = umap_df, 
 geom = "point",
 stand = FALSE,
 title = "kMEANS — CLUSTERING",
 frame.type = "convex")

clusterized

my_clusters= (data.frame(Clusters = 1:3, dataKmeans$centers))  
names(my_clusters) = c("Clusters", "Variável1", "Variável2")
knitr::kable((my_clusters) %>% dplyr::arrange(my_clusters[2]))

	Clusters	Variável1	Variável2
3	3	-8.566504	-14.248161
2	2	-1.669596	2.091563
1	1	3.482893	-0.520113

Interpretação a partir dos centróides dos clusters:

O gráfico mostra que os grupos 1 e 2 são bem próximos e os dois juntos são bem distantes do grupo 3. Por outro lado, parece que o grupo 2 contém mais jogadores brasileiros do fifa24 do que os dois outros grupos. Olhando as características dos centróides dos 3 (três) clusters (grupos) acima podemos dizer que em média o grupo 1 possui características acima da média considerando apenas a variável1 e o grupo 2 é aquele que apresentou características acima da média considerando apenas a variável2. Infelizmente a dimensão do banco original foi bem reduzida, mas seria mais interessante olhar a formação dos clusters em função de todas as variáveis íniciais

E se não tivéssemos reduzido a dimensão do banco de dados, o que aconteceria com os clusters???

Vamos olhar juntos o que acontecer…..

# Semente definida 
set.seed(00316695)
fviz_nbclust(ourdata, kmeans,method = "silhouette", linecolor = "red")

set.seed(00316695)

dataKmeans_entire <- kmeans(ourdata,3)

clusterized_entire <- fviz_cluster(dataKmeans_entire,
 data = ourdata, 
 geom = "point",
 stand = FALSE,
 title = "kMEANS — CLUSTERING",
 frame.type = "convex")

clusterized_entire

my_clusters_entire= (data.frame(Clusters = 1:3, dataKmeans_entire$centers))  

knitr::kable(my_clusters_entire) 

Clusters	height	weight	age	ball_control	dribbling	slide_tackle	stand_tackle	aggression	reactions	att_position	interceptions	vision	crossing	short_pass	long_pass	acceleration	stamina	strength	sprint_speed	agility	jumping	heading	shot_power	finishing	long_shots	curve	penalties	volleys	value
1	175.0000	68.00000	31.00000	94.00000	95.00000	29.00000	32.00000	63.00000	88.00000	86.00000	37.00000	90.00000	83.00000	85.00000	81.00000	88.00000	79.00000	52.00000	86.00000	93.00000	62.00000	63.00000	79.00000	83.00000	81.00000	88.00000	91.00000	86.00000	99500000
2	179.3871	73.70968	26.45161	74.70968	71.09677	54.35484	56.77419	67.96774	78.25806	64.19355	56.32258	67.54839	64.00000	73.83871	65.70968	77.19355	77.61290	70.06452	76.58065	73.61290	70.64516	64.38710	69.51613	59.64516	61.77419	64.25806	59.32258	57.48387	19774194
3	180.4974	75.57068	27.72775	64.04188	60.77487	49.69634	51.53927	58.69634	66.54450	54.68063	50.81152	57.56544	55.59686	63.97382	58.09424	67.17801	67.16754	67.58639	67.28272	65.69634	65.63351	56.91099	63.02094	50.80628	53.31937	52.21990	54.07853	48.21466	2311152

Interpretação: Temos agora todas as características importantes dos 3 clusters. Com base nessas informações pode se tomar decisões ou desenvolver algum sistema de recomendação no jogo. Por exemplo, novos contratos podem ser oferecidos para alguns jogadores do cluster 1 que aparentemente possuem uma boa finalização e uma boa visão do jogo, habilidades que podem ser muito valiosas numa partida de football.

Forecasting

Pacotes utilizados

library(tidyverse)
library(caret)
require(WVPlots)
library(gridExtra)
library(grid)
library(ggridges)
library(ggthemes)
theme_set(theme_minimal())

library(iml)


library(breakDown)

library(rpart) #arvore de decisao
library(rpart.plot) # arvore de decisao

library(plotROC) # plotar a curva roc
library(pROC)

Divisão dos dados do banco em \(80\)% e \(20\)%

set.seed(00316695)
idx <- createDataPartition(ourdata$value, 
                           p = 0.8, ## proporcao de dados do banco de treinamento
                           list = FALSE, 
                           times = 1)

ourdata_train <- ourdata[ idx,]
ourdata_test  <- ourdata[-idx,]

Árvores de Decisão

fit_control <- trainControl(method = "repeatedcv",
                           number = 5,
                           repeats = 1)

set.seed(00316695)
arvore_model <- train(value ~ ., 
                  data = ourdata_train, 
                  method = "rpart", # árvore de decisao 
                  preProcess = c("scale", "center"),
                  trControl = fit_control)
arvore_model

## CART 
## 
## 179 samples
##  28 predictor
## 
## Pre-processing: scaled (28), centered (28) 
## Resampling: Cross-Validated (5 fold, repeated 1 times) 
## Summary of sample sizes: 143, 142, 144, 143, 144 
## Resampling results across tuning parameters:
## 
##   cp         RMSE     Rsquared   MAE    
##   0.0233678  6750566  0.5115469  3558647
##   0.1017104  7475209  0.4253208  4035609
##   0.4388383  8225123  0.3045293  4559974
## 
## RMSE was used to select the optimal model using the smallest value.
## The final value used for the model was cp = 0.0233678.

plot(arvore_model)

rpart.plot(arvore_model$finalModel)

Salários preditos

test_predict <- predict(arvore_model, ourdata_test)

print(test_predict)

##        3        4        9       11       15       17       27       31 
##  2642832  2642832  2642832  2642832  2642832  2642832  2642832  2642832 
##       32       33       34       38       49       61       66       70 
##  2642832  2642832  2642832  2642832  2642832 12252424  2642832 12252424 
##       72       73       89       95       96       98      104      110 
## 12252424 12252424  2642832  2642832  2642832  2642832  2642832  2642832 
##      113      117      121      125      127      136      139      143 
##  2642832  2642832  2642832 12252424 34812500  2642832 12252424 12252424 
##      148      159      163      168      171      172      175      177 
## 12252424  2642832  2642832  2642832  2642832  2642832  2642832  2642832 
##      187      194      198      217 
##  2642832  2642832  2642832  2642832

#library(ModelMetrics)
rmse_arvore_decision = RMSE(test_predict, ourdata_test$value)

Result: Obtivemos um RMSE de \(5025686\)

Será que podemos encontrar um modelo com uma melhor performance???

Random Forest

modelLookup("rf")

##   model parameter                         label forReg forClass probModel
## 1    rf      mtry #Randomly Selected Predictors   TRUE     TRUE      TRUE

fit_control_rf <- trainControl(method = "repeatedcv",
                           number = 5,
                           repeats = 1)

set.seed(00316695)
rf_model <- train(value ~ ., 
                  data = ourdata_train, 
                  method = "rf", 
                  preProcess = c("scale", "center"),
                  trControl = fit_control_rf,
                  verbose = FALSE)
rf_model

## Random Forest 
## 
## 179 samples
##  28 predictor
## 
## Pre-processing: scaled (28), centered (28) 
## Resampling: Cross-Validated (5 fold, repeated 1 times) 
## Summary of sample sizes: 143, 142, 144, 143, 144 
## Resampling results across tuning parameters:
## 
##   mtry  RMSE     Rsquared   MAE    
##    2    5615815  0.7567667  2738425
##   15    5351718  0.7395533  2423744
##   28    5569078  0.6971769  2510609
## 
## RMSE was used to select the optimal model using the smallest value.
## The final value used for the model was mtry = 15.

The Features Importance

rf_model_imp <- varImp(rf_model, scale = TRUE)
p1 <- rf_model_imp$importance %>%
  as.data.frame() %>%
  rownames_to_column() %>%
  ggplot(aes(x = reorder(rowname, Overall), y = Overall)) +
    geom_bar(stat = "identity", fill = "red", alpha = 0.8) +
    coord_flip()

p1

Interpretação: É importante salientar que a variável que foi mais importante é Tempo de reação do jogador o que pode até fazer sentido já que numa partida decisiva, reagir mais rápido e de maneira eficaz pode ser muito valioso para o time e pode ter uma consequência positiva no salário do jogador

Salários preditos

test_predict_rf <- predict(rf_model, ourdata_test)
print(test_predict_rf)

##          3          4          9         11         15         17         27 
##  1141597.6  1020352.0   832637.0  2948855.6  1627349.6   918078.8  3390879.7 
##         31         32         33         34         38         49         61 
##  1079918.2  1730325.8  1644538.3  1383555.9  1670762.6  2902915.0  9161806.2 
##         66         70         72         73         89         95         96 
##   442020.7 10749789.6 16943161.8 15346139.7  2223928.0  2228586.4  2047435.8 
##         98        104        110        113        117        121        125 
##  4255261.1  2866743.4  3152151.7  5401559.3  3217054.1   115147.9 20525448.5 
##        127        136        139        143        148        159        163 
## 20182166.6  6489255.1  9099577.4 12867433.4 28734111.7  3489754.9  4204215.5 
##        168        171        172        175        177        187        194 
##   136322.9  4342810.8 14679415.4  5051358.8   285087.2   589829.9   349033.0 
##        198        217 
##   523596.1  1931167.7

#library(ModelMetrics)
rmse_randomforest = RMSE(test_predict_rf, ourdata_test$value)

DECISÃO FINAL

knitr::kable(data.frame(rmse_arvore_decision, rmse_randomforest))

rmse_arvore_decision	rmse_randomforest
5025686	2944535

Fica óbvio que o modelo que teve uma boa performance em predizer os salários dos jogadores brasileiros do fifa 24 foi o modelo de random forest.

Conclusão

Em virtude de todas as análises feitas anteriormente podemos dizer que conseguimos estabelecer um certo padrão de comportamento nos jogadores do jogo fifa 24 e que um modelo de random forest com uma validação cruzada repetida, com 5 folds e uma repetição única pode ser melhor que uma árvore de decisão com a mesma configuração. A variável a mais importante encontrada com o algorithmo de random forest foi o Tempo de reação do jogador. </ center>

“Dado é informação e informação bem análisada é poder”

Referências

https://smolski.github.io/livroavancado/analise-de-clusters.html

https://www.tmwr.org/dimensionality.html

O link para baixar o banco de dados para possível reprodutibilidade: https://www.kaggle.com/datasets/rehandl23/fifa-24-player-stats-dataset/data