Projet d’économétrie : Consommation de résine de cannabis des 16 à 34 ans en Europe
Jean Charvet
19 avril 2019
Présentation du problème :
Dans ce projet nous nous intéresserons à la consommation de cannabis dans les pays européens, à savoir que la France est une des plus grosses consommatrices de résine de cannabis en Europe, il serait intéressant d’en trouver une quelconque explication. Elle pourrait alors peut être utile pour des campgagnes de préventions dans certains pays cherchant à controler cette consommation afin de pouvoir trouver d’éventuels leviers d’actions. Nous tenterons alors de prendre des features souvent basées sur des critères sociaux. L’étude ne requiert pas nécessairement un faible taux d’erreur on posera alors un seuil \(\alpha = 10\)% d’erreur dans la suite du projet.
Sources
Consommation de cannabis des jeunes (16-34) : http://www.emcdda.europa.eu/countries/drug-reports/2018/romania_en
Population : http://www.emcdda.europa.eu/countries/drug-reports/2018/romania_en
IBM : https://atlasocio.com/classements/societe/bonheur/classement-etats-par-indice-de-bonheur-monde.php
EMP: https://www.demographie-responsable.org/classement-soutenable.html : Trace Ecologique par pays
Chômage: https://www.touteleurope.eu/actualite/le-taux-de-chomage-en-europe.html
la part de jeune se connectant quotidiennenment à un ordinateur provient d’une étude réalisée par:
https://www.education.gouv.fr/cid108986/l-europe-de-l-education-en-chiffres-2018.html
fichier excel numéro 6.5 second tableau
Dépense publique sociale: https://data.oecd.org/fr/socialexp/depenses-sociales.htm et rapport supplémentaire pour données manquantes:
Temps moyen d’étude: https://fr.db-city.com/Pays--Dur%C3%A9e-moyenne-de-scolarisation
Et si mes souvenirs sont bons les salaires par tête sont d’une liste OIT provenant de Wikipédia et j’ai malheureusement oublié de noter ma source lorsque j’ai récupéré la part de pauvreté
Présentation du jeux de données :
Audit
## 'data.frame': 26 obs. of 13 variables:
## $ pays : Factor w/ 26 levels "Austria","Belgium",..: 14 6 5 22 24 18 17 16 9 19 ...
## $ Consocana.16.34 : num 13.8 19.4 4.3 9.3 17.1 9.8 6 10 13.5 9.8 ...
## $ population : int 3097263 6997715 580541 3810273 30720535 399401 1916284 1282112 3468182 26198877 ...
## $ treatment.enrantsc.cana : int 27 12 58 24 33 33 3 22 20 30 ...
## $ Part.pauvrete : num 16.3 8.9 21 15.3 17.4 4.8 28.9 24.8 4.2 12 ...
## $ ibm : num 7.02 6.85 6.05 6.2 6.35 ...
## $ emp : num 6.2 5.3 3 4.7 4.7 14.7 4.4 4 6.2 3.9 ...
## $ chomage : num 5.3 2.1 7.4 6.2 14.1 4.9 6.2 7.3 6.7 3.7 ...
## $ Tx.suicide : num 11.1 10.6 3.9 9.9 6 8.5 26.1 17.4 14.2 18.5 ...
## $ conex.quoti.16.cite02 : int 33 NA 29 52 24 63 44 45 64 41 ...
## $ Duree.moyenne.scolarisation: num 11.6 12.3 9.9 11.6 10.4 10.1 10.9 10.4 10.3 10 ...
## $ Dep.social.pib : num 14.4 18.7 19 16.9 23.7 ...
## $ Sal.moyen.ppa : num 3 1.79 2.6 1.38 2.35 ...Summary
## pays Consocana.16.34 population treatment.enrantsc.cana
## Austria : 1 Min. : 3.50 Min. : 399401 Min. : 1.00
## Belgium : 1 1st Qu.: 8.00 1st Qu.: 2774312 1st Qu.:12.00
## Bulgaria: 1 Median :10.30 Median : 5848657 Median :25.00
## Croatia : 1 Mean :11.42 Mean :10707409 Mean :27.96
## Cyprus : 1 3rd Qu.:14.10 3rd Qu.: 7326873 3rd Qu.:34.00
## Czechia : 1 Max. :21.50 Max. :42069267 Max. :70.00
## (Other) :19
## Part.pauvrete ibm emp chomage
## Min. : 2.90 Min. :5.011 Min. : 2.800 Min. : 2.100
## 1st Qu.: 8.90 1st Qu.:5.940 1st Qu.: 4.000 1st Qu.: 4.800
## Median :15.30 Median :6.198 Median : 4.700 Median : 5.600
## Mean :17.74 Mean :6.394 Mean : 5.216 Mean : 6.564
## 3rd Qu.:21.00 3rd Qu.:7.021 3rd Qu.: 5.300 3rd Qu.: 7.300
## Max. :49.70 Max. :7.769 Max. :14.700 Max. :18.500
##
## Tx.suicide conex.quoti.16.cite02 Duree.moyenne.scolarisation
## Min. : 3.20 Min. :20.00 Min. : 8.00
## 1st Qu.: 8.50 1st Qu.:31.25 1st Qu.: 9.90
## Median :11.20 Median :37.50 Median :10.40
## Mean :11.63 Mean :39.29 Mean :10.46
## 3rd Qu.:14.90 3rd Qu.:48.75 3rd Qu.:11.60
## Max. :26.10 Max. :64.00 Max. :12.30
## NA's :1
## Dep.social.pib Sal.moyen.ppa
## Min. :14.38 Min. : 1.098
## 1st Qu.:18.40 1st Qu.: 1.756
## Median :21.20 Median : 2.600
## Mean :21.87 Mean : 142.253
## 3rd Qu.:26.05 3rd Qu.: 3.065
## Max. :31.20 Max. :1800.000
## On remarque déjà que nous avons seulement une unique donnée manquante pour notre observation sur la République Tchèque et c’est la part d’individus de plus de 16 ans appartenant aux classifications internationales d’éducation allant de 0 à 2 selon la classification internationale type de l’éducation, je ne sais pas pourquoi la data n’a pas été réalisé par l’étude, nous devrons alors nous détacher de cette observation afin que la fonction leaps fonctionne correctement. Le niveau 0 correspondant à l’école maternelle jusqu’au premier cycle de l’enseignement secondaire soit le collège en France.
Explication des variables :
Cible :
Proportion d’individus entre 16 et 34 ans ayant consommé au moins une fois une substance type résine de cannabis l’année passée.
Features :
1 - Population (data 2018).
2 - Part d’entrée hospitalière pour la première fois pour traitement anti-addiction cannabis.
3 - Part de la population vivant en dessous du seuil de pauvreté.
4 - Indice de Bonheur Moyen
5 -Empreinte écologique des pays qui peut également se définir comme la pression exercée par les hommes sur les ressources renouvelables
6 - Taux de chômage
7 - Taux de suicide homme & femme.
8 - Part des individus de + de 16 ans appartenant à la classification 0 à 2 internationale type de l’éducation ayant une connexion quotidienne sur un ordinateur.
9 - Durée moyenne de scolarisation.
A - Part du PIB allouée aux dépenses sociales.
B - Salaire Moyen en PPA liste (OIT) (à remplir d’après liste wik).
Régression linéaire multiple sur l’ensemble des features :
Modélisation :
\[ \forall i = 1,.., 25\ : \ \ Y_i = b_1X^1_i+b_2X^2 +..+ b_{11}X^{11}_i+u_i \]
nous établirons également des hypothèses sur notre vecteurs d’erreurs \(u_i\) tq :
\[ \mathbb E[u_i] = 0 \] \[ Var(u_i) = \sigma^2 \] \[ \mathbb E(u_iu_j) = 0 \]
## [1] 13.8 19.4 4.3 9.3 17.1 9.8 6.0 10.0 13.5 9.8 21.5 4.5 10.3 8.0
## [15] 10.1 16.0 5.8 15.4 14.1 3.5 7.3 20.7 11.5 13.6 10.3##
## Call:
## lm(formula = data.cible ~ ., data = data.reg)
##
## Residuals:
## Min 1Q Median 3Q Max
## -5.8889 -2.4147 -0.0176 3.1282 4.2852
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 5.404e+00 2.126e+01 0.254 0.8037
## population 1.621e-07 8.273e-08 1.959 0.0737 .
## treatment.enrantsc.cana -4.665e-02 6.236e-02 -0.748 0.4689
## Part.pauvrete -1.509e-01 1.384e-01 -1.091 0.2969
## ibm -2.021e-02 2.266e+00 -0.009 0.9930
## emp 3.880e-01 6.017e-01 0.645 0.5311
## chomage -1.988e-01 4.533e-01 -0.439 0.6687
## Tx.suicide 2.844e-02 2.673e-01 0.106 0.9170
## conex.quoti.16.cite02 -1.669e-01 1.453e-01 -1.149 0.2731
## Duree.moyenne.scolarisation 6.166e-01 1.330e+00 0.464 0.6511
## Dep.social.pib 3.392e-01 3.551e-01 0.955 0.3583
## Sal.moyen.ppa -1.320e-03 3.130e-03 -0.422 0.6808
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 4.564 on 12 degrees of freedom
## (1 observation deleted due to missingness)
## Multiple R-squared: 0.5398, Adjusted R-squared: 0.1179
## F-statistic: 1.28 on 11 and 12 DF, p-value: 0.3382## [1] 13300Validité de la régression :
La régression est un peu hasardeuse, ayant construit moi-même ma base de données je ne m’attendais évidemment pas à un modèle convenable à la premère modélisation, cependant il serait tout de même intéressant de modéliser par ces variables un modèle plus robuste, ou tout simplement utilisable. Nous avons donc sans surprise, la p-value\(= 0.3382\) > \(\alpha = 0.1\). Nous rejetons alors ce modèle et redéfinirons un modèle à l’aide de la focntion leaps.
Etude des résidus :
Regardons tout de même les résidus afin d’observer d’eventuelles valeurs qui fausseront éventuellement notre modélisation future :
On remarque cependant sur le graphique des distances de Cooks qu’une valeur semble fausser l’homoscedasticité de nos résidus et cela impliquera l’ensemble des modélisations que l’on pourrait établir. C’est pourquoi nous nous séparerons de l’observation faite sur Luxembourg (6), la Grèce (12), ainsi que le Portugal (14) dans le reste de la modélisation.
Nouvelle modélisation optimale obtenue par leaps
Il m’est nécessaire de préciser que il m’est également obligatoire de me détacher des observations de la République Tchèque qui possèdent toutes deux des variables non renseignées.
## Warning: package 'leaps' was built under R version 3.5.3## $which
## 1 2 3 4 5 6 7 8 9 A B
## 1 FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE TRUE FALSE
## 2 FALSE FALSE FALSE FALSE FALSE TRUE FALSE FALSE FALSE TRUE FALSE
## 3 TRUE FALSE FALSE FALSE TRUE TRUE FALSE FALSE FALSE FALSE FALSE
## 4 TRUE FALSE FALSE TRUE TRUE TRUE FALSE FALSE FALSE FALSE FALSE
## 5 TRUE FALSE TRUE TRUE TRUE TRUE FALSE FALSE FALSE FALSE FALSE
## 6 TRUE FALSE TRUE TRUE TRUE TRUE FALSE FALSE FALSE FALSE TRUE
## 7 TRUE FALSE TRUE TRUE TRUE TRUE FALSE TRUE FALSE FALSE TRUE
## 8 TRUE FALSE TRUE TRUE TRUE TRUE FALSE TRUE TRUE FALSE TRUE
## 9 TRUE FALSE TRUE TRUE TRUE TRUE TRUE TRUE TRUE FALSE TRUE
## 10 TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE FALSE TRUE
## 11 TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
##
## $label
## [1] "(Intercept)" "1" "2" "3" "4"
## [6] "5" "6" "7" "8" "9"
## [11] "A" "B"
##
## $size
## [1] 2 3 4 5 6 7 8 9 10 11 12
##
## $adjr2
## [1] 0.2978320 0.3845212 0.4998753 0.5380438 0.5365541 0.6117719 0.6225313
## [8] 0.6498208 0.6419186 0.6030191 0.5539025## 1 2 3 4 5 6 7 8 9 A B
## TRUE FALSE TRUE TRUE TRUE TRUE FALSE TRUE TRUE FALSE TRUENouvelle modélisation :
Les features de notre nouveau modèle sont alors :
1 - : population
3 - : Part pauvreté
4 - : indice de bonheur moyen
5 - : empreinte écologique
6 - : chômage
8 - : Connexion quotidienne ordinateur 16+ CITE 0-2
9 - : Durée moyenne de scolarisation
B - : Salaire moyen PPA
On a alors :
\[ Y_t = b_1X_1 + b_3X_3 + b_4X_4 + b_5X_5 + b_6X_6 + b_8X_8 + b_9X_9 + b_BX_B + v_t \]
où \(v_t\) est munit des hypothèses suivantes :
\[ 1 - \mathbb E[v_t] = 0 \] \[ 2 - Var(v_t) = \sigma_t^2 \] \[ 3 - \mathbb E(v_kv_j) = 0 \ ; \ \forall\ k \not=j \]
##
## Call:
## lm(formula = data.ciblenona ~ ., data = data.regopti)
##
## Residuals:
## Min 1Q Median 3Q Max
## -5.4093 -0.8282 -0.1509 1.4011 3.4863
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.211e+01 1.215e+01 0.997 0.34023
## population 1.635e-07 5.356e-08 3.053 0.01099 *
## Part.pauvrete -3.177e-01 1.188e-01 -2.673 0.02166 *
## ibm -3.659e+00 1.691e+00 -2.164 0.05333 .
## emp 2.758e+00 8.827e-01 3.125 0.00967 **
## chomage 1.270e+00 4.260e-01 2.982 0.01247 *
## conex.quoti.16.cite02 -1.498e-01 8.736e-02 -1.715 0.11436
## Duree.moyenne.scolarisation 1.073e+00 7.713e-01 1.391 0.19169
## Sal.moyen.ppa 9.216e-03 4.718e-03 1.953 0.07670 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 2.883 on 11 degrees of freedom
## Multiple R-squared: 0.7973, Adjusted R-squared: 0.6498
## F-statistic: 5.407 on 8 and 11 DF, p-value: 0.006075Il est intéressant que les variables les plus significatives sont l’empreinte écologique, la population, la part de pauvreté ainsi que le taux de chômage.
Validité de la régression :
Problème de test : Test de la significativité de la regression (Fischer)
\(H_0\) : la regression n’est pas significative.
\(H_1\) : la regression est significative.
On établira la règle de décision sur le p-value, ayant initialisé notre seuil \(\alpha\) d’erreur à \(1\)%. Or, ici p-value \(= 0.006075 < 0.01\). On admet donc la significativité de la régression.
Etudes des résidus
Problème de test : Test de l’hypothèse de Gaussianité de nos résidus
Ici nous utiliserons le test de Shapiro qui fonctionne très simplement lorsque que l’on veut montrer qu’un échantillon est issu d’une distribution Normale :
\(H_0\) : les résidus sont gaussiens
\(H_1\) : les résidus ne sont pas gaussiens
et nous établissons la règle de décision suivante, si la p-value du test est supérieur au seuil \(\alpha = 0.1\).
##
## Shapiro-Wilk normality test
##
## data: residu
## W = 0.96515, p-value = 0.651La statistique W indique sur le rapprochement de nos résidus par rapport à une loi \(\mathcal N(0,1)\), ainsi que la Q-Q plot appuie cette hypothèse en étant très resserée autour de la droite. La p-value \(=0.651 > 0.1\) bien supérieur à notre seuil \(\alpha\). Ainsi le test de Shapiro valide l’hypothèse de gaussianité des résidus, et valide ainsi la modélisation.
Comparaison des modèles
La comparaison n’a pas lieu d’être, tant que l’un ne peut se suffit même pas à lui seul.
## Warning: package 'DAAG' was built under R version 3.5.3## [1] 1685.82## [1] 265.8227La prédiction sera plus efficace dans le second modèle. De toute façon c’était une évidence étant donné que je ne peux valider établir la significativé de ma première régression.
Prédictions
Après tout ce travail, je me suis rendu compte que mon scrapper n’est pas allé récuperer les données de l’Allemagne pourtant présentées sur le site initial, j’ai donc complété les données à la main, ainsi je réaliserai une prédiction sur la part des Allemands âgés entre 16 et 34 ans ayant consommé du cannabis l’an passé.
La prédiction semble relativement précise, certainement du fait que l’Allemagne doit être un pays européen proche de ses voisins en moyenne et se voit bien simuler par ce modèle. Peut être qu’un pays plus excentré du centre géographique de la zone observée remarquerait une plus faible qualité de sa prédiction. Etablissons un nouveau modèle avec les données de l’Allemagne et en enleveant celle de la Slovénie et regardons notre prédiction sur ce dernier.
Limite du modèle prédictif
## $which
## 1 2 3 4 5 6 7 8 9 A B
## 1 FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE TRUE FALSE
## 2 FALSE FALSE FALSE FALSE FALSE TRUE FALSE FALSE FALSE TRUE FALSE
## 3 TRUE FALSE FALSE FALSE TRUE TRUE FALSE FALSE FALSE FALSE FALSE
## 4 TRUE FALSE FALSE TRUE TRUE TRUE FALSE FALSE FALSE FALSE FALSE
## 5 TRUE FALSE TRUE TRUE TRUE TRUE FALSE FALSE FALSE FALSE FALSE
## 6 TRUE FALSE TRUE TRUE TRUE TRUE FALSE FALSE FALSE FALSE TRUE
## 7 TRUE FALSE TRUE TRUE TRUE TRUE FALSE TRUE FALSE FALSE TRUE
## 8 TRUE FALSE TRUE TRUE TRUE TRUE FALSE TRUE TRUE FALSE TRUE
## 9 TRUE FALSE TRUE TRUE TRUE TRUE TRUE TRUE TRUE FALSE TRUE
## 10 TRUE FALSE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## 11 TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
##
## $label
## [1] "(Intercept)" "1" "2" "3" "4"
## [6] "5" "6" "7" "8" "9"
## [11] "A" "B"
##
## $size
## [1] 2 3 4 5 6 7 8 9 10 11 12
##
## $adjr2
## [1] 0.3026613 0.3661235 0.5027944 0.5412182 0.5441215 0.6315919 0.6632952
## [8] 0.6796598 0.6826102 0.6484884 0.6046702## 1 2 3 4 5 6 7 8 9 A B
## TRUE FALSE TRUE TRUE TRUE TRUE TRUE TRUE TRUE FALSE TRUENouvelle de modélisation :
\[ Y_t = b_1X_1 + b_3X_3 + b_4X_4 + b_5X_5 + b_6X_6 +b_7X_7 + b_8X_8 + b_9X_9 + b_BX_B + w_t \]
où bien entendu, à nouveau \(w_t\) est un vecteur hypothètiquement gaussien.
##
## Call:
## lm(formula = data.dernier.nonacible ~ ., data = data.regopti2)
##
## Residuals:
## Min 1Q Median 3Q Max
## -5.7087 -0.6229 0.2556 0.7552 3.4983
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.354e+01 1.336e+01 1.014 0.33450
## population 1.753e-07 4.393e-08 3.991 0.00255 **
## Part.pauvrete -4.084e-01 1.300e-01 -3.141 0.01050 *
## ibm -3.771e+00 1.669e+00 -2.260 0.04738 *
## emp 2.770e+00 8.449e-01 3.278 0.00831 **
## chomage 1.310e+00 4.059e-01 3.226 0.00908 **
## Tx.suicide 1.764e-01 1.680e-01 1.050 0.31848
## conex.quoti.16.cite02 -2.062e-01 9.308e-02 -2.215 0.05113 .
## Duree.moyenne.scolarisation 1.124e+00 7.562e-01 1.486 0.16817
## Sal.moyen.ppa 1.169e-02 4.940e-03 2.367 0.03950 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 2.752 on 10 degrees of freedom
## Multiple R-squared: 0.833, Adjusted R-squared: 0.6826
## F-statistic: 5.54 on 9 and 10 DF, p-value: 0.0066
Finalement la prédiction sur la Slovénie ne me semble pas trop absurde, je m’attendais à une prévision bien moins précise car j’imaginais que la Slovénie collerait moins à la modélisation générale de l’Europe et ainsi démontrer les limites très vite atteintes de ma modélisation.
Comparaison des modèles :
Press du premier modèle (sans Allemagne, avec Slovénie)
## [1] 265.8227Press du second modèle (avec Allemagne, sans Slovénie)
## [1] 250.2981Mais comme nous permet de vérifier la fonction press, la prédiction sur le premier modèle sera plus efficace, intégrant les données de l’Allemagne au modèle, la régression est d’autant plus significative. Résultat attendu également lorsque que le \(R^2\) ajusté du second modèle était plus élevè.