Bellotto Anthony
Latour Nathanaël
Le Mercier Aurore
Projet de statistique
Introduction :
Nous avons réalisé une étude statistique pour répondre à cette problématique : Peut-on
déterminer l’efficacité d’un joueur seulement à partir de ses statistiques ?
Pour ce faire nous avons étudier certaines variables sur un échantillon de 100 joueurs de NBA.
Ces variables sont la moyenne de point par match, de rebond par match ou encore de passe
décisive par match. Nous avons réalisé l’étude sur trois saisons différentes : 2018-2019, 2019-
2020 et 2020-2021 afin de nous assurer de la fiabilité de notre étude. Vous trouverez en
dessous le code R attribué a notre étude de l’année 18-19. Il s’agit du même code pour les
autres années.
Code R:
# Installation des librairies
[Link]("car")
# Importation de la base de donnee (Format exel)
library(readxl)
#Donnees_20_21 <- read_excel("chemin")
#------------------------------------------------ Partie 1 : PPM/RPM/PDPM ------------------------------------------------
#Nous cherchons a voir s'il y a des liens entre les differentes variables : Points par match (PPM), Rebonds par
Match (RPM) et Passe decisives par Match (PDPM)
#--------------------------------------------------- Test d'independance ----------------------------------------------------
# Le principe est de voir la dependance entre nos variables
# H0 : Les variable sont independantes
# H1 : Les variable sont dependantes
# Test d'independance: (Si pv < 5% il y a dependence)
#----------------------------------------- Test d'independance entre PPM et RPM---------------------------------------
X <- Stat_2018_et_2019$PPM
X2 <- Stat_2018_et_2019$RPM
[Link](X, X2)
# On obtient pv < 2.2e-16 < alpha 5%
# On rejette alors H0 au risque alpha 5%
# Donc les variables sont dependantes
# Pour visualiser la dependance
Bellotto Anthony
Latour Nathanaël
Le Mercier Aurore
plot(ecdf(X), xlim = range(c(X, X2)), col = "blue")
plot(ecdf(X2), add = TRUE, lty = "dashed", col = "red")
#---------------------------------------------Test d'independance entre PPM et PDPM-------------------------------
X <- Stat_2018_et_2019$PPM
X2 <- Stat_2018_et_2019$PDPM
[Link](X, X2)
# On obtient pv < 2.2e-16 < alpha 5%
# On rejette alors H0 au risque alpha 5%
# Donc les variables sont dependantes
# Pour visualiser la dependance
plot(ecdf(X), xlim = range(c(X, X2)), col = "blue")
plot(ecdf(X2), add = TRUE, lty = "dashed", col = "red")
#-------------------------------------------- Test d'independance entre RPM et PDPM----------------------------------
X <- Stat_2018_et_2019$RPM
X2 <- Stat_2018_et_2019$PDPM
[Link](X, X2)
# On obtient pv =1.972e-10 < alpha 5%
# On rejette alors H0 au risque alpha 5%
# Donc les variables sont dependantes
# Pour visualiser la dependance
plot(ecdf(X), xlim = range(c(X, X2)), col = "blue")
plot(ecdf(X2), add = TRUE, lty = "dashed", col = "red")
#------------------------------------------------------- Regression lineaire ----------------------------------------------------
# Chargement de la librairie
library(car)
#Le but est de determiner si entre nos variables nous avons une distrbution lineaire et si c'est le cas quels sont les
coefficients.
#-------------------------------------------Regression lineaire entre PPM~RPM-------------------------------------------
Regression1 <- lm(PPM~RPM, data=Stat_2018_et_2019)
scatterplot(PPM~RPM, data=Stat_2018_et_2019, main="Regression entre PPM~RPM")
summary(Regression1)
#On peut voir que r-squared est tres faible, egal e 0.074 ce qui signifie que la regression lineaire n'est pas le bon
choix pour notre modele.
Bellotto Anthony
Latour Nathanaël
Le Mercier Aurore
#Le r-squared est tres faible, cela signifie que l'equation de la droite de regression determine 7.4% de la
distribution des points.
#Cela signifie que le modele mathematique utilise n'explique pas la distribution des points.
#-------------------------------------------Regression lineaire entre PPM~PDPM-----------------------------------------
Regression2 <- lm(PPM~PDPM, data=Stat_2018_et_2019)
scatterplot(PPM~PDPM, data=Stat_2018_et_2019, main="Regression entre PPM~PDPM")
summary(Regression2)
#On peut voir que r-squared est de 0.33 ce qui signifie que la regression lineaire n'est pas le bon choix pour notre
modele.
#Cela signifie que l'equation de la droite de regression determine 33.06% de la distribution des points.
#Donc le modele mathematique utilise n'explique pas la distribution des points.
#-----------------------------------------------Regression lineaire entre RPM~PDPM-------------------------------------
Regression3 <- lm(RPM~PDPM, data=Stat_2018_et_2019)
scatterplot(RPM~PDPM, data=Stat_2018_et_2019, main="Regression entre RPM~PDPM")
summary(Regression3)
#On peut voir que r-squared est tres faible, egal e 0.045 ce qui signifie que la regression lineaire n'est pas le bon
choix pour notre modele.
#Le r-squared est tres faible, cela signifie que l'equation de la droite de regression determine 4.5% de la
distribution des points.
#Cela signifie que le modele mathematique utilise n'explique absolument pas la distribution des points.
#------------------------------------------------------ Regression logistique -------------------------------------------------
#Les conditions pour appliquer la regression logistique :
# Avoir dix fois plus d'evenements que de parametres dans le monde : On a deux Parametres => Il nous faut au
minimum
#20 evenemenents en sachant qu'on en a 100. Cette condition est respectee.
#On a une surdispersion puisque le ration de la deviance residuelle sur le nombre de degres de libertes est
superieur a 1
#On a 215.69/98 = 2.20. Puisque nous avons des sudispersions, nous allons utiliser la loi quasipoisson.
#Neanmoins l'utilisation de la structure d'erreur "Quasi Poisson a pour concequence d'augmenter l'erreur
standard des parametres"
#-------------------------------------------- Regression logistique entre PPM~RPM -------------------------------------
Regressionlogistique <- glm(PPM~RPM, family = quasipoisson(link = "log"), Stat_2018_et_2019)
scatterplot(PPM~RPM, data=Stat_2018_et_2019, main="Regression entre PPM~RPM")
summary(Regressionlogistique)
Bellotto Anthony
Latour Nathanaël
Le Mercier Aurore
#Le coefficients 0.045 associe e RPM signifie qu'une augmentation d'une unite de RPM de chaque joueur, est
associee avec une augmentation de 0.045 du PPM.
#Ainsi on peut predire le nombre de points en fonction du nombre de rebonds. Neanmoins, il y a une marge
d'erreur a prendre en compte.
#Visualisation d'une prediction suivant notre regression logistique :
xmin <- min(Stat_2018_et_2019$RPM)
xmax <- max(Stat_2018_et_2019$RPM)
predicted <- [Link](RPM=seq(xmin, xmax, [Link]=10000))
predicted$PPM <-[Link](Regressionlogistique,newdata= predicted, type="response")
head(predicted)
library(ggplot2)
ggplot(Stat_2018_et_2019, aes(x=PPM, y=RPM)) + geom_point()+
geom_line(data=predicted, size=1) # permet d'ajouter le modele
#Ainsi on voit qu'avec le nombre de rebond, on peut prevoir le nombre de point mis par le joueur grace a la courbe.
#----------------------------------------- Regression logistique entre PPM~PDPM --------------------------------------
Regressionlogique2 <- glm(PPM~PDPM, family = quasipoisson(link = "log"), data=Stat_2018_et_2019)
scatterplot(PPM~PDPM, data=Stat_2018_et_2019, main="Regression entre PPM~PDPM")
summary(Regressionlogique2)
#Le coefficients 0.1 associe e PDPM signifie qu'une augmentation d'une unite de PDPM de chaque joueur, est
associee avec une augmentation de 0.1 du PPM.
#Ainsi on peut predire le nombre de points en fonction du nombre de rebonds. Neanmoins, il y a une marge
d'erreur a prendre en compte.
#Visualisation d'une prediction suivant notre regression logistique :
xmin <- min(Stat_2018_et_2019$PDPM)
xmax <- max(Stat_2018_et_2019$PDPM)
predicted <- [Link](PDPM=seq(xmin, xmax, [Link]=10000))
predicted$PPM <-[Link](Regressionlogique2,newdata= predicted, type="response")
head(predicted)
library(ggplot2)
ggplot(Stat_2018_et_2019, aes(x=PPM, y=PDPM)) + geom_point()+
geom_line(data=predicted, size=1) # permet d'ajouter le modele
#Ainsi on voit qu'avec le nombre de passe decisive, on peut prevoir le nombre de point mis par le joueur grace a
la courbe.
#---------------------------------------- Regression logistique entre RPM~PDPM ---------------------------------------
Bellotto Anthony
Latour Nathanaël
Le Mercier Aurore
Regressionlogique3 <- glm(RPM~PDPM, family = quasipoisson(link = "log"), data=Stat_2018_et_2019)
scatterplot(RPM~PDPM, data=Stat_2018_et_2019, main="Regression entre PPM~PDPM")
summary(Regressionlogique2)
#Le coefficients 0.1 associe e RPM signifie qu'une augmentation d'une unite de RPM de chaque joueur, est
associee avec une augmentation de 0.1 du PDPM.
#Ainsi on peut predire le nombre de points en fonction du nombre de rebonds. Neanmoins, il y a une marge
d'erreur a prendre en compte.
#Visualisation d'une prediction suivant notre regression logistique :
xmin <- min(Stat_2018_et_2019$PDPM)
xmax <- max(Stat_2018_et_2019$PDPM)
predicted <- [Link](PDPM=seq(xmin, xmax, [Link]=10000))
predicted$RPM <-[Link](Regressionlogique3,newdata= predicted, type="response")
head(predicted)
library(ggplot2)
ggplot(Stat_2018_et_2019, aes(x=RPM, y=PDPM)) + geom_point()+
geom_line(data=predicted, size=1) # permet d'ajouter le modele
#Ainsi on voit qu'avec le nombre de passe decisive, on peut prevoir le nombre de rebond mis par le joueur grace
a la courbe.
#----------------------------------------------------- Partie 2 : Efficacite ------------------------------------------------------
#----------------------------------------- Test d'independance entre EFF et MPM ---------------------------------------
#Nous comparons l'efficacite et les minutes par match jouees. On cherche a savoir s'ils sont independant.
# H0 : Les variable sont independantes
# H1 : Les variable sont dependantes
# Test d'independance: (Si pv < 5% il y a dependence)
X <- Stat_2018_et_2019$EFF
X2 <- Stat_2018_et_2019$MPM
[Link](X, X2)
# On obtient pv < 2.2e-16 < alpha 5%
# On rejette alors H0 au risque alpha 5%
# Donc les variables sont dependantes
# Pour visualiser la dependance
plot(ecdf(X), xlim = range(c(X, X2)), col = "blue")
plot(ecdf(X2), add = TRUE, lty = "dashed", col = "red")
Bellotto Anthony
Latour Nathanaël
Le Mercier Aurore
#----------------------------------------------- Regression lineaire entre MPM~EFF--------------------------------------
Regression4 <- lm(EFF~MPM, data=Stat_2018_et_2019)
scatterplot(EFF~MPM, data=Stat_2018_et_2019, main="Regression entre MPM~EFF")
summary(Regression4)
#On peut voir que r-squared est de 0.38 ce qui signifie que la regression lineaire n'est pas le bon choix pour notre
modele.
##Cela signifie que l'equation de la droite de regression determine 38% de la distribution des points.
#Donc le modele mathematique utilise n'explique pas vraiment la distribution des points.
#---------------------------- Calcul de l'efficacite theorique sans les coefficients trouves avant ------------------
#On essaye de calculer une efficacite en partant de l'hypothèse que tous les parametres se valent pour calculer
l'efficacite
EFFth2= Stat_2018_et_2019$PPM + Stat_2018_et_2019$RPM + Stat_2018_et_2019$PDPM
scatterplot(EFF ~ EFFth2, data=Stat_2018_et_2019, main="Regression entre EFF~EFFth2")
#---------------------------------- Regression lineaire entre EFF ~ PPM + RPM + PDPM ------------------------------
#On vient alors verifier notre hypothese de distrubution en effectuant une regression lineaire a variables multiples.
model <- lm(EFF ~ PPM + RPM + PDPM, data=Stat_2018_et_2019)
model
summary(model)
summary(model)$coefficient
confint(model)
#On peut voir que r-squared est de 0.87 ce qui signifie que la regression lineaire est le bon choix pour notre
modele.
##Cela signifie que l'equation de la droite de regression determine 87.97% de la distribution des points.
#Donc le modele mathematique utilise explique la distribution des points.
#Par consequent on deduit cette equation : EFFth= 0.15442 + 0.48981*PPM + 1.07985*RPM + 0.78953*PDPM
#--------------------------Calcul de l'efficacite theorique avec les coefficients trouves avant --------------------
EFFth= 0.15442 + 0.48981*Stat_2018_et_2019$PPM + 1.07985*Stat_2018_et_2019$RPM +
0.78953*Stat_2018_et_2019$PDPM
scatterplot(EFF ~ EFFth, data=Stat_2018_et_2019, main="Regression entre EFF ~ EFFth")
#On remarque donc que les rebonds represente la statistique qui compte le plus suivie par le nombre de point et
enfin les passes decisives.
Bellotto Anthony
Latour Nathanaël
Le Mercier Aurore
#---------------------------------------------------------------------- Prediction du MVP --------------------------------------------------
#On prends une nouvelle base de donnees avec les MVP des 67 annees precedentes. Dans cette base de donnees,
on retrouve les PPM, PDPM et les RPM.
#On calcule leur efficacite grace a l'equation qu'on a trouve juste avant.
#On essaie de predire le MVP de l'annee prochaine.
[Link](MVP$EFF)
library(Hmisc)
Annee2=seq(1956,2022,1)
resultat=approxExtrap(MVP$Annee, MVP$EFF, xout = Annee2, method="const", ties="ordered")$y
basePQFinale=[Link](Annee2,resultat)
basePQFinale
#Par cette extrapolation, on prédit que pour la saison 20-21, le MVP aurait 31.11 d'efficacite.
