intro_to_ml/05_d_svd_mca.Rmd

574 lines
24 KiB
Plaintext

# SVD et analyse exploratoire d'un jeu de données
```{r}
set.seed(1123)
source('05_d_svd_mca_code.R')
```
## Analyse des correspondances multiples
### Matrice de Burt
Soit un tableau $\mathbf{N}$ qui croise un ensemble d'individus $\{i\}_{i=1}^I$ et un ensemble de variables $\{j\}_{j=1}^Q$. Chaque individu $\mathbf{n_i}$ est décrit par $Q$ valeurs : $n_{i,1},\dots,n_{i,Q}$.
\[
\mathbf{N} =
\begin{array}{c|cccc}
& j_1 & j_2 & \dots & j_Q \\
\hline
\mathbf{i_1} & n_{1,1} & n_{1,2} & \dots & n_{1,Q} \\
\mathbf{i_2} & n_{2,1} & n_{2,2} & \dots & n_{2,Q} \\
\dots & \dots & \dots & \dots & \dots \\
\mathbf{i_I} & n_{I,1} & n_{I,2} & \dots & n_{I,Q} \\
\end{array}
\]
Nous considérons la situation où chaque variable $j$ est catégorielle. Mettons que la variable $j_1$ ait 2 modalités, la variable $j_2$ ait 3 modalités,\dots, la variable $j_Q$ ait 2 modalités. Notons $J$ le nombre total de modalités toutes variables confondues. Nous constuisons le tableau binaire $\mathbf{Z}$, nommé \emph{tableau disjonctif complet}.
\[
\mathbf{Z} =
\begin{array}{c|cc|ccc|c|cc}
& \multicolumn{2}{c|}{j_1} & \multicolumn{3}{c|}{j_2} & \dots & \multicolumn{2}{c}{j_Q} \\
& 1 & 2 & 1 & 2 & 3 & \dots & 1 & 2 \\
\hline
\mathbf{i_1} & 0 & 1 & 1 & 0 & 0 & \dots & 1 & 0 \\
\mathbf{i_2} & 0 & 1 & 0 & 0 & 1 & \dots & 0 & 1 \\
\dots & \dots & \dots & \dots & \dots & \dots & \dots & \dots & \dots \\
\mathbf{i_I} & 1 & 0 & 1 & 0 & 0 & \dots & 1 & 0 \\
\end{array}
\]
Nous construisons la \emph{matrice de Burt} $\mathbf{C} = \mathbf{Z}^T\mathbf{Z}$. C'est une matrice $J \times J$ symétrique. Les blocs diagonaux sont les histogrammes de chaque variable catégorielle. Les autres blocs sont les tables de contingence entre paires de variables catégorielles. Prenons un petit exemple numérique pour fixer les idées. Nous partons d'un tableau disjonctif complet $\mathbf{Z}$, voir Table \@ref(tab:05-d-mat-Z), puis nous calculons la matrice de Burt $\mathbf{B}$, voir Table \@ref(tab:05-d-mat-B).
```{r 05-d-mat-Z}
Z <- matrix( c(0,1,1,0,0,0,1,1,
1,0,0,1,1,1,0,0,
0,1,0,0,0,0,0,0,
1,0,1,1,0,0,1,0,
0,0,0,0,1,1,0,1,
0,0,1,0,0,0,1,0,
1,1,0,1,1,1,0,1),
nrow = 8, ncol = 7,
dimnames = list(
c("i1", "i2", "i3", "i4",
"i5", "i6", "i7", "i8"),
c("j1-1", "j1-2", "j2-1", "j2-2", "j2-3",
"j3-1", "j3-2")))
kbl(Z, caption = "Exemple jouet d'un tableau disjonctif complet",
booktabs = TRUE) %>%
kable_styling(latex_options = "striped")
```
```{r 05-d-mat-B}
B = t(Z) %*% Z
kbl(B, caption = "Matrice de Burt pour l'exemple jouet",
booktabs = TRUE) %>%
kable_styling(latex_options = "striped")
```
### Analyse des correspondances de la matrice de Burt
L'analyse des correspondances du tableau disjonctif complet $\mathbf{Z}$ ou l'analyse des correspondances de la matrice de Burt $\mathbf{B}$ sont très proches. Les deux analyses diffèrent en ceci que :
* L'analyse de $\mathbf{B}$ ne donne des résultats que pour les catégories (les individus n'apparaissent plus).
* Pour chaque facteur principal, l'inertie associée par l'analyse de $\mathbf{B}$ est le carré de celle associée par l'analyse de $\mathbf{Z}$.
* $\mathbf{B}$ étant une matrice symétrique définie positive, la décomposition en valeurs singulières est identique à une décomposition en valeurs propres.
Nous pouvons reprendre les résultats dérivés au chapitre sur l'analyse des correspondances pour les appliquer à l'analyse de la matrice de Burt.
* $n \triangleq \sum_i \sum_j b_{i,j}$
* $\mathbf{P} \triangleq \left[ p_{i,j} \right] \quad ; \quad p_{i,j} \triangleq b_{i,j} / n$
* $r_i \triangleq \sum_j p_{i,j}$
* $\mathbf{S} \triangleq \left[ s_{i,j} \right] \quad ; \quad s_{i,j} \triangleq \left( p_{i,j} - r_i r_j \right) / \sqrt{r_i r_j}$ (écarts à l'indépendance standardisés)
* $\mathbf{S} = \mathbf{V} \boldsymbol \Lambda \mathbf{V}^T$ avec $\mathbf{V}^T\mathbf{V}=\mathbf{I}$
* Coordonnées standard des modalités sur l'axe factoriel facteur $k$ : $a_{i,k} = v_{i,k} / \sqrt{r_i}$
* Coordonnées principales des modalités sur l'axe factoriel $k$ : $f_{i,k} = a_{i,k} \lambda_k$
* Contribution de la modalité $i$ à l'inertie du facteur $k$ : $CTR_{i,k} \triangleq r_i f_{i,k}^2 / \sum_i r_i f_{i,k}^2$
* Corrélation de la modalité $i$ avec le facteur $k$ : $COR_{i,k} \triangleq f_{i,k}^2 / \sum_k f_{i,k}^2$
Opérons ces calculs sur notre petit exemple jouet.
```{r}
Q <- 3
J <- 7
P <- B / sum(B)
r <- apply(P, 2, sum)
rr <- r %*% t(r)
S <- (P - rr) / sqrt(rr)
dec <- eigen(S)
# Les Q dernières valeurs propres doivent être nulles (codage disjonctif complet)
K <- J - Q
delt <- dec$values[1 : K]
a <- sweep(dec$vectors, 1, sqrt(r), FUN = "/")
a <- a[,(1 : K)]
f <- a %*% diag(delt)
rownames(a) <- c("j1-1", "j1-2", "j2-1", "j2-2", "j2-3", "j3-1", "j3-2")
colnames(a) <- c("F1", "F2", "F3", "F4")
rownames(f) <- rownames(a)
colnames(f) <- colnames(a)
temp <- sweep(f^2, 1, r, FUN = "*")
sum_ctr <- apply(temp, 2, sum)
ctr <- sweep(temp, 2, sum_ctr, FUN = "/")
temp <- f^2
sum_cor <- apply(temp, 1, sum)
cor <- sweep(temp, 1, sum_cor, FUN="/")
```
### Individus supplémentaires
Le passage par la matrice de Burt ne permet pas de trouver directement les coordonnées principales des individus (seulement celles des variables). Cependant, nous pouvons a posteriori associer à chaque individu ses coordonnées principales. Pour ce faire, il faut utiliser les formules de transition (voir section \@ref(c-05-c-transition-formula)) qui permettent d'exprimer les coordonnées principales d'un profil ligne supplémentaire (noté $f^*_{is,k}$) comme barycentre des coordonnées standards des profils colonnes pondérés par le profil ligne supplémentaire. Nous notons $b^*_{is,j}$ la représentation de la $j$-ème composante de l'individu supplémentaire $is$ comme ligne supplémentaire du tableau disjonctif complet. La $j$-ème composante du profil ligne de cet individu supplémentaire est : $\frac{b^*_{is,j}}{b^*_{is,+}}$ (où $b^*_{is,+}$ signifie la somme des éléments de la ligne supplémentaire $\mathbf{b^*_{is}}$ au tableau disjonctif complet).
Sur notre exemple jouet de la Table \@ref(tab:05-d-mat-Z), considérons le premier individu : $\mathbf{b^*_1} = [0,1,0,1,0,0,1]^T$. Nous le notons $\mathbf{b^*_1}$ car nous faisons comme si nous l'ajoutions comme ligne supplémentaire au tableau de Burt $\mathbf{B}$ de la Table \@ref(tab:05-d-mat-B). D'après les formules de transition, nous avons :
\[f^*_{1,k} = \sum_{i=1}^J \frac{b^*_{1,i}}{b^*_{1,+}} a_{i,k}\]
Calculons ainsi les coordonnées principales des individus :
```{r}
# calcul des profils des individus supplémentaires
IS <- sweep(Z, 1, apply(Z, 1, sum), FUN = "/")
# calcul des coordonnées principales des individus supplémentaires
FIS <- IS %*% a
```
Affichons une carte des deux premiers axes factoriels avec des points aux lieux des individus (voir Figure \@ref(fig:05-d-map-toy-1-2)).
```{r 05-d-map-toy-1-2, fig.width = 6, fig.cap = "Carte selon les axes factoriels 1 (x) et 2 (y)"}
plot(f[,1], f[,2], type = "n",
xlab="", ylab="", asp = 1, xaxt = "n", yaxt = "n")
text(f[,1], f[,2], rownames(f), adj = 0)
points(0, 0, pch = 3)
points(FIS[,1], FIS[,2], pch = 20)
```
### Variables supplémentaires
Pour gérer des variables supplémentaires, il suffit de faire la tabulation croisée des nouvelles variables avec les variables actives (c'est-à-dire celles qui ont été utilisées pour calculer les axes factoriels). Notons $\mathbf{Z^*}$ le tableau disjonctif complet des variables supplémentaires (voir Table \@ref(tab:05-d-mat-Z-sup)). Alors, $\mathbf{B^*} \triangleq \mathbf{Z^{*T}}\mathbf{Z}$ produit de nouvelles lignes de la matrice de Burt qui correspondent aux variables supplémentaires. Par les formules de transition, les coordonnées principales de la $s$-ème variable supplémentaire sont :
\[f^*_{s,k} = \sum_{i=1}^J \frac{b^*_{s,i}}{b^*_{s,+}} a_{i,k}\]
Sur notre exemple jouet, mettons que nous ajoutions une variable supplémentaire $js$ à trois modalités dont le codage disjonctif complet est donné par la Table \@ref(tab:05-d-mat-Z-sup).
```{r 05-d-mat-Z-sup}
Zsup <- matrix( c(0,0,1,1,1,1,1,0,
1,0,0,0,0,0,0,0,
0,1,0,0,0,0,0,1),
nrow = 8, ncol = 3,
dimnames = list(
c("i1", "i2", "i3", "i4",
"i5", "i6", "i7", "i8"),
c("js-1", "js-2", "js-3")))
kbl(Zsup, caption = "Exemple du codage disjonctif d'une variable supplémentaire \
sur un exemple jouet",
booktabs = TRUE) %>%
kable_styling(latex_options = "striped")
```
Calculons les coordonnées principales de ces modalités supplémentaires.
```{r}
# calcul des profils des variables supplémentaires
JS <- t(Zsup) %*% Z
JS <- sweep(JS, 1, apply(JS, 1, sum), FUN = "/")
# calcul des coordonnées principales des variables supplémentaires
FJS <- JS %*% a
```
Affichons une carte des deux premiers axes factoriels avec les variables supplémentaires (voir Figure \@ref(fig:05-d-map-toy-1-2-vsup)).
```{r 05-d-map-toy-1-2-vsup, fig.width = 6, fig.cap = "Carte selon les axes factoriels 1 (x) et 2 (y)"}
plot(c(f[,1], FJS[,1]), c(f[,2], FJS[,2]), type = "n",
xlab="", ylab="", asp = 1, xaxt = "n", yaxt = "n")
text(f[,1], f[,2], rownames(f), adj = 0)
text(FJS[,1], FJS[,2], colnames(Zsup), adj = 0)
points(0, 0, pch = 3)
```
## Jeu de données
`housing` est un jeu de données célèbre aux nombreuses vertues pédagogiques^[https://www.kaggle.com/datasets/harrywang/housing]. Il permet d'expérimenter sur un problème de régression réaliste, viz. prédire la valeur médiane d'une maison en fonction des caractéristiques de son quartier. Nous allons faire une analyse exploratoire de ce jeu de données par analyse des correspondances.
```{r}
dat <- read.csv(file="data/housing.csv", header=TRUE)
str(dat)
```
## Analyse individuelle des variables et discrétisation
Nous analysons chaque variable du jeu de données. Nous proposons également une discrétisation de chaque variable afin de mener dans un second une analyse des correspondances.
### Proximité de l'océan
La variable `ocean_proximity` est du type `chr`. C'est en fait une variable catégorielle avec des modalités comme "NEAR BAY", "NEAR OCEAN", etc. Nous la transformons explicitement en variable catégorielle, aussi appelée \emph{facteur} dans le langage R.
```{r}
dat$ocean_proximity <- as.factor(dat$ocean_proximity)
summary(dat)
```
### Longitude
La distribution des longitudes apparait comme étant bi-modale, avec un premier pic autour de -122°, près de la côte ouest, et un second pic autour de -118°, plus dans les terres.
```{r}
hist(dat$longitude)
```
Nous pouvons découper la longitude en, par exemple, 4 intervalles d'égales densités.
```{r}
cuts <- quantile(dat$longitude, probs = seq(0,1,1/4))
hist(dat$longitude)
abline(v=cuts, lwd=4)
```
Alternativement, nous pouvons adopter une approche par clustering pour découper la variable en intervalles.
```{r}
cuts <- kcuts(x = dat$longitude, centers = 4)
cuts
```
```{r}
hist(dat$longitude)
abline(v=cuts, lwd=4)
```
Nous proposons de discrétiser les longitudes en une nouvelle variable catégorielle `c_longitude` avec pour modalités `LO-W` (West), `LO-M` (Mid-West), `LO-ME` (Mid-East), `LO-E` (East).
```{r}
dat$c_longitude <- cut(x = dat$longitude, unique(cuts), include.lowest = TRUE)
levels(dat$c_longitude) <- c('LO-W', 'LO-MW', 'LO-ME', 'LO-E')
summary(dat$c_longitude)
```
Analyser des données peut être vu comme initier un dialogue avec elles et les laisser nous guider vers un modèle. C'est un processus itératif. Par exemple, nous venons, en première intention, de tester un découpage des longitudes en quatre modalités obtenues par l'application d'un algorithme de classification par moyennes mobiles (k-means). Nous pourrions, plus tard, revenir sur ce choix.
### Latitude
Nous procédons similairement pour les latitudes. Nous les discrétisons en une nouvelle variable catégorielle nommée `c_latitude` avec pour modalités `LA-S` (South), `LA-MS` (Mid-South), `LA-MN` (Mid-North) and `LA-N` (North).
```{r}
cuts <- kcuts(x = dat$latitude, centers = 4)
cuts
```
```{r}
hist(dat$latitude)
abline(v=cuts, lwd=3)
```
```{r}
dat$c_latitude <- cut(x = dat$latitude, unique(cuts), include.lowest = TRUE)
levels(dat$c_latitude) <- c('LA-S','LA-MS','LA-MN','LA-N')
summary(dat$c_latitude)
```
### Âge médian des habitations
L'histogramme de la variable `housing_median_age` parait unimodal.
```{r}
hist(dat$housing_median_age)
```
Les valeurs supérieures à 50 semblent étonnamment nombreuses. Nous comptons les valeurs différentes supérieures à 45 pour mieux comprendre ce phénomène.
```{r}
table(dat$housing_median_age[dat$housing_median_age>45])
```
Une limite semble avoir été fixée à la valeur 52. Elle apparait clairement sur un histogramme avec plus d'intervalles. Ce phénomène pourrait avoir un impact sur les analyses à venir.
```{r}
nb_age_52 <- length(dat$housing_median_age[dat$housing_median_age == 52])
pc_age_52 <- round(100 * (nb_age_52 / dim(dat)[1]))
hist(dat$housing_median_age, breaks = 40)
```
`r pc_age_52`% des observations ont un âge médian des habitations égal à 52. C'est sans doute suffisant pour qu'il soit intéressant de les regrouper dans une catégorie à part.
```{r}
quantile(dat$housing_median_age[dat$housing_median_age<52])
```
Nous sommes guidés par l'analyse des quantiles pour discrétiser cette variable en une nouvelle variable catégorielle nommée `c_age` avec des modalités dont les frontières correspondent à des nombres entiers faciles à saisir.
```{r}
cuts <- c(min(dat$housing_median_age), 15, 25, 35, 51, 52)
hist(dat$housing_median_age, breaks = 40)
abline(v=cuts, lwd=3)
```
```{r}
dat$c_age <- cut(x = dat$housing_median_age, unique(cuts), include.lowest = TRUE)
levels(dat$c_age) <- c('A<=15','A(15,25]','A(25,35]','A(35,51]', 'A=52')
summary(dat$c_age)
```
### Nombre de pièces
Sur l'histogramme de la variable `total_rooms`, nous observons des valeurs élevées peu fréquentes (l'histogramme est dit à longue queue). Par ailleurs, les valeurs, qui s'étendent de `r min(dat$total_rooms)` à `r format(max(dat$total_rooms), scientific = FALSE)`, sont difficiles à interpréter puisqu'elles dépendent du nombre de foyers.
```{r}
cuts <- quantile(dat$total_rooms)
hist(dat$total_rooms)
abline(v=cuts, lwd=3)
```
Nous créons une nouvelle variable `rooms` pour compter le nombre relatif de pièces par foyers.
```{r}
dat$rooms <- dat$total_rooms / dat$households
nb_rooms_gt_8 <- length(dat$rooms[dat$rooms>8])
pc_rooms_gt_8 <- round(100 * (nb_rooms_gt_8 / dim(dat)[1]))
quantile(dat$rooms)
```
Nous sommes guidés par l'analyse des quantiles pour discrétiser cette variable en une nouvelle variable catégorielle nommée `c_rooms` avec pour modalités : `R<=4` moins de 4 pièces, `R(4,6]` entre 4 et 6 pièces, `R(6,8]` entre 6 et 8 pièces, `R>8` plus de 8 pièces. Nous ajoutons cette dernière catégorie, `R>8`, pour prendre en compte la longue queue de la distribution : seulement `r pc_rooms_gt_8`% des observations appartiennent à cette catégorie.
Pour mieux visualiser les coupures, nous affichons un histogramme après une transformation logarithmique des nombres de pièces.
```{r}
cuts <- c(min(dat$rooms), 4, 6, 8, max(dat$rooms))
hist(log10(dat$rooms))
abline(v=log10(cuts), lwd=3)
```
```{r}
dat$c_rooms <- cut(x = dat$rooms, unique(cuts), include.lowest = TRUE)
levels(dat$c_rooms) <- c('R<=4','R(4,6]','R(6,8]', 'R>8')
summary(dat$c_rooms)
```
### Chambres
Comme pour les pièces, nous créons une nouvelle variable `bedrooms` pour compter le nombre relatif de chambres par foyers. Nous remarquons par ailleurs que cette variable possède des valeurs manquantes indiquées par le symbole `NA`. Nous devons demander à certaines fonctions du langage R d'ignorer les valeurs manquantes. Pour ce faire, nous fixons le paramètre `na.rm` à `TRUE`.
```{r}
dat$bedrooms <- dat$total_bedrooms / dat$households
quantile(dat$bedrooms, na.rm = TRUE)
```
Nous sommes guidés par l'analyse des quantiles pour discrétiser cette variable en une nouvelle variable catégorielle nommée `c_bedrooms` avec pour modalités : `B<=1` 1 chambre ou moins, `B>1` plus de 1 chambre .
```{r}
cuts <- c(min(dat$bedrooms, na.rm = TRUE), 1.1, max(dat$bedrooms, na.rm = TRUE))
hist(log10(dat$bedrooms))
abline(v=log10(cuts), lwd=3)
```
```{r}
dat$c_bedrooms <- cut(x = dat$bedrooms, unique(cuts), include.lowest = TRUE)
levels(dat$c_bedrooms) <- c('B<=1','B>1')
summary(dat$c_bedrooms)
```
### Population
Comme pour les variables comptant les pièces et les chambres, nous créons une nouvelle variable `pop` pour compter le nombre de personnes par foyers.
```{r}
dat$pop <- dat$population / dat$households
quantile(dat$pop, probs = seq(0,1,1/4))
```
Nous sommes guidés par l'analyse des quantiles pour discrétiser cette variable en une nouvelle variable catégorielle nommée `c_pop` avec pour modalités : `P<=2`, `P(2,3]`, `P(3,4]` et `P>4`.
```{r}
cuts <- c(min(dat$pop), 2, 3, 4, max(dat$pop))
hist(log10(dat$pop))
abline(v=log10(cuts), lwd=3)
```
```{r}
dat$c_pop <- cut(x = dat$pop, unique(cuts), include.lowest = TRUE)
levels(dat$c_pop) <- c('P<=2','P(2,3]', 'P(3,4]', 'P>4')
summary(dat$c_pop)
```
### Nombre de foyers
Après une analyse des quantiles, nous créons une variable catégorielle `c_households` avec pour modalités : moins de 300, entre 300 et 400, entre 400 et 600, plus de 600.
```{r}
quantile(dat$households, probs = seq(0,1,1/4))
```
```{r}
cuts <- c(min(dat$households), 300, 400, 600, max(dat$households))
hist(log10(dat$households))
abline(v=log10(cuts), lwd=3)
```
```{r}
dat$c_households <- cut(x = dat$households, cuts, include.lowest = TRUE)
levels(dat$c_households) <- c('H<=3', 'H(3,4]', 'H(4,6]', 'H>6')
summary(dat$c_households)
```
### Revenu médian
Nous remarquons un nombre étonnamment important de revenus supérieurs à 15.
```{r}
cuts <- quantile(dat$median_income, probs = seq(0,1,1/4))
hist(dat$median_income)
abline(v=cuts, lwd=3)
```
Nous pouvons compter le nombre de valeurs distinctes supérieures à 14 pour mieux mesurer ce phénomène.
```{r}
table(dat$median_income[dat$median_income>14])
```
Nous observons une limite, sans doute artificielle, pour les revenus plus grand que 15. Elle apparait clairement sur un histogramme aux intervalles plus fins. Ce phénomène pourrait impacter les analyses à venir.
```{r}
nb_income_gt_15 <- length(dat$median_income[dat$median_income > 15])
pc_income_gt_15 <- round(100 * (nb_income_gt_15 / dim(dat)[1]), digits = 2)
hist(dat$median_income, breaks = 40)
```
Seules `r pc_income_gt_15`% des observations correspondent à un revenu médian supérieur à 15. Nous les isolons cependant dans une catégorie à part, elle pourrait nous être utile plus tard.
```{r}
cuts <- c(cuts[1:length(cuts)-1], 15, max(dat$median_income))
dat$c_income <- cut(x = dat$median_income, cuts, include.lowest = TRUE)
levels(dat$c_income) <- c('IL', 'IML', 'IMH', 'IH', 'I>15')
summary(dat$c_income)
```
### Prix médian des habitations
Les prix médians supérieurs à 50000 semblent avoir été ramenés à cette valeur limite.
```{r}
hist(dat$median_house_value, breaks = 30)
```
```{r}
loc_mhv_gt_50k <- dat$median_house_value > 500000
nb_house_value_gt_50k <- length(dat$median_house_value[loc_mhv_gt_50k])
pc_house_value_gt_50k <- round(100 * (nb_house_value_gt_50k / dim(dat)[1]),
digits = 2)
table(dat$median_house_value[dat$median_house_value>499000])
```
`r pc_house_value_gt_50k`% des observations ont subi cette simplification.
```{r}
quantile(dat$median_house_value[dat$median_house_value < 500000])
```
Après analyse des quantiles, nous proposons une discrétisation tout en isolant dans une catégorie à part les prix médians supérieurs à 50000.
```{r}
cuts <- c(min(dat$median_house_value), 115000, 175000, 250000, 500000,
max(dat$median_house_value))
dat$c_house_value <- cut(x = dat$median_house_value, cuts, include.lowest = TRUE)
levels(dat$c_house_value) <- c('V<=115', 'V(115,175]', 'V(175,250]', 'V(250,500]',
'V>500')
summary(dat$c_house_value)
```
```{r}
hist(dat$median_house_value)
abline(v=cuts, lwd=3)
```
## Analyse des correspondances du jeu de données `housing`
### Ventilation des petites modalités
Nous commençons par ventiler les modalités avec de trop petits effectifs, c'est-à-dire que nous les répartissons aléatoirement parmi les autres modalités.
```{r}
dat.all <- dat
dat <- dat.all[c('ocean_proximity', 'c_longitude', 'c_latitude', 'c_age',
'c_rooms', 'c_bedrooms', 'c_pop', 'c_households', 'c_income',
'c_house_value')]
summary(dat)
```
Nous ventilons la modalité `R>8` de la variable `c_rooms`.
```{r}
c_rooms_sup <- ventilate(dat$c_rooms, "R>8")
dat$c_rooms[c_rooms_sup$sup_i] <- c_rooms_sup$smpl
```
De même pour les modalités `I>15` de `c_income`, `ISLAND` de `ocean_proximity` et pour les valeurs manquantes de `c_bedrooms`.
```{r}
c_income_sup <- ventilate(dat$c_income, "I>15")
dat$c_income[c_income_sup$sup_i] <- c_income_sup$smpl
ocean_proximity_sup <- ventilate(dat$ocean_proximity, "ISLAND")
dat$ocean_proximity[ocean_proximity_sup$sup_i] <- ocean_proximity_sup$smpl
c_bedrooms_sup <- ventilate(dat$c_bedrooms, "NA")
dat$c_bedrooms[c_bedrooms_sup$sup_i] <- c_bedrooms_sup$smpl
dat <- droplevels(dat)
summary(dat)
```
### Variables supplémentaires
Nous considérons `c_house_value` comme variable supplémentaire. C'est-à-dire, comme nous l'avons vu au début de ce chapitre, qu'elle ne doit pas influencer le calcul des facteurs.
### Synthèse des transformations opérées sur le jeu de données
Nous reprenons dans une fonction `datasetHousing.mca` (voir code source en annexe de ce chapitre) toutes les transformations opérées sur le jeu de données.
```{r}
dat <- datasetHousing.mca()
```
### Analyse des correspondances du tableau disjonctif complet
La fonction `mca` (voir code source en annexe de ce chapitre) reprend la méthode introduite en début de chapitre pour calculer l'analyse des correpondances du tableau disjonctif complet.
```{r}
cam <- mca(dat) # cam pour correspondence analysis model
```
### Cartes factorielles
Nous générons la Figure \@ref(fig:05-d-map-1-2) qui est une carte du plan factoriel 1-2.
```{r 05-d-map-1-2, fig.width = 7, fig.cap = "Carte selon les facteurs 1 (x) et 2 (y)"}
plot(cam)
```
Observons les corrélations des modalités supplémentaires (i.e., valeurs des habitations) avec les axes factoriels (voir Table \@ref(tab:05-d-mat-cor-sup)).
```{r 05-d-mat-cor-sup}
kbl( round_preserve_sum(1000 * cam$sjcor)[,1:7],
caption = "Corrélations des modalités supplémentaires avec les axes factoriels",
booktabs = TRUE ) %>%
kable_styling(latex_options = "striped")
```
Créons une carte des deux premiers axes factoriels en ajoutant la représentation des modalités supplémentaires (voir Figure \@ref(fig:05-d-map-1-2-jsup))
```{r 05-d-map-1-2-jsup, fig.width = 7, fig.cap = "Carte selon les facteurs 1 (x) et 2 (y) avec modalités supplémentaires"}
plotjsup.mca(cam)
```
### Clustering des individus
Calculons les corrélations des clusters d'individus avec les différents axes factoriels (voir Tables \@ref(tab:05-d-clust-cor-1-33), \@ref(tab:05-d-clust-cor-34-66) et \@ref(tab:05-d-clust-cor-67-100)).
```{r}
clstcor <- clstcor.mca(cam)
```
```{r 05-d-clust-cor-1-33}
kbl( clstcor[1:33,],
caption = "Corrélations des clusters d'individus avec les axes factoriels (1/3)",
booktabs = TRUE ) %>%
kable_styling(latex_options = "striped")
```
```{r 05-d-clust-cor-34-66}
kbl( clstcor[34:66,],
caption = "Corrélations des clusters d'individus avec les axes factoriels (2/3)",
booktabs = TRUE ) %>%
kable_styling(latex_options = "striped")
```
```{r 05-d-clust-cor-67-100}
kbl( clstcor[67:100,],
caption = "Corrélations des clusters d'individus avec les axes factoriels (3/3)",
booktabs = TRUE ) %>%
kable_styling(latex_options = "striped")
```
Créons une carte des deux premiers axes factoriels en ajoutant la représentation des clusters d'individus (voir Figure \@ref(fig:05-d-map-1-2-tot))
```{r 05-d-map-1-2-tot, fig.width = 7, fig.cap = "Carte selon les facteurs 1 (x) et 2 (y) avec modalités supplémentaires et clusters d'individus"}
plotisupjsup.mca(cam)
```
Observons par exemple un diagramme en bâtons de la variable catégorielle supplémentaire `c_house_value` pour les individus du cluster 8 (voir Figure \@ref(fig:05-d-bar-clst-8-c-house-value)).
```{r 05-d-bar-clst-8-c-house-value, fig.width = 7, fig.cap = "Barplot de house value pour le cluster 8"}
barplotClst.mca(cam, dat, 8, 'c_house_value')
```
## Annexe code source
```{r, code=readLines("05_d_svd_mca_code.R"), eval=FALSE}
```