Annexe 9 : Programme R des analyses de l’article
Texte intégral
library(GDAtools)
# Chargement des donnees
load('PCF2008_etc.RData')
Xtele <- data.frame(freq.tv, allum.tv, qui.tv, chain=tv.chain1, freq.arte, emi=emi.tv[, -20], serie=serie.tv, manq.tv, duree.tv)
levels(Xtele$freq.tv)[4:5] <- c('rare/jms', 'rare/jms')
Xlectu <- data.frame(liv=catliv, pref=catliv.pref, nbl=nbliv.lu, char, moliere,
pratt, quoti, quot=nom.quoti[, c(1, 9, 11)], rev=revue[, c(2, 3, 5, 6, 17)],
aim.auteur[, c(1, 6, 10:13)])
levels(Xlectu$pref)[9] <- 'bd'
levels(Xlectu$char)[1:2] <- c('connait', 'connait')
levels(Xlectu$pratt)[1:2] <- c('connait', 'connait')
Xcine <- data.frame(freq=cine.12m, gpref=gpref.film[, -c(7, 8, 11, 12, 15, 16, 17)], gjms=jms.film[, -c(1, 2, 3, 4, 5, 6, 7, 10, 17)], vu=
vu.film[, -c(14:15)], aim=aim.film[, -5], beurk=beurk.film[, -c(10, 12, 13)])
x <- musique[, -c(33:60)] # on elimine Benabar and co
v <- names(x) %in% c('svt_acco', 'svt_blues', 'svt_count', 'svt_disco', 'svt_relax',
'svt_film', 'svt_regg',
'svt_soul', 'svt_lati', 'svt_rai')
x <- x[, !v] # on elimine qd < 1%
x <- data.frame(x, celeb[, c('boulez', 'rieu')])
Xmusq <- x[, -c(13, 14)] # on elimine jms_Vfr et jms_Wld
# Definition de la sous-population etudiee
zoom <- c(21, 22, 23, 31, 33, 34, 35, 37, 38, 42, 43, 45, 46, 47, 48, 52, 53, 54, 55, 56, 62, 63, 64,
65, 67, 68, 69)
condi <- csp42 %in% zoom
## =============
## ACMs separees
## =============
a <- c(1, 2)
## ACM sur TELEVISION
apply(Xtele[condi, ], 2, wtable, w=pcf$POIDS[condi])
getindexcat(Xtele) # on repere les 'junk categories' (99, etc)
junk1 <- c(9, 14, 22:28, 30:31, 37:38, 77, 80:81, 83, 86, 91:92, 98:99)
acm.tele <- csMCA(Xtele, subcloud=condi, excl=junk1, row.w=pcf$POIDS)
titre <- paste0('ACM gouts television, axes ', a[1], '-', a[2])
plot(acm.tele, points='best', main=titre, axes=a, col='darkorchid')
dev.print(png, filename='ACM television.png', width=900, height=900)
titre <- paste0('ACM gouts television, axes ', a[1], '-', a[2], ' (var supplementaires)')
plot(acm.tele, col='white', main=titre, axes=a)
abline(h=0, v=0, col='lightgray')
textvarsup(acm.tele, age, axes=a, col='orange', vname='age')
textvarsup(acm.tele, diplo7, sel=1:6, axes=a, col='darkolivegreen3')
textvarsup(acm.tele, sexe, axes=a, col='deeppink')
textvarsup(acm.tele, csp42, axes=a, col='black', vname='pcs')
textvarsup(acm.tele, revenu2, sel=1:5, axes=a, col='blue', vname='rev')
textvarsup(acm.tele, PER_csp6, sel=1:6, axes=a, col='red', vname='Pere')
textvarsup(acm.tele, MER_diplo2, sel=1:5, axes=a, col='darkgreen', vname='Mere')
textvarsup(acm.tele, public3, sel=2:4, axes=a, col='steelblue1')
textvarsup(acm.tele, PER_pays, sel=1:2, axes=a, col='gray60', vname='Pere')
dev.print(png, filename='ACM television, variables illustratives.png', width=900, height=900)
## ACM sur LECTURE
apply(Xlectu[condi, ], 2, wtable, w=pcf$POIDS[condi])
getindexcat(Xlectu)
junk2 <- c(33, 36, 38:40, 42:43, 45:49, 55, 58, 62, 65) # on repere les 'junk categories' (99, etc)
acm.lectu <- csMCA(Xlectu, subcloud=condi, excl=junk2, row.w=pcf$POIDS)
titre <- paste0('ACM gouts lecture, axes ', a[1], '-', a[2])
plot(acm.lectu, points='best', main=titre, axes=a, col='steelblue1')
dev.print(png, filename='ACM lecture.png', width=900, height=900)
titre <- paste0('ACM gouts lecture, axes ', a[1], '-', a[2], ' (var supplementaires)')
plot(acm.lectu, col='white', main=titre, axes=a)
abline(h=0, v=0, col='lightgray')
textvarsup(acm.lectu, age, axes=a, col='orange', vname='age')
textvarsup(acm.lectu, diplo7, sel=1:6, axes=a, col='darkolivegreen3')
textvarsup(acm.lectu, sexe, axes=a, col='deeppink')
textvarsup(acm.lectu, csp42, axes=a, col='black', vname='pcs')
textvarsup(acm.lectu, revenu2, sel=1:5, axes=a, col='blue', vname='rev')
textvarsup(acm.lectu, PER_csp6, sel=1:6, axes=a, col='red', vname='Pere')
textvarsup(acm.lectu, MER_diplo2, sel=1:5, axes=a, col='darkgreen', vname='Mere')
textvarsup(acm.lectu, public3, sel=2:4, axes=a, col='steelblue1')
textvarsup(acm.lectu, PER_pays, sel=1:2, axes=a, col='gray60', vname='Pere')
dev.print(png, filename='ACM lecture, variables illustratives.png', width=900, height=900)
## ACM sur CINEMA
apply(Xcine[condi, ], 2, wtable, w=pcf$POIDS[condi])
getindexcat(Xcine)
acm.cine <- csMCA(Xcine, subcloud=condi, row.w=pcf$POIDS)
titre <- paste0('ACM gouts cinema, axes ', a[1], '-', a[2])
plot(acm.cine, points='best', main=titre, axes=a, col='tomato3')
dev.print(png, filename='ACM cinema.png', width=900, height=900)
titre <- paste0('ACM gouts cinema, axes ', a[1], '-', a[2], ' (var supplementaires)')
plot(acm.cine, col='white', main=titre, axes=a)
abline(h=0, v=0, col='lightgray')
textvarsup(acm.cine, age, axes=a, col='orange', vname='age')
textvarsup(acm.cine, diplo7, sel=1:6, axes=a, col='darkolivegreen3')
textvarsup(acm.cine, sexe, axes=a, col='deeppink')
textvarsup(acm.cine, csp42, axes=a, col='black', vname='pcs')
textvarsup(acm.cine, revenu2, sel=1:5, axes=a, col='blue', vname='rev')
textvarsup(acm.cine, PER_csp6, sel=1:6, axes=a, col='red', vname='Pere')
textvarsup(acm.cine, MER_diplo2, sel=1:5, axes=a, col='darkgreen', vname='Mere')
textvarsup(acm.cine, public3, sel=2:4, axes=a, col='steelblue1')
textvarsup(acm.cine, PER_pays, sel=1:2, axes=a, col='gray60', vname='Pere')
dev.print(png, filename='ACM cinema, variables illustratives.png', width=900, height=900)
## ACM sur MUSIQUE
apply(Xmusq[condi, ], 2, wtable, w=pcf$POIDS[condi])
getindexcat(Xmusq)
junk4 <- c(8, 11, 13:25, 66, 69:70, 72, 74:75, 77:79, 95, 99) # on repere les 'junk categories' (99, etc) 3, 4, 7, 15, 16, 17, 19
acm.musq <- csMCA(data=Xmusq, subcloud=condi, excl=junk4, row.w=pcf$POIDS)
titre <- paste0('ACM gouts musique, axes ', a[1], '-', a[2])
plot(acm.musq, points='best', main=titre, axes=a, col='seagreen4')
dev.print(png, filename='ACM musique.png', width=900, height=900)
titre <- paste0('ACM gouts musique, axes ', a[1], '-', a[2], ' (var supplementaires)')
plot(acm.musq, col='white', main=titre, axes=a)
abline(h=0, v=0, col='lightgray')
textvarsup(acm.musq, age, axes=a, col='orange', vname='age')
textvarsup(acm.musq, diplo7, sel=1:6, axes=a, col='darkolivegreen3')
textvarsup(acm.musq, sexe, axes=a, col='deeppink')
textvarsup(acm.musq, csp42, axes=a, col='black', vname='pcs')
textvarsup(acm.musq, revenu2, sel=1:5, axes=a, col='blue', vname='rev')
textvarsup(acm.musq, PER_csp6, sel=1:6, axes=a, col='red', vname='Pere')
textvarsup(acm.musq, MER_diplo2, sel=1:5, axes=a, col='darkgreen', vname='Mere')
textvarsup(acm.musq, public3, sel=2:4, axes=a, col='steelblue1')
textvarsup(acm.musq, PER_pays, sel=1:2, axes=a, col='gray60', vname='Pere')
dev.print(png, filename='ACM musique, variables illustratives.png', width=900, height=900)
## =============================================
## ACM "classique", avec les 4 DOMAINES ensemble
## =============================================
Xtot <- data.frame(Xtele, Xlectu, Xcine, Xmusq)
junktot <- c(junk1, junk2+99, junk4+99+98+115)
acm <- csMCA(data=Xtot, subcloud=condi, excl=junktot, row.w=pcf$POIDS)
a <- c(1, 2)
domain <- c(rep('tele', times=77), rep('lect', times=82), rep('cine', times=115), rep('musq',
times=73))
nv <- nrow(acm$var$coord)
ctrbest <- acm$var$contrib[, a[1]]>=100/nv | acm$var$contrib[, a[2]]>=100/nv
titre <- paste0('ACM 4 domaines, axes ', a[1], '-', a[2])
plot(acm, col='white', axes=a, main=titre)
text(acm$var$coord[domain=='tele' & ctrbest==TRUE, a], rownames(acm$var$coord)[domain=='tele' & ctrbest==TRUE], col='steelblue1')
text(acm$var$coord[domain=='lect' & ctrbest==TRUE, a], rownames(acm$var$coord)[domain=='lect' & ctrbest==TRUE], col='darkorchid')
text(acm$var$coord[domain=='cine' & ctrbest==TRUE, a], rownames(acm$var$coord)[domain=='cine' & ctrbest==TRUE], col='tomato3')
text(acm$var$coord[domain=='musq' & ctrbest==TRUE, a], rownames(acm$var$coord)[domain=='musq' & ctrbest==TRUE], col='seagreen4')
dev.print(png, filename='ACM 4 domaines.png', width=900, height=900)
titre <- paste0('ACM 4 domaines, axes ', a[1], '-', a[2], ' (var supplementaires)')
plot(acm, col='white', main=titre, axes=a)
abline(h=0, v=0, col='lightgray')
textvarsup(acm, age, axes=a, col='orange', vname='age')
textvarsup(acm, diplo7, sel=1:6, axes=a, col='darkolivegreen3')
textvarsup(acm, sexe, axes=a, col='deeppink')
textvarsup(acm, csp42, axes=a, col='black', vname='pcs')
textvarsup(acm, revenu2, sel=1:5, axes=a, col='blue', vname='rev')
textvarsup(acm, PER_csp6, sel=1:6, axes=a, col='red', vname='Pere')
textvarsup(acm, MER_diplo2, sel=1:5, axes=a, col='darkgreen', vname='Mere')
textvarsup(acm, public3, sel=2:4, axes=a, col='steelblue1')
textvarsup(acm, PER_pays, sel=1:2, axes=a, col='gray60', vname='Pere')
dev.print(png, filename='ACM 4 domaines, var illustratives.png', width=900, height=900)
## ===============
## AFM, 4 DOMAINES
## ===============
l_acm <- list(acm.musq, acm.cine, acm.tele, acm.lectu)
afm <- multiMCA(l_acm)
# inverser l'axe 1
#afm$ind$coord[, 1] <- -afm$ind$coord[, 1]
#afm$VAR$mca1$coord[, 1] <- -afm$VAR$mca1$coord[, 1]
#afm$VAR$mca2$coord[, 1] <- -afm$VAR$mca2$coord[, 1]
#afm$VAR$mca3$coord[, 1] <- -afm$VAR$mca3$coord[, 1]
#afm$VAR$mca4$coord[, 1] <- -afm$VAR$mca4$coord[, 1]
a <- c(1, 2)
# Graphique AFM, variables actives (figure 1)
plot(afm, points='best', col=c('seagreen4', 'tomato3', 'darkorchid', 'steelblue1'), axes=a)
dev.print(tiff, filename='Figure 1.tif', res=300, compression="lzw", height=10, width=10, units="in")
plot(afm, points='best', col=c('gray0', 'gray20', 'gray40', 'gray60'), axes=a)
dev.print(tiff, filename='Figure 1 (N&B).tif', res=300, compression="lzw", height=10, width=10, units="in")
# Contributions des domaines (tableau 1)
round(afm$group$contrib[, a], 1)
# eta2 des proprietes sociales (tableau 2)
l <- list(sexe, age, diplo7, csp6, public3, revenu2, MER_diplo2, PER_csp6, PER_pays,
patrim$resII, patrim$epar, patrim$immo)
l <- lapply(l, function(x) factor(x[condi]))
n <- c('sexe', 'age', 'diplo7', 'csp6', 'publ-priv', 'revenu2', 'MER_diplo2', 'PER_csp6', 'PER_pays', 'resII', 'epar', 'immo')
dimeta2(afm, l, n, dim=1:2)
# Coordonnees des modalites "notables" (tableaux 3 et 4)
temp <- do.call('rbind.data.frame', lapply(afm$VAR, function(x) x$coord))
aides <- list()
for(i in 1:ncol(temp)) {
x <- temp[, i]
names(x) <- substr(rownames(temp), 6, nchar(rownames(temp)))
x <- x[order(x)]
aides[[i]] <- x[abs(x)>=0.5]
}
aides[[1]]
aides[[2]]
# Graphiques AFM par domaine, variables actives (figures 2 a 5)
plot(afm, points='best', groups=1, col='seagreen4', axes=a)
dev.print(tiff, filename='Figure 2.tif', res=300, compression="lzw", height=10, width=10, units="in")
plot(afm, points='best', groups=1, col='black', axes=a)
dev.print(tiff, filename='Figure 2 (N&B).tif', res=300, compression="lzw", height=10, width=10, units="in")
plot(afm, points='best', groups=2, col='tomato3', axes=a)
dev.print(tiff, filename='Figure 3.tif', res=300, compression="lzw", height=10, width=10, units="in")
plot(afm, points='best', groups=2, col='black', axes=a)
dev.print(tiff, filename='Figure 3 (N&B).tif', res=300, compression="lzw", height=10, width=10, units="in")
plot(afm, points='best', groups=3, col='darkorchid', axes=a)
dev.print(tiff, filename='Figure 4.tif', res=300, compression="lzw", height=10, width=10, units="in")
plot(afm, points='best', groups=3, col='black', axes=a)
dev.print(tiff, filename='Figure 4 (N&B).tif', res=300, compression="lzw", height=10, width=10, units="in")
plot(afm, points='best', groups=4, col='steelblue1', axes=a)
dev.print(tiff, filename='Figure 5.tif', res=300, compression="lzw", height=10, width=10, units="in")
plot(afm, points='best', groups=4, col='black', axes=a)
dev.print(tiff, filename='Figure 5 (N&B).tif', res=300, compression="lzw", height=10, width=10, units="in")
# Graphique AFM, variables illustratives (proprietes sociales)
plot(afm, points='best', col=c('white', 'white', 'white', 'white'), axes=a)
abline(h=0, v=0, col='lightgray')
textvarsup(afm, age, axes=a, col='orange', vname='age')
textvarsup(afm, diplo7, sel=1:6, axes=a, col='darkolivegreen3')
textvarsup(afm, sexe, axes=a, col='deeppink')
textvarsup(afm, csp42, axes=a, col='black', vname='pcs')
textvarsup(afm, revenu2, sel=1:5, axes=a, col='blue', vname='rev')
textvarsup(afm, PER_csp6, sel=1:6, axes=a, col='red', vname='Pere')
textvarsup(afm, MER_diplo2, sel=1:5, axes=a, col='darkgreen', vname='Mere')
textvarsup(afm, public3, sel=2:4, axes=a, col='steelblue1')
textvarsup(afm, PER_pays, sel=1:2, axes=a, col='gray60', vname='Pere')
dev.print(png, filename='AFM, variables illustratives.png', width=900, height=900)
## ===================================
## ANALYSES SELON LES CLASSES SOCIALES
## ===================================
frac.bourg <- factor(csp42 %in% c(23, 31, 33, 34, 35, 37, 38))
levels(frac.bourg) <- c('0', 'bourgeoisie')
frac.pbourg <- factor(csp42 %in% c(21, 22, 42, 43, 45, 46, 47, 48))
levels(frac.pbourg) <- c('0', 'intermediaire')
frac.clpop <- factor(csp42 %in% c(52, 53, 54, 55, 56, 62, 63, 64, 65, 67, 68, 69))
levels(frac.clpop) <- c('0', 'populaire')
a <- c(1, 2)
# Graphique avec les ellipses (figure 6)
plot(afm, type='i', axes=a, col='black')
conc.ellipse(afm, var=frac.bourg, sel=2, col='steelblue1')
conc.ellipse(afm, var=frac.pbourg, sel=2, col='seagreen4')
conc.ellipse(afm, var=frac.clpop, sel=2, col='tomato3')
dev.print(tiff, filename='Figure 6.tif', res=300, compression="lzw", height=10, width=10, units="in")
plot(afm, type='i', axes=a, col='black')
conc.ellipse(afm, var=frac.bourg, sel=2, col='gray0')
conc.ellipse(afm, var=frac.pbourg, sel=2, col='gray25')
conc.ellipse(afm, var=frac.clpop, sel=2, col='gray50')
dev.print(tiff, filename='Figure 6 (N&B).tif', res=300, compression="lzw", height=10, width=10, units="in")
# Variance des classes (tableau 5)
fraction <- factor(interaction(frac.bourg, frac.pbourg, frac.clpop)[condi]);
levels(fraction) <- c('bourg', 'pbourg', 'clpop')
round(varsup(afm, fraction)$var[1:3, a], 1)
## ===============
## AFM BOURGEOISIE
## ===============
zoom <- c(23, 31, 33, 34, 35, 37, 38)
condi <- csp42 %in% zoom
apply(Xtele[condi, ], 2, wtable, w=pcf$POIDS[condi])
getindexcat(Xtele[condi, ])
junk1 <- c(9, 14, 22:28, 30:31, 37:38, 77, 80:81, 83, 86, 91:92, 98:99, 82)
acm.tele <- csMCA(Xtele, subcloud=condi, excl=junk1, row.w=pcf$POIDS)
apply(Xlectu[condi, ], 2, wtable, w=pcf$POIDS[condi])
getindexcat(Xlectu[condi, ])
junk2 <- c(36, 38:40, 42:43, 45:49, 55, 58, 62, 65)
acm.lectu <- csMCA(Xlectu, subcloud=condi, excl=junk2, row.w=pcf$POIDS)
apply(Xcine[condi, ], 2, wtable, w=pcf$POIDS[condi])
getindexcat(Xcine[condi, ])
acm.cine <- csMCA(Xcine, subcloud=condi, row.w=pcf$POIDS)
apply(Xmusq[condi, ], 2, wtable, w=pcf$POIDS[condi])
getindexcat(Xmusq[condi, ])
junk4 <- c(8, 11, 13:25, 66, 69:70, 72, 74:75, 77:79, 95, 99)
acm.musq <- csMCA(data=Xmusq, subcloud=condi, excl=junk4, row.w=pcf$POIDS)
l_acm <- list(acm.musq, acm.cine, acm.tele, acm.lectu)
afm <- multiMCA(l_acm)
a <- c(1, 2)
# Contributions des domaines aux axes (tableau 6)
round(afm$group$contrib[, a], 1)
# eta2 des variables de position sociale (tableau 7)
l <- list(sexe, age, diplo7, csp42, public3, revenu2, MER_diplo2, PER_csp6, PER_pays,
patrim$resII, patrim$epar, patrim$immo)
l <- lapply(l, function(x) factor(x[condi]))
n <- c('sexe', 'age', 'diplo7', 'csp42', 'publ-priv', 'revenu2', 'MER_diplo2', 'PER_csp6', 'PER_pays', 'resII', 'epar', 'immo')
dimeta(afm, l, n, dim=a)
# Coordonnees des modalites "notables" (tableau 8)
temp <- do.call('rbind.data.frame', lapply(afm$VAR, function(x) x$coord))
aides <- list()
for(i in 1:ncol(temp)) {
x <- temp[, i]
names(x) <- substr(rownames(temp), 6, nchar(rownames(temp)))
x <- x[order(x)]
aides[[i]] <- x[abs(x)>=0.5]
}
aides[[1]]
## ======================
## AFM PETITE BOURGEOISIE
## ======================
zoom <- c(21, 22, 42, 43, 45, 46, 47, 48)
condi <- csp42 %in% zoom
apply(Xtele[condi, ], 2, wtable, w=pcf$POIDS[condi])
getindexcat(Xtele[condi, ])
junk1 <- c(9, 14, 22:28, 30:31, 37:38, 77, 80:81, 83, 86, 91:92, 98:99, 82)
acm.tele <- csMCA(Xtele, subcloud=condi, excl=junk1, row.w=pcf$POIDS)
apply(Xlectu[condi, ], 2, wtable, w=pcf$POIDS[condi])
getindexcat(Xlectu[condi, ])
junk2 <- c(36, 38:40, 42:43, 45:49, 55, 58, 62, 65)
acm.lectu <- csMCA(Xlectu, subcloud=condi, excl=junk2, row.w=pcf$POIDS)
apply(Xcine[condi, ], 2, wtable, w=pcf$POIDS[condi])
getindexcat(Xcine[condi, ])
acm.cine <- csMCA(Xcine, subcloud=condi, row.w=pcf$POIDS)
apply(Xmusq[condi, ], 2, wtable, w=pcf$POIDS[condi])
getindexcat(Xmusq[condi, ])
junk4 <- c(8, 11, 13:25, 66, 69:70, 72, 74:75, 77:79, 95, 99)
acm.musq <- csMCA(data=Xmusq, subcloud=condi, excl=junk4, row.w=pcf$POIDS)
l_acm <- list(acm.musq, acm.cine, acm.tele, acm.lectu)
afm <- multiMCA(l_acm)
a <- c(1, 2)
# Contributions des domaines aux axes (tableau 6)
round(afm$group$contrib[, a], 1)
# eta2 des variables de position sociale (tableau 7)
l <- list(sexe, age, diplo7, csp42, public3, revenu2, MER_diplo2, PER_csp6, PER_pays,
patrim$resII, patrim$epar, patrim$immo)
l <- lapply(l, function(x) factor(x[condi]))
n <- c('sexe', 'age', 'diplo7', 'csp42', 'publ-priv', 'revenu2', 'MER_diplo2', 'PER_csp6', 'PER_pays', 'resII', 'epar', 'immo')
dimeta2(afm, l, n, dim=a)
# Coordonnees des modalites "notables" (tableau 8)
temp <- do.call('rbind.data.frame', lapply(afm$VAR, function(x) x$coord))
aides <- list()
for(i in 1:ncol(temp)) {
x <- temp[, i]
names(x) <- substr(rownames(temp), 6, nchar(rownames(temp)))
x <- x[order(x)]
aides[[i]] <- x[abs(x)>=0.5]
}
aides[[1]]
## ======================
## AFM CLASSES POPULAIRES
## ======================
zoom <- c(52, 53, 54, 55, 56, 62, 63, 64, 65, 67, 68, 69)
condi <- csp42 %in% zoom
apply(Xtele[condi, ], 2, wtable, w=pcf$POIDS[condi])
getindexcat(Xtele[condi, ])
junk1 <- c(9, 14, 22:28, 30:31, 37:38, 77, 80:81, 83, 86, 91:92, 98:99, 82)
acm.tele <- csMCA(Xtele, subcloud=condi, excl=junk1, row.w=pcf$POIDS)
apply(Xlectu[condi, ], 2, wtable, w=pcf$POIDS[condi])
getindexcat(Xlectu[condi, ])
junk2 <- c(36, 38:40, 42:43, 45:49, 55, 58, 62, 65)
acm.lectu <- csMCA(Xlectu, subcloud=condi, excl=junk2, row.w=pcf$POIDS)
apply(Xcine[condi, ], 2, wtable, w=pcf$POIDS[condi])
getindexcat(Xcine[condi, ])
acm.cine <- csMCA(Xcine, subcloud=condi, row.w=pcf$POIDS)
apply(Xmusq[condi, ], 2, wtable, w=pcf$POIDS[condi])
getindexcat(Xmusq[condi, ])
junk4 <- c(8, 11, 13:25, 66, 69:70, 72, 74:75, 77:79, 95, 99)
acm.musq <- csMCA(data=Xmusq, subcloud=condi, excl=junk4, row.w=pcf$POIDS)
l_acm <- list(acm.musq, acm.cine, acm.tele, acm.lectu)
afm <- multiMCA(l_acm)
a <- c(1, 2)
# Contributions des domaines aux axes (tableau 6)
round(afm$group$contrib[, a], 1)
# eta2 des variables de position sociale (tableau 7)
l <- list(sexe, age, diplo7, csp42, public3, revenu2, MER_diplo2, PER_csp6, PER_pays,
patrim$resII, patrim$epar, patrim$immo)
l <- lapply(l, function(x) factor(x[condi]))
n <- c('sexe', 'age', 'diplo7', 'csp42', 'publ-priv', 'revenu2', 'MER_diplo2', 'PER_csp6', 'PER_pays', 'resII', 'epar', 'immo')
dimeta(afm, l, n, dim=a)
# Coordonnees des modalites "notables" (tableau 8)
temp <- do.call('rbind.data.frame', lapply(afm$VAR, function(x) x$coord))
aides <- list()
for(i in 1:ncol(temp)) {
x <- temp[, i]
names(x) <- substr(rownames(temp), 6, nchar(rownames(temp)))
x <- x[order(x)]
aides[[i]] <- x[abs(x)>=0.5]
}
aides[[1]]
## ===============================
## Residus de Pearson (tableau 10)
## ===============================
round(chisq.test(table(diplo7[condi], Xmusq$gpref[condi])[1:6, 1:10])$stdres, 2)
round(chisq.test(table(fraction, Xmusq$gpref[condi])[, 1:10])$stdres, 2)
Documents annexes
-
Texte intégral disponible sur le portail Cairn (Lien externe) -
Annexes électroniques de l’article « L’espace contemporain des goûts culturels » (Annexes électroniques)
-
Annexe 4 : AFM des 4 domaines (version en couleurs) (Annexes électroniques)
-
Annexe 5 : AFM des 4 domaines en version « interactive » (Annexes électroniques)
-
Annexe 6 : AFM des 4 domaines, variables supplémentaires (position sociale) (Annexes électroniques)
-
Annexe 7. Ellipses de concentration correspondant aux classes sociales (graphique en couleurs) (Annexes électroniques)
-
Annexe 8 : Détails sur les goûts musicaux (Annexes électroniques)
-
Annexe 9 : Programme R des analyses de l’article (Annexes électroniques)
Pour citer cet article
Référence électronique
Nicolas Robette et Olivier Roueff, « Annexe 9 : Programme R des analyses de l’article », Sociologie [En ligne], N° 4, vol. 8 | 2017, mis en ligne le 13 janvier 2018, consulté le 08 mars 2026. URL : http://journals.openedition.org/sociologie/3283
Haut de pageDroits d’auteur
Le texte et les autres éléments (illustrations, fichiers annexes importés), sont « Tous droits réservés », sauf mention contraire.
Haut de page
