Présentation tableau noir

la pollution plastique et sa gestion à travers le monde

Une analyse statistique par Théo VORONCA (TSE) et Elorien BORDA (TSE)

INTRODUCTION

L'un des enjeux majeurs auquel notre société mondiale moderne fait face est la préservation de l'environnement. Diverses problèmatiques sont rencontrées lorsque l'on essaie de répondre positivement à cet enjeu (pollution atmosphérique, lumineuse, déforestation, préservation de la faune, etc.). L'une d'entres elles est la pollution plastique, notamment dans les milieux océaniques. Nous allons nous intéresser à celle-ci, principalement en essayant de répondre à deux questions: -De quelles zones géographiques provient majoritairement la pollution plastique? -y'a t'il une corrélation entre déchêts mal gérés et pollution plastique dans l'océan?

source des données utilisées : Our World In Data

Etude univariée de la variable: Plastique émis dans l'océan par personne

médiane : 0,022 kg par an

moyenne : 0,211 kg par an

écart-type : 0,513 kg par an

codes des sorties Rstudio utilisées :

histogramme de la variable

quantiles

boîte à moustaches de la variable

codes des sorties Rstudio utilisées :

Etude univariée de la variable: quantité de déchéts plastiques mal gérée par personne

moyenne: 8,65 kg médiane: 5,98 kg écart-type: 10,62 kg

histogramme de la variable :

codes des sorties Rstudio utilisées :

boîte à moustache de la variable

quantiles:

Etude univariée de la variable: Continent

table d'effectifs de la variable

diagramme en colonnes de la variable :

table de distribution en fréquence de la variable:

codes des sorties Rstudio utilisées:

Etude de la première liaison "continent-quantité de déchets plastiques" (quanti-quali)

boîtes à moustaches juxtaposées des distributions conditionnelles du plastique selon le continent :

divers indicateurs conditionnels :

codes des sorties Rstudio utilisées :

étude du rapport de corrélation :

code des sorties Rstudio utilisées:

étude de la deuxième liaison entre quantité de déchets plastiques émise dans l'océanla gestion de déchets plastiques

covariance, coefficient de corrélation linéaire et coefficient de détermination

nuage de points avec et sans la droite de regression

droite de régression sans le point le maximum

ligne de code pour les sorties Rstudio:

conclusion

- Il n'y a à première vue pas de corrélations linéaires dans les deux liaisons. Nous pouvons tout de même remarquer que les plus gros emetteurs de plastiques sont l'Europe et l'Amérique du Sud. -cependant, nous avons montré que la présence de points très influents fausse nettement notre analyse statistique

donnees=donnees[,-1]#on enlève la première colonne dim(donnees) donnees$continent=factor(donnees$continent,labels=c("AF","AMN","AMS","EUR","ASI","OC")) attach(donees)#pour appeler les variables par leur nom s #Variables qualitatives table(continent)#effectifs prop.table(table(continent))#proportions round(prop.table(table(continent)),digits=2) pie(table(continent),col=c("magenta","red","green","blue","yellow","orange"), main="Diagramme en secteurs représentant la distribution des pays selon le continent") barplot(prop.table(table(continent)),col="blue", xlab="statpro",ylab="Fréquence relative", main="Diagramme en colonnes du continent", ylim=c(0,0.8)) #Variable quanti continue : gestion #Histogramme hist(gestion,freq=FALSE,col="orange" ,main="Histogramme du gestion", xlab="Mismanaged plastic waste per capita (kg per year)",ylab="DensitÃoportion") #quelques fonctions sur les variables quantis #le traitement des variables quantis summary(gestion)#quartiles, moyenne, min et max mean(gestion) median(gestion) quantile(gestion)#quartiles, min et max max(gestion) var(gestion)#le dénominateur est n-1 n=length(gestion) var_gestion=((n-1)/n)*var(gestion) var_gestion sd(gestion)#standard deviation : écart-type CV=sd(gestion)/mean(gestion)#CV=0.5>0.25 : gestion dispersé CV quantile(gestion,0.9)#quantile d'ordre 0.9 plot(ecdf(plastique), xlab="Part du plastique global émis dans l'océan en 2019 en pourcentage", ylab="F(x)", main="Fonction de répartition empirique de la variable plastique") #Boite a moustaches boxplot(gestion,col="red", main="Boite à moustaches de gestion") points(mean(gestion),col="cyan",pch="*",cex=2) #A faire bém de plastique boxplot(plastique,col="magenta", main="Boéte é moustaches du nombre d'années d'études") points(mean(plastique),col="green",pch="*",cex=2) ############################################################################# ## 2. Etude univariée ############################################################################# # 2.1 Etude univariée du continent ############################################# # tableau de distribution en effectifs et en fréquences table(continent) round(prop.table(table(continent)),digits=3) # diagramme en colonnes barplot(prop.table(table(continent)), col="orange", main="Distribution de la variable 'continent'", xlab="continent", ylab="Fréquences relatives",ylim=c(0,0.3)) # 2.2 Etude univariée du plastique ################################ # variance mean(plastique) median(plastique) n=length(plastique) var_tot=(n-1)/n*var(plastique) # correction pour avoir la variance étudiée en cours var_tot sqrt(var_tot)#écart-type # coef. de variation sqrt(var_tot)/mean(plastique) # histogramme hist(plastique,col = "blue",freq=FALSE,xlab="plastique annuel (en dollars)", ylab="Densité de proportion", main="Histogramme du plastique") # boite à moustaches boxplot(plastique,ylab="plastique annuel (en dollars)", main="Boite à moustaches du plastique") ############################################################################# ## 3. Etude de la liaison entre le plastique et le continent ############################################################################# # 3.1 Représentation graphique des distributions conditionnelles ################################################################ boxplot(plastique~continent, col="green", main="Boites à moustaches juxtaposées des distributions conditionnelles de 'plastique' selon 'continent'", xlab="continent",ylab="plastique annuel (en dollars)") # 3.2 Résumés numériques des distributions conditionnelles ########################################################## # moyennes conditionnelles mcond=tapply(plastique,continent,mean) mcond # on ajoute les moyennes conditionnelles aux boite à moustaches juxtaposées points(mcond,col="blue",pch="*",cex=1.8) # option pch pour changer le marqueur et option cex pour augmenter la taille # variances conditionnelles varcondR=tapply(plastique,continent,var) # formule de R en divisant par n_i-1 varcondR # variances conditionnelles varcond=(table(continent)-rep(1,3))/table(continent)*varcondR # (sigma_i^2) avec la formule du cours varcond # résumés numériques des distributions conditionnelles tapply(plastique,continent,summary) # afin de commenter plus précisément les bam juxtaposées # 3.3 Equation d'analyse de la variance et rapport de corrélation ################################################################# # Variance INTRA (moyenne pondérée des sigma_i^2) varINTRA=1/n*sum(table(continent)*varcond) varINTRA # 102 383 296 # Variance INTER varINTER=1/n*sum(table(continent)*(mcond-rep(mean(plastique),3))^2) varINTER # 189 194 322 # Vérification de l'équation d'analyse de la variance varINTER+varINTRA var_tot # Rapport de corrlation eta2 varINTER/var_tot # eta2=0,07 < 0,2 donc PAS forte liaison # (le sens de la liaison est donné en comparant les moyennes conditionnelles) ############################################################################# #### TP 3 : Analyse descriptive bivariée #### #### liaison entre 2 variables quantitatives #### ############################################################################# summary(plastique) (n-1)/n*var(plastique) mean(plastique) median(plastique) round(quantile(plastique),3) sqrt((n-1)/n*var(plastique)) #écart-type sqrt((n-1)/n*var(plastique))/mean(plastique) #coefficient de variation hist(plastique, col="cyan",freq=FALSE,xlab="Quantité de plastique émise dans l'océan par personne en 2019", ylab="Densité de proportion", main="Histogramme de la variable 'plastique'") boxplot(plastique,ylab="Quantité de plastique émise dans l'océan par personne en 2019 en kg/hab", main="Boite à moustaches de la variable 'plastique'") points(mean(plastique),col="blue",pch="*",cex=2) # Etude univariée de gestion summary(gestion) round(mean(gestion),3) round(median(gestion),3) round(quantile(gestion),3) sqrt((n-1)/n*var(gestion)) #écart-type sqrt((n-1)/n*var(gestion))/mean(gestion) #CV hist(gestion, col="purple",freq=FALSE,xlab="Quantité de déchets plastiques mal gérés par personne en 2019 en kg/hab", ylab="Densité de proportion", main="Histogramme de la variable 'gestion'") boxplot(gestion, col="purple",ylab="Quantité de déchets plastiques mal gérés par personne en 2019 en kg/hab", main="Boite à moustache de la variable 'gestion'") points(mean(gestion),col="pink",pch="*",cex=2) par(mfrow=c(2,2)) # cette commande sert é diviser la fenétre Plots en 4 zones (2 lignes et 2 colonnes) # les 4 graphiques pourront donc plus facilement étre comparés hist(plastique,freq=FALSE,xlab="plastique annuel (en dollars)", ylab="Densité de fréquence", main="Histogramme de la variable plastique") hist(gestion,freq=FALSE,xlab="plastique (en dollars)", ylab="Densité de fréquence", main="Histogramme du plastique ") # attention les histogrammes ont des échelles différentes pour les deux axes boxplot(plastique,ylab="plastique annuel (en dollars)",ylim=c(0,2), main="Boéte é moustaches de la variable plastique") boxplot(gestion,ylab="plastique (en dollars)",ylim=c(0,2), main="Boéte é moustaches du plastique ") # les 2 séries sont tres asymétriques, avec une sur-représentation des plastiques # peu élevés, il y a bcp de valeurs extrémes élevées. # les plastiques actuels sont plus élevés que les plastiques # (b é m de SA plus haute que celle de SE) # par ailleurs, la dispersion des plastiques actuels est plus grande que celle # des plastiques (b é m plus longue) par(mfrow=c(1,1)) # on rétablit la fenétre graphique en 1 seule partie ## attention é ne pas oublier cette commande ! ############################################################################# ## 2. Nuage de points ############################################################################# # on choisit plastique comme variable à expliquer (=Y, en ordonnées) # et gestion comme variable explicative (=X, en abscisses) plot(gestion,plastique,main="Nuage de points", xlab="gestion ",ylab="plastique") ############################################################################# ## 3. Corrélation linéaire ############################################################################# # covariance des deux variables cov(gestion,plastique) # coefficient de corrélation linéaire cor(gestion,plastique) # r(gestion,plastique)=0,88, il est positif et proche de 1 en valeur absolue # il existe donc une forte corrélation linéaire positive entre les 2 variables cov(gestion,plastique)/sqrt(var(gestion)*var(plastique)) # on retrouve bien le méme résultat ############################################################################# ## 4. Calcul de l'équation de la droite des moindres carrés ############################################################################# # modélisation par une droite de régression regression=lm(plastique~gestion) # la variable é expliquer, Y, est plastique # la variable explicative, X, est gestion # le résultat de la régression lineaire est stocké dans l'objet regression regression # les coefficients de la droite des moindres carrés sont affichés dans la Console : # a chapeau, la pente, sous le nom de la variable explicative # b chapeau, l'ordonnée à l'origine, est appelée Intercept # équation de la droite de régression (D) : plastique = 1,91*gestion + 1929,52 # l'objet regression contient de nombreux éléments, parmi lesquels : # 1) coefficients de la droite de régression regression$coefficients # Remarque : on peut arrondir les coefficients avec la fonction round round(regression$coefficients,3) # 2) valeurs ajustées de Y (y_i chapeau = a chapeau * x_i + b chapeau), # prédites par la droite de régression (pour tous les individus) regression$fitted.values # 3) résidus (e_i chapeau = y_i-y_i chapeau) (pour tous les individus) regression$residuals # Coefficient de détermination R2 summary(regression) # R2 =0.7748 "Multiple R-squared" #coefficient de détermination cor(plastique,gestion)^2 # R2=0.77 donc 77% de la variation totale de la variable plastique est expliquée par la régression, # c'est-é-dire par la variable gestion # Le R2 est proche de 1 donc la droite de régression ajuste bien les données, # le modéle est de bonne qualité ############################################################################# ## 5. Tracé de la droite de régression sur le nuage de points ############################################################################# # on refait le nuage de points plot(gestion,plastique,main="Nuage de points", xlab="gestion ",ylab="plastique") # on ajoute la droite de régression (en rouge) abline(regression,col="red") # on ajoute le barycentre du nuage de points points(mean(gestion),mean(plastique),pch="+",col="blue",cex=2) # l'argument pch permet de choisir le marqueur et cex d'en augmenter la taille # la droite de régression passe bien par le barycentre du nuage de points (vu en cours) ############################################################################# ## 6. Etude des résidus ############################################################################# ## 1) Résidus en fonction de la variable explicative plot(gestion,regression$residuals, main="Résidus en fonction de la variable explicative", xlab="variable explicative : gestion ",ylab="résidus") # il ne doit pas y avoir de liaison entre les résidus et la variable explicative # pour que les hypothéses du modéle (que vous verrez en L3) sont respectées # ici on voit que la dispersion des résidus augmente quand le plastique augmente ## 2) Moyenne des résidus mean(regression$residuals) # 9,6.10^(-13) sum(regression$residuals) # 4,5.10^(-10) # en théorie la moyenne et la somme des résidus sont nulles, # leurs valeurs sont très proches de 0 ## 3) Identification de résidus sur le nuage de points # Il est important de repérer les individus ayant de forts résidus (en valeur absolue) # car leur plastique actuel a été mal prédit par la régression (erreur de saisie é # comportement particulier é point influent, c'est-é-dire qui a un fort impact dans # l'estimation des coef. de la régression é) # on retrace le nuage de points et la droite de régression plot(gestion,plastique,main="Nuage de points", xlab="gestion ",ylab="plastique") abline(regression,col="red") identify(gestion,plastique) # cliquer sur les points dont on veut obtenir l'indice (ceux ayant un fort résidu) # puis sur le bouton Finish pour obtenir les valeurs # graphiquement, l'individu ayant le plus fort résidu est le 18 # valeur du résidu de cet individu regression$residuals[112] # 26.3612 max(regression$residuals) # c'est bien le résidu le plus élevé regression$residuals[26] min(regression$residuals) # on peut repérer graphiquement que les individus 18,218,274,160,205 ont de forts résidus # valeur des résidus de ces individus regression$residuals[c(85,123,59,159,139,147)] # pour une analyse plus fine, on peut déterminer les plus forts résidus par le calcul : # les 10 plus forts négatifs head(sort(regression$residuals),10) # les 10 plus forts positifs tail(sort(regression$residuals),10) # l'individu 106 a également un résidu élevé # les 10 plus grands en valeur absolue tail(sort(abs(regression$residuals)),10) # mais on perd le signe # on peut donc considérer que les individus ayant de forts résidus sont les individus # 18, 218, 274 et 106 avec de forts résidus positifs (le plastique observé est beaucoup # plus élevé que le plastique prédit) et l'individu 205 avec un fort résidu négatif (le # plastique observé est beaucoup plus faible que le plastique prédit) # on peut chercher é faire une analyse de ces individus pour mieux comprendre pourquoi # ils ont été mal prédits par la droite de régression # pour afficher en bleu ces individus points(gestion[c(147,139,121,26,112,109,85)],plastique[c(147,139,121,26,112,109,85)],pch=19,col="magenta") ############################################################################# ## 7. Points influents éventuels ############################################################################# ## Etude sans le point de plastique maximum ###################################################### # valeur de plastique maximum max(gestion) # identification de l'individu maximum which(gestion==max(gestion)) # individu 26 # On crée de nouveaux vecteurs sans cet individu gestion2=gestion[-26] plastique2=plastique[-26] points(gestion[26],plastique[26],pch=19,col="green") # coefficient de corrélation cor(gestion2,plastique2) # régression linéaire regression2=lm(gestion2~plastique2) regression2$coefficients # Nuage de points et droites de régression plot(gestion,plastique,main="Nuage de points", xlab="gestion ",ylab="plastique") abline(regression,col="red") # ajout de cette nouvelle droite de régression sur le nuage de points abline(regression2,col="green3") # la droite verte est trés proche de la rouge : on ne peut donc pas considérer que # le point 29 est un point influent ## Etude sans le point de plus fort résidu (numéro 18) ###################################################### # on pourrait aussi faire cette analyse en excluant tous les individus que l'on a repérés # comme ayant de forts résidus (numéros : 18, 218, 274, 205, 106) # On crée de nouveaux vecteurs de données sans cet individu SE3=gestion[-112] SA3=plastique[-112] # coefficient de corrélation cor(SE3,SA3) # 0,886 (au lieu de 0,880), il est légèrement supérieur # régression linéaire regression3=lm(SA3~SE3) summary(regression3) # le R2 a augmenté : 78.5% au lieu de 77% regression3$coefficients # les coefficients ont trés peu changé # ajout de cette nouvelle droite de régression sur le nuage de points abline(regression3,col="blue") # la droite blue est quasiment confondue avec la rouge, # donc le point 112 n'est pas un point influent ### Conclusion : on garde la régression linéaire initiale car il n'y a pas de point influent