1.1 PGA Tour

Le PGA Tour (Wikipédia, s. d.b) (Professional Golfers’ Association) est un circuit de golf professionnel qui se déroule aux États-Unis. Il a été créé en 1968 et est considéré comme le meilleur circuit au monde. Il compte aujourd’hui plus de 50 tournois officiels par saison.

La FedExCup (Wikipédia, s. d.a) est un championnat du PGA Tour qui dure toute la saison. Durant chaque tournoi, les golfeurs remportent des points qui comptent pour ce championnat en fonction de leurs résultats à l’évènement. À la fin de la saison, les 30 meilleurs golfeurs du classement s’affrontent pour remporter le trophée.

Un tournoi du PGA Tour se déroule sur 4 jours en 4 rounds. Les joueurs jouent le parcours une fois par jour. Après les 2 premiers jours, seuls les meilleurs se qualifient pour les 2 derniers rounds. On dit qu’ils ont passé le cut. Ceux qui n’arrivent pas à se qualifier dans le cut ne touchent pas d’argent pour leur participation au tournoi.

1.2 Initiation au golf

Voici la définition du golf d’après le Larousse :

Sport consistant à envoyer une balle à l’aide de clubs dans les 18 trous successifs d’un vaste terrain avec le minimum de coups.

Pour les non-initiés, commençons par donner quelques définitions nécessaires à la compréhension de l’analyse (Wikipédia, s. d.c; D. Chessel 2003) :

• Par : nombre de coups théorique fixé pour un trou (ou un parcours). Le par d’un trou (3, 4 ou 5) dépend de sa longueur. Le par d’un parcours est égal à la somme des pars des trous du parcours (généralement entre 70 et 73).
• Birdie : trou joué 1 coup sous le par (par 4 en 3 coups par exemple).
• Drive : coup joué avec le driver. Le driver est le club qui permet de faire les coups les plus longs en distance. Les joueurs utilisent le driver pour jouer le premier coup des pars 5 et souvent celui des pars 4. Il n’est pas utilisé sur les pars 3 car la balle dépasserait le trou.
• Fairway : zone herbeuse et bien tondue séparant le départ du green, où il est préférable d’envoyer la balle.
• Rough : partie du parcours de golf longeant les trous et placée sur les côtés du fairway. L’herbe y est plus haute. Elle sanctionne un mauvais drive car il est plus difficile de jouer dans le rough que sur le fairway.
• Green : le green est la zone du terrain qui entoure le drapeau. Elle est parfaitement tondue pour permettre au joueur de putter.
• Putt : coup exécuté sur ou très proche du green en faisant rouler la balle. C’est le coup de golf qui nécessite le plus d’application et de précision car il faut étudier la pente du green et contrôler précisément la force du coup.
• Bunker : un bunker est une zone de sable censée gêner l’approche du green. Il existe aussi des bunkers de parcours.

La figure 1.1 montre les différentes aires de jeu décrites.

Figure 1.1: Schéma des aires de jeu au golf

1.3 Objectifs

L’analyse de données va répondre aux questions suivantes :

1. Comment les différentes statistiques sont-elles distribuées ?
2. Y a-t-il une évolution des performances des golfeurs sur ces 10 dernières années ?
3. Quels sont les pays les plus représentés au PGA Tour ?
4. Quels sont les liens entre les variables ?
5. Quelles sont les statistiques qui permettent d’expliquer le score moyen d’un golfeur ?
6. Y a-t-il différents profils de golfeurs ?
7. Peut-on déterminer si un golfeur a gagné un tournoi ou non en fonction des autres statistiques ?

Pour répondre à ces questions, les analyses et méthodes suivantes sont mises en oeuvre :

• Analyse descriptive des données
• Modèles de régression linéaire
• Analyse en composantes principales
• Classification non supervisée
• Classification supervisée

1.4 Librairies

L’analyse utilise les librairies suivantes :

• ggplot2 (STHDA, s. d.g, s. d.d, s. d.f; Chang, s. d.) : génération d’histogrammes, de boxplots et diagrammes en bâtons
• gridExtra (STHDA, s. d.e) : mise en grille des graphes générés avec ggplot2
• ggcorrplot (STHDA, s. d.b) : matrice de corrélation et heatmap
• ggfortify (STHDA, s. d.c) : extension de ggplot2 pour l’analyse des résidus en regréssion linéaire
• car : calcul du VIF pour l’analyse des résidus en régression linéaire
• mclust : comparaison des clustering
• cluster : clustering
• FactoMineR (Husson 2008) : ACP et clustering
• factoextra (STHDA, s. d.a, s. d.h) : extension de FactoMineR pour la visualisation des analyses
• MASS : méthodes LDA et QDA
• pROC : courbes ROC
• klaR : sélection de modèle pour les méthodes LDA et QDA
• rpart : arbres de classification
• randomForest : algorithme de Random forest

3.1 Distribution des variables

On étudie d’abord les variables quantitatives du jeu de données.

3.1.1 Histogrammes

On réalise un histogramme (STHDA, s. d.g) pour chacune de ces variables, en superposant l’estimation de la densité afin de voir comment elles sont distribuées.

bins <- 30

h1 <- ggplot(pga, aes(x = POINTS)) +
        geom_histogram(aes(y = ..density..), bins = bins, color = "darkblue",
                       fill = "lightblue") +
        geom_density(alpha = .2, fill = "#FF6666") +
        ggtitle("Histogram of POINTS") +
        theme_minimal()
h1

h2 <- ggplot(pga, aes(x = ROUNDS)) +
        geom_histogram(aes(y = ..density..), bins = bins, color = "darkblue",
                       fill = "lightblue") +
        geom_density(alpha = .2, fill = "#FF6666") +
        ggtitle("Histogram of ROUNDS") +
        theme_minimal()
h2

h3 <- ggplot(pga, aes(x = SCORING)) +
        geom_histogram(aes(y = ..density..), bins = bins, color = "darkblue",
                       fill = "lightblue") +
        geom_density(alpha = .2, fill = "#FF6666") +
        ggtitle("Histogram of SCORING") +
        theme_minimal()
h3

h4 <- ggplot(pga, aes(x = DD)) +
        geom_histogram(aes(y = ..density..), bins = bins, color = "darkblue",
                       fill = "lightblue") +
        geom_density(alpha = .2, fill = "#FF6666") +
        ggtitle("Histogram of DD") +
        theme_minimal()
h4

h5 <- ggplot(pga, aes(x = DA)) +
        geom_histogram(aes(y = ..density..), bins = bins, color = "darkblue",
                       fill = "lightblue") +
        geom_density(alpha = .2, fill = "#FF6666") +
        ggtitle("Histogram of DA") +
        theme_minimal()
h5

h6 <- ggplot(pga, aes(x = GIR)) +
        geom_histogram(aes(y = ..density..), bins = bins, color = "darkblue",
                       fill = "lightblue") +
        geom_density(alpha = .2, fill = "#FF6666") +
        ggtitle("Histogram of GIR") +
        theme_minimal()
h6

h7 <- ggplot(pga, aes(x = SS)) +
        geom_histogram(aes(y = ..density..), bins = bins, color = "darkblue",
                       fill = "lightblue") +
        geom_density(alpha = .2, fill = "#FF6666") +
        ggtitle("Histogram of SS") +
        theme_minimal()
h7

h8 <- ggplot(pga, aes(x = SCRAMBLING)) +
        geom_histogram(aes(y = ..density..), bins = bins, color = "darkblue",
                       fill = "lightblue") +
        geom_density(alpha = .2, fill = "#FF6666") +
        ggtitle("Histogram of SCRAMBLING") +
        theme_minimal()
h8

h9 <- ggplot(pga, aes(x = PA)) +
        geom_histogram(aes(y = ..density..), bins = bins, color = "darkblue",
                       fill = "lightblue") +
        geom_density(alpha = .2, fill = "#FF6666") +
        ggtitle("Histogram of PA") +
        theme_minimal()
h9

h10 <- ggplot(pga, aes(x = BA)) +
        geom_histogram(aes(y = ..density..), bins = bins, color = "darkblue",
                       fill = "lightblue") +
        geom_density(alpha = .2, fill = "#FF6666") +
        ggtitle("Histogram of BA") +
        theme_minimal()
h10

h11 <- ggplot(pga, aes(x = MONEY)) +
        geom_histogram(aes(y = ..density..), bins = bins, color = "darkblue",
                       fill = "lightblue") +
        geom_density(alpha = .2, fill = "#FF6666") +
        ggtitle("Histogram of MONEY") +
        theme_minimal()
h11

Figure 3.1: Histogrammes

D’après les histogrammes de la figure 3.1, il est clair que les variables POINTS et MONEY ne sont pas distribuées normalement.

On trace le Q-Q plot des variables et on effectue des tests de normalité de Shapiro-Wilk.

qq1 <- ggplot(pga, aes(sample = POINTS)) +
        stat_qq() + stat_qq_line(color = "red") +
        ggtitle("Q-Q Plot of POINTS")
qq1

qq2 <- ggplot(pga, aes(sample = ROUNDS)) +
        stat_qq() + stat_qq_line(color = "red") +
        ggtitle("Q-Q Plot of ROUNDS")
qq2

qq3 <- ggplot(pga, aes(sample = SCORING)) +
        stat_qq() + stat_qq_line(color = "red") +
        ggtitle("Q-Q Plot of SCORING")
qq3

qq4 <- ggplot(pga, aes(sample = DD)) +
        stat_qq() + stat_qq_line(color = "red") +
        ggtitle("Q-Q Plot of DD")
qq4

qq5 <- ggplot(pga, aes(sample = DA)) +
        stat_qq() + stat_qq_line(color = "red") +
        ggtitle("Q-Q Plot of DA")
qq5

qq6 <- ggplot(pga, aes(sample = GIR)) +
        stat_qq() + stat_qq_line(color = "red") +
        ggtitle("Q-Q Plot of GIR")
qq6

qq7 <- ggplot(pga, aes(sample = SS)) +
        stat_qq() + stat_qq_line(color = "red") +
        ggtitle("Q-Q Plot of SS")
qq7

qq8 <- ggplot(pga, aes(sample = SCRAMBLING)) +
        stat_qq() + stat_qq_line(color = "red") +
        ggtitle("Q-Q Plot of SCRAMBLING")
qq8

qq9 <- ggplot(pga, aes(sample = PA)) +
        stat_qq() + stat_qq_line(color = "red") +
        ggtitle("Q-Q Plot of PA")
qq9

qq10 <- ggplot(pga, aes(sample = BA)) +
        stat_qq() + stat_qq_line(color = "red") +
        ggtitle("Q-Q Plot of BA")
qq10

qq11 <- ggplot(pga, aes(sample = MONEY)) +
        stat_qq() + stat_qq_line(color = "red") +
        ggtitle("Q-Q Plot of MONEY")
qq11

Figure 3.2: Q-Q plots

shapiro.test(pga$POINTS)

## 
##  Shapiro-Wilk normality test
## 
## data:  pga$POINTS
## W = 0.83667, p-value < 2.2e-16

shapiro.test(pga$ROUNDS)

## 
##  Shapiro-Wilk normality test
## 
## data:  pga$ROUNDS
## W = 0.99156, p-value = 6.123e-06

shapiro.test(pga$SCORING)

## 
##  Shapiro-Wilk normality test
## 
## data:  pga$SCORING
## W = 0.98503, p-value = 3.359e-09

shapiro.test(pga$DD)

## 
##  Shapiro-Wilk normality test
## 
## data:  pga$DD
## W = 0.99654, p-value = 0.01564

shapiro.test(pga$DA)

## 
##  Shapiro-Wilk normality test
## 
## data:  pga$DA
## W = 0.9974, p-value = 0.07436

shapiro.test(pga$GIR)

## 
##  Shapiro-Wilk normality test
## 
## data:  pga$GIR
## W = 0.99638, p-value = 0.01164

shapiro.test(pga$SS)

## 
##  Shapiro-Wilk normality test
## 
## data:  pga$SS
## W = 0.9987, p-value = 0.6125

shapiro.test(pga$SCRAMBLING)

## 
##  Shapiro-Wilk normality test
## 
## data:  pga$SCRAMBLING
## W = 0.99853, p-value = 0.4888

shapiro.test(pga$PA)

## 
##  Shapiro-Wilk normality test
## 
## data:  pga$PA
## W = 0.99767, p-value = 0.1194

shapiro.test(pga$BA)

## 
##  Shapiro-Wilk normality test
## 
## data:  pga$BA
## W = 0.98937, p-value = 3.808e-07

shapiro.test(pga$MONEY)

## 
##  Shapiro-Wilk normality test
## 
## data:  pga$MONEY
## W = 0.80708, p-value < 2.2e-16

On conclut que les variables DA, SS, SCRAMBLING et PA semblent être distribuées normalement. En revanche, les variables POINTS, ROUNDS, SCORING, DD, GIR, BA et MONEY ne sont pas distribuées normalement (au risque de se tromper de 5%).

Interprétations :

• On observe que les histogrammes des variables POINTS et MONEY penchent fortement vers la gauche. Cela signifie que les meilleurs golfeurs gagnent beaucoup plus de points et de gains que les autres. En effet, les récompenses des tournois sont beaucoup plus généreuses pour les golfeurs du top 10 que pour les autres, ce qui explique ce phénomène.
• Les histogrammes des autres variables témoignent d’un niveau assez similaire entre les golfeurs avec quelques disparités.

3.1.2 Boxplots

On regarde maintenant les boxplots de ces variables par année, en superposant en rouge la moyenne. Cela permet d’étudier l’évolution des performances des golfeurs sur ces 10 dernières années.

b1 <- ggplot(pga, aes(x = YEAR, y = POINTS)) +
        geom_boxplot(aes(fill = YEAR)) +
        stat_summary(fun = mean, geom = "point", size = 2,
                     color = "red", fill = "red") +
        ggtitle("Boxplot of POINTS") +
        theme_minimal() +
        theme(legend.position = "none")
b1

b2 <- ggplot(pga, aes(x = YEAR, y = ROUNDS)) +
        geom_boxplot(aes(fill = YEAR)) +
        stat_summary(fun = mean, geom = "point", size = 2,
                     color = "red", fill = "red") +
        ggtitle("Boxplot of ROUNDS") +
        theme_minimal() +
        theme(legend.position = "none")
b2

b3 <- ggplot(pga, aes(x = YEAR, y = SCORING)) +
        geom_boxplot(aes(fill = YEAR)) +
        stat_summary(fun = mean, geom = "point", size = 2,
                     color = "red", fill = "red") +
        ggtitle("Boxplot of SCORING") +
        theme_minimal() +
        theme(legend.position = "none")
b3

b4 <- ggplot(pga, aes(x = YEAR, y = DD)) +
        geom_boxplot(aes(fill = YEAR)) +
        stat_summary(fun = mean, geom = "point", size = 2,
                     color = "red", fill = "red") +
        ggtitle("Boxplot of DD") +
        theme_minimal() +
        theme(legend.position = "none")
b4

b5 <- ggplot(pga, aes(x = YEAR, y = DA)) +
        geom_boxplot(aes(fill = YEAR)) +
        stat_summary(fun = mean, geom = "point", size = 2,
                     color = "red", fill = "red") +
        ggtitle("Boxplot of DA") +
        theme_minimal() +
        theme(legend.position = "none")
b5

b6 <- ggplot(pga, aes(x = YEAR, y = GIR)) +
        geom_boxplot(aes(fill = YEAR)) +
        stat_summary(fun = mean, geom = "point", size = 2,
                     color = "red", fill = "red") +
        ggtitle("Boxplot of GIR") +
        theme_minimal() +
        theme(legend.position = "none")
b6

b7 <- ggplot(pga, aes(x = YEAR, y = SS)) +
        geom_boxplot(aes(fill = YEAR)) +
        stat_summary(fun = mean, geom = "point", size = 2,
                     color = "red", fill = "red") +
        ggtitle("Boxplot of SS") +
        theme_minimal() +
        theme(legend.position = "none")
b7

b8 <- ggplot(pga, aes(x = YEAR, y = SCRAMBLING)) +
        geom_boxplot(aes(fill = YEAR)) +
        stat_summary(fun = mean, geom = "point", size = 2,
                     color = "red", fill = "red") +
        ggtitle("Boxplot of SCRAMBLING") +
        theme_minimal() +
        theme(legend.position = "none")
b8

b9 <- ggplot(pga, aes(x = YEAR, y = PA)) +
        geom_boxplot(aes(fill = YEAR)) +
        stat_summary(fun = mean, geom = "point", size = 2,
                     color = "red", fill = "red") +
        ggtitle("Boxplot of PA") +
        theme_minimal() +
        theme(legend.position = "none")
b9

b10 <- ggplot(pga, aes(x = YEAR, y = BA)) +
        geom_boxplot(aes(fill = YEAR)) +
        stat_summary(fun = mean, geom = "point", size = 2,
                     color = "red", fill = "red") +
        ggtitle("Boxplot of BA") +
        theme_minimal() +
        theme(legend.position = "none")
b10

b11 <- ggplot(pga, aes(x = YEAR, y = MONEY)) +
        geom_boxplot(aes(fill = YEAR)) +
        stat_summary(fun = mean, geom = "point", size = 2,
                     color = "red", fill = "red") +
        ggtitle("Boxplot of MONEY") +
        theme_minimal() +
        theme(legend.position = "none")
b11

Figure 3.3: Boxplots

Étudions les boxplots où on observe des phénomènes intéressants.

3.1.2.1 Points à la FedExCup

On regarde les boxplots de la variable POINTS et on affiche les 10 meilleurs golfeurs en fonction de leur nombre de points au classement de la FedExCup pour les saisons 2010, 2015, 2018 et 2020.

b1

# Top 10 de la FedExCup pour chaque année
for (year in c("2010", "2015", "2018", "2020")) {
  df.points <- data.frame(NAMES = pga$PLAYER.NAME[pga$YEAR == year],
                          POINTS = pga$POINTS[pga$YEAR == year])
  df.points$NAMES <- df.points$NAMES[order(df.points$POINTS,
                                           decreasing = TRUE)]
  df.points$POINTS <- df.points$POINTS[order(df.points$POINTS,
                                             decreasing = TRUE)]
  print(head(df.points, 10))
}

##             NAMES POINTS
## 1       Ernie Els   1846
## 2  Steve Stricker   1697
## 3       Jim Furyk   1691
## 4  Phil Mickelson   1629
## 5     Justin Rose   1593
## 6    Jeff Overton   1536
## 7    Hunter Mahan   1528
## 8    Bubba Watson   1498
## 9     Matt Kuchar   1437
## 10      Tim Clark   1409
##             NAMES POINTS
## 1   Jordan Spieth   4169
## 2       Jason Day   2459
## 3    Bubba Watson   2407
## 4    Jimmy Walker   2014
## 5     Justin Rose   1742
## 6    Robert Streb   1720
## 7  Dustin Johnson   1718
## 8    Patrick Reed   1593
## 9       Danny Lee   1561
## 10   Zach Johnson   1559
##                 NAMES POINTS
## 1      Dustin Johnson   2717
## 2       Justin Thomas   2634
## 3       Brooks Koepka   2012
## 4         Justin Rose   1991
## 5        Bubba Watson   1879
## 6           Jason Day   1771
## 7        Webb Simpson   1710
## 8  Francesco Molinari   1682
## 9   Bryson DeChambeau   1617
## 10       Patrick Reed   1555
##                NAMES POINTS
## 1      Justin Thomas   2458
## 2    Collin Morikawa   1902
## 3       Webb Simpson   1878
## 4  Bryson DeChambeau   1657
## 5         Sungjae Im   1633
## 6       Patrick Reed   1426
## 7      Daniel Berger   1347
## 8       Rory McIlroy   1327
## 9       Brendon Todd   1316
## 10          Jon Rahm   1295

On remarque que la moyenne (en rouge) est toujours au dessus de la médiane. En effet, comme le montre les top 10, on voit que les meilleurs golfeurs ont une marge de points assez importante sur les autres. Par exemple, en 2015, Jordan Spieth a terminé en tête de ce classement avec 4169 points, soit 1710 points de plus que le deuxième, Jason Day, et 2155 points de plus que le quatrième.

On peut de plus remarquer que le nombre de points est moins élevé en 2020. Ceci est expliqué par la crise du COVID-19 qui a fait annuler des tournois.

3.1.2.2 Rounds

On affiche le nombre moyen de rounds joués par les golfeurs pour chaque année étudiée.

b2

tapply(pga$ROUNDS, pga$YEAR, mean)

##  2010  2011  2012  2013  2014  2015  2016  2017  2018  2019  2020 
## 84.59 82.44 81.74 77.44 83.94 87.46 82.84 84.80 86.04 80.53 68.00

On voit que le nombre de rounds disputés par les golfeurs est beaucoup moins élevé en 2020 que les autres années. En effet, les joueurs ont disputé en moyenne 68 rounds en 2020 contre plus de 80 sur les autres années. Ceci est encore expliqué par les annulations de tournois dues au COVID-19.

3.1.2.3 Driving distance

On affiche la distance moyenne des drives pour chaque année étudiée.

b4

tapply(pga$DD, pga$YEAR, mean)

##    2010    2011    2012    2013    2014    2015    2016    2017    2018    2019 
## 287.880 293.002 291.611 288.409 291.476 292.614 292.527 296.308 299.018 296.547 
##    2020 
## 298.265

Il est intéressant de voir que la distance moyenne des drives a nettement augmenté au fil des années. En effet, les drives ont gagné en moyenne 10 yards sur ces 10 dernières années.

3.1.2.3.1 Putting average

On affiche le nombre moyen de putts joués par trou pour chaque année étudiée.

b9

tapply(pga$PA, pga$YEAR, mean)

##    2010    2011    2012    2013    2014    2015    2016    2017    2018    2019 
## 1.77278 1.77005 1.77093 1.77343 1.76471 1.76116 1.76741 1.76808 1.76546 1.75537 
##    2020 
## 1.75071

On voit que le nombre moyen de putts joués par trou a diminué. Il est passé de 1.77 en 2010 à 1.75 en 2020.

3.1.2.4 Birdie average

On affiche le nombre moyen de birdies divisé par le nombre de rounds joués pour chaque année étudiée.

b10

tapply(pga$BA, pga$YEAR, mean)

##   2010   2011   2012   2013   2014   2015   2016   2017   2018   2019   2020 
## 3.6083 3.6629 3.5771 3.5619 3.6072 3.7450 3.6485 3.6907 3.7612 3.8639 3.8669

On remarque que le nombre moyen de birdies divisé par le nombre de rounds joués a bien augmenté. Il est passé de 3.6 en 2010 à 3.9 en 2020.

3.1.2.5 Money

On considère les années 2010, 2015, 2018 et 2020. On affiche :

• Les boxplots des gains remportés durant les tournois par année
• Les écarts-type et les moyennes de gains par année
• Les classements des salaires par année

b11

sqrt(tapply(pga$MONEY, pga$YEAR, var))

##    2010    2011    2012    2013    2014    2015    2016    2017    2018    2019 
## 1062532 1240897 1300093 1363190 1406883 1737810 1427342 1693366 1693924 1560821 
##    2020 
## 1295483

tapply(pga$MONEY, pga$YEAR, mean)

##    2010    2011    2012    2013    2014    2015    2016    2017    2018    2019 
## 1893241 2031651 2117782 2044258 2309034 2369100 2304901 2499168 2808228 2502853 
##    2020 
## 2086422

# Classement des salaires par année
for (year in c("2010", "2015", "2018", "2020")) {
  df.money <- data.frame(NAMES = pga$PLAYER.NAME[pga$YEAR == year],
                         MONEY = pga$MONEY[pga$YEAR == year])
  df.money$NAMES <- df.money$NAMES[order(df.money$MONEY,
                                         decreasing = TRUE)]
  df.money$MONEY <- df.money$MONEY[order(df.money$MONEY,
                                         decreasing = TRUE)]
  print(head(df.money))
}

##            NAMES   MONEY
## 1    Matt Kuchar 4910477
## 2      Jim Furyk 4809622
## 3      Ernie Els 4558861
## 4 Dustin Johnson 4473122
## 5 Steve Stricker 4190235
## 6 Phil Mickelson 3821733
##            NAMES    MONEY
## 1  Jordan Spieth 12030465
## 2      Jason Day  9403330
## 3   Bubba Watson  6876797
## 4  Rickie Fowler  5773430
## 5 Dustin Johnson  5509467
## 6    Justin Rose  5462677
##               NAMES   MONEY
## 1     Justin Thomas 8694821
## 2    Dustin Johnson 8457352
## 3       Justin Rose 8130678
## 4 Bryson DeChambeau 8094489
## 5     Brooks Koepka 7094047
## 6      Bubba Watson 5793748
##               NAMES   MONEY
## 1     Justin Thomas 7344040
## 2          Jon Rahm 5959819
## 3    Dustin Johnson 5837267
## 4   Collin Morikawa 5250868
## 5      Webb Simpson 5097742
## 6 Bryson DeChambeau 4998495

On observe que les gains moyens remportés par un golfeur sur une saison ont augmenté jusqu’en 2018 et ont ensuite diminué, ce qui est encore une des conséquences de la crise du COVID-19. En effet, moins de tournois entraîne moins de gains.

On note aussi de grandes différences de gains entre les meilleurs golfeurs et les autres. Par exemple, en 2015, les gains de Jordan Spieth s’élevaient à 12030465 dollars, ce qui représente plus du double des gains du quatrième, Rickie Fowler, avec 5773430 dollars.

3.1.2.6 Conclusions

Pour conclure sur l’interprétation des boxplots, on peut dire que :

• Le niveau des golfeurs a augmenté durant ces dernières années.
• La crise du COVID-19 a eu des conséquences sur le nombre de tournois disputés et les gains remportés par les golfeurs en 2020.
• Il y a de grands écarts au niveau des points au classement de la FedExCup et au niveau des gains remportés entre les meilleurs golfeurs (top 5 par exemple) et les autres.

3.2 Nationalités des golfeurs

Pour terminer l’analyse descriptive, on étudie la variable qualitative COUNTRY afin de déterminer les pays les plus représentés au PGA Tour. Pour les années 2010, 2015, 2018 et 2020, on trie les pays du plus au moins représenté et on montre les 5 premiers pays (STHDA, s. d.d).

for (year in c("2010", "2015", "2018", "2020")) {
  # On trie les pays du plus représenté au moins représenté
  countries <- sort(table(pga$COUNTRY[pga$YEAR == year]), decreasing = TRUE)
  # On crée un dataframe en gardant les 5 pays les plus représentés
  df.countries <- data.frame(countries[1:5])
  # On renomme la colonne 1
  names(df.countries)[1] <- "Country"

  b <- ggplot(data = df.countries, aes(x = Country, y = Freq, fill = Country)) +
    geom_bar(stat = "identity") +
    geom_text(aes(label = Freq), hjust = 1.6, color = "white", size = 3.5) +
    ggtitle(paste0("Countries represented in top 100 players in PGA Tour ", year)) +
    coord_flip()
  print(b)
}

Figure 3.4: Pays représentés dans le top 100 du PGA Tour

Les diagrammes en bâtons de la figure 3.4 montrent clairement que les États-Unis sont bien plus représentés que les autres pays. Après les États-Unis, l’Australie et l’Angleterre sont les deux pays qui comptent le plus de golfeurs dans le top 100 du PGA Tour pour chaque saison.

4.1 Matrice de corrélation

Pour identifier les corrélations entre les variables quantitatives, nous étudions la matrice de corrélation entre ces variables. On construit deux matrices (STHDA, s. d.b) :

• La matrice de corrélation avec les coefficients de corrélation
• La matrice de corrélation avec les p-values

# Compute a correlation matrix
pga.corr <- round(cor(pga.num), 2)
pga.corr

##            POINTS ROUNDS SCORING    DD    DA   GIR    SS SCRAMBLING    PA    BA
## POINTS       1.00   0.09   -0.66  0.22 -0.05  0.22  0.20       0.27 -0.37  0.49
## ROUNDS       0.09   1.00    0.11 -0.12  0.08  0.09 -0.04       0.07  0.01 -0.03
## SCORING     -0.66   0.11    1.00 -0.24 -0.05 -0.41 -0.31      -0.46  0.43 -0.58
## DD           0.22  -0.12   -0.24  1.00 -0.61  0.30 -0.17      -0.23 -0.03  0.48
## DA          -0.05   0.08   -0.05 -0.61  1.00  0.26  0.04       0.20  0.09 -0.16
## GIR          0.22   0.09   -0.41  0.30  0.26  1.00 -0.14      -0.02  0.15  0.38
## SS           0.20  -0.04   -0.31 -0.17  0.04 -0.14  1.00       0.58 -0.32  0.14
## SCRAMBLING   0.27   0.07   -0.46 -0.23  0.20 -0.02  0.58       1.00 -0.35  0.14
## PA          -0.37   0.01    0.43 -0.03  0.09  0.15 -0.32      -0.35  1.00 -0.68
## BA           0.49  -0.03   -0.58  0.48 -0.16  0.38  0.14       0.14 -0.68  1.00
## MONEY        0.93  -0.01   -0.71  0.31 -0.06  0.27  0.22       0.28 -0.40  0.57
##            MONEY
## POINTS      0.93
## ROUNDS     -0.01
## SCORING    -0.71
## DD          0.31
## DA         -0.06
## GIR         0.27
## SS          0.22
## SCRAMBLING  0.28
## PA         -0.40
## BA          0.57
## MONEY       1.00

# Compute a matrix of correlation p-values
pga.corr.pmat <- cor_pmat(pga.num)
pga.corr.pmat

##                   POINTS       ROUNDS       SCORING            DD            DA
## POINTS      0.000000e+00 2.421364e-03 4.486332e-138  2.514529e-13  8.348631e-02
## ROUNDS      2.421364e-03 0.000000e+00  1.929372e-04  8.231272e-05  7.265872e-03
## SCORING    4.486332e-138 1.929372e-04  0.000000e+00  5.930619e-16  7.938390e-02
## DD          2.514529e-13 8.231272e-05  5.930619e-16  0.000000e+00 1.963491e-111
## DA          8.348631e-02 7.265872e-03  7.938390e-02 1.963491e-111  0.000000e+00
## GIR         4.472659e-13 3.610021e-03  2.776172e-46  5.257056e-24  7.054084e-19
## SS          9.692371e-12 2.364224e-01  1.710130e-25  2.517885e-08  2.308852e-01
## SCRAMBLING  2.713168e-19 1.744482e-02  7.809477e-59  4.593441e-15  3.420000e-11
## PA          2.331310e-36 7.333580e-01  2.140805e-50  2.724850e-01  2.695786e-03
## BA          2.012598e-68 2.528169e-01 5.172684e-100  7.024429e-66  5.663322e-08
## MONEY       0.000000e+00 6.629974e-01 1.257115e-172  5.149349e-26  5.994701e-02
##                     GIR           SS   SCRAMBLING            PA            BA
## POINTS     4.472659e-13 9.692371e-12 2.713168e-19  2.331310e-36  2.012598e-68
## ROUNDS     3.610021e-03 2.364224e-01 1.744482e-02  7.333580e-01  2.528169e-01
## SCORING    2.776172e-46 1.710130e-25 7.809477e-59  2.140805e-50 5.172684e-100
## DD         5.257056e-24 2.517885e-08 4.593441e-15  2.724850e-01  7.024429e-66
## DA         7.054084e-19 2.308852e-01 3.420000e-11  2.695786e-03  5.663322e-08
## GIR        0.000000e+00 6.066047e-06 4.404226e-01  4.384295e-07  1.392748e-38
## SS         6.066047e-06 0.000000e+00 5.932967e-98  2.191031e-28  2.457553e-06
## SCRAMBLING 4.404226e-01 5.932967e-98 0.000000e+00  7.199359e-33  1.877694e-06
## PA         4.384295e-07 2.191031e-28 7.199359e-33  0.000000e+00 2.577555e-147
## BA         1.392748e-38 2.457553e-06 1.877694e-06 2.577555e-147  0.000000e+00
## MONEY      4.249159e-20 5.461786e-14 2.049932e-21  2.676516e-43  1.862827e-97
##                    MONEY
## POINTS      0.000000e+00
## ROUNDS      6.629974e-01
## SCORING    1.257115e-172
## DD          5.149349e-26
## DA          5.994701e-02
## GIR         4.249159e-20
## SS          5.461786e-14
## SCRAMBLING  2.049932e-21
## PA          2.676516e-43
## BA          1.862827e-97
## MONEY       0.000000e+00

Afin de visualiser facilement les liens entre les variables, on réalise un heatmap (STHDA, s. d.b) de la matrice de corrélation montré par la figure 4.1.

ggcorrplot(pga.corr, hc.order = TRUE, type = "lower", lab = TRUE,
           lab_size = 2.5, tl.cex = 8,
           title = "PGA Tour Correlation matrix heatmap")

Figure 4.1: Heatmap de la matrice de corrélation

Le heatmap montre les corrélations entre les variables numériques du jeu de données. Les cases en rouge indiquent une corrélation positive, tandis que les cases en bleu indiquent une corrélation négative.

Voici les liens importants détectés :

• POINTS et MONEY (0.93) : plus un golfeur gagne de points à la FedExCup, plus il gagne d’argent.
• SCRAMBING et SS (0.58) : les Sand Saves et les Scrambling sont deux situations difficiles pour un golfeur. On en déduit que si un golfeur arrive à gérer l’une de ces deux situations, alors il gère bien l’autre aussi.
• BA et MONEY (0.57) : les birdies font rapporter plus de gains aux golfeurs, ce qui est logique car cela améliore leurs scores.
• SCORING et MONEY (-0.71) : plus le score moyen est faible, plus le golfeur gagne d’argent. En effet, quand un golfeur a un score plus faible que les autres, il se situe dans les premières places du classement d’un tournoi, ce qui lui rapporte plus de gains.
• PA et BA (-0.68) : un golfeur qui réalise moins de putts par trou réalise plus de birdies. En effet, en cas d’échec à un putt sur un trou, il est plus difficile de réaliser un birdie. Dans le cas où le golfeur est en GIR, il est obligé de réussir le putt du premier coup s’il veut faire un birdie.
• SCORING et POINTS (-0.66) : plus le score moyen d’un golfeur est faible, plus il remporte de points pour la FedExCup. Cela est logique car un golfeur est mieux classé dans les tournois s’il réalise des scores plus faibles que ses adversaires.
• DA et DD (-0.61) : la balle arrive moins souvent sur le fairway lorsque les drives sont plus longs en moyenne.
• SCORING et BA (-0.58) : plus le score est faible et plus le nombre moyen de birdies est élevé. En effet, un birdie diminue le score d’un golfeur, ce qui explique cette corrélation. On rappelle qu’au golf, l’objectif est d’obtenir le score le plus faible.

4.2 Régression linéaire

À partir des liaisons entre variables identifiées, nous allons maintenant mettre en oeuvre quelques modèles de régressions.

4.2.1 Régression linéaire simple

Nous allons d’abord montrer des modèles de régressions linéaires simples (STHDA, s. d.f) adaptés au jeu de données.

4.2.1.1 Explication des gains remportés

On peut expliquer les gains remportés durant les tournois en fonction du nombre de points au classement de la FedExCup.

# Linear regression
pga.lm.res <- lm(pga$MONEY ~ pga$POINTS)
summary(pga.lm.res)

## 
## Call:
## lm(formula = pga$MONEY ~ pga$POINTS)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -1448429  -321854   -73607   217055  3571338 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -483448.00   36689.92  -13.18   <2e-16 ***
## pga$POINTS     3096.23      36.99   83.71   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 539500 on 1098 degrees of freedom
## Multiple R-squared:  0.8645, Adjusted R-squared:  0.8644 
## F-statistic:  7008 on 1 and 1098 DF,  p-value: < 2.2e-16

# Scatter plot with regression line
ggplot(pga, aes(x = POINTS, y = MONEY)) +
  geom_point() +
  geom_smooth(formula = y ~ x, method = lm) +
  ggtitle("Gains remportés en fonction du nombre de points à la FedExCup")

Figure 4.2: Gains remportés en fonction du nombre de points à la FedExCup

Comme le montre la figure 4.2, les meilleurs golfeurs, c’est-à-dire ceux qui ont un nombre de points élevé, sont ceux qui gagnent le plus d’argent, ce qui paraît juste.

4.2.1.2 Explication du pourcentage de birdies

On peut expliquer le nombre moyen de birdies (BA) par le nombre moyen de putts (PA).

# Linear regression
pga.lm2.res <- lm(pga$BA ~ pga$PA)
summary(pga.lm2.res)

## 
## Call:
## lm(formula = pga$BA ~ pga$PA)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -0.69272 -0.13995 -0.00095  0.13482  0.63900 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  17.5337     0.4564   38.42   <2e-16 ***
## pga$PA       -7.8412     0.2585  -30.34   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.2041 on 1098 degrees of freedom
## Multiple R-squared:  0.456,  Adjusted R-squared:  0.4555 
## F-statistic: 920.2 on 1 and 1098 DF,  p-value: < 2.2e-16

# Scatter plot with regression line
ggplot(pga, aes(x = PA, y = BA)) +
  geom_point() +
  geom_smooth(formula = y ~ x, method = lm) +
  ggtitle("Nombre moyen de birdies en fonction du nombre moyen de putts")

Figure 4.3: Nombre moyen de birdies en fonction du nombre moyen de putts

En effet, d’après la figure 4.3, on en déduit que moins un golfeur joue de putts par trou, plus il a de chance de réaliser un birdie.

4.2.1.3 Explication de la précision des drives

On peut expliquer la précision des drives (DA) par la longueur des drives (DD).

# Linear regression
pga.lm3.res <- lm(pga$DA ~ pga$DD)
summary(pga.lm3.res)

## 
## Call:
## lm(formula = pga$DA ~ pga$DD)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -14.6859  -2.4589   0.1084   2.6847  12.6497 
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 155.86676    3.71925   41.91   <2e-16 ***
## pga$DD       -0.32016    0.01267  -25.27   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 3.841 on 1098 degrees of freedom
## Multiple R-squared:  0.3677, Adjusted R-squared:  0.3672 
## F-statistic: 638.6 on 1 and 1098 DF,  p-value: < 2.2e-16

# Scatter plot with regression line
ggplot(pga, aes(x = DD, y = DA)) +
  geom_point() +
  geom_smooth(formula = y ~ x, method = lm) +
  ggtitle("Précision moyenne des drives en fonction de leur longueur moyenne")

Figure 4.4: Précision moyenne des drives en fonction de leur longueur moyenne

En effet, d’après la figure 4.4, on en déduit que les golfeurs qui réalisent de longs drives ont plus de chance de rater le fairway que ceux qui préfèrent jouer plus court pour assurer leur coup.

4.2.2 Régression linéaire multiple

Dans cette partie, on veut comprendre quelles variables influencent le score moyen d’un golfeur. On cherche à expliquer la variable SCORING en fonction d’autres variables quantitatives grâce à une régression linéaire multiple.

On considère uniquement les variables en rapport avec les performances d’un golfeur sur le terrain : ROUNDS, DD, DA, GIR, SS, SCRAMBLING, PA et BA.

pga.lm.scoring <- lm(SCORING ~ ROUNDS + DD + DA + GIR + SS + SCRAMBLING + PA + BA, pga)

On vérifie la colinéarité entre les variables.

vif(pga.lm.scoring)

##     ROUNDS         DD         DA        GIR         SS SCRAMBLING         PA 
##   1.050025   3.274633   2.452101   2.473770   1.594171   1.704819   3.898243 
##         BA 
##   5.064998

Les VIF sont inférieurs à 10 donc il n’y a pas de problème de colinéarité entre les variables. On effectue une analyse des résidus (STHDA, s. d.c).

# Diagnostic plots for Linear Model
autoplot(pga.lm.scoring)

## Warning: `arrange_()` was deprecated in dplyr 0.7.0.
## Please use `arrange()` instead.
## See vignette('programming') for more help

Figure 4.5: Analyse des résidus

Aucune observation ne semble perturber le modèle. On vérifie la normalité des résidus avec un test de Shapiro-Wilk.

shapiro.test(pga.lm.scoring$residuals)

## 
##  Shapiro-Wilk normality test
## 
## data:  pga.lm.scoring$residuals
## W = 0.99888, p-value = 0.7385

La p-value est supérieure à 5% donc il semble que les résidus sont gaussiens. Voici le résumé de la régression linéaire.

summary(pga.lm.scoring)

## 
## Call:
## lm(formula = SCORING ~ ROUNDS + DD + DA + GIR + SS + SCRAMBLING + 
##     PA + BA, data = pga)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -1.06782 -0.24015 -0.00005  0.23005  1.08998 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 74.4985266  1.6070841  46.356  < 2e-16 ***
## ROUNDS       0.0059704  0.0008223   7.260 7.32e-13 ***
## DD          -0.0084875  0.0021390  -3.968 7.72e-05 ***
## DA          -0.0027733  0.0035058  -0.791 0.429087    
## GIR         -0.0838955  0.0070439 -11.910  < 2e-16 ***
## SS          -0.0063163  0.0022826  -2.767 0.005752 ** 
## SCRAMBLING  -0.0637172  0.0044302 -14.383  < 2e-16 ***
## PA           5.1214353  0.8958820   5.717 1.40e-08 ***
## BA          -0.3207765  0.0879403  -3.648 0.000277 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.3583 on 1091 degrees of freedom
## Multiple R-squared:  0.5812, Adjusted R-squared:  0.5782 
## F-statistic: 189.3 on 8 and 1091 DF,  p-value: < 2.2e-16

On utilise une procédure de sélection de modèle pour obtenir un modèle de dimension réduite.

pga.lm.scoring0 <- lm(SCORING ~ 1, pga)
pga.lm.scoring.step <- step(pga.lm.scoring0, scope = formula(pga.lm.scoring))

## Start:  AIC=-1307.41
## SCORING ~ 1
## 
##              Df Sum of Sq    RSS     AIC
## + BA          1   112.653 221.86 -1757.1
## + SCRAMBLING  1    70.937 263.58 -1567.6
## + PA          1    61.477 273.04 -1528.8
## + GIR         1    56.746 277.77 -1509.9
## + SS          1    31.598 302.92 -1414.6
## + DD          1    19.369 315.15 -1371.0
## + ROUNDS      1     4.210 330.31 -1319.3
## + DA          1     0.937 333.58 -1308.5
## <none>                    334.52 -1307.4
## 
## Step:  AIC=-1757.1
## SCORING ~ BA
## 
##              Df Sum of Sq    RSS     AIC
## + SCRAMBLING  1    48.652 173.21 -2027.4
## + SS          1    17.315 204.55 -1844.5
## + GIR         1    14.500 207.36 -1829.5
## + DA          1     7.464 214.40 -1792.7
## + ROUNDS      1     2.844 219.02 -1769.3
## + PA          1     0.834 221.03 -1759.2
## + DD          1     0.722 221.14 -1758.7
## <none>                    221.86 -1757.1
## - BA          1   112.653 334.52 -1307.4
## 
## Step:  AIC=-2027.4
## SCORING ~ BA + SCRAMBLING
## 
##              Df Sum of Sq    RSS     AIC
## + GIR         1    19.467 153.75 -2156.5
## + ROUNDS      1     4.988 168.22 -2057.5
## + DD          1     2.876 170.34 -2043.8
## + PA          1     2.550 170.66 -2041.7
## + DA          1     1.396 171.82 -2034.3
## <none>                    173.21 -2027.4
## + SS          1     0.065 173.15 -2025.8
## - SCRAMBLING  1    48.652 221.87 -1757.1
## - BA          1    90.368 263.58 -1567.6
## 
## Step:  AIC=-2156.54
## SCORING ~ BA + SCRAMBLING + GIR
## 
##              Df Sum of Sq    RSS     AIC
## + ROUNDS      1     7.642 146.10 -2210.6
## + PA          1     1.821 151.93 -2167.7
## + DD          1     1.374 152.37 -2164.4
## + SS          1     1.273 152.47 -2163.7
## + DA          1     0.318 153.43 -2156.8
## <none>                    153.75 -2156.5
## - GIR         1    19.467 173.21 -2027.4
## - BA          1    50.063 203.81 -1848.5
## - SCRAMBLING  1    53.618 207.36 -1829.5
## 
## Step:  AIC=-2210.62
## SCORING ~ BA + SCRAMBLING + GIR + ROUNDS
## 
##              Df Sum of Sq    RSS     AIC
## + PA          1     2.452 143.65 -2227.2
## + SS          1     0.875 145.23 -2215.2
## + DD          1     0.758 145.35 -2214.3
## + DA          1     0.267 145.84 -2210.6
## <none>                    146.10 -2210.6
## - ROUNDS      1     7.642 153.75 -2156.5
## - GIR         1    22.121 168.22 -2057.5
## - BA          1    46.358 192.46 -1909.5
## - SCRAMBLING  1    56.793 202.90 -1851.4
## 
## Step:  AIC=-2227.23
## SCORING ~ BA + SCRAMBLING + GIR + ROUNDS + PA
## 
##              Df Sum of Sq    RSS     AIC
## + DD          1     2.548 141.10 -2244.9
## + DA          1     0.847 142.81 -2231.7
## + SS          1     0.735 142.92 -2230.9
## <none>                    143.65 -2227.2
## - PA          1     2.452 146.10 -2210.6
## - BA          1     7.723 151.38 -2171.6
## - ROUNDS      1     8.272 151.93 -2167.7
## - GIR         1    21.952 165.60 -2072.8
## - SCRAMBLING  1    41.626 185.28 -1949.3
## 
## Step:  AIC=-2244.92
## SCORING ~ BA + SCRAMBLING + GIR + ROUNDS + PA + DD
## 
##              Df Sum of Sq    RSS     AIC
## + SS          1     0.940 140.16 -2250.3
## <none>                    141.10 -2244.9
## + DA          1     0.037 141.07 -2243.2
## - BA          1     1.949 143.05 -2231.8
## - DD          1     2.548 143.65 -2227.2
## - PA          1     4.242 145.35 -2214.3
## - ROUNDS      1     7.418 148.52 -2190.6
## - GIR         1    23.617 164.72 -2076.7
## - SCRAMBLING  1    44.110 185.21 -1947.7
## 
## Step:  AIC=-2250.28
## SCORING ~ BA + SCRAMBLING + GIR + ROUNDS + PA + DD + SS
## 
##              Df Sum of Sq    RSS     AIC
## <none>                    140.16 -2250.3
## + DA          1    0.0803 140.08 -2248.9
## - SS          1    0.9399 141.10 -2244.9
## - BA          1    1.7466 141.91 -2238.7
## - DD          1    2.7537 142.92 -2230.9
## - PA          1    4.1601 144.32 -2220.1
## - ROUNDS      1    6.9529 147.12 -2199.0
## - GIR         1   24.4357 164.60 -2075.5
## - SCRAMBLING  1   27.1027 167.27 -2057.8

summary(pga.lm.scoring.step)

## 
## Call:
## lm(formula = SCORING ~ BA + SCRAMBLING + GIR + ROUNDS + PA + 
##     DD + SS, data = pga)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -1.07189 -0.24036 -0.00072  0.23178  1.08779 
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 74.226703   1.569649  47.289  < 2e-16 ***
## BA          -0.323994   0.087831  -3.689 0.000236 ***
## SCRAMBLING  -0.064059   0.004408 -14.531  < 2e-16 ***
## GIR         -0.086441   0.006265 -13.798  < 2e-16 ***
## ROUNDS       0.006028   0.000819   7.360 3.61e-13 ***
## PA           5.096219   0.895161   5.693 1.60e-08 ***
## DD          -0.007354   0.001588  -4.632 4.06e-06 ***
## SS          -0.006150   0.002273  -2.706 0.006914 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.3583 on 1092 degrees of freedom
## Multiple R-squared:  0.581,  Adjusted R-squared:  0.5783 
## F-statistic: 216.3 on 7 and 1092 DF,  p-value: < 2.2e-16

On en déduit que les variables ROUNDS, DD, GIR, SS, SCRAMBLING, PA et BA sont significatives pour expliquer la variable SCORING. En revanche, Driving Accuracy ne permet pas d’expliquer le score moyen obtenu.

Donc le score ne se déduit pas de la précision des drives. On voit notamment que les Sand Saves et les Scrambling, qui sont des situations difficiles pour les golfeurs, permettent d’expliquer le score moyen. C’est pour cela que les golfeurs qui obtiennent les meilleurs scores moyens sont ceux qui sont complets et qui savent gérer les situations délicates.

Notons tout de même que la variable SS a moins d’influence que les autres variables pour expliquer le score. En effet, les Sand Saves sont des situations assez rares en comparaison avec les Green in Regulation par exemple.

6.1 Classification ascendante hiérarchique

On réalise une classification ascendante hiérarchique (CAH) des golfeurs de l’année 2020.

Les variables étant dans des unités différentes, on travaille sur les données centrées réduites pour accorder la même importance à chaque variable et éviter que les variables à forte variance pèsent indûment sur les résultats.

pga.scale <- scale(pga.2020)
summary(pga.scale)

##      POINTS            ROUNDS           SCORING              DD          
##  Min.   :-0.9352   Min.   :-2.4029   Min.   :-2.5023   Min.   :-2.01552  
##  1st Qu.:-0.7196   1st Qu.:-0.6408   1st Qu.:-0.4959   1st Qu.:-0.74417  
##  Median :-0.3018   Median : 0.1602   Median : 0.1004   Median : 0.02224  
##  Mean   : 0.0000   Mean   : 0.0000   Mean   : 0.0000   Mean   : 0.00000  
##  3rd Qu.: 0.4205   3rd Qu.: 0.6408   3rd Qu.: 0.6550   3rd Qu.: 0.54521  
##  Max.   : 4.4543   Max.   : 2.2427   Max.   : 2.7167   Max.   : 2.86548  
##        DA                GIR                 SS            SCRAMBLING       
##  Min.   :-1.95202   Min.   :-2.45139   Min.   :-2.0914   Min.   :-2.663182  
##  1st Qu.:-0.74429   1st Qu.:-0.66488   1st Qu.:-0.7216   1st Qu.:-0.622468  
##  Median :-0.03156   Median :-0.04503   Median :-0.2211   Median : 0.002622  
##  Mean   : 0.00000   Mean   : 0.00000   Mean   : 0.0000   Mean   : 0.000000  
##  3rd Qu.: 0.70049   3rd Qu.: 0.67666   3rd Qu.: 0.8000   3rd Qu.: 0.702630  
##  Max.   : 2.65750   Max.   : 2.06912   Max.   : 2.5711   Max.   : 2.328177  
##        PA                 BA              MONEY        
##  Min.   :-2.52739   Min.   :-2.5424   Min.   :-1.0059  
##  1st Qu.:-0.62264   1st Qu.:-0.6077   1st Qu.:-0.7254  
##  Median :-0.03005   Median :-0.1216   Median :-0.3719  
##  Mean   : 0.00000   Mean   : 0.0000   Mean   : 0.0000  
##  3rd Qu.: 0.61545   3rd Qu.: 0.5646   3rd Qu.: 0.2561  
##  Max.   : 3.10220   Max.   : 3.0616   Max.   : 4.0584

On calcule la matrice des distances entre individus avec la distance euclidienne, puis on réalise la CAH avec la mesure de Ward. La figure 6.1 montre le dendrogramme obtenu.

# Compute distances and hierarchical clustering
pga.dist <- dist(pga.scale, method = "euclidean")
pga.hc <- hclust(pga.dist, method = "ward.D2")

# Plot dendrogram
fviz_dend(pga.hc, cex = 0.3, labels_track_height = 5,
          main = "Cluster Dendrogram PGA Tour 2020")

Figure 6.1: Dendrogramme de la CAH

La figure 6.2 montre les hauteurs des branches pour déterminer le nombre de classes à garder.

# Dataframe of heights
df.height <- data.frame(Class = 1:length(pga.hc$height),
                        Height = sort(pga.hc$height, decreasing = TRUE))

# Barplot
ggplot(df.height, aes(x = Class, y = Height, fill = Height)) +
  geom_bar(stat = "identity", width = 0.5) +
  ggtitle("Dendrogram Height") +
  theme_minimal()

Figure 6.2: Hauteurs des branches du dendrogram de la CAH

La perte d’inertie devient plus importante quand on passe de 4 à 3 classes, donc on peut garder 4 classes.

On affiche alors les classes sur le dendrogramme comme le montre la figure 6.3.

k <- 4
# Compute hierarchical clustering and cut into 4 clusters
pga.hcut <- hcut(pga.2020, k = k, stand = TRUE)

# Visualize
fviz_dend(pga.hcut, rect = TRUE, cex = 0.3, labels_track_height = 5,
          main = "Cluster Dendrogram PGA Tour 2020")

Figure 6.3: Dendrogramme de la CAH avec clusters

On forme ensuite les groupes : on liste les golfeurs de chaque groupe.

pga.groups <- cutree(pga.hc, k)

for (i in 1:k)
{
  cat("Group", i,"\n")
  print(rownames(pga.2020)[which(pga.groups == i)])
}

## Group 1 
##  [1] "Justin Thomas"     "Webb Simpson"      "Bryson DeChambeau"
##  [4] "Patrick Reed"      "Daniel Berger"     "Rory McIlroy"     
##  [7] "Jon Rahm"          "Xander Schauffele" "Dustin Johnson"   
## [10] "Hideki Matsuyama"  "Tyrrell Hatton"    "Tony Finau"       
## [13] "Scottie Scheffler" "Harris English"    "Patrick Cantlay"  
## [16] "Adam Scott"       
## Group 2 
##  [1] "Collin Morikawa"  "Sungjae Im"       "Brendon Todd"     "Lanto Griffin"   
##  [5] "Abraham Ancer"    "Sebastián Muñoz"  "Kevin Na"         "Adam Long"       
##  [9] "Joel Dahmen"      "Tom Hoge"         "Kevin Kisner"     "Mark Hubbard"    
## [13] "Jason Day"        "Dylan Frittelli"  "Maverick McNealy" "J.T. Poston"     
## [17] "Matt Kuchar"      "Brian Harman"     "Bud Cauley"       "Alex Noren"      
## [21] "Ian Poulter"      "Brandt Snedeker" 
## Group 3 
##  [1] "Marc Leishman"      "Cameron Champ"      "Kevin Streelman"   
##  [4] "Billy Horschel"     "Joaquin Niemann"    "Viktor Hovland"    
##  [7] "Ryan Palmer"        "Cameron Smith"      "Byeong Hun An"     
## [10] "Gary Woodland"      "Matthew Wolff"      "Richy Werenski"    
## [13] "Brendan Steele"     "Carlos Ortiz"       "Mackenzie Hughes"  
## [16] "Danny Lee"          "Paul Casey"         "Max Homa"          
## [19] "Sung Kang"          "Talor Gooch"        "Charles Howell III"
## [22] "Bubba Watson"       "Denny McCarthy"     "Phil Mickelson"    
## [25] "Xinjun Zhang"       "Sepp Straka"        "Harry Higgs"       
## [28] "Patrick Rodgers"    "Robby Shelton"      "Si Woo Kim"        
## [31] "Matt Jones"         "Cameron Tringale"   "Tommy Fleetwood"   
## [34] "Jason Kokrak"       "Cameron Davis"      "Scott Harrington"  
## [37] "Brooks Koepka"      "Jordan Spieth"     
## Group 4 
##  [1] "Tyler Duncan"      "Nick Taylor"       "Adam Hadwin"      
##  [4] "Michael Thompson"  "Andrew Landry"     "Matt Fitzpatrick" 
##  [7] "Jim Herman"        "Corey Conners"     "Doc Redman"       
## [10] "Henrik Norlander"  "Harold Varner III" "Vaughn Taylor"    
## [13] "Brian Stuard"      "Pat Perez"         "Troy Merritt"     
## [16] "Chez Reavie"       "Nate Lashley"      "Rickie Fowler"    
## [19] "Emiliano Grillo"   "Matthew NeSmith"   "Ryan Armour"      
## [22] "Ryan Moore"        "Louis Oosthuizen"  "Russell Henley"

On affiche le nombre de golfeurs par groupe.

table(pga.groups)

## pga.groups
##  1  2  3  4 
## 16 22 38 24

On regarde maintenant les caractéristiques moyennes de chaque groupe.

# Create matrix
pga.groups.means <- matrix(NA, nrow = k, ncol = ncol(pga.2020))

# Set rownames and colnames
rownames(pga.groups.means) <- 1:k
colnames(pga.groups.means) <- colnames(pga.2020)

# Compute means
for (i in 1:k)
{
  pga.groups.means[i,] <- colMeans(pga.2020[pga.groups == i,])
}

round(pga.groups.means, 2)

##    POINTS ROUNDS SCORING     DD    DA   GIR    SS SCRAMBLING   PA   BA   MONEY
## 1 1244.81  61.56   69.45 305.84 59.31 68.91 54.59      62.73 1.73 4.27 4169090
## 2  811.27  74.45   70.32 292.83 62.19 65.62 55.02      62.61 1.74 3.83 2194328
## 3  588.00  68.82   70.69 302.60 57.99 66.59 50.05      58.23 1.76 3.83 1672304
## 4  484.83  65.08   70.80 291.32 66.37 67.72 48.78      58.56 1.76 3.69 1254750

Interprétations : en 2020, le top 100 des golfeurs au classement de la FedExCup peut être divisé en 4 groupes. On peut même identifier 2 paires de 2 groupes. La première paire est constituée des golfeurs complets, prétendant aux victoires :

• Le groupe 1 est composé de l’élite des golfeurs. C’est le plus petit groupe. On retrouve notamment Dustin Johnson, le vainqueur de la FedExCup 2020. Ce groupe a les meilleures caractéristiques moyennes pour presque toutes les statistiques. On voit notamment un grand écart au niveau du nombre de points et des gains remportés par rapport aux autres groupes. En revanche, les golfeurs de ce groupe participent à moins de rounds que les autres. On peut alors nommer ce groupe celui des favoris.
• Le groupe 2 constitue le groupe des outsiders. Les caractéristiques moyennes sont un peu moins bonnes que celles du groupe 1, mais restent néanmoins assez proches pour espérer des podiums et des victoires lors des tournois.

La seconde paire, constituée des groupes 3 et 4, est plus dense et est composée des autres golfeurs du top 100. Les scores moyens sont très proches (70.69 et 70.80) et les précisions des putts sont même égales (1.76). Ces golfeurs ont plus de mal à gérer les situations délicates que les deux premiers groupes (SS et SCRAMBLING). On peut identifier deux styles de jeu différents :

• Le groupe 3 est composé des golfeurs effectuant des drives plus longs, mais moins précis. En effet :
  • La distance moyenne des drives de ce groupe est de 10 yards supérieure à celle du groupe 4.
  • C’est le groupe ayant la moins bonne précision moyenne aux drives (57.99%).
• Le groupe 4 est composé des golfeurs effectuant des drives plus courts, mais plus précis. En effet :
  • La distance moyenne des drives est plus de 10 yards inférieure à celle du groupe 3.
  • C’est le groupe ayant nettement la meilleure précision de drives, avec 7% de plus que le groupe 1 constitué des meilleurs golfeurs.

Pour conclure :

• Les groupes 1 et 2 sont constitués des golfeurs complets qui peuvent prétendre aux victoires.
• Les groupes 3 et 4 sont les autres golfeurs qui ont des scores moyens similaires mais qui s’appuient sur leurs points forts. Ceux du groupe 3 préfèrent allonger leurs drives pour progresser plus vite au risque d’être moins précis, tandis que ceux du groupe 4 les raccourcissent pour être plus précis.

6.2 Méthode des k-means

On met ensuite en oeuvre la méthode des k-means avec les mêmes données. On utilise comme initialisation les centres de gravité des classes obtenues avec la CAH.

# Create init matrix
init <- matrix(NA, nrow = k, ncol = ncol(pga.2020))
colnames(init) <- colnames(pga.2020)
for (i in 1:k)
{
  init[i,] <- colMeans(pga.scale[pga.groups == i,])
}

# Compute k-means
pga.kmeans <- kmeans(pga.scale, centers = init)
pga.kmeans

## K-means clustering with 4 clusters of sizes 17, 21, 37, 25
## 
## Cluster means:
##        POINTS      ROUNDS    SCORING         DD          DA         GIR
## 1  1.58504832 -0.16490188 -1.6432936  0.7969638 -0.19354702  0.81248118
## 2 -0.03941647  0.27842617 -0.0878207 -0.6238075  0.06058796 -0.78917003
## 3 -0.37312248 -0.04978891  0.3480919  0.5984928 -0.66612251 -0.08864522
## 4 -0.49250175 -0.04805712  0.6760331 -0.9037065  1.06657941  0.24161054
##           SS SCRAMBLING         PA         BA      MONEY
## 1  0.5351646  0.8298330 -1.0409399  1.5770629  1.7505405
## 2  0.8185057  0.7880637 -0.4513150 -0.2586669 -0.1106063
## 3 -0.3379735 -0.4985977  0.3394574 -0.1334580 -0.3590634
## 4 -0.5512559 -0.4883354  0.5845467 -0.6576048 -0.5660444
## 
## Clustering vector:
##      Justin Thomas    Collin Morikawa       Webb Simpson  Bryson DeChambeau 
##                  1                  1                  1                  1 
##         Sungjae Im       Patrick Reed      Daniel Berger       Rory McIlroy 
##                  1                  1                  1                  1 
##       Brendon Todd           Jon Rahm  Xander Schauffele      Lanto Griffin 
##                  2                  1                  1                  2 
##      Abraham Ancer      Marc Leishman     Dustin Johnson    Sebastián Muñoz 
##                  2                  3                  1                  2 
##           Kevin Na   Hideki Matsuyama     Tyrrell Hatton      Cameron Champ 
##                  2                  1                  1                  3 
##          Adam Long    Kevin Streelman         Tony Finau  Scottie Scheffler 
##                  4                  4                  1                  1 
##     Billy Horschel    Joaquin Niemann     Harris English     Viktor Hovland 
##                  3                  3                  1                  3 
##        Ryan Palmer      Cameron Smith      Byeong Hun An    Patrick Cantlay 
##                  3                  2                  3                  1 
##      Gary Woodland      Matthew Wolff       Tyler Duncan         Adam Scott 
##                  3                  3                  4                  3 
##        Nick Taylor        Joel Dahmen           Tom Hoge       Kevin Kisner 
##                  4                  2                  4                  2 
##     Richy Werenski       Mark Hubbard     Brendan Steele        Adam Hadwin 
##                  3                  2                  3                  2 
##          Jason Day   Michael Thompson       Carlos Ortiz      Andrew Landry 
##                  2                  4                  3                  4 
##    Dylan Frittelli   Matt Fitzpatrick   Mackenzie Hughes          Danny Lee 
##                  2                  4                  2                  3 
##         Jim Herman         Paul Casey      Corey Conners           Max Homa 
##                  4                  3                  4                  3 
##   Maverick McNealy        J.T. Poston         Doc Redman          Sung Kang 
##                  2                  2                  4                  3 
##        Talor Gooch        Matt Kuchar Charles Howell III       Bubba Watson 
##                  3                  2                  3                  3 
##     Denny McCarthy     Phil Mickelson   Henrik Norlander       Brian Harman 
##                  3                  3                  4                  2 
##       Xinjun Zhang        Sepp Straka        Harry Higgs  Harold Varner III 
##                  3                  3                  3                  3 
##         Bud Cauley      Vaughn Taylor       Brian Stuard    Patrick Rodgers 
##                  2                  4                  4                  3 
##         Alex Noren          Pat Perez       Troy Merritt      Robby Shelton 
##                  2                  4                  4                  4 
##         Si Woo Kim        Chez Reavie       Nate Lashley        Ian Poulter 
##                  3                  4                  4                  2 
##         Matt Jones   Cameron Tringale      Rickie Fowler    Tommy Fleetwood 
##                  3                  3                  4                  3 
##       Jason Kokrak      Cameron Davis    Emiliano Grillo    Matthew NeSmith 
##                  3                  3                  4                  4 
##   Scott Harrington        Ryan Armour         Ryan Moore      Brooks Koepka 
##                  3                  4                  4                  3 
##    Brandt Snedeker      Jordan Spieth   Louis Oosthuizen     Russell Henley 
##                  2                  3                  3                  4 
## 
## Within cluster sum of squares by cluster:
## [1] 135.3548 114.4067 208.8775 161.4616
##  (between_SS / total_SS =  43.1 %)
## 
## Available components:
## 
## [1] "cluster"      "centers"      "totss"        "withinss"     "tot.withinss"
## [6] "betweenss"    "size"         "iter"         "ifault"

On compare ce clustering avec celui obtenu avec la CAH.

table(pga.groups, pga.kmeans$cluster)

##           
## pga.groups  1  2  3  4
##          1 15  0  1  0
##          2  2 18  0  2
##          3  0  2 34  2
##          4  0  1  2 21

adjustedRandIndex(pga.groups, pga.kmeans$cluster)

## [1] 0.7036602

Seulement 10 individus sur les 100 sont classés différemment. Donc, les partitionnements sont très proches. De plus, l’index d’ajustement (0.70) est proche de 1 ce qui confirme ce constat.

On lance maintenant une ACP pour interpréter les groupes. On crée un jeu de données des golfeurs de 2020, en ajoutant le numéro de groupe des golfeurs.

pga.2020.pca <- PCA(cbind.data.frame(
  pga.2020, Group = factor(pga.kmeans$cluster)),
  scale.unit = TRUE, quali.sup = 12, graph = FALSE)
summary(pga.2020.pca)

## 
## Call:
## PCA(X = cbind.data.frame(pga.2020, Group = factor(pga.kmeans$cluster)),  
##      scale.unit = TRUE, quali.sup = 12, graph = FALSE) 
## 
## 
## Eigenvalues
##                        Dim.1   Dim.2   Dim.3   Dim.4   Dim.5   Dim.6   Dim.7
## Variance               4.354   1.761   1.391   1.067   0.891   0.646   0.418
## % of var.             39.583  16.009  12.649   9.702   8.097   5.870   3.801
## Cumulative % of var.  39.583  55.592  68.241  77.943  86.039  91.910  95.711
##                        Dim.8   Dim.9  Dim.10  Dim.11
## Variance               0.192   0.164   0.074   0.042
## % of var.              1.743   1.490   0.677   0.380
## Cumulative % of var.  97.454  98.943  99.620 100.000
## 
## Individuals (the 10 first)
##                       Dist    Dim.1    ctr   cos2    Dim.2    ctr   cos2  
## Justin Thomas     |  7.549 |  7.026 11.338  0.866 | -0.267  0.040  0.001 |
## Collin Morikawa   |  4.428 |  3.070  2.164  0.481 |  0.454  0.117  0.011 |
## Webb Simpson      |  6.746 |  6.057  8.425  0.806 |  1.066  0.645  0.025 |
## Bryson DeChambeau |  5.956 |  5.516  6.987  0.858 | -1.422  1.149  0.057 |
## Sungjae Im        |  4.213 |  3.134  2.256  0.553 |  1.188  0.802  0.080 |
## Patrick Reed      |  4.527 |  3.926  3.539  0.752 |  1.150  0.750  0.064 |
## Daniel Berger     |  4.785 |  4.417  4.481  0.852 |  1.306  0.969  0.075 |
## Rory McIlroy      |  4.288 |  3.323  2.536  0.601 | -2.173  2.682  0.257 |
## Brendon Todd      |  4.610 |  1.816  0.757  0.155 |  3.958  8.898  0.737 |
## Jon Rahm          |  5.287 |  4.964  5.660  0.881 | -0.034  0.001  0.000 |
##                    Dim.3    ctr   cos2  
## Justin Thomas      0.433  0.135  0.003 |
## Collin Morikawa    1.895  2.580  0.183 |
## Webb Simpson       1.634  1.919  0.059 |
## Bryson DeChambeau -0.660  0.313  0.012 |
## Sungjae Im         0.764  0.420  0.033 |
## Patrick Reed      -1.474  1.562  0.106 |
## Daniel Berger     -0.089  0.006  0.000 |
## Rory McIlroy       0.158  0.018  0.001 |
## Brendon Todd       0.646  0.300  0.020 |
## Jon Rahm           0.671  0.323  0.016 |
## 
## Variables (the 10 first)
##                      Dim.1    ctr   cos2    Dim.2    ctr   cos2    Dim.3    ctr
## POINTS            |  0.834 15.992  0.696 |  0.042  0.102  0.002 |  0.138  1.369
## ROUNDS            | -0.016  0.006  0.000 |  0.245  3.400  0.060 |  0.245  4.298
## SCORING           | -0.919 19.384  0.844 |  0.010  0.006  0.000 | -0.096  0.661
## DD                |  0.400  3.681  0.160 | -0.834 39.521  0.696 | -0.130  1.219
## DA                | -0.166  0.631  0.027 |  0.611 21.233  0.374 |  0.683 33.483
## GIR               |  0.321  2.368  0.103 | -0.320  5.831  0.103 |  0.728 38.142
## SS                |  0.459  4.843  0.211 |  0.403  9.238  0.163 | -0.405 11.779
## SCRAMBLING        |  0.612  8.598  0.374 |  0.493 13.816  0.243 | -0.183  2.414
## PA                | -0.682 10.678  0.465 | -0.302  5.187  0.091 |  0.252  4.552
## BA                |  0.836 16.070  0.700 | -0.166  1.556  0.027 |  0.141  1.435
##                     cos2  
## POINTS             0.019 |
## ROUNDS             0.060 |
## SCORING            0.009 |
## DD                 0.017 |
## DA                 0.466 |
## GIR                0.531 |
## SS                 0.164 |
## SCRAMBLING         0.034 |
## PA                 0.063 |
## BA                 0.020 |
## 
## Supplementary categories
##                       Dist    Dim.1   cos2 v.test    Dim.2   cos2 v.test  
## Group_1           |  3.785 |  3.742  0.977  8.074 | -0.327  0.007 -1.109 |
## Group_2           |  1.644 |  0.184  0.013  0.453 |  1.347  0.671  5.208 |
## Group_3           |  1.309 | -0.688  0.276 -2.513 | -1.022  0.609 -5.873 |
## Group_4           |  2.097 | -1.681  0.643 -4.628 |  0.603  0.083  2.612 |
##                    Dim.3   cos2 v.test  
## Group_1            0.384  0.010  1.464 |
## Group_2           -0.867  0.278 -3.771 |
## Group_3           -0.369  0.080 -2.388 |
## Group_4            1.014  0.234  4.939 |

On regarde les valeurs propres et parts d’inertie expliquées par chaque axe.

# Extract eigenvalues/variances
get_eig(pga.2020.pca)

##        eigenvalue variance.percent cumulative.variance.percent
## Dim.1  4.35408684       39.5826076                    39.58261
## Dim.2  1.76103252       16.0093865                    55.59199
## Dim.3  1.39137836       12.6488942                    68.24089
## Dim.4  1.06718410        9.7016737                    77.94256
## Dim.5  0.89066213        8.0969285                    86.03949
## Dim.6  0.64574977        5.8704524                    91.90994
## Dim.7  0.41808727        3.8007933                    95.71074
## Dim.8  0.19171554        1.7428685                    97.45360
## Dim.9  0.16386890        1.4897173                    98.94332
## Dim.10 0.07445594        0.6768722                    99.62019
## Dim.11 0.04177863        0.3798058                   100.00000

# Visualize eigenvalues/variances
fviz_screeplot(pga.2020.pca, addlabels = TRUE, ylim = c(0, 50))

Figure 6.4: Part d’inertie expliquée pour chaque axe

On garde les deux premières composantes. On regarde le cercle de corrélation entre elles.

# Graph of variables: control variable colors using their contributions
fviz_pca_var(pga.2020.pca, col.var = "contrib",
             gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),
             repel = TRUE # Avoid text overlapping
             )

Figure 6.5: Graphe des variables

On étudie les contributions des deux axes.

# Contributions of variables to PC1
fviz_contrib(pga.2020.pca, choice = "var", axes = 1, top = 10)
# Contributions of variables to PC2
fviz_contrib(pga.2020.pca, choice = "var", axes = 2, top = 10)

Figure 6.6: Graphe des contributions

Interprétation des axes :

• L’axe 1 oppose les meilleurs golfeurs au moins bons. Importance de SCORING, MONEY, BA, POINTS et PA. On rappelle qu’il est mieux d’avoir PA et SCORING faibles.
• L’axe 2 oppose les golfeurs faisant de longs drives (en bas) et ceux préférant la précision (en haut).

On regarde maintenant le graphe des individus en montrant les groupes identifiés par la méthode des k-means sur les deux premières composantes (figure 6.7).

# Graph of individuals: use habillage to specify groups for coloring
fviz_pca_ind(pga.2020.pca,
             habillage = factor(pga.kmeans$cluster), # color by groups
             addEllipses = TRUE, # Concentration ellipses
             ellipse.type = "convex",
             repel = TRUE,
             labelsize = 2,
             title = "Cluster plot with k-means, PGA Tour 2020"
             )

Figure 6.7: Clustering avec la méthode des k-means

Interprétations :

Le graphe des individus confirme l’interprétation donnée à la suite de la CAH. En effet :

• On retrouve le groupe des favoris (le 1) le plus à droite, et celui des outsiders (le 2) juste à sa gauche.
• Les golfeurs du groupe 3 se trouvent en dessous de l’axe des abscisses ce qui montre leur préférence pour les drives longs mais moins précis.
• Les golfeurs du groupe 4 se trouvent au dessus de l’axe des abscisses ce qui montre leur préférence pour les drives courts mais plus précis.

On représente ensuite la silhouette des individus (figure 6.8).

pga.sil <- silhouette(pga.kmeans$cluster, pga.dist)

fviz_cluster(pga.kmeans, pga.2020, ellipse.type = "convex", repel = TRUE,
             labelsize = 7, main = "Cluster plot with k-means, PGA Tour 2020")
fviz_silhouette(pga.sil)

##   cluster size ave.sil.width
## 1       1   17          0.21
## 2       2   21          0.16
## 3       3   37          0.15
## 4       4   25          0.10

Figure 6.8: Clusters et silhouettes des individus avec k-means

Interprétation :

D’après la silhouette, on voit qu’il est assez difficile de classer les golfeurs. En effet, les silhouettes sont globalement faibles. Cela se voit aussi sur le graphe des clusters où on voit les ellipses se chevaucher. On en déduit que les golfeurs ont finalement des niveaux de jeu assez proches.

6.3 Algorithme des k-médoïdes

Enfin, on met en oeuvre l’algorithme des k-médoïdes sur le même jeu de données avec le même nombre de classes. La figure 6.10 montre le clustering obtenu.

# k-medoids
pga.pam <- pam(pga.scale, k)
plot(pga.pam)

# Comparison with k-means
table(pga.pam$clustering, pga.kmeans$cluster)

##    
##      1  2  3  4
##   1 12  0  0  0
##   2  0 13  2  0
##   3  5  4 29  6
##   4  0  4  6 19

Figure 6.9: Graphes des clusters et silhouettes avec PAM

fviz_cluster(pga.pam, pga.2020, ellipse.type = "convex", repel = TRUE,
             labelsize = 7, main = "Cluster plot with PAM, PGA Tour 2020")

Figure 6.10: Clustering avec l’algorithme des k-médoïdes

Sur la figure 6.10, l’axe des abscisses est inversé : les meilleurs golfeurs sont à gauche. En comparant avec la méthode des k-means, on voit que les résultats sont similaires.

6.4 HCPC

On considère désormais le jeu de données complet. On réalise un clustering des golfeurs à partir de l’ACP réalisée dans la partie 5.

On lance donc la commande HCPC (STHDA, s. d.h) de FactoMineR sur l’ACP en laissant choisir le nombre de classes.

# Compute hierarchical clustering on principal components
pga.hcpc <- HCPC(pga.pca, nb.clust = -1, graph = FALSE)

# Dendrogram
# fviz_dend(pga.hcpc, rect = TRUE, rect_fill = TRUE, show_labels = FALSE,
#           main = "Cluster Dendrogram with HCPC, PGA 2010-2020")

# Individuals on the principal component with clustering
fviz_cluster(pga.hcpc, show.clust.cent = TRUE, geom = "point",
             main = "Cluster plot with HCPC, PGA Tour 2010-2020")

# Principal components + tree
plot(pga.hcpc, choice = "3D.map")

Figure 6.11: Clustering avec HCPC

Interprétation : avec cette méthode, on ne trouve que 3 classes. Ici, le groupe des favoris et celui des outsiders ne forment qu’un seul groupe (en bleu). Sinon, on retrouve les deux autres groupes : celui des golfeurs puissants (en rouge) et celui des golfeurs précis (en vert). Les résultats trouvés sur l’année 2020 sont donc cohérents avec ceux trouvés sur la période 2010-2020.

7.1 LDA et QDA

On met en oeuvre les méthodes LDA et QDA sur l’échantillon d’apprentissage.

# Modèle
lda.res <- lda(WINS ~ ., data.train)
qda.res <- qda(WINS ~ ., data.train)

# Prédiction
lda.class <- predict(lda.res, newdata = data.test)$class
qda.class <- predict(qda.res, newdata = data.test)$class

# Table de confusion
table(lda.class, data.test$WINS)

##          
## lda.class   0   1
##         0 139  33
##         1   4  44

table(qda.class, data.test$WINS)

##          
## qda.class   0   1
##         0 132  27
##         1  11  50

# Accuracy
lda.accuracy <- mean(lda.class == data.test$WINS)
lda.accuracy

## [1] 0.8318182

qda.accuracy <- mean(qda.class == data.test$WINS)
qda.accuracy

## [1] 0.8272727

# Aire sous la courbe ROC
lda.pred <- predict(lda.res, newdata = data.test)$posterior[, 2]
lda.roc <- roc(data.test$WINS, lda.pred)

## Setting levels: control = 0, case = 1

## Setting direction: controls < cases

lda.roc$auc

## Area under the curve: 0.9417

qda.pred <- predict(qda.res, newdata = data.test)$posterior[, 2]
qda.roc <- roc(data.test$WINS, qda.pred)

## Setting levels: control = 0, case = 1
## Setting direction: controls < cases

qda.roc$auc

## Area under the curve: 0.9107

On utilise maintenant une procédure de sélection de modèle pour la LDA et la QDA.

# Sélection de modèle
lda.stepwise <- stepclass(WINS ~ ., data = data.train, method = "lda",
                          direction = "backward")

##  `stepwise classification', using 10-fold cross-validated correctness rate of method lda'.

## 880 observations of 11 variables in 2 classes; direction: backward

## stop criterion: improvement less than 5%.

## correctness rate: 0.86591;  starting variables (11): POINTS, ROUNDS, SCORING, DD, DA, GIR, SS, SCRAMBLING, PA, BA, MONEY 
## correctness rate: 0.87386;  out: "PA";  variables (10): POINTS, ROUNDS, SCORING, DD, DA, GIR, SS, SCRAMBLING, BA, MONEY 
## correctness rate: 0.87614;  out: "SCRAMBLING";  variables (9): POINTS, ROUNDS, SCORING, DD, DA, GIR, SS, BA, MONEY 
## 
##  hr.elapsed min.elapsed sec.elapsed 
##       0.000       0.000       1.107

lda.stepwise

## method      : lda 
## final model : WINS ~ POINTS + ROUNDS + SCORING + DD + DA + GIR + SS + BA + 
##     MONEY
## <environment: 0x56242d6e5878>
## 
## correctness rate = 0.8761

qda.stepwise <- stepclass(WINS ~ ., data = data.train, method = "qda",
                          direction = "backward")

##  `stepwise classification', using 10-fold cross-validated correctness rate of method qda'.

## 880 observations of 11 variables in 2 classes; direction: backward

## stop criterion: improvement less than 5%.

## correctness rate: 0.85455;  starting variables (11): POINTS, ROUNDS, SCORING, DD, DA, GIR, SS, SCRAMBLING, PA, BA, MONEY 
## correctness rate: 0.86364;  out: "MONEY";  variables (10): POINTS, ROUNDS, SCORING, DD, DA, GIR, SS, SCRAMBLING, PA, BA 
## correctness rate: 0.86818;  out: "SS";  variables (9): POINTS, ROUNDS, SCORING, DD, DA, GIR, SCRAMBLING, PA, BA 
## correctness rate: 0.87273;  out: "GIR";  variables (8): POINTS, ROUNDS, SCORING, DD, DA, SCRAMBLING, PA, BA 
## 
##  hr.elapsed min.elapsed sec.elapsed 
##       0.000       0.000       1.267

qda.stepwise

## method      : qda 
## final model : WINS ~ POINTS + ROUNDS + SCORING + DD + DA + SCRAMBLING + PA + 
##     BA
## <environment: 0x56243a840c50>
## 
## correctness rate = 0.8727

# Modèle
lda.stepwise.res <- lda(lda.stepwise$formula, data = data.train)
qda.stepwise.res <- lda(qda.stepwise$formula, data = data.train)

# Prédiction
lda.stepwise.class <- predict(lda.stepwise.res, newdata = data.test)$class
qda.stepwise.class <- predict(qda.stepwise.res, newdata = data.test)$class

# Accuracy
lda.stepwise.accuracy <- mean(lda.stepwise.class == data.test$WINS)
lda.stepwise.accuracy

## [1] 0.8227273

qda.stepwise.accuracy <- mean(qda.stepwise.class == data.test$WINS)
qda.stepwise.accuracy

## [1] 0.8181818

# Aire sous la courbe ROC
lda.stepwise.pred <- predict(lda.stepwise.res,
                             newdata = data.test)$posterior[, 2]
lda.stepwise.roc <- roc(data.test$WINS, lda.stepwise.pred)

## Setting levels: control = 0, case = 1

## Setting direction: controls < cases

lda.stepwise.roc$auc

## Area under the curve: 0.9392

qda.stepwise.pred <- predict(qda.stepwise.res,
                             newdata = data.test)$posterior[, 2]
qda.stepwise.roc <- roc(data.test$WINS, qda.stepwise.pred)

## Setting levels: control = 0, case = 1
## Setting direction: controls < cases

qda.stepwise.roc$auc

## Area under the curve: 0.9431

7.2 CART

On lance l’algorithme CART sur les données d’apprentissage pour trouver un arbre optimal.

set.seed(1)

# Tree
tree <- rpart(WINS ~ ., data.train,
              control = rpart.control(minsplit = 5, cp = 0))
printcp(tree)

## 
## Classification tree:
## rpart(formula = WINS ~ ., data = data.train, control = rpart.control(minsplit = 5, 
##     cp = 0))
## 
## Variables actually used in tree construction:
##  [1] BA         DA         DD         GIR        MONEY      PA        
##  [7] POINTS     ROUNDS     SCORING    SCRAMBLING SS        
## 
## Root node error: 264/880 = 0.3
## 
## n= 880 
## 
##           CP nsplit rel error  xerror     xstd
## 1  0.4053030      0  1.000000 1.00000 0.051493
## 2  0.0757576      1  0.594697 0.61364 0.043549
## 3  0.0265152      3  0.443182 0.53788 0.041336
## 4  0.0151515      4  0.416667 0.54545 0.041570
## 5  0.0094697      7  0.371212 0.54167 0.041453
## 6  0.0075758     11  0.333333 0.54167 0.041453
## 7  0.0063131     20  0.265152 0.56439 0.042141
## 8  0.0056818     24  0.238636 0.54167 0.041453
## 9  0.0050505     33  0.185606 0.56061 0.042028
## 10 0.0037879     41  0.143939 0.56439 0.042141
## 11 0.0018939     53  0.098485 0.64773 0.044461
## 12 0.0012626     58  0.087121 0.65909 0.044754
## 13 0.0000000     61  0.083333 0.65909 0.044754

plotcp(tree)

# Optimal cp
cp.opt <- tree$cptable[which.min(tree$cptable[, "xerror"]), "CP"]

# Prune tree
tree.opt <- prune(tree, cp.opt)
rpart.plot(tree.opt, type = 4)

Figure 7.1: Arbre CART optimal

On prédit les classes des individus de l’échantillon test, et on évalue la méthode.

# Prédiction
cart.class <- predict(tree.opt, newdata = data.test, type = "class")

# Table de confusion
table(cart.class, data.test$WINS)

##           
## cart.class   0   1
##          0 130  33
##          1  13  44

# Accuracy
cart.accuracy <- mean(cart.class == data.test$WINS)
cart.accuracy

## [1] 0.7909091

# Aire sous la courbe ROC
cart.pred <- predict(tree.opt, newdata = data.test, type = "prob")[, 2]
cart.roc <- roc(data.test$WINS, cart.pred)

## Setting levels: control = 0, case = 1

## Setting direction: controls < cases

cart.roc$auc

## Area under the curve: 0.7768

7.3 Random forest

On lance l’algorithme de Random forest sur l’échantillon d’apprentissage.

# Modèle
rf <- randomForest(WINS ~ ., data.train)

# Prédiction
rf.class <- predict(rf, data.test, type = "class")

# Table de confusion
table(rf.class, data.test$WINS)

##         
## rf.class   0   1
##        0 132  23
##        1  11  54

# Accuracy
rf.accuracy <- mean(rf.class == data.test$WINS)
rf.accuracy

## [1] 0.8454545

# Aire sous la courbe ROC
rf.pred <- predict(rf, newdata = data.test, type = "prob")[, 2]
rf.roc <- roc(data.test$WINS, rf.pred)

## Setting levels: control = 0, case = 1

## Setting direction: controls < cases

rf.roc$auc

## Area under the curve: 0.901

7.4 Régression logistique

On lance une régression logistique sur l’échantillon d’apprentissage.

# Modèle
GLM <- glm(WINS ~ ., family = binomial, data.train)

# Prédiction
glm.pred <- predict(GLM, data.test, type = "response")
# Si pred > 0.5 class 1; Sinon class 0
glm.class <- ifelse(glm.pred > 0.5, 1, 0)

# Table de confusion
table(glm.class, data.test$WINS)

##          
## glm.class   0   1
##         0 132  28
##         1  11  49

# Accuracy
glm.accuracy <- mean(glm.class == data.test$WINS)
glm.accuracy

## [1] 0.8227273

# Aire sous la courbe ROC
glm.roc <- roc(data.test$WINS, glm.pred)

## Setting levels: control = 0, case = 1

## Setting direction: controls < cases

glm.roc$auc

## Area under the curve: 0.9431

7.5 Comparaison

Pour conclure, on compare les méthodes précédentes avec les taux de bons classements (Accuracy) et l’aire sous la courbe ROC (AUC).

results <- matrix(NA, ncol = 7, nrow = 2)
rownames(results) <- c('Accuracy', 'AUC')
colnames(results) <- c('LDA', 'LDA.STEP', 'QDA', 'QDA.STEP',
                       'CART', 'RF', 'GLM')

# 1ère ligne : Accuracy
results[1,] <- c(lda.accuracy, lda.stepwise.accuracy, qda.accuracy,
                 qda.stepwise.accuracy, cart.accuracy, rf.accuracy,
                 glm.accuracy)

# 2nde ligne : AUC
results[2,] <- c(lda.roc$auc, lda.stepwise.roc$auc, qda.roc$auc,
                 qda.stepwise.roc$auc, cart.roc$auc, rf.roc$auc, glm.roc$auc)
results

##                LDA  LDA.STEP       QDA  QDA.STEP      CART        RF       GLM
## Accuracy 0.8318182 0.8227273 0.8272727 0.8181818 0.7909091 0.8454545 0.8227273
## AUC      0.9416947 0.9392426 0.9107256 0.9431478 0.7767687 0.9009627 0.9431478

# Meilleure méthode
apply(results, 1, which.max)

## Accuracy      AUC 
##        6        7

# ROC plot
ggroc(list(LDA = lda.roc, LDA.STEP = lda.stepwise.roc, QDA = qda.roc,
           QDA.STEP = qda.stepwise.roc, CART = cart.roc, RF = rf.roc,
           GLM = glm.roc)) +
  ggtitle('ROC Curves') +
  theme_minimal()

Figure 7.2: Courbes ROC

D’après le tableau et les courbes ROC de la figure 7.2, les méthodes sont plutôt efficaces pour déterminer si un golfeur a gagné un tournoi ou non pendant une saison : les taux de bons classements et les aires sous la courbe ROC sont proches de 1. Les meilleures méthodes semblent être la régression logistique, la LDA, la QDA et Random forest. La méthode CART donne de moins bons résultats.

7.6 Importance des variables

Pour finir, on regarde les scores d’importance de chaque variable pour l’algorithme de Random forest et pour la méthode CART.

# On crée un dataframe en triant par importance
rf.ord <- order(rf$importance, decreasing = TRUE)
rf.importance.df <- data.frame(Variable = rownames(rf$importance)[rf.ord],
                               Importance = rf$importance[rf.ord])

cart.importance.df <- data.frame(tree.opt$variable.importance)
names(cart.importance.df)[1] <- "Importance"
cart.importance.df$Variable <- row.names(cart.importance.df)

# Rend la colonne Variable ordonnée
rf.importance.df$Variable <- factor(rf.importance.df$Variable,
                                    levels = rf.importance.df$Variable)
cart.importance.df$Variable <- factor(cart.importance.df$Variable,
                                      levels = cart.importance.df$Variable)

# Barplot
ggplot(data = rf.importance.df, aes(x = Variable,
                                    y = Importance, fill = Variable)) +
    geom_bar(stat = "identity") +
    geom_text(aes(label = round(Importance)), hjust = 1.6, color = "white", size = 3.5) +
    ggtitle("Importance of variables for Random forest") +
    coord_flip()

ggplot(data = cart.importance.df, aes(x = Variable,
                                      y = Importance, fill = Variable)) +
    geom_bar(stat = "identity") +
    geom_text(aes(label = round(Importance)), hjust = 1.6, color = "white", size = 3.5) +
    ggtitle("Importance of variables for CART") +
    coord_flip()

Figure 7.3: Importances des variables

D’après la figure 7.3, les variables les plus importantes pour expliquer WINS sont POINTS, MONEY et SCORING. En effet, un golfeur ayant gagné beaucoup de points pour la FedExCup et ayant remporté beaucoup de gains a plus de chance d’avoir gagné un tournoi au cours de la saison.