Cours de Master 2 : r for research - Valeurs, confiance et bonheur
Christophe Benavent - Université Paris Nanterre
6 novembre 2018
Menager- Rue de Broca
Introduction
L’objectif de ce document est d’analyser un tableau de données multivariées, en l’occurrence les profils de valeurs de 35000 européens en 2016, ainsi qu’un groupe de variables relatives à leur satisfaction dans la vie et dans la société, ainsi que leur degré de confiance envers les institutions et les personnes. Un groupe de variables socio-démographiques est disponible. La source des données est l’European Social Survey , et notamment la vague 8 (2016). Elle concerne 16 pays.
C’est le support de cours pour les enseignements suivants:
On pourra aussi consulter une analyse du même type centré sur la Confiance en France de 2002 à 2006.
Le synopsis général de l’analyse est simple : Les 21 valeurs mesurées dans l’enquête (inventaire de Schwartz (1992) et Schwartz (2012) ) peuvent étre étre décrites par un nombre réduit de dimensions sous-jascentes. On verra comment les identifier.
L’autre probléme, symétrique, est d’identifier les individus qui se ressemblent, et de les regrouper en un nombre limité de segments (types, cluster, groupes …) dont on cherchera à décrire les profils. On envisage ensuite leurs relations avec les indicateurs de bien-être, avec un controle par les variables socio-démographiques.
On conduira l’analyse d’abord en suivant l’hypothése que les valeurs “font” le bonheur, puis en retenant au contraire l’hypothése que le niveau de bonheur peut expliquer les valeurs auxquelles on adhére.
On utilisera les techniques suivantes :
- Analyse descriptives,
- Analyse des corrélations,
- Analyse de variance,
- Analyse factorielle exploratoire (EFA) et confirmatoire (CFA).
- Classification automatique : hiérarchique, Kmeans…
- Modèles de régression, y compris multinomiale.
- Arbres de décision
- représentations graphiques avec ggplot
Les données ont été préparées au préalable (Recodage et labellisation), le code est disponible dans le fichier recodage.r, il faut le consulter, mais il est inutile de l’activer), On charge directement le fichier au format r (pensez é modifier le chemin du fichier de données). Les packages utilisés sont déclarés dans le chunk suivant.
knitr::opts_chunk$set(echo = TRUE,include=TRUE,warning=FALSE)
library(Rcmdr)
library(readr)
library(readr)
H <- read_delim("~/Bonheur master/bonheur/H.csv",
";", escape_double = FALSE, trim_ws = TRUE)
#library(Rcmdr) #le demarrage et le secours
library(bookdown) # encore pour de fonctions dans le markdown
#gestion des données
library(dplyr) # ce truc bizarre pour gerer les données
library(plyr) #l'autre ne l'inclue pas t il le precedent é
library(tidyr) # ces truc bizarre pour gerer les donnes
library(reshape2) #surtout utilé pour ggplot
#graphiques
library(fmsb)
library(ggplot2) #l indispensable bibliothéque graphique
library(radarchart) #graphique radar
library(ggridges)
#psych pour aller bcp plus loin dans l'analyse factorielle
library(psych)
#typologie
library(dendextend) #pour visualiser les dendogram
library(NbClust) #test du nb optimal de groupe
library(FactoMineR) #la boite é outil de l'analyse des correspondance
library(factoextra) #pour faire la liaison avec GGplot
#regression
library(multilevel) #l'espace - 16- pays
library(stargazer) # mise en tableau des résultats de modeles de régression
library("foreign") #pour la regression multinomiale
library("nnet") #pour la regression multinomiale
#modele structurel
library(lavaan)
library(semPlot)
#palettes et graphiques
library(RColorBrewer)
library(corrplot)
library(gridExtra) # plusieurs ggplot en une image
library(knitr)#pour la fonction kable qui permet de faire des tableaux élégants
library(kableExtra) #complement de kable
#palette pal16 : des couleurs sur mesure des pays
pal16<-c("#3B9AB2", "#EBCC2A" , "#F8AFA8" , "#C25B56", "#0B775E", "#BEB9B5","#35274A","#FEE1AE",
"#F2AD00" ,"#F98400","#F5CDB6" ,"#FF0000", "#9A8822","#00A08A","#046C9A","#74828F")Structure des valeurs
Le premier temps de l’analyse est consacré à l’analyse de la structure des corrélations entre les 21 items de l’échelle de mesure des valeurs. L’objectif est de les réduire à un petit nombre de facteurs fondamentaux.
les statistiques élémentaires sont les suivantes
V<-as.data.frame(H[,c("Admiration", "Altruisme", "Autoritegvt", "Aventure", "Bontemps", "Creativite", "Egalite", "Environnement", "Liberte","Loyaute", "Modestie", "Nouveau", "Plaisir", "Respect", "RespectdesRegles", "Richesse", "SeConduireBien", "Securite", "Succes",
"Tolerance", "Tradition")])
elem <-V %>%
psych::describe(quant=c(.25,.75)) %>%
as_tibble() %>%
print()## # A tibble: 21 x 15
## vars n mean sd median trimmed mad min max range skew
## * <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 34249 3.73 1.41 4 3.72 1.48 1 6 5 -0.149
## 2 2 34299 4.82 1.00 5 4.94 1.48 1 6 5 -0.864
## 3 3 34130 4.61 1.21 5 4.75 1.48 1 6 5 -0.829
## 4 4 34280 3.16 1.44 3 3.12 1.48 1 6 5 0.284
## 5 5 34294 4.14 1.31 4 4.21 1.48 1 6 5 -0.454
## 6 6 34280 4.44 1.25 5 4.56 1.48 1 6 5 -0.662
## 7 7 34284 4.82 1.08 5 4.96 1.48 1 6 5 -1.000
## 8 8 34322 4.81 1.05 5 4.94 1.48 1 6 5 -0.877
## 9 9 34318 4.85 1.09 5 4.99 1.48 1 6 5 -0.998
## 10 10 34297 5.08 0.921 5 5.21 1.48 1 6 5 -1.19
## # ... with 11 more rows, and 4 more variables: kurtosis <dbl>, se <dbl>,
## # Q0.25 <dbl>, Q0.75 <dbl>elem %>% kable(digit=2) %>% kable_styling(full_width =F,bootstrap_options = "striped", font_size = 10) | vars | n | mean | sd | median | trimmed | mad | min | max | range | skew | kurtosis | se | Q0.25 | Q0.75 | |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| Admiration | 1 | 34249 | 3.73 | 1.41 | 4 | 3.72 | 1.48 | 1 | 6 | 5 | -0.15 | -0.98 | 0.01 | 3 | 5 |
| Altruisme | 2 | 34299 | 4.82 | 1.00 | 5 | 4.94 | 1.48 | 1 | 6 | 5 | -0.86 | 0.73 | 0.01 | 4 | 6 |
| Autoritegvt | 3 | 34130 | 4.61 | 1.21 | 5 | 4.75 | 1.48 | 1 | 6 | 5 | -0.83 | 0.12 | 0.01 | 4 | 6 |
| Aventure | 4 | 34280 | 3.16 | 1.44 | 3 | 3.12 | 1.48 | 1 | 6 | 5 | 0.28 | -0.91 | 0.01 | 2 | 4 |
| Bontemps | 5 | 34294 | 4.14 | 1.31 | 4 | 4.21 | 1.48 | 1 | 6 | 5 | -0.45 | -0.59 | 0.01 | 3 | 5 |
| Creativite | 6 | 34280 | 4.44 | 1.25 | 5 | 4.56 | 1.48 | 1 | 6 | 5 | -0.66 | -0.18 | 0.01 | 4 | 5 |
| Egalite | 7 | 34284 | 4.82 | 1.08 | 5 | 4.96 | 1.48 | 1 | 6 | 5 | -1.00 | 0.83 | 0.01 | 4 | 6 |
| Environnement | 8 | 34322 | 4.81 | 1.05 | 5 | 4.94 | 1.48 | 1 | 6 | 5 | -0.88 | 0.56 | 0.01 | 4 | 6 |
| Liberte | 9 | 34318 | 4.85 | 1.09 | 5 | 4.99 | 1.48 | 1 | 6 | 5 | -1.00 | 0.72 | 0.01 | 4 | 6 |
| Loyaute | 10 | 34297 | 5.08 | 0.92 | 5 | 5.21 | 1.48 | 1 | 6 | 5 | -1.19 | 1.82 | 0.00 | 5 | 6 |
| Modestie | 11 | 34244 | 4.31 | 1.24 | 5 | 4.41 | 1.48 | 1 | 6 | 5 | -0.57 | -0.34 | 0.01 | 4 | 5 |
| Nouveau | 12 | 34296 | 4.00 | 1.36 | 4 | 4.04 | 1.48 | 1 | 6 | 5 | -0.30 | -0.82 | 0.01 | 3 | 5 |
| Plaisir | 13 | 34295 | 4.03 | 1.32 | 4 | 4.08 | 1.48 | 1 | 6 | 5 | -0.37 | -0.63 | 0.01 | 3 | 5 |
| Respect | 14 | 34152 | 3.77 | 1.37 | 4 | 3.77 | 1.48 | 1 | 6 | 5 | -0.17 | -0.92 | 0.01 | 3 | 5 |
| RespectdesRegles | 15 | 34147 | 3.76 | 1.41 | 4 | 3.78 | 1.48 | 1 | 6 | 5 | -0.23 | -0.95 | 0.01 | 3 | 5 |
| Richesse | 16 | 34311 | 2.85 | 1.33 | 3 | 2.77 | 1.48 | 1 | 6 | 5 | 0.52 | -0.55 | 0.01 | 2 | 4 |
| SeConduireBien | 17 | 34257 | 4.27 | 1.25 | 5 | 4.37 | 1.48 | 1 | 6 | 5 | -0.59 | -0.35 | 0.01 | 3 | 5 |
| Securite | 18 | 34315 | 4.57 | 1.25 | 5 | 4.72 | 1.48 | 1 | 6 | 5 | -0.79 | -0.09 | 0.01 | 4 | 6 |
| Succes | 19 | 34237 | 3.73 | 1.38 | 4 | 3.74 | 1.48 | 1 | 6 | 5 | -0.16 | -0.91 | 0.01 | 3 | 5 |
| Tolerance | 20 | 34264 | 4.67 | 1.06 | 5 | 4.77 | 1.48 | 1 | 6 | 5 | -0.87 | 0.63 | 0.01 | 4 | 5 |
| Tradition | 21 | 34326 | 4.18 | 1.38 | 4 | 4.28 | 1.48 | 1 | 6 | 5 | -0.55 | -0.56 | 0.01 | 3 | 5 |
Une représentation graphique est sans doute plus utile. On va utiliser un lolipop chart en
elem$label<-row.names(elem)
g<-ggplot(elem, aes(x=reorder(label,mean),y=mean))
g<-g+geom_segment(aes(y = 0, x=reorder(label,mean), xend = label, yend = mean+0.5*sd), color = "grey60", size=0.8) + coord_flip() +geom_point(size=2)
g<-g+ geom_point( aes(x=reorder(label,mean), y=mean-0.5*sd), color=rgb(0.2,0.7,0.1,0.5), size=2 )
g<-g+ geom_point( aes(x=reorder(label,mean), y=mean+0.5*sd), color=rgb(0.7,0.2,0.1,0.5), size=2 )
g
Analyse de corrélations entre les 21 valeurs
Commençons par analyser les correlations bi-variées. Le probléme est qu’analyser 21 variables, c’est analyser 21x20/2= 210 corrélations. Un tableau illisible pour la plupart d’entre nous. On se tournera donc vers une méthode de visualisation proposée par le package corrplot.
On extrait le bloc de variables qui nous intéressent du fichier de base H. On calcule la correlation entre les variable avec cor, que l’on stocke dans l’objet X, qu’on introduit dans la fonction corrplot avec deux autres paramétres : une méthode de regroupement des variables (hclust que l’on va étudier un peu plus loin et associe les variables qui sont le plus corrélées entres elles, et un nombre de rectangle qui permet d’identifier ces groupes). X n’est pas affiché, on peut afficher les (21x20)/2= 210 corrélations simplement en enlevant le # avant le X.
X<-cor(V, use="complete")
#X
#avec corrplot
corrplot(X,order="hclust", addrect=4) # avec un clustering des variables
Analyse factorielle
L’objectif de l’analyse factorielle exploratoire est de réduire cette batterie d’items en facteurs principaux. (pour en savoir plus voici quelques liens : - sur rblogger - )
L’idée a été introduite Thurstone (1931) notamment pour identifier les structures de l’intelligence, elle est désormais au coeur de la construction des échelles de mesures dont Churchill (1979) a popularisé le processus dans un article fameux pour les sciences de gestion.
L’analyse nous montre qu’il y a apparemment 4 groupes de variables. Si les variables sont représentées par des vecteurs, d’autant plus proche qu’ils sont correlées (le cosinus de leur angle est élevé), on peut rechercher un vecteur moyen, qui indique une variable latente, un concept, dont les variables associées donne la signification.
On utilise ici la fonction factanal en optant pour une méthode de rotation oblique promax. Cette dernière permet aux facteurs d’étre corrélés entre eux alors que la rotation varimax importe l’orthogonalité.
#analyse factorielle
library(GPArotation)
Valeurs <- fa(V,nfactors = 4,rotate = "oblimin",fm="minres")
print(Valeurs, digits = 3)## Factor Analysis using method = minres
## Call: fa(r = V, nfactors = 4, rotate = "oblimin", fm = "minres")
## Standardized loadings (pattern matrix) based upon correlation matrix
## MR1 MR4 MR3 MR2 h2 u2 com
## Admiration 0.082 -0.010 0.706 -0.024 0.498 0.502 1.03
## Altruisme 0.626 0.092 -0.017 0.046 0.452 0.548 1.06
## Autoritegvt 0.177 0.415 0.157 -0.020 0.310 0.690 1.67
## Aventure -0.050 -0.134 0.153 0.600 0.484 0.516 1.25
## Bontemps 0.088 0.009 0.045 0.546 0.361 0.639 1.07
## Creativite 0.395 -0.216 0.273 0.117 0.295 0.705 2.62
## Egalite 0.558 -0.015 0.041 -0.056 0.297 0.703 1.03
## Environnement 0.457 0.156 -0.018 0.002 0.277 0.723 1.23
## Liberte 0.395 -0.072 0.159 0.142 0.254 0.746 1.68
## Loyaute 0.552 0.120 -0.024 0.084 0.389 0.611 1.15
## Modestie 0.260 0.366 -0.186 0.016 0.255 0.745 2.36
## Nouveau 0.222 -0.105 0.134 0.460 0.402 0.598 1.76
## Plaisir 0.010 0.094 -0.080 0.734 0.488 0.512 1.06
## Respect -0.058 0.328 0.442 0.041 0.370 0.630 1.91
## RespectdesRegles -0.068 0.545 0.075 0.028 0.301 0.699 1.07
## Richesse -0.276 0.074 0.508 0.166 0.395 0.605 1.84
## SeConduireBien 0.076 0.620 0.007 0.002 0.423 0.577 1.03
## Securite 0.148 0.447 0.217 -0.151 0.348 0.652 1.97
## Succes 0.027 0.058 0.676 0.093 0.558 0.442 1.06
## Tolerance 0.596 0.016 -0.035 0.035 0.369 0.631 1.02
## Tradition 0.037 0.500 0.004 0.048 0.266 0.734 1.03
##
## MR1 MR4 MR3 MR2
## SS loadings 2.334 1.847 1.881 1.732
## Proportion Var 0.111 0.088 0.090 0.082
## Cumulative Var 0.111 0.199 0.289 0.371
## Proportion Explained 0.299 0.237 0.241 0.222
## Cumulative Proportion 0.299 0.536 0.778 1.000
##
## With factor correlations of
## MR1 MR4 MR3 MR2
## MR1 1.000 0.330 0.126 0.279
## MR4 0.330 1.000 0.228 -0.054
## MR3 0.126 0.228 1.000 0.514
## MR2 0.279 -0.054 0.514 1.000
##
## Mean item complexity = 1.4
## Test of the hypothesis that 4 factors are sufficient.
##
## The degrees of freedom for the null model are 210 and the objective function was 5.02 with Chi Square of 174849.5
## The degrees of freedom for the model are 132 and the objective function was 0.31
##
## The root mean square of the residuals (RMSR) is 0.025
## The df corrected root mean square of the residuals is 0.032
##
## The harmonic number of observations is 34119 with the empirical chi square 8946.146 with prob < 0
## The total number of observations was 34837 with Likelihood Chi Square = 10784.65 with prob < 0
##
## Tucker Lewis Index of factoring reliability = 0.903
## RMSEA index = 0.0481 and the 90 % confidence intervals are 0.0474 0.0489
## BIC = 9404.135
## Fit based upon off diagonal values = 0.986
## Measures of factor score adequacy
## MR1 MR4 MR3 MR2
## Correlation of (regression) scores with factors 0.885 0.860 0.885 0.876
## Multiple R square of scores with factors 0.783 0.740 0.784 0.767
## Minimum correlation of possible factor scores 0.567 0.479 0.568 0.534#on ajoute les scores factoriels ( mean=0 sd=1) c'est é dire les coordonnées des individus
#fans le df de base (H)
H <<- within(H, {
F4Hedonisme <- Valeurs$scores[,4]
F3Conformisme <- Valeurs$scores[,3]
F2Reussite <- Valeurs$scores[,2]
F1Civisme <- Valeurs$scores[,1]
})Les résultats se présentent sous la forme de 6 éléments
- les Uniqueness, représentent la variance spécifique é l’item, celle dont les facteurs ne rendent pas compte.
- les loadings, sont les corrélations des items avec les facteurs et servent é interpréter la solution.
- les variances des facteurs
- la matrice de corrélations entre les facteurs
- Un test sur le nombre de facteurs
On a bien 4 facteurs dont l’interprétation est assez aisée :
- hedonisme,
- developpement personnel,
- civisme,
- conformisme sont des termes qui semblent assez pertinents. On les comparera é ceux qu’emploie et que justifie Schwartz.
Ce sont ceux qu’ils proposent, les resultats sont consistants.
Les “Uniqueness” qui représentent la variance propre é l’item (ce que n’explique pas les facteurs) sont élevés. C’est compréhensible compte-tenu de la redaction des items qui sont peu redondants, et est en ligne avec l’idée de schartz que les 4 grands facteurs sont des meta-facteurs, les valeurs sont véritablement multiples et se réduisent partiellement é ces quatres dimensions.
La structure profonde est sans doute é deux niveaux : des facteurs et sous-facteurs. C’est ce que suggérent les travaux de Schwartz.
Test de fiabilité des échelles
L’usage de questionnaires dans les sciences de gestion a largement emprunté é la littérature psychométrique oé la question de la fiabilité des échelles est depuis longtemps une préoccupation essentielle.
la validité est relative é la question de savoir si on mesure sans biais ce qu’on veut mesurer, la fiabilité est celle de savoir si nos indicateurs, les items sont consistants au sens qu’ils convergent vers la méme valeur.
Un indicateurs historique de la fiabilité est le alpha de cronbach dont les valeurs sont qualitativement évaluées : * 0.90 est excellent et denote une convergence presque parfaite, * 0.60 est acceptable dans le cadre de test, * 0.75 peut étre bon si les items sémantiquement sont peu redondants. * en dessous on peut avoir des doutes d’autant plus prononcés qu’on est é un stade avancé d’évaluation des échelles.
le alpha de crobach mesure la consistance interne de l’échalle. Il estime la part de variance commune des items. Sa formulation est la suivante avec X le score total et xi les items , le coeef tend vers 1 quand la somme de la variance des items est égale à la variance du score et que le nombre des items est élevé.
pour écrire les équations : formules markdown
\[\alpha=\frac{k}{(k-1)}*1-\frac{\sum_{x = i}^{k}\sigma_{x_i}^2}{\sigma_X^2}\]
Elle exprime l’idée que la somme des variance des items sur la variance totale de l’échelle est faible. Autrement dit si cette quantité est faible, c’est que la variance des items ext expliquée par un fateur général plus que par la spécificité des items.Cette quantité est pondéré par le nombre d’item dans l’échelle, si celui ci est important la pondératin tend vers 1.
D’autres méthodes ont été proposés, mais c’est un classique.
Dans le chunks suivant on en fait le calcul. Deux résultats nous intéressent : la fiabilité de l’échelle testée, sa valeur si on enléve l’item d’intérét.
On en profite pour fabriquer les scores en les normalisant sur une échelle de 1 é 6.
On en décrit ensuite les ditribution par des histogrammes simples, un diagramme de densité superposée, et la technique élégante des violons.
H$Val_reussite<-(H$Admiration+H$Respect+H$Succes+H$Richesse)/4
reliability(cov(H[,c("Admiration","Respect","Richesse","Succes")], use="complete.obs"))## Alpha reliability = 0.7319
## Standardized alpha = 0.7311
##
## Reliability deleting each item in turn:
## Alpha Std.Alpha r(item, total)
## Admiration 0.6431 0.6429 0.5696
## Respect 0.7062 0.7054 0.4615
## Richesse 0.7078 0.7074 0.4571
## Succes 0.6217 0.6212 0.6056H$Val_plaisir<-(H$Bontemps+H$Aventure+H$Nouveau+H$Plaisir)/4
reliability(cov(H[,c("Bontemps","Aventure","Nouveau","Plaisir")], use="complete.obs"))## Alpha reliability = 0.7321
## Standardized alpha = 0.7325
##
## Reliability deleting each item in turn:
## Alpha Std.Alpha r(item, total)
## Bontemps 0.6919 0.6915 0.4870
## Aventure 0.6641 0.6651 0.5370
## Nouveau 0.6782 0.6810 0.5118
## Plaisir 0.6528 0.6516 0.5569H$Val_Civisme<-(H$Altruisme+H$Tolerance+H$Creativite+H$Egalite+H$Environnement+H$Liberte+H$Loyaute)/7
reliability(cov(H[,c("Altruisme","Tolerance","Creativite","Egalite","Environnement","Liberte","Loyaute")], use="complete.obs"))## Alpha reliability = 0.7316
## Standardized alpha = 0.7395
##
## Reliability deleting each item in turn:
## Alpha Std.Alpha r(item, total)
## Altruisme 0.6788 0.6861 0.5395
## Tolerance 0.6881 0.6979 0.4943
## Creativite 0.7279 0.7322 0.3494
## Egalite 0.7003 0.7101 0.4427
## Environnement 0.7052 0.7147 0.4214
## Liberte 0.7132 0.7236 0.3887
## Loyaute 0.6875 0.6931 0.5127H$Val_Conformisme<-(H$Modestie+H$RespectdesRegles+H$SeConduireBien+H$Autoritegvt+H$Securite+H$Tradition)/6
reliability(cov(H[,c("Modestie","RespectdesRegles","SeConduireBien","Autoritegvt","Securite","Tradition")], use="complete.obs"))## Alpha reliability = 0.705
## Standardized alpha = 0.707
##
## Reliability deleting each item in turn:
## Alpha Std.Alpha r(item, total)
## Modestie 0.6920 0.6952 0.3469
## RespectdesRegles 0.6695 0.6713 0.4271
## SeConduireBien 0.6378 0.6401 0.5256
## Autoritegvt 0.6625 0.6642 0.4478
## Securite 0.6546 0.6558 0.4720
## Tradition 0.6756 0.6773 0.4074#histogrammes
ggplot(H, aes(x=Val_reussite))+geom_histogram()## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
ggplot(H, aes(x=Val_plaisir))+geom_histogram()## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
ggplot(H, aes(x=Val_Civisme))+geom_histogram()## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
ggplot(H, aes(x=Val_Conformisme))+geom_histogram()## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
#diagramme de densité
Vdf<-subset(H,select=c(Val_reussite,Val_plaisir,Val_Civisme,Val_Conformisme))
Vdf<-melt(Vdf)## No id variables; using all as measure variablesggplot(Vdf, aes(x=value,fill=variable))+ geom_density(alpha=.3)+scale_fill_manual(values=pal16)
#violin plot
p<-ggplot(Vdf, aes(x=variable, y=value)) #la forme de base
p<-p+geom_violin(trim=FALSE) # le triatement de la queue de distribution
p<-p+ stat_summary(fun.data=mean_sdl, mult=1, geom="pointrange", color="red") #ajout de la mediane
p<-p+scale_fill_manual(values=c("#999999", "#E69F00", "#56B4E9", "#56B4E9"))+ theme_classic()
p
Variations socio-démographiques
On peut examiner comment ces quatre meta valeurs varient selon les différents variables socio-demo; commenéons par l’ége, on laisse le soin aux étudiants de tester la procédure avec le sexe, l’éducation etc… : AgeClasse, gender, NbFoyer, education
naturellement avant de s’aventurer é interpréter les différences, on s’assure par une simplke anbalyse de variance que ces différences ne sont pas le produit de l’alea de l’échantillonnage, qu’elle sont suffisemment solide pour qu’on puisse le donner un sens, celui de la formulation de l’hypothése théorique. Dans notre cas, l’éducation étant une ressource, on peut supposer que plus elle est abondante et plus on peut préter d’attention au plaisir et é la réussite. le respect des régles devrait étre moins important.
En complément on introduit le calcul du d de cohen pour mesurer la taille de l’effet qui est devenu un standard en psychologie, voir aussi.
Vdf<-subset(H,select=c(gender,Val_reussite,Val_plaisir,Val_Civisme,Val_Conformisme))
AnovaModel.1 <- aov(Val_plaisir ~ gender, data=Vdf)
summary(AnovaModel.1)## Df Sum Sq Mean Sq F value Pr(>F)
## gender 1 199 198.73 195.9 <2e-16 ***
## Residuals 33978 34467 1.01
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 857 observations deleted due to missingnesswith(Vdf, numSummary(Val_plaisir, groups=gender
, statistics=c("mean", "sd")))## mean sd data:n data:NA
## F 3.763226 1.025606 17655 431
## H 3.916294 0.986838 16325 377#cohen.d(Vdf$Val_plaisir, Vdf$education)
Vdf<-aggregate(cbind(Val_reussite,Val_plaisir,Val_Civisme,Val_Conformisme)~ gender,data=Vdf,FUN=mean)
Vdf<-melt(Vdf, id="gender")
g<-ggplot(Vdf,aes(x=gender,y=value,group=variable))+geom_line(aes(color=variable), size=1.5)+scale_color_manual(values=pal16)+ylim(3,5.5) + coord_flip()
g
On observe un gradiant systématique : les valeurs civiques et celles de la réussite sont d’autant plus fortes que le niveau d’éducation est élevé. La conformité aux régles se réduit en proportion. Quand aux valeurs hédonique elles semblent étre les faits des niveaux intermédiaires. Il y a dans ce résultat une indication sur la relation entre les valeurs et les ressources.
L’effet pays
Pays et par pays on observe plutot ceci (on classe les pays par leur score moyen avec la fonction reorder().
La valeur civique semble assez bien partagée. Conformisme et hédonisme semblent étre négativement liés. La valeur réussite est plus faible dans la partie occidentale de l’europe.
Un test d’analyse de variance permet de s’assurance de la pertience d’interpreter les différences ( on laisse é la réflexion des étudiants un aspect intéressant de la taille de l’échantillon : é une échelle de plusieurs dizaines de milliers d’observation, les test sont toujours significatifs)
Vdf<-subset(H,select=c(cntry,Val_reussite,Val_plaisir,Val_Civisme,Val_Conformisme))
Vdf<-aggregate(cbind(Val_reussite,Val_plaisir,Val_Civisme,Val_Conformisme)~ cntry, data=Vdf,FUN=mean)
Vdf<-melt(Vdf, id=c("cntry"))
ggplot(Vdf,aes(x=reorder(cntry,value),y=value,group=variable))+geom_line(aes(color=variable), size=1.5)+scale_color_manual(values=pal16)+coord_flip()
Un modèle structurel de mesure avec Lavaan
Au cours des années 80, l’analyses factorielle a connu un nouveau développement avec l’idée de modéle confirmatoire. L’article de Joreskorg en 1969 marque un tournant. Il developpera ce travail en introduisant le premier systéme d’évaluation de modéle structurels é variables latente : le fameux lisrel. http://www.ssicentral.com/lisrel/
On peut aussi tester notre structure avec un modéle confirmatoire, le modéle CFA. La différence avec l’EFA c’est qu’on impose des contraintes sur les paramétres, certains sont fixés é zero. Dans ce modéle chaque item de l’échelle de valeurs dépend d’un seul facteur et d’un terme spécifique.
On utilise ici les ressources de lavaan et pour le graphique celles de semplot.
#avec http://lavaan.ugent.be/tutorial/cfa.html
Value.model <- ' civism =~ Altruisme + Egalite + Tolerance +Creativite+ Environnement +Liberte
ordre =~ Autoritegvt + SeConduireBien + Tradition + Securite+ RespectdesRegles
reussite =~ Admiration + Respect + Succes + Richesse
hedonism =~ Aventure + Bontemps + Succes+Nouveau+Plaisir '
fit <- cfa(Value.model, data=H)
summary(fit, fit.measures=TRUE,standardized=TRUE)## lavaan 0.6-3 ended normally after 42 iterations
##
## Optimization method NLMINB
## Number of free parameters 45
##
## Used Total
## Number of observations 32814 34837
##
## Estimator ML
## Model Fit Test Statistic 22292.101
## Degrees of freedom 145
## P-value (Chi-square) 0.000
##
## Model test baseline model:
##
## Minimum Function Test Statistic 142617.075
## Degrees of freedom 171
## P-value 0.000
##
## User model versus baseline model:
##
## Comparative Fit Index (CFI) 0.845
## Tucker-Lewis Index (TLI) 0.817
##
## Loglikelihood and Information Criteria:
##
## Loglikelihood user model (H0) -962303.758
## Loglikelihood unrestricted model (H1) -951157.707
##
## Number of free parameters 45
## Akaike (AIC) 1924697.516
## Bayesian (BIC) 1925075.454
## Sample-size adjusted Bayesian (BIC) 1924932.444
##
## Root Mean Square Error of Approximation:
##
## RMSEA 0.068
## 90 Percent Confidence Interval 0.067 0.069
## P-value RMSEA <= 0.05 0.000
##
## Standardized Root Mean Square Residual:
##
## SRMR 0.064
##
## Parameter Estimates:
##
## Information Expected
## Information saturated (h1) model Structured
## Standard Errors Standard
##
## Latent Variables:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## civism =~
## Altruisme 1.000 0.632 0.637
## Egalite 0.895 0.012 72.353 0.000 0.566 0.526
## Tolerance 0.975 0.012 78.271 0.000 0.617 0.588
## Creativite 0.838 0.014 61.079 0.000 0.530 0.425
## Environnement 0.837 0.012 70.178 0.000 0.530 0.505
## Liberte 0.786 0.012 65.082 0.000 0.497 0.459
## ordre =~
## Autoritegvt 1.000 0.711 0.589
## SeConduireBien 1.050 0.014 75.263 0.000 0.747 0.598
## Tradition 0.949 0.014 65.854 0.000 0.675 0.489
## Securite 1.078 0.014 76.423 0.000 0.767 0.614
## RespectdesRgls 0.997 0.015 67.297 0.000 0.709 0.504
## reussite =~
## Admiration 1.000 0.979 0.699
## Respect 0.794 0.009 85.507 0.000 0.777 0.570
## Succes 0.978 0.012 78.722 0.000 0.957 0.698
## Richesse 0.733 0.009 81.818 0.000 0.718 0.541
## hedonism =~
## Aventure 1.000 0.958 0.666
## Bontemps 0.806 0.010 84.806 0.000 0.772 0.592
## Succes 0.143 0.010 13.811 0.000 0.137 0.100
## Nouveau 0.905 0.010 89.889 0.000 0.867 0.641
## Plaisir 0.886 0.010 90.587 0.000 0.848 0.648
##
## Covariances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## civism ~~
## ordre 0.217 0.004 49.136 0.000 0.483 0.483
## reussite 0.161 0.005 31.956 0.000 0.260 0.260
## hedonism 0.277 0.006 49.860 0.000 0.458 0.458
## ordre ~~
## reussite 0.327 0.007 49.734 0.000 0.470 0.470
## hedonism 0.040 0.005 7.674 0.000 0.059 0.059
## reussite ~~
## hedonism 0.523 0.009 57.799 0.000 0.558 0.558
##
## Variances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .Altruisme 0.585 0.006 97.018 0.000 0.585 0.594
## .Egalite 0.836 0.008 110.784 0.000 0.836 0.723
## .Tolerance 0.718 0.007 104.050 0.000 0.718 0.654
## .Creativite 1.272 0.011 118.169 0.000 1.272 0.819
## .Environnement 0.817 0.007 112.610 0.000 0.817 0.745
## .Liberte 0.923 0.008 116.054 0.000 0.923 0.789
## .Autoritegvt 0.955 0.009 103.650 0.000 0.955 0.654
## .SeConduireBien 1.003 0.010 102.447 0.000 1.003 0.643
## .Tradition 1.449 0.013 113.703 0.000 1.449 0.761
## .Securite 0.971 0.010 100.146 0.000 0.971 0.623
## .RespectdesRgls 1.478 0.013 112.492 0.000 1.478 0.746
## .Admiration 1.005 0.011 91.797 0.000 1.005 0.512
## .Respect 1.257 0.011 110.592 0.000 1.257 0.675
## .Succes 0.802 0.010 81.316 0.000 0.802 0.426
## .Richesse 1.243 0.011 113.100 0.000 1.243 0.707
## .Aventure 1.148 0.012 97.525 0.000 1.148 0.556
## .Bontemps 1.104 0.010 107.605 0.000 1.104 0.650
## .Nouveau 1.077 0.011 101.439 0.000 1.077 0.589
## .Plaisir 0.992 0.010 100.360 0.000 0.992 0.580
## civism 0.400 0.007 54.538 0.000 1.000 1.000
## ordre 0.506 0.010 49.666 0.000 1.000 1.000
## reussite 0.958 0.015 62.956 0.000 1.000 1.000
## hedonism 0.917 0.015 59.450 0.000 1.000 1.000semPaths(fit, layout = "circle",'std', style="lisrel",nCharNodes=6)
Les résultats valident la structure, tout les lambda sont significatifs et importants. On peut avoir l’habitude de valeur plus faibles, mais lé les items sont heterogénes dans leurs formulation, ils ont une forte spécificité rencontre dans l’EFA.
mais le RMSEA de 0.068 est acceptable compte tenu de la complexité du modéle.
L’information intéressante est dans la corrélation des facteurs. La réussite et l’hédonisme vont de pair. L’ordre et la réussite aussi. On a ici deux systémes de valeurs. En troisiéme lieu une bonne liaison entre civisme et hédonisme.
A ce stade de l’analyse on commence é comprendre la structure des valeurs : une sorte de double plan :
l’un se structure dans la polarité Hédonisme/ordre, la seconde Civisme/ réussite personnel. (carré sémiotique ?)
Classification automatique
Puisqu’on comprend mieux la structure de l’échelle, et ses variations, on peut passer é la seconde téche : identifier des groupes qui partagent les mémes valeurs.
On construit la typologie en deux temps. D’abord sur un petit échantillon une évaluation des groupes, puis on emploie la méthode kmeans qui permet de traiter l’ensemble de l’échantillon large .
Exploration avec la classification hierarchique.
Pour explorer les partitions possibles de l’ensemble des individus on va s’appuyer sur la fonction hclust dont les paramétres sont a) le tableau de distance ( obtenu par la fonction dist appliqué au tableau de données b) la méthode de regroupement ici ward.D2 qui marche bien le plus souvent ( en particulier si les distances sont euclidienne).
Cette méthode consiste é regroupper successivement les classes les plus proches. Elle est spécifié par un double choix : l’indicateur de distance, et choix de la distance é retenir quand on évalue la distance entre deux groupes : la plus petite des distances des individus des deux classes, ou au contraire la plus longue.
Ces méthodes ont été proposées d’abord dans le champs de la biologie pour répondre aux problémes de la classification des éspéces en particulier par sokal et sneath.
Pour une explcation plus détailleé voir xxx, . Le package `ape’ apportent des ressources particuliérement riche, méme si on ne l’utilise pas dans cette application.
Les premiéres lignes servent é “sampler” notre base d’étude. La classification ne prend qu’une ligne, on affiche les résultat avec plot, les autres lignes permettent de faire un peu de décoration avec les ressources du package .
mysample<-subset(H,select=c(F4Hedonisme,F3Conformisme,F2Reussite,F1Civisme)) #on isole les variables
set.seed(42)
mysample <- mysample[sample(1:nrow(H),1000,replace=FALSE),] #on echantillonne les individus
mysample<-as.data.frame(mysample) #on cree le dataframe
mysample<- mysample[complete.cases(mysample), ] #on filtre sur les observations validesla fonction hclust dont les paramétres sont a) le tableau de distance ( obtenu par la fonction dist appliquée au tableau de données b) la méthode de regroupement ici ward.D2 qui marche bien le plus souvent. Les autres paramétres labellisent le graphique. Avec cutree, on choisit le nombre de groupe qui nous semble adéquat. Les lignes suivantes améliorent le graphique (dplyr est requis)
ClustHV <- hclust(dist(mysample), method= "ward.D2") #clustering
plot(ClustHV, main= "Typologie des valeurs (Schwartz)", xlab= "Observation", sub="Method=ward; Distance=euclidian")
ClustHV5 <- cutree(ClustHV, k=5) # cut tree into 5 clusters
#un peu de decoration avec dendextend
Dend<-as.dendrogram(ClustHV)
Dend<-hang.dendrogram(Dend)
Dend<-Dend %>% set("branches_lwd", 1.5)
Dend<-Dend %>% set("labels_colors", k=5)
plot(Dend,horiz=T)
Le probléme principal posé par cette famille de méthode, outre le choix des distances et des algorithmes d’agrégation est celui de déterminer le nombre de groupes optimum. NBClust, un package qui calcule plus de 30 indices pour évaluer la qualité d’une partition, est un outil particuliérement utile é cette fin. Il répond é un besoin exprimé depuis trés longtemps.
On explore ici toute les solutions de 3 é 12 groupes et pour tous les indices, et une méthode du vote majoritaire (le nombre de groupes qui est le plus souvent indiqué par les 30 indices disponibles) aide é conclure . Dans notre cas une majorité penche pour 4 groupes. Pour en savoir plus on consultera ce lien.
Dans la foulée, on constitue le fichier des centres de classes qu’on va employer ensuite pour initialiser la solution kmeans, avec une simple aggrégation.
#test du nombre de groupes avec la fonction nbclust
nb <- NbClust(mysample, distance = "euclidean", min.nc = 3, max.nc = 12, method = "ward.D2",index="all", alphaBeale = 0.1)
## *** : The Hubert index is a graphical method of determining the number of clusters.
## In the plot of Hubert index, we seek a significant knee that corresponds to a
## significant increase of the value of the measure i.e the significant peak in Hubert
## index second differences plot.
## 
## *** : The D index is a graphical method of determining the number of clusters.
## In the plot of D index, we seek a significant knee (the significant peak in Dindex
## second differences plot) that corresponds to a significant increase of the value of
## the measure.
##
## *******************************************************************
## * Among all indices:
## * 8 proposed 3 as the best number of clusters
## * 3 proposed 4 as the best number of clusters
## * 4 proposed 5 as the best number of clusters
## * 3 proposed 6 as the best number of clusters
## * 3 proposed 7 as the best number of clusters
## * 1 proposed 10 as the best number of clusters
## * 1 proposed 11 as the best number of clusters
## * 1 proposed 12 as the best number of clusters
##
## ***** Conclusion *****
##
## * According to the majority rule, the best number of clusters is 3
##
##
## *******************************************************************# Print the result
nb## $All.index
## KL CH Hartigan CCC Scott Marriot TrCovW
## 3 0.0474 312.2362 101.1926 -13.9172 1411.887 141215826269 148862.11
## 4 6.7263 264.3984 102.9766 -20.2745 1715.075 181016784663 142241.28
## 5 0.3101 245.8999 107.1941 -20.0523 2112.820 184161033024 138085.81
## 6 2.0124 240.7685 83.2776 -18.5803 2400.762 194384128647 98390.70
## 7 27.0813 232.4095 63.8677 -17.8486 2659.570 200126392185 79083.60
## 8 0.6091 221.9199 55.1835 -17.6970 2869.205 208485257538 64112.88
## 9 0.6642 212.5064 50.4995 -17.6188 3073.010 211786615101 53946.76
## 10 0.4649 204.6736 46.5624 -17.4787 3241.828 217933145650 53587.38
## 11 0.3498 197.9997 45.8902 -17.2983 3406.178 220857183834 45901.33
## 12 1.2659 192.9784 41.4365 -16.9526 3575.776 218893598236 42275.31
## TraceW Friedman Rubin Cindex DB Silhouette Duda Pseudot2
## 3 1629.5423 4.0083 1.6762 0.2737 1.5168 0.2263 0.7289 137.9590
## 4 1468.6968 4.7126 1.8597 0.2659 1.6176 0.1693 0.7755 107.0923
## 5 1321.2847 5.7082 2.0672 0.2474 1.7338 0.1545 0.6373 102.4364
## 6 1183.6683 6.4382 2.3076 0.2925 1.6021 0.1680 0.6962 92.9293
## 7 1085.5151 7.1280 2.5162 0.2849 1.4919 0.1721 0.7331 73.8935
## 8 1015.0489 7.7570 2.6909 0.2740 1.4886 0.1625 0.6912 69.2596
## 9 957.5506 8.4476 2.8525 0.2655 1.4283 0.1659 0.6906 51.9701
## 10 907.6220 9.0066 3.0094 0.3399 1.4157 0.1669 0.5859 63.6193
## 11 863.7628 9.5774 3.1622 0.3347 1.3226 0.1645 0.7554 53.7418
## 12 822.5541 10.1542 3.3206 0.3240 1.3924 0.1590 0.7609 46.2010
## Beale Ratkowsky Ball Ptbiserial Frey McClain Dunn Hubert
## 3 0.8953 0.3609 543.1808 0.4172 1.4600 1.2032 0.0349 0.0007
## 4 0.6969 0.3369 367.1742 0.3795 0.4149 1.7411 0.0349 0.0008
## 5 1.3663 0.3183 264.2569 0.3684 0.0255 2.5465 0.0349 0.0008
## 6 1.0484 0.3063 197.2780 0.3855 0.1953 2.7182 0.0433 0.0009
## 7 0.8745 0.2931 155.0736 0.3866 0.3541 3.0664 0.0441 0.0010
## 8 1.0718 0.2799 126.8811 0.3743 0.1085 3.5995 0.0441 0.0010
## 9 1.0724 0.2682 106.3945 0.3768 0.0821 3.7887 0.0441 0.0011
## 10 1.6878 0.2580 90.7622 0.3794 0.1129 3.8962 0.0578 0.0011
## 11 0.7769 0.2490 78.5239 0.3801 0.3440 3.9875 0.0578 0.0011
## 12 0.7536 0.2411 68.5462 0.3666 0.2823 4.5272 0.0578 0.0013
## SDindex Dindex SDbw
## 3 2.3618 1.2335 1.6536
## 4 2.7059 1.1636 1.2177
## 5 2.5864 1.0988 1.3902
## 6 2.3604 1.0414 1.3065
## 7 2.2878 1.0036 1.0029
## 8 2.4162 0.9702 0.6746
## 9 2.3270 0.9441 0.5483
## 10 2.6250 0.9228 0.4690
## 11 2.4158 0.9024 0.4362
## 12 2.9221 0.8793 0.4015
##
## $All.CriticalValues
## CritValue_Duda CritValue_PseudoT2 Fvalue_Beale
## 3 0.7362 132.9207 0.4659
## 4 0.7361 132.6584 0.5941
## 5 0.6911 80.4639 0.2440
## 6 0.7030 89.9668 0.3811
## 7 0.6997 87.1134 0.4787
## 8 0.6796 73.0785 0.3695
## 9 0.6548 61.1420 0.3696
## 10 0.6302 52.8136 0.1522
## 11 0.6850 76.3502 0.5404
## 12 0.6753 70.6752 0.5558
##
## $Best.nc
## KL CH Hartigan CCC Scott Marriot
## Number_clusters 7.0000 3.0000 6.0000 3.0000 5.0000 5
## Value_Index 27.0813 312.2362 23.9165 -13.9172 397.7445 7078847261
## TrCovW TraceW Friedman Rubin Cindex DB Silhouette
## Number_clusters 6.00 6.0000 5.0000 7.000 5.0000 11.0000 3.0000
## Value_Index 39695.11 39.4632 0.9956 -0.034 0.2474 1.3226 0.2263
## Duda PseudoT2 Beale Ratkowsky Ball PtBiserial Frey
## Number_clusters 4.0000 4.0000 3.0000 3.0000 4.0000 3.0000 3.00
## Value_Index 0.7755 107.0923 0.8953 0.3609 176.0066 0.4172 1.46
## McClain Dunn Hubert SDindex Dindex SDbw
## Number_clusters 3.0000 10.0000 0 7.0000 0 12.0000
## Value_Index 1.2032 0.0578 0 2.2878 0 0.4015
##
## $Best.partition
## 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
## 1 1 2 1 3 1 3 1 2 1 1 1 2 2 3
## 16 17 19 20 21 22 23 24 25 26 27 29 30 31 32
## 1 2 2 2 2 2 2 1 1 1 2 3 1 1 1
## 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47
## 3 1 2 3 1 1 3 1 1 1 1 2 3 3 3
## 48 49 51 52 53 54 56 57 58 59 61 62 63 64 65
## 2 1 2 2 1 1 2 1 2 2 2 2 2 3 1
## 66 67 68 69 70 71 72 74 75 76 77 78 79 80 81
## 1 2 1 3 2 1 2 2 3 1 2 1 3 2 2
## 82 83 84 85 86 87 88 90 91 92 93 94 95 96 97
## 1 3 2 1 1 1 3 1 2 3 3 3 1 2 2
## 98 99 100 102 103 104 105 106 107 108 109 110 111 112 113
## 2 3 1 1 1 1 1 3 1 2 1 1 3 2 2
## 114 115 117 118 119 120 121 122 123 124 125 126 127 128 129
## 1 1 2 1 2 1 1 2 3 1 2 3 1 1 3
## 130 131 132 134 135 136 137 138 139 140 141 142 143 144 145
## 1 3 2 1 1 2 1 2 2 2 2 1 2 1 1
## 146 147 148 149 151 152 153 154 155 156 157 158 159 160 161
## 1 3 3 1 3 1 1 1 2 2 3 1 3 2 3
## 162 163 164 165 166 168 169 170 171 172 174 175 176 178 179
## 2 3 2 1 1 1 2 1 1 1 3 1 3 2 2
## 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194
## 1 2 1 2 3 1 3 2 2 2 1 2 1 2 1
## 195 196 197 198 200 201 202 205 206 207 208 209 210 211 212
## 3 2 1 1 2 2 3 3 3 3 3 2 2 1 3
## 213 214 215 216 217 218 219 221 222 223 224 225 226 227 228
## 1 1 2 1 2 1 3 1 3 1 3 1 1 2 1
## 229 231 232 233 234 235 236 237 238 239 240 241 242 243 244
## 2 3 2 3 2 2 3 2 2 2 1 2 2 2 3
## 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259
## 2 2 2 2 1 1 1 3 3 1 2 1 1 2 1
## 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274
## 2 2 3 2 2 1 1 1 3 2 2 3 3 2 1
## 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289
## 2 3 2 2 2 1 3 2 2 1 1 3 1 2 3
## 290 291 292 293 294 295 296 297 298 299 301 302 303 304 306
## 2 3 2 3 1 3 1 1 3 2 2 2 1 2 3
## 308 309 310 311 312 313 314 315 317 318 319 320 321 322 323
## 3 1 3 2 2 1 3 2 2 2 2 1 1 2 1
## 324 325 326 327 328 329 330 332 333 334 335 336 337 338 339
## 1 2 1 1 1 3 1 2 3 1 2 2 1 1 1
## 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354
## 3 2 2 2 1 1 3 1 3 1 1 2 3 2 2
## 356 358 359 360 361 363 364 365 366 367 368 369 370 371 372
## 3 3 2 1 2 1 3 1 3 2 1 2 2 2 2
## 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387
## 2 2 1 2 1 1 2 1 3 2 2 1 1 2 1
## 389 390 391 392 393 394 396 397 398 399 400 401 402 404 405
## 2 3 3 2 1 2 3 2 1 1 2 2 2 1 2
## 406 407 408 409 411 412 413 414 416 417 418 419 420 421 422
## 2 1 1 2 3 2 2 1 1 2 1 2 1 2 1
## 423 424 425 426 427 428 429 430 431 432 433 434 436 437 438
## 2 1 1 3 1 1 1 3 1 1 1 2 1 3 3
## 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453
## 2 2 2 2 3 2 3 3 2 1 2 1 2 1 1
## 454 455 456 458 459 460 461 462 463 464 465 466 467 468 469
## 3 2 1 1 2 1 3 1 1 3 3 2 3 2 1
## 470 471 472 474 475 476 477 478 479 480 481 482 483 484 485
## 2 2 1 1 1 3 2 1 3 1 1 2 1 1 2
## 486 488 489 490 491 492 493 494 495 496 497 498 499 500 501
## 3 3 1 2 2 1 2 2 2 3 2 1 3 1 1
## 502 503 504 505 507 508 509 510 511 512 513 514 516 517 518
## 2 2 1 1 3 2 1 3 2 2 3 2 3 2 2
## 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533
## 1 1 3 2 1 1 2 1 2 1 3 1 2 2 2
## 534 535 536 537 538 539 540 541 542 543 544 545 546 548 549
## 2 1 2 1 1 2 2 3 3 1 2 1 2 3 2
## 550 551 552 553 554 555 556 557 558 559 560 561 562 563 565
## 1 1 1 2 1 1 2 2 1 1 2 1 2 1 1
## 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580
## 1 2 1 2 1 3 1 1 2 3 2 1 2 3 1
## 581 583 584 585 586 587 588 589 590 591 592 593 594 595 596
## 1 2 1 2 3 2 2 1 2 2 2 1 2 3 2
## 598 600 601 602 603 604 605 606 607 608 609 610 611 612 613
## 2 2 2 1 1 2 1 3 2 2 2 2 1 1 2
## 614 615 617 618 619 620 621 622 623 624 625 626 627 628 629
## 3 2 3 3 2 2 1 2 2 2 2 1 1 2 1
## 630 631 632 633 634 635 636 637 639 640 641 642 643 645 646
## 3 3 1 2 1 1 1 1 1 1 1 1 3 3 2
## 648 649 650 652 653 654 655 656 657 658 659 660 661 663 664
## 1 1 1 1 1 1 2 3 1 1 1 3 2 1 3
## 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679
## 2 1 3 1 1 1 2 3 3 1 1 1 1 1 2
## 680 681 682 683 684 685 686 687 688 689 690 692 693 694 695
## 2 1 2 1 2 2 2 1 1 2 3 2 2 2 2
## 696 697 699 700 702 703 704 706 708 709 710 712 713 714 715
## 1 1 2 3 2 3 1 1 3 2 1 2 2 1 3
## 716 718 719 720 721 722 723 724 725 726 727 728 729 730 731
## 2 1 2 2 2 2 1 2 1 3 1 3 2 1 2
## 732 733 734 735 736 737 738 739 740 741 743 744 745 746 747
## 1 2 2 2 3 3 3 2 1 1 2 1 1 2 2
## 748 749 750 751 752 754 755 756 757 758 759 760 761 762 763
## 2 3 2 1 2 2 2 1 2 2 1 1 1 1 2
## 764 765 767 768 769 770 771 772 773 774 775 776 777 778 779
## 3 2 1 2 2 2 2 2 3 2 3 3 2 2 2
## 780 782 783 784 785 786 787 789 790 792 793 794 795 796 797
## 1 2 1 1 2 3 1 1 2 1 1 2 3 1 1
## 798 799 800 801 802 803 804 805 807 808 809 810 811 812 813
## 2 2 1 1 3 1 1 3 2 1 1 1 3 1 2
## 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828
## 2 1 1 3 1 3 2 1 2 2 2 1 1 2 2
## 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843
## 3 1 1 1 3 1 1 2 2 2 2 1 2 2 3
## 844 845 846 847 848 849 850 851 852 853 854 855 856 857 859
## 2 3 2 1 3 2 1 1 2 2 1 3 2 2 1
## 860 862 863 864 865 867 868 869 870 871 872 873 874 875 876
## 3 1 2 3 1 3 2 2 1 3 2 1 1 1 3
## 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891
## 2 3 2 1 1 3 2 3 1 1 1 3 2 2 1
## 892 893 894 895 896 897 898 899 900 901 902 903 904 905 907
## 1 1 2 2 1 1 1 2 2 1 2 2 2 3 2
## 909 910 911 912 913 914 915 917 918 919 920 921 922 923 924
## 1 1 2 1 1 2 1 2 1 2 1 3 2 1 2
## 925 926 927 928 930 931 932 933 935 937 938 939 940 941 942
## 2 1 2 1 1 2 2 3 3 3 1 2 1 1 2
## 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957
## 2 1 1 1 2 3 2 2 1 1 2 2 2 1 2
## 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972
## 2 2 2 3 2 1 2 2 3 2 1 1 1 3 3
## 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987
## 2 2 2 3 2 1 3 2 2 2 1 1 2 1 2
## 988 989 990 992 993 994 995 996 997 998 999 1000
## 1 3 1 3 2 2 1 1 3 1 1 1fviz_nbclust(nb) + theme_minimal()## Among all indices:
## ===================
## * 2 proposed 0 as the best number of clusters
## * 8 proposed 3 as the best number of clusters
## * 3 proposed 4 as the best number of clusters
## * 4 proposed 5 as the best number of clusters
## * 3 proposed 6 as the best number of clusters
## * 3 proposed 7 as the best number of clusters
## * 1 proposed 10 as the best number of clusters
## * 1 proposed 11 as the best number of clusters
## * 1 proposed 12 as the best number of clusters
##
## Conclusion
## =========================
## * According to the majority rule, the best number of clusters is 3 .
#sauvegarde des centres de classes
mysample$cluster <- assignCluster(mysample,mysample,ClustHV5)
Initial<-as.matrix(aggregate(cbind(F4Hedonisme,F3Conformisme,F2Reussite,F1Civisme)~ cluster, data=mysample,FUN=mean))
Initial## cluster F4Hedonisme F3Conformisme F2Reussite F1Civisme
## [1,] "1" "-0.783914783" "-0.87294888" "-0.04268095" "-0.132926662"
## [2,] "2" " 0.826892221" " 1.04473571" " 0.70723181" " 0.728358493"
## [3,] "3" "-0.559744557" "-0.05521409" " 0.76278058" " 0.373885097"
## [4,] "4" "-0.009488216" "-0.43303348" "-1.07422264" "-0.741343788"
## [5,] "5" " 0.599515917" " 0.48311365" "-0.21951238" " 0.009991042"Cette analyse sur un échantillon indique que le nombre optimum est de 3, 5 étant le second concurrent.
Typologie avec kmeans
On part sur l’ hypothése d’une partition é 5 groupes en generalisant avec une méthode kmeans. L’astuce est qu’on prendra comme centre de groupes initiaux la solution précédentes.
pour en savoir plus sur kmeans : https://uc-r.github.io/kmeans_clustering
Avant d’analyser le profil des groupes on observera qu’avec notre partition , la variance entre les groupes représente presque 60% de la variance totale.
#les classes initiales
H<- H[complete.cases(H), ]
Kdf<- subset(H,select=c(F4Hedonisme, F3Conformisme , F2Reussite , F1Civisme))
set.seed(239)
Cluster <- kmeans(Kdf[, 1:4], centers=5, nstart = 25, iter.max = 200, algorithm="MacQueen")
H$KMeans <- assignCluster(H,Kdf,Cluster$cluster)
Cluster$size # Effectifs des Cluste## [1] 2943 1958 2449 2778 1803Cluster$centers # Cluster Centroids## F4Hedonisme F3Conformisme F2Reussite F1Civisme
## 1 -0.7963279 -0.4822977 0.72680591 0.3041223
## 2 0.1781069 -0.5908922 -0.51315529 0.4900884
## 3 0.3651100 0.5696762 -0.09059955 -0.3296810
## 4 0.7646141 0.9176065 0.80760324 0.8219914
## 5 -0.8087633 -0.7693738 -0.60456095 -1.0373149Cluster$withinss # Within Cluster Sum of Squares## [1] 3503.540 2320.734 2570.639 3021.752 2781.954Cluster$tot.withinss # Total Within Sum of Squares## [1] 14198.62Cluster$betweenss # Between Cluster Sum of Squares## [1] 19462.22remove(Cluster)Analyse interne
Les groupes sont affectés , il n’y a plus qu’a examiner les profils par une méthodes graphique. On fait d’abord une comparaison des profils avec un simple diagramme en ligne avec ggplot
Mais la solution la plus pratique est celle d’un diagramme radar interactif, qui permet de mieux analyser les profils de nos 5 types.
#diagramme en ligne
Vdf<-subset(H,select=c(KMeans,Val_reussite,Val_plaisir,Val_Civisme,Val_Conformisme))
Vdf<-aggregate(cbind(Val_reussite,Val_plaisir,Val_Civisme,Val_Conformisme)~ KMeans, data=Vdf,FUN=mean)
Vdf<-melt(Vdf, id=c("KMeans"))
ggplot(Vdf,aes(x=variable,y=value,group=KMeans))+geom_line(aes(color=KMeans), size=1.5)
#diagramme radar
Vdf<-subset(H,select=c(KMeans,Val_reussite,Val_plaisir,Val_Civisme,Val_Conformisme))
Vdf<-aggregate(cbind(Val_reussite,Val_plaisir,Val_Civisme,Val_Conformisme)~ KMeans, data=Vdf,FUN=mean)
#radarDF <- Vdf %>% select(KMeans,2:5) %>% as.data.frame()
radarDF <- gather(Vdf, key=Label, value=Score, -KMeans) %>% spread(key=KMeans, value=Score)
chartJSRadar(scores = radarDF, maxScale = 6, minScale=0, scaleStartValue=1, labelSize =16,showToolTipLabel = TRUE)Le radar plot est pratique pour interpreter les profils :
le travail interprétatif conduit é 5 dénominations
autoritarisme“” “scepticisme” * “Réussite etlegitimité” “civisme et hedonisme”" “Pluralisme”
Pour mieux apprécier ces configurations , on peut revenir aux données initiales et refaire le radarplot avec les 21 valeurs.
Vdf<-subset(H,select=c(KMeans,Admiration,Altruisme,Autoritegvt,Aventure,Bontemps,
Creativite,Egalite,Environnement,Liberte,Loyaute,Modestie,
Nouveau,Plaisir,Respect,RespectdesRegles,Richesse,SeConduireBien,Securite,Succes,Tolerance,Tradition))
H$KMeansb[Vdf$KMeans=="1"]<-"Scepticisme"
H$KMeansb[Vdf$KMeans=="2"]<-"HedonismeCivique"
H$KMeansb[Vdf$KMeans=="3"]<-"RéussiteLégitime"
H$KMeansb[Vdf$KMeans=="4"]<-"Polyethique"
H$KMeansb[Vdf$KMeans=="5"]<-"Hedonisme materiel"
H$KMeansb<-as.factor(H$KMeansb)
Vdf<-subset(H,select=c(KMeansb,Admiration,Altruisme,Autoritegvt,Aventure,Bontemps,
Creativite,Egalite,Environnement,Liberte,Loyaute,Modestie,
Nouveau,Plaisir,Respect,RespectdesRegles,Richesse,SeConduireBien,Securite,Succes,Tolerance,Tradition))
Vdf<-aggregate(cbind(Admiration,Altruisme,Autoritegvt,Aventure,Bontemps,
Creativite,Egalite,Environnement,Liberte,Loyaute,Modestie,
Nouveau,Plaisir,Respect,RespectdesRegles,Richesse,SeConduireBien,Securite,Succes,Tolerance,Tradition)~ KMeansb, data=Vdf,FUN=mean)
radarDF <- gather(Vdf, key=Label, value=Score, -KMeansb) %>% spread(key=KMeansb, value=Score)
chartJSRadar(scores = radarDF, maxScale = 7, minScale=1, scaleStartValue=1, labelSize =16,showToolTipLabel = TRUE)Analyse externe
L’étape précédente visait é décrire les classes en fonctions des variables qui ont permis de les élaborer. Il y a un caractére tautologique et interne.
Pour mieux apprécier la qualité de la typologie il est utile d’examiner quelles variables externes, en l’occurennce les profils sociodémographique, sont associés é ces différents types. On croisera donc la typologie avec par exemple les niveaux d’éducations ( On laisse le soin aux étudiants de copier le chunk et é l’adpater aux autres variables : age, sexe, )
Pour chaque variable une analyse en trois temps est effectuée : 1 - analyse du tableau croisé 2 - test du chié pour s’assurer d’une dépendance ( pour comprendre le test du chi2 on se reportera é xxxxxx) 3 - analyse factorielle des correspondance sur le tableau (pour l’AFC simple on se reportera é xxxxx) Des tableaux, une AFC, et quelques graphiques ggplots
Vdf<-subset(H,select=c(KMeansb,education,cntry))
#tableau croisé
.Table <- with(Vdf, table(KMeansb))
cat("\ncounts:\n")##
## counts: print(.Table)## KMeansb
## Hedonisme materiel HedonismeCivique Polyethique
## 1803 1958 2778
## RéussiteLégitime Scepticisme
## 2449 2943 cat("\npercentages:\n")##
## percentages: print(round(100*.Table/sum(.Table), 2))## KMeansb
## Hedonisme materiel HedonismeCivique Polyethique
## 15.11 16.41 23.28
## RéussiteLégitime Scepticisme
## 20.53 24.67mytable <- xtabs(~education+KMeansb, data=Vdf)
mytable## KMeansb
## education Hedonisme materiel HedonismeCivique
## 2 primary 149 92
## 3 Lower secondary 276 204
## 4 Upper secondary 584 637
## 5 Post-second non tertia. 136 122
## 6 Short-cycle tertiary 179 221
## 7 Bachelor 226 310
## 8 Master 231 336
## 9 Doctoral 22 36
## KMeansb
## education Polyethique RéussiteLégitime Scepticisme
## 2 primary 190 111 251
## 3 Lower secondary 314 316 516
## 4 Upper secondary 1118 840 1015
## 5 Post-second non tertia. 171 166 194
## 6 Short-cycle tertiary 250 252 298
## 7 Bachelor 372 358 287
## 8 Master 327 371 360
## 9 Doctoral 36 35 22print(rowPercents(mytable))## KMeansb
## education Hedonisme materiel HedonismeCivique
## 2 primary 18.8 11.6
## 3 Lower secondary 17.0 12.5
## 4 Upper secondary 13.9 15.2
## 5 Post-second non tertia. 17.2 15.5
## 6 Short-cycle tertiary 14.9 18.4
## 7 Bachelor 14.6 20.0
## 8 Master 14.2 20.7
## 9 Doctoral 14.6 23.8
## KMeansb
## education Polyethique RéussiteLégitime Scepticisme Total
## 2 primary 24.0 14.0 31.7 100.1
## 3 Lower secondary 19.3 19.4 31.7 99.9
## 4 Upper secondary 26.7 20.0 24.2 100.0
## 5 Post-second non tertia. 21.7 21.0 24.6 100.0
## 6 Short-cycle tertiary 20.8 21.0 24.8 99.9
## 7 Bachelor 24.0 23.1 18.5 100.2
## 8 Master 20.1 22.8 22.2 100.0
## 9 Doctoral 23.8 23.2 14.6 100.0
## KMeansb
## education Count
## 2 primary 793
## 3 Lower secondary 1626
## 4 Upper secondary 4194
## 5 Post-second non tertia. 789
## 6 Short-cycle tertiary 1200
## 7 Bachelor 1553
## 8 Master 1625
## 9 Doctoral 151#test du chié
.Test <- chisq.test(mytable, correct=FALSE)
.Test##
## Pearson's Chi-squared test
##
## data: mytable
## X-squared = 240.67, df = 28, p-value < 2.2e-16#analyse des correspondances
res.ca <- CA(mytable)
eig.val <- res.ca$eig
barplot(eig.val[, 2],
names.arg = 1:nrow(eig.val),
main = "Variances Explained by Dimensions (%)",
xlab = "Principal Dimensions",
ylab = "Percentage of variances",
col ="steelblue")
#graphique répartition par CSP en effectifs absolus
ggplot(Vdf,aes(x = education, fill=KMeansb))+ geom_bar()+scale_fill_manual(values=pal16)+coord_flip()
#graphique répartition par CSP en effectifs relatifs
ggplot(Vdf,aes(x = education, fill=KMeansb))+ geom_bar(position ="fill")+scale_fill_manual(values=pal16)+coord_flip()
Une importance particuliére doit étre données aux pays. La variable pays permet de distinguer des situations historique, culturelle, économique différentes. Notre tableau de données est en fait constitué de 16 tableaux distincts.
l’analyse par pays La carto par pays permet de discerner une double structuration :
Les pays é forte population ( en h é d) s’apposent petit pays oé le pluralisme est le plus répandu ( en b é d) . En gb, en fr, en all on se partage entre une forme d’autoritarisme et un certain de gré de scepticisme.
L’autre opposition se construit dans le dualisme de la réussite sociale et du plaisir é vivre. L’est pays de l’est contre ceux du nord ouest.
# par pays
ggplot(H,aes(x = cntry, fill=KMeansb))+ geom_bar(position = "fill")+scale_fill_manual(values=pal16)+coord_flip()
mytable <- xtabs(~cntry+KMeansb, data=Vdf)
print(rowPercents(mytable))## KMeansb
## cntry Hedonisme materiel HedonismeCivique Polyethique RéussiteLégitime
## AT 7.1 9.6 34.1 23.7
## BE 8.5 15.9 25.9 25.9
## CH 6.8 19.1 33.2 18.6
## CZ 25.3 2.0 14.5 26.7
## DE 11.1 27.0 16.5 19.2
## EE 20.7 8.0 12.4 25.6
## FI 16.0 25.9 14.3 16.1
## FR 25.4 26.2 14.0 11.1
## GB 16.0 20.1 20.6 16.8
## IE 18.2 10.9 22.0 23.2
## IL 12.7 5.7 47.1 21.5
## IS 21.4 34.0 11.5 13.7
## NL 10.5 26.8 17.8 24.2
## NO 25.0 16.9 12.2 18.3
## PL 10.2 4.5 22.3 23.9
## RU 24.0 1.7 18.3 33.4
## SE 23.2 32.7 13.7 14.9
## SI 4.9 8.4 50.3 17.7
## KMeansb
## cntry Scepticisme Total Count
## AT 25.5 100.0 889
## BE 23.7 99.9 691
## CH 22.4 100.1 603
## CZ 31.4 99.9 296
## DE 26.2 100.0 1248
## EE 33.3 100.0 426
## FI 27.7 100.0 914
## FR 23.3 100.0 841
## GB 26.5 100.0 601
## IE 25.7 100.0 1033
## IL 13.0 100.0 993
## IS 19.5 100.1 262
## NL 20.8 100.1 400
## NO 27.6 100.0 663
## PL 39.1 100.0 704
## RU 22.6 100.0 470
## SE 15.6 100.1 410
## SI 18.7 100.0 487.Test <- chisq.test(mytable, correct=FALSE)
.Test##
## Pearson's Chi-squared test
##
## data: mytable
## X-squared = 1961.2, df = 68, p-value < 2.2e-16res.ca <- CA(mytable)
Une méthode d’arbre de décision
PLusieurs package sont disponibles, on a choisi partykit.<>
Le principe des arbre de décision est é chauque étape de choisir la variable la plus prédictive, et son découpage le plus discriminant, celui-ci est retenu pour diviser la population en deux sous propulations qui différent le plus du point de vue de la variable qu’on veut prédire. La méme opération est réalisée sur chacun des groupes, jusqu’à ce qu’un critére minimal de prediction n’est plus satisfait.
Vdf<-subset(H,select=c(KMeansb,education,Pays,gender,AgeClasse,NbFoyer))
library(partykit)## Loading required package: grid## Loading required package: libcoin## Loading required package: mvtnorm# grow tree
Vdf$education<-as.factor(Vdf$education)
Vdf$NbFoyer<-as.factor(Vdf$NbFoyer)
Vdf$gender<-as.factor(Vdf$gender)
Vdf$AgeClasse<-as.factor(Vdf$AgeClasse)
fit <- ctree(KMeansb ~ education + NbFoyer + gender+ AgeClasse, data=Vdf,maxdepth = 3)
plot(fit, main="Conditional Inference Tree for Valeurs", gp = gpar(fontsize = 7),type="extended",drop=F,
ip_args=list(abbreviate = F, id = F, pval=F), tp_args = list(rot = 45, just = c("right", "top")))
#png("fit.png", res=60, height=800, width=1600)
# evaluation et accuracy
table<-table(Vdf$KMeansb, predict(fit), dnn = c("Actual ", "Predicted "))
table## Predicted
## Actual Hedonisme materiel HedonismeCivique Polyethique
## Hedonisme materiel 0 0 131
## HedonismeCivique 0 0 285
## Polyethique 0 0 480
## RéussiteLégitime 0 0 420
## Scepticisme 0 0 206
## Predicted
## Actual RéussiteLégitime Scepticisme
## Hedonisme materiel 279 1393
## HedonismeCivique 289 1384
## Polyethique 655 1643
## RéussiteLégitime 778 1251
## Scepticisme 280 2457prop.table(table, 1)## Predicted
## Actual Hedonisme materiel HedonismeCivique Polyethique
## Hedonisme materiel 0.00000000 0.00000000 0.07265668
## HedonismeCivique 0.00000000 0.00000000 0.14555669
## Polyethique 0.00000000 0.00000000 0.17278618
## RéussiteLégitime 0.00000000 0.00000000 0.17149857
## Scepticisme 0.00000000 0.00000000 0.06999660
## Predicted
## Actual RéussiteLégitime Scepticisme
## Hedonisme materiel 0.15474210 0.77260122
## HedonismeCivique 0.14759959 0.70684372
## Polyethique 0.23578114 0.59143269
## RéussiteLégitime 0.31768069 0.51082074
## Scepticisme 0.09514101 0.83486239margin.table(mytable, 1)## cntry
## AT BE CH CZ DE EE FI FR GB IE IL IS NL NO PL
## 889 691 603 296 1248 426 914 841 601 1033 993 262 400 663 704
## RU SE SI
## 470 410 487Vdf$predict<-predict(fit)
Vdf$match<-0
Vdf$match[which(Vdf$predict==Vdf$KMeansb)]<-1
accuracy<-sum(Vdf$match)/nrow(Vdf)
accuracy## [1] 0.3113737Les valeurs et le bien être :
Adopter des valeurs distinctes conduit-il é des niveaux de bonheur différents ou non é bien sur se poser la question de savoir si le bonheur ne conduit pas le choix des valeurs. L’hypothése d’absence de relation : qu’importe le niveau de bonheur, les valeurs sont juste des grilles culturelles (acquises lors de la socialisation).
Bref une vaste question
Analyse des critères de satisfaction et de bien-être
On reprend la méthode corrplot pour analyser les variables :
l’état de santé est lié uniquement é la satisfaction dans la vie, c’est une variable isolée. La confiance se distribue en deux blocs clairs : la confiance dans les institutions et dans les personnes. Satisfaction dans la vie et satisfaction é l’égards de la situation économique sont trés liés.
W<-subset(H,select=c("happyness","sat_life","sat_eco","sat_gov","sat_demo","sat_edu","sat_sant","Healthness","Trust_tst","Trust_fair","Trust_hlp","trstprl", "trstlgl","trstplc","trstplc", "trstplt", "trstprt","trstep","trstun"))
X<-cor(W, use="complete")
#necessite corrplot
corrplot(X,order="hclust", addrect=6) # avec un clustering des variables
Modélisation du bonheur
Trois sources : - les valeurs susceptibles d’engendre du bonheur - la confiance - l’origine pays comme contréle ( effet pays)
x<-c("KMeansb")
Vdf<-subset(H,select=c(get(paste0(x)),Trust_people,Trust_Institut,happyness,Healthness))
Vdf<-aggregate(cbind(Trust_people,Trust_Institut,happyness,Healthness)~ KMeansb,data=Vdf,FUN=mean)
Vdf<-melt(Vdf, id="KMeansb")
g<-ggplot(Vdf,aes(x=KMeansb,y=value,group=variable))+geom_line(aes(color=variable), size=1.5)+scale_color_manual(values=pal16)+ylim(3,9) + coord_flip()
g
AnovaModel.1 <- aov(Trust_Institut ~ KMeansb, data=H)
summary(AnovaModel.1)## Df Sum Sq Mean Sq F value Pr(>F)
## KMeansb 4 225 56.30 14.86 4.05e-12 ***
## Residuals 11926 45176 3.79
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1with(H, numSummary(Trust_Institut, groups=KMeansb, statistics=c("mean", "sd")))## mean sd data:n
## Hedonisme materiel 4.745055 1.888800 1803
## HedonismeCivique 5.082482 1.868739 1958
## Polyethique 4.688145 2.077688 2778
## RéussiteLégitime 4.814278 1.894084 2449
## Scepticisme 4.700079 1.946121 2943AnovaModel.2 <- aov(Trust_people ~ KMeansb, data=H)
summary(AnovaModel.2)## Df Sum Sq Mean Sq F value Pr(>F)
## KMeansb 4 519 129.65 41.93 <2e-16 ***
## Residuals 11926 36874 3.09
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1with(H, numSummary(Trust_people, groups=KMeansb, statistics=c("mean", "sd")))## mean sd data:n
## Hedonisme materiel 5.844518 1.756034 1803
## HedonismeCivique 6.199694 1.619907 1958
## Polyethique 5.617591 1.797191 2778
## RéussiteLégitime 5.587587 1.693857 2449
## Scepticisme 5.749462 1.860976 2943AnovaModel.3 <- aov(happyness ~ KMeansb, data=H)
summary(AnovaModel.3)## Df Sum Sq Mean Sq F value Pr(>F)
## KMeansb 4 584 145.96 51.66 <2e-16 ***
## Residuals 11926 33692 2.83
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1with(H, numSummary(happyness, groups=KMeansb, statistics=c("mean", "sd")))## mean sd data:n
## Hedonisme materiel 7.392124 1.693457 1803
## HedonismeCivique 8.064862 1.452143 1958
## Polyethique 7.899568 1.689743 2778
## RéussiteLégitime 7.599837 1.667382 2449
## Scepticisme 7.615358 1.812280 2943Test par des modèles de régression
moduler par l’effet pays
d’abord des modèles emboités, l’effet pays est fort.
on se demande si l’effet est homogéne : une regression par pays et comparaison des paramètres
LinearModel.1 <- lm(happyness ~ Trust_Institut+Trust_people+Healthness+cntry, data=H)
LinearModel.2 <- lm(happyness ~ Trust_Institut+Trust_people+Healthness+cntry+KMeansb, data=H)
LinearModel.3 <- lm(happyness ~ Trust_Institut+Trust_people+Healthness+Val_Civisme + Val_Conformisme + Val_plaisir + Val_reussite + cntry,
data=H)
stargazer(LinearModel.1, LinearModel.2, LinearModel.3, type="text",font.size="tiny",style="asq",column.sep.width = "1pt")##
## --------------------------------------------------------------------------------------------------
## happyness
## Model 1 Model 2 Model 3
## --------------------------------------------------------------------------------------------------
## Trust_Institut 0.071 0.071 0.076
## (0.008) (0.008) (0.008)
## Trust_people 0.167 0.166 0.159
## (0.009) (0.009) (0.009)
## Healthness 0.509 0.504 0.503
## (0.016) (0.016) (0.017)
## Val_Civisme 0.227
## (0.027)
## Val_Conformisme 0.058
## (0.021)
## Val_plaisir 0.087
## (0.017)
## Val_reussite -0.146
## (0.017)
## cntryBE 0.216 0.223 0.187
## (0.077) (0.077) (0.077)
## cntryCH 0.302 0.288 0.237
## (0.081) (0.080) (0.080)
## cntryCZ -0.377 -0.307 -0.289
## (0.103) (0.103) (0.102)
## cntryDE 0.322 0.325 0.255
## (0.067) (0.067) (0.067)
## cntryEE -0.238 -0.185 -0.203
## (0.090) (0.090) (0.090)
## cntryFI 0.395 0.411 0.282
## (0.072) (0.073) (0.074)
## cntryFR -0.095 -0.066 -0.183
## (0.074) (0.074) (0.075)
## cntryGB 0.082 0.096 0.036
## (0.080) (0.080) (0.080)
## cntryIE -0.336 -0.298 -0.339
## (0.070) (0.070) (0.069)
## cntryIL 0.213 0.215 0.243
## (0.071) (0.071) (0.070)
## cntryIS 0.386 0.408 0.300
## (0.107) (0.108) (0.108)
## cntryNL 0.277 0.285 0.204
## (0.092) (0.092) (0.092)
## cntryNO 0.288 0.340 0.286
## (0.079) (0.080) (0.079)
## cntryPL 0.305 0.325 0.319
## (0.078) (0.078) (0.077)
## cntryRU -0.817 -0.745 -0.673
## (0.088) (0.088) (0.088)
## cntrySE 0.148 0.175 0.080
## (0.091) (0.092) (0.092)
## cntrySI 0.142 0.112 0.081
## (0.086) (0.086) (0.086)
## KMeansbHedonismeCivique 0.341
## (0.050)
## KMeansbPolyethique 0.341
## (0.048)
## KMeansbRéussiteLégitime 0.110
## (0.048)
## KMeansbScepticisme 0.248
## (0.046)
## Constant 4.357 4.149 3.252
## (0.094) (0.100) (0.153)
## Observations 11931 11931 11931
## R-squared 0.198 0.204 0.211
## Adj. R-squared 0.197 0.202 0.210
## Residual Std. Error 1.519 (df = 11910) 1.514 (df = 11906) 1.507 (df = 11906)
## F Statistic 147.217 (df = 20; 11910) 126.748 (df = 24; 11906) 132.847 (df = 24; 11906)
## --------------------------------------------------------------------------------------------------
## p < .1; p < .05; p < .01On se demande si l’éffet est homogéne : une régression par pays et comparaison des paramaétres. On s’appeleréoit sur le graphique, que la hiérarchie des paramétres est relativement homogéne à travers les pays : c’est l’état de santé qui domine. La confiance suit avec un effet plus important de sa composante interpersonnelle et systématiquement moins de sa dimension institutionnelle. Les valeurs semblent peu compter. La réussite personnelle semble être systématiquement liée de manière négative. Accorder de l’importance à la réussite c’est connaitre un bonheur moindre.
Voilà qui incite à renverser le raisonnement : le niveau de bonheur ne determine-t-il pas les valeurs plus qu’il n’en dépend ?
# analyse par Pays
P<-subset(H, select=c(happyness, Trust_Institut,Trust_people,Healthness,F1Civisme , F2Reussite , F3Conformisme , F4Hedonisme,cntry))
P$cntry<-as.factor(P$cntry)
LinearModel.4 <- lmList(happyness ~ Trust_Institut+Trust_people+Healthness+F1Civisme +F2Reussite+ F3Conformisme +F4Hedonisme| cntry,data=P)
LinearModel.4## Call:
## Model: happyness ~ Trust_Institut + Trust_people + Healthness + F1Civisme + F2Reussite + F3Conformisme + F4Hedonisme | cntry
## Data: P
##
## Coefficients:
## (Intercept) Trust_Institut Trust_people Healthness F1Civisme
## AT 4.870922 -0.001744686 0.13418157 0.5296114 0.449606350
## BE 4.765240 0.109645646 0.20395229 0.3434629 0.213676385
## CH 4.575883 0.114819323 0.16892567 0.4583313 0.068362435
## CZ 3.389928 0.097055686 0.20656997 0.6321306 0.227921617
## DE 4.659349 0.152530601 0.10973349 0.4861942 0.066623839
## EE 2.576923 0.095307431 0.25474473 0.8508526 0.124839518
## FI 5.043651 0.057745184 0.13737054 0.4806825 0.135861594
## FR 4.275366 0.027681484 0.22812323 0.4722172 -0.087297604
## GB 4.141808 0.201060872 0.15404743 0.4585331 -0.277029293
## IE 4.523587 0.104263385 0.07362376 0.4812407 0.550345301
## IL 5.306760 -0.014998776 0.17680762 0.4228383 0.376946939
## IS 5.951011 0.126830656 0.06909009 0.2765650 0.439777091
## NL 4.952356 0.117457414 0.19502462 0.2986999 -0.065598279
## NO 5.649964 0.061674728 0.09399799 0.3889012 0.169803040
## PL 4.407164 0.027928296 0.12696578 0.6510296 0.059937060
## RU 1.843668 0.116516453 0.19950558 0.9350509 0.087925936
## SE 4.600316 0.027074175 0.14059287 0.5661212 -0.008240946
## SI 4.036871 0.126666557 0.16910208 0.5587997 0.132957770
## F2Reussite F3Conformisme F4Hedonisme
## AT -0.244753865 -0.066237045 -0.23331929
## BE 0.098690050 -0.134441882 0.18006890
## CH 0.122875442 -0.200152387 0.08608399
## CZ 0.071821417 -0.173136309 0.17295232
## DE 0.095177336 -0.288689786 0.38685828
## EE -0.294539609 -0.154194414 0.33279853
## FI -0.031551911 -0.167298867 0.04618130
## FR 0.068781762 -0.093193803 0.34410290
## GB 0.072364951 -0.317833679 0.40516185
## IE -0.009818119 -0.126843946 0.06771607
## IL 0.075722910 -0.268757578 -0.12645844
## IS 0.031198195 -0.050137905 -0.17923834
## NL 0.115587795 -0.063268089 0.38380016
## NO 0.300591909 -0.355634591 0.13764293
## PL 0.213339780 -0.092079786 0.11894468
## RU 0.113013953 -0.007623289 -0.03734924
## SE 0.144920563 -0.323043105 0.27265351
## SI 0.137900740 -0.536041700 0.63409185
##
## Degrees of freedom: 11931 total; 11787 residual
## Residual standard error: 1.48663Coefff<-as.data.frame(coef(LinearModel.4))
Coefff$Pays<-row.names(Coefff)
Coefff<-melt(Coefff, id=c("Pays"))
Coefff<-subset(Coefff, variable != "(Intercept)")
ggplot(Coefff,aes(x=reorder(Pays, value), y=value, group=variable))+geom_line(aes(color=variable), size=1.5)+scale_color_manual(values=pal16) + coord_flip()
Renverser le raisonnement
C’est é cette derniére question que l’on va essayer de répondre en reprenant un graphique précédent.
Une comparaison des profils
Dans le diagramme suivant on met en abcisse les variables du bien-étre et les profil des groupes en ordonnée.
x<-c("KMeansb")
Vdf<-subset(H,select=c(get(paste0(x)),Trust_people,Trust_Institut,happyness,Healthness))
Vdf<-aggregate(cbind(Trust_people,Trust_Institut,happyness,Healthness)~ KMeansb,data=Vdf,FUN=mean)
Vdf<-melt(Vdf, id="KMeansb")
g<-ggplot(Vdf,aes(x=KMeansb,y=value,group=variable))+geom_line(aes(color=variable),size=1.5)+scale_color_manual(values=pal16)+ylim(1,9) + coord_flip()+facet_grid(variable ~ .)
g
Un modéle de régression logistique multinomiale
On va chercher é modéliser l’effet des 4 variables de bien-être sur la probabilité d’appartenir à tel ou tel type de valeurs.
va étre utile é cette fin. On s’appuit sur cette page
Formellement le modéle peut étre écrit sous la forme de k-1 équation. K indique le nombre de groupe considérées. On cherche donc é estimer k-1 équations.
\[\log(p(Y_{i})/p(Y_{k}))= \beta_{k}X_{ki}\] Pour plus de détails l’article de wikipedia donne une bonne idée formelle de l’idée introduite semble-t-il par Engel (1988) .
library("foreign")
library("nnet")
# ajustement du model
test <- multinom(KMeansb ~ Trust_Institut+Trust_people+Healthness+happyness, data = H)## # weights: 30 (20 variable)
## initial value 19202.203733
## iter 10 value 18768.836768
## iter 20 value 18669.757286
## final value 18617.184896
## convergedsummary(test)## Call:
## multinom(formula = KMeansb ~ Trust_Institut + Trust_people +
## Healthness + happyness, data = H)
##
## Coefficients:
## (Intercept) Trust_Institut Trust_people Healthness
## HedonismeCivique -2.4616339 0.024218284 0.04519159 0.1591529
## Polyethique -1.2507036 -0.016239357 -0.13524680 0.3394605
## RéussiteLégitime -0.5596819 0.044043016 -0.14245426 0.2998944
## Scepticisme 0.5968257 -0.006220424 -0.04632736 -0.1892006
## happyness
## HedonismeCivique 0.19847529
## Polyethique 0.15877979
## RéussiteLégitime 0.04206823
## Scepticisme 0.11807647
##
## Std. Errors:
## (Intercept) Trust_Institut Trust_people Healthness
## HedonismeCivique 0.2027586 0.01910700 0.02190373 0.03921921
## Polyethique 0.1783958 0.01762601 0.01983488 0.03674377
## RéussiteLégitime 0.1748996 0.01815274 0.02026870 0.03730786
## Scepticisme 0.1632163 0.01735905 0.01951068 0.03467173
## happyness
## HedonismeCivique 0.02202251
## Polyethique 0.01953104
## RéussiteLégitime 0.01922563
## Scepticisme 0.01848321
##
## Residual Deviance: 37234.37
## AIC: 37274.37#calcul des "cotes" (odd ratio) (exp(b))
z <- summary(test)$coefficients/summary(test)$standard.errors
p <- (1 - pnorm(abs(z), 0, 1))*2
p## (Intercept) Trust_Institut Trust_people Healthness
## HedonismeCivique 0.000000e+00 0.20497346 3.909448e-02 4.948780e-05
## Polyethique 2.368994e-12 0.35687868 9.191092e-12 0.000000e+00
## RéussiteLégitime 1.374193e-03 0.01525591 2.090772e-12 8.881784e-16
## Scepticisme 2.555287e-04 0.72008962 1.757459e-02 4.844808e-08
## happyness
## HedonismeCivique 0.000000e+00
## Polyethique 4.440892e-16
## RéussiteLégitime 2.865989e-02
## Scepticisme 1.677289e-10exp(coef(test))## (Intercept) Trust_Institut Trust_people Healthness
## HedonismeCivique 0.08529547 1.0245139 1.0462283 1.1725172
## Polyethique 0.28630328 0.9838918 0.8735003 1.4041898
## RéussiteLégitime 0.57139081 1.0450273 0.8672272 1.3497163
## Scepticisme 1.81634399 0.9937989 0.9547294 0.8276204
## happyness
## HedonismeCivique 1.219542
## Polyethique 1.172080
## RéussiteLégitime 1.042966
## Scepticisme 1.125330L’interprétation des paramétre du modéle n’est pas évidente. Pour mieux visaliser le résultat, nous allons simuler les probabilités d’appartenir é l’un des 5 groupes en fonction de valeurs données aux quatre variables étudiée . On explore toute l’étendue de la plage de valeur.
#prediction
#simulation d'un fichiers de valeurs combinées
expanded=expand.grid(Trust_Institut=c(1,1.5,2,2.5,3,3.5,4,4.5,5,5.5,6,6.5,7,7.5,8,8.5,9),
Trust_people=c(1,1.5,2,2.5,3,3.5,4,4.5,5,5.5,6,6.5,7,7.5,8,8.5,9),
Healthness=c(1,1.5,2,2.5,3,3.5,4,4.5,5,5.5,6,6.5,7,7.5,8,8.5,9),
happyness=c(1,1.5,2,2.5,3,3.5,4,4.5,5,5.5,6,6.5,7,7.5,8,8.5,9) )
#prediction des probabilités
predicted=predict(test,expanded,type="probs")
#head(predicted)
#associer les valeurs simulées et leurs probabilités
bpp=cbind(expanded, predicted)
bpp2 = melt (bpp,id.vars=c("Trust_Institut", "Trust_people","Healthness", "happyness"))
#affichage des résultats
trust<- aggregate(value ~ Trust_Institut + variable, data=bpp2, FUN=mean)
ggplot(trust, aes(x = Trust_Institut, y = value, colour = variable)) + geom_line() +facet_grid(variable ~ ., scales="free")
trust<- aggregate(value ~ Trust_people + variable, data=bpp2, FUN=mean)
ggplot(trust, aes(x = Trust_people, y = value, colour = variable)) + geom_line() + facet_grid(variable ~ ., scales="free")
trust<- aggregate(value ~ Healthness + variable, data=bpp2, FUN=mean)
ggplot(trust, aes(x = Healthness, y = value, colour = variable)) + geom_line() + facet_grid(variable ~ ., scales="free")
trust<- aggregate(value ~ happyness + variable, data=bpp2, FUN=mean)
ggplot(trust, aes(x = happyness, y = value, colour = variable)) + geom_line() + facet_grid(variable ~ ., scales="free")
On observe que :
- plus on confiance dans les proches et plus on a de chance d’avoir une configuation de valeur tournée vers l’hédonisme civique ou le scepticisme
- plus le bonheur est grand et plus grandes sont les chances que
- plus on est en bonne santé, ou qu’on le croit, et plus on est polyéthique ( une forme de libertinage) ou un hédoniste matérialiste. La santé donne de l’appétit
- plus on est heureux et moins on est sceptique ou matérialiste. Etre heureux favorise les valeurs civiques.
On peut élaborer ici l’hypothése que le bonheur, ou plutot l’écart au bonheur normatif (Nous nous inscrivons dans une théorie homéostatique du bonheur) détermine les stratégies de représentations du monde et sans doute les critéres de son évaluation.
C’est au fond une théorie de la justification plus qu’une théorie causale. Les valeur ne determine pas le bonheur, mais ce dernier oriente les modes de jugement.
Conclusion : le job des étudiants
Le premier job est de lire ligne à ligne ce document, y compris les références.
Le second job est de jouer avec les variables, en décomposant les chunks, en en variant le paramétrage, mais aussi en jouant directement avec les données avec On laisse aux étudiants le soin de commenter et de lancer des analyses complémentaires é chaque étape de l’analyse avec Rcmdr qui permet d’analyser avec une interface graphique pas bien différente du vieux SPSS.
Le troisiéme est de s’approprier le code, et de l’augmenter par exemple en
* étude de la structure des valeurs (explorer une structure plus complexe ) * contruction d’une typologie (par exemple tester un nombre de groupes différent) * relation avec la confiance et le bonheur (exploration des interactions produites par une tierce variable).
Ce document est une premiére matrice, il peut étre affiné et enrichi. On conseille aux étudiants d’en faire une copie qu’ils ajusterons à leurs propres analyses, commentaires, notes et leurs propres besoins.
A ce stade du pipe, Il n’y a plus qu’à emballer!
Pour tricoter ce document en html, il suffit de lancer la commande suivante dans la console ( on pourra aussi tester le bouton Knit dans Rstudio) :
rmarkdown::render(‘analyseValeurs.Rmd’) rmarkdown::render(‘analyseValeurs.Rmd’, encoding = ‘UTF-8’)
Références
Churchill, Gilbert A. 1979. “A Paradigm for Developing Better Measures of Marketing Constructs.” Journal of Marketing Research 16 (1): 64. doi:10.2307/3150876.
Engel, J. 1988. “Polytomous Logistic Regression.” Statistica Neerlandica 42 (4): 233–52. doi:10.1111/j.1467-9574.1988.tb01238.x.
Schwartz, Shalom H. 1992. “Universals in the Content and Structure of Values: Theoretical Advances and Empirical Tests in 20 Countries.” In Advances in Experimental Social Psychology, 25:1–65. Elsevier. doi:10.1016/S0065-2601(08)60281-6.
———. 2012. “An Overview of the Schwartz Theory of Basic Values.” Online Readings in Psychology and Culture 2 (1). doi:10.9707/2307-0919.1116.
Thurstone, L. L. 1931. “Multiple Factor Analysis.” Psychological Review 38 (5): 406–27. doi:10.1037/h0069792.