# install.packages("data.table") # install.packages("igraph") # install.packages("survey") # install.packages("fixest") # install.packages("readODS") library("igraph") library("data.table") library("readxl") library("dplyr") library("R2HTML") library("ggplot2") library("texreg") library(devEMF) library("texreg") library("fixest") library("readODS") # Fonctions #### my_rtable <- function(tt) { tt1 <- tt tt1[is.na(tt1)] <- 0 tt2 <- addmargins(tt1,1) nb_obs <- round(addmargins(tt2,2)[,(ncol(tt2)+1)],0) tt3 <- cbind(round(100*addmargins(prop.table(tt2,1),2),2),nb_obs) rownames(tt3)[rownames(tt3) %in% "Sum"] <- "Ensemble" colnames(tt3)[colnames(tt3) %in% "Sum"] <- "Ensemble" colnames(tt3)[colnames(tt3) %in% "nb_obs"] <- "Nb. Obs." tt3 } simplelag <- function(x, by = NULL, mylag = 1, outside = NA) { myend <- length(x) - mylag if (!is.null(by)) { lby <- c(replicate(mylag,""), as.character(by[1:myend])) y0 <- c(replicate(mylag, outside), x[1:myend]) y <- ifelse(as.character(by) == lby, y0, outside) } else { y <- c(replicate(mylag, outside), x[1:myend]) } return(y) } forward <- function(x, by = NULL, myforward = 1, outside = NA) { mystart <- myforward + 1 if (!is.null(by)) { fby <- c(as.character(by[mystart:length(x)]), replicate(myforward, "")) y0 <- c(x[mystart:length(x)], replicate(myforward, outside)) y <- ifelse(as.character(by) == fby, y0, outside) } else { y <- c(x[mystart:length(x)], replicate(myforward, outside)) } return(y) } retain <- function(x, event, outside = NA) { indices <- c(1, which(event == TRUE), length(x) + 1) values <- c(outside, x[event %in% TRUE]) y <- rep(values, diff(indices)) return(y) } obtain <- function(x, event, outside = NA) { indices <- c(0, which(event == TRUE), length(x)) values <- c(x[event %in% TRUE], outside) y <- rep(values, diff(indices)) return(y) } wtd.summary <- function (x,w=NULL,q=F) { ss <- NULL name <- paste(deparse(substitute(x)),collapse=" ") ss <- data.frame(name) ss$nb_obs <- length(x) if(!is.null(w)){ ss$weight <- paste(deparse(substitute(w)),collapse=" ") ss$sum_wgt <- sum(w[is.na(x) ==F]) ss$nb_missing <- sum(is.na(x)) ss$sum_wgt_missing <- sum(w[is.na(x) ==T]) ss$wtd_mean <- Hmisc::wtd.mean(x,w=w,na.rm=T) ss$wtd_sd <- Hmisc::wtd.var(x,w=w,na.rm=T)**0.5 ss$ESS <- ss$sum_wgt^2/sum(w[is.na(x) ==F]^2) ss$wtd_se <- diagis::weighted_se(x,w=w,na.rm=T) ss$min <- min(x,na.rm=T) if(q==T){ ss$p01 <- Hmisc::wtd.quantile(x,weights=w,probs=0.01,na.rm=T) ss$p05 <- Hmisc::wtd.quantile(x,weights=w,probs=0.05,na.rm=T) ss$p10 <- Hmisc::wtd.quantile(x,weights=w,probs=0.10,na.rm=T) ss$q1 <- Hmisc::wtd.quantile(x,weights=w,probs=0.25,na.rm=T) ss$q2 <- Hmisc::wtd.quantile(x,weights=w,probs=0.50,na.rm=T) ss$q3 <- Hmisc::wtd.quantile(x,weights=w,probs=0.75,na.rm=T) ss$p90 <- Hmisc::wtd.quantile(x,weights=w,probs=0.90,na.rm=T) ss$p95 <- Hmisc::wtd.quantile(x,weights=w,probs=0.95,na.rm=T) ss$p99 <- Hmisc::wtd.quantile(x,weights=w,probs=0.99,na.rm=T) } ss$max <- max(x,na.rm=T) } else{ ss$weight <- "Unweighted" ss$sum_wgt <- sum(1-is.na(x)) ss$nb_missing <- sum(is.na(x)) ss$sum_wgt_missing <- sum(is.na(x)) ss$wtd_mean <- mean(x,na.rm=T) ss$wtd_sd <- var(x,na.rm=T)**0.5 ss$ESS <- ss$sum_wgt^2/sum((1-is.na(x))^2) ss$wtd_se <- ss$wtd_sd/(ss$sum_wgt^0.5) ss$min <- min(x,na.rm=T) if(q==T){ ss$p01 <- quantile(x,weights=w,probs=0.01,na.rm=T) ss$p05 <- quantile(x,weights=w,probs=0.05,na.rm=T) ss$p10 <- quantile(x,weights=w,probs=0.10,na.rm=T) ss$q1 <- quantile(x,weights=w,probs=0.25,na.rm=T) ss$q2 <- quantile(x,weights=w,probs=0.50,na.rm=T) ss$q3 <- quantile(x,weights=w,probs=0.75,na.rm=T) ss$p90 <- quantile(x,weights=w,probs=0.90,na.rm=T) ss$p95 <- quantile(x,weights=w,probs=0.95,na.rm=T) ss$p99 <- quantile(x,weights=w,probs=0.99,na.rm=T) } ss$max <- max(x,na.rm=T) } # structure(data.frame(name,nb_obs,sum_wgt,nb_missing,sum_wgt_missing,wtd_mean,wtd_se,wtd_sd,min,p01,p05,p10,q1,q2,q3,p90,p95,p99,max)) structure(ss) } pro_log <- function(x){round(100/(1+exp(-x)),2)} logodds <- function(x){log(x/(1-x))} #-----------------------------# # Import des données #### #-----------------------------# # Set working directory to the directory containing the current script setwd(dirname(rstudioapi::getActiveDocumentContext()$path)) # Read RDS file into aa dataframe aa <- readRDS("base_candidatEs_id.rds") colnames(aa) str(aa) aa <- as.data.table(aa) ## Fichier html pour la sortie #### outhtml <- "digue_resultats.html" # On commence par le supprimer unlink(outhtml) options(digits = 4) HTML("",outhtml,align="left") # Tableau A2. Description Base_candidates #### HTML("Tableau A2. Description de la base de données base_candidates",outhtml,align="left") tt1 <- as.data.frame.matrix(table(aa$election_an[aa$tour %in% c(1,2)],aa$tour[aa$tour %in% c(1,2)])) tt2 <- as.data.frame.matrix(table(aa$election_an[aa$tour==1],1-is.na(aa$date_naissance_cor[aa$tour==1]))) tt3 <- as.data.frame.matrix(table(aa$election_an[aa$tour==1],aa$suppleant[aa$tour==1])) colnames(tt1) <- c("nb_tour1","nb_tour2") colnames(tt2) <- c("nb_nodn","nb_dn") colnames(tt3) <- c("nb_nosup","nb_sup") tt1$election_an <- rownames(tt1) tt2$election_an <- rownames(tt2) tt3$election_an <- rownames(tt3) tt <- merge(tt1,tt2,by="election_an",all.x=T,suffixes=c("_tour","_dn")) tt <- merge(tt,tt3,by="election_an",all.x=T,suffixes=c("","_sup")) tt$part_dn <- tt$nb_dn/tt$nb_tour1 tt$part_sup <- ifelse(tt$nb_sup>0,tt$nb_sup/tt$nb_tour1,NA) tt <- tt[,c("election_an","nb_tour1","part_dn","part_sup","nb_tour2")] HTML(tt,outhtml,align="left",digits = 4,nsmall=2) ## Le problème des homonymes #### ### Nombre d'homonymes visibles ### aa$election_bis <- aa$election aa$election_bis[aa$election_bis %in% c("municipale (petites communes)","maire")] <- "municipale" aa$election_bis_an_tour <- paste(aa$election_bis, aa$tour, aa$annee) aa$count <- 1 # aa[,`:=` (nb_pb=sum(count)),by=paste(nom_prenom_std,election_bis_an_tour,date_debut_ministere)] # table(aa$nb_pb) # table(aa$election_an_tour,aa$nb_pb) # my_rtable(table(aa$election_bis_an_tour,aa$nb_pb<2)) # # tt <- as.data.frame.table(table(aa$nom_prenom_std[aa$nb_pb>40],aa$election_bis_an_tour[aa$nb_pb>40])) # tt[tt$Freq>0,] # #Avec date de naissance aa[,`:=` (nb_pbdn=sum(count)),by=paste(nom_prenom_std,date_naissance_cor,election_bis_an_tour,date_debut_ministere)] table(aa$nb_pbdn[is.na(aa$date_naissance_cor)==F]) tt <- as.data.frame.table(table(paste(aa$nom_prenom_std[aa$nb_pbdn>1 & is.na(aa$date_naissance_cor)==F], aa$date_naissance_cor[aa$nb_pbdn>1 & is.na(aa$date_naissance_cor)==F]), aa$election_bis_an_tour[aa$nb_pbdn>1 & is.na(aa$date_naissance_cor)==F])) tt[tt$Freq>0,] table(aa$election_bis_an_tour[is.na(aa$date_naissance_cor)==F],aa$nb_pbdn[is.na(aa$date_naissance_cor)==F]<2) # # tt <- table(aa$election_bis_an_tour[aa$tour==1 & is.na(aa$date_naissance)==F],aa$nb_pbdn[aa$tour==1 & is.na(aa$date_naissance)==F]) # write.csv(tt,"homonymie_dn.csv") # # tt <- table(aa$election_bis_an_tour[aa$tour==1],(aa$nb_pb[aa$tour==1])>1) # write.csv(tt,"homonymie.csv") # # my_rtable(tt) ## Indicateur de rareté des noms et des prénoms #### # Nom de famille rare. Source externe: Fréquence nom de famille Insee # nn <- read.csv("noms2008nat_txt.txt",sep="\t") # nn$freq_nom <- rowSums(as.matrix(nn[,c(-1)])) # nn$nom_std <- tolower(nn$NOM) # nn <- as.data.table(nn) # # nn2 <- merge(aa[,c("nom_std")],nn[,c("nom_std","freq_nom")],by="nom_std") # aa <- merge(aa,unique(nn2),by="nom_std",all.x=T) # aa$freq_nom <- ifelse(is.na(aa$freq_nom),1,aa$freq_nom) # aa[,`:=` (freq_nom=max(freq_nom)), by=id_personne] # summary(aa$freq_nom) # aa$nom_rare <- (aa$freq_nom<=940)*1 # Nom de famille rare. Methode Interne aa$count <- 1 aa[,`:=` (pds_prenom=sum(count)), by=paste(nom_std,prenom_std,sep="#")] aa[,`:=` (freq_nom_i=sum(1/pds_prenom)), by=nom_std] aa[,`:=` (freq_nom_i=max(freq_nom_i)), by=id_personne] table(aa$freq_nom_i) summary(aa$freq_nom_i) aa$nom_rare_i <- (aa$freq_nom_i<=25)*1 # Prénom rare. Methode Interne aa[,`:=` (pds_nom=sum(count)), by=paste(prenom_std,nom_std,sep="#")] aa[,`:=` (freq_prenom_i=sum(1/pds_nom)), by=prenom_std] aa[,`:=` (freq_prenom_i=max(freq_prenom_i)), by=id_personne] table(aa$freq_prenom_i) summary(aa$freq_prenom_i) aa$prenom_rare_i <- (aa$freq_prenom_i<=5794)*1 table(aa$nom_rare_i,aa$nom_rare) # Nuances #### # Importation du codage des étiquettes politiques pp <- read_ods("Etiquettes.ods",sheet="Presidentielle") colnames(pp) aa <- merge(aa,pp,by=c("nom_prenom_std","annee","election"),all.x=T) aa$nuance <- ifelse(is.na(aa$nuance_pres)==F,aa$nuance_pres,aa$nuance) # Create d'une colonne 'nuanceplus' dans le data frame aa aa$nuance_plus <- ifelse((is.na(aa$nuance) ), aa$intitule_liste,aa$nuance) # Recodage distinction verts et divers écologie #### table(aa$election_an,aa$nuance_plus %in% c("BC-VEC","EUROPE ÉCOLOGIE","LVE","LVEC","VEC")) aa$nuance_plus <- ifelse(aa$election_an %in% c("departementale 2021", "legislative 1997", "legislative 2017", "legislative 2022", "regionale 2021", "senatoriale 2017") & aa$nuance_plus %in% c("BC-ECO","ECO","LEC","LECO"),"VEC", aa$nuance_plus) ee <- read_ods("Etiquettes.ods",sheet="Etiquettes") colnames(ee) <- tolower(colnames(ee) ) #--------------------------------------------------# # Gestion des données et création de variables #### #---------------------------------------------------# # Garder les premiers tours ou les élections à un seul tour : tour== 0 ou 1 aa <- aa[!is.na(aa$nuance_plus) & aa$tour %in% 1,] aa[,`:=` (nb_id=sum(count)),by=id_personne] # Fusion aa avec ee par "nuance_plus" ff <- merge(aa, ee, by = "nuance_plus", all.x = TRUE) # Ordre par identifian id_personne et année pour créer des variables passées et futures ff <- ff[order(ff$id_personne,ff$date),] row.names(ff) <- NULL nrow(ff) # Vérification du lien entre rareté du nom de famille et appartenance au FN/RN tapply(ff$freq_nom/sd(ff$freq_nom),(ff$parti %in% "1.2 FN-RN")*1,mean) tapply(ff$freq_nom_i/sd(ff$freq_nom_i),(ff$parti %in% "1.2 FN-RN")*1,mean) chisq.test(table(ff$nom_rare,(ff$parti %in% "1.2 FN-RN")*1)) chisq.test(table(ff$nom_rare_i,(ff$parti %in% "1.2 FN-RN")*1)) # Obtenir le parti précédent en t-1 par 'id_personne' ff$parti_1 <- simplelag(ff$parti,by=ff$id_personne) # Obtenir le parti suivant en t+1 par 'id_personne' ff$parti1 <- forward(ff$parti,by=ff$id_personne) # Obtenir l'année suivante en t+1 par 'id_personne' ff$annee1 <- forward(ff$annee,by=paste(ff$id_personne)) # # Fréquence des noms et des prénoms et résultats électoraux # mm <- glm(I(voix/exprimes)~ I(freq_nom_i/sd(freq_nom_i)) # + I((freq_nom_i/sd(freq_nom_i))^2) # + I(freq_prenom_i/sd(freq_prenom_i)) # + I((freq_prenom_i/sd(freq_prenom_i))^2), # data=ff[ff$voix/ff$exprimes<1],family=quasibinomial) # screenreg(mm,digits=4) # # mm <- glm(elu_in_fine~ I(freq_nom_i/sd(freq_nom_i)) # + I((freq_nom_i/sd(freq_nom_i))^2) # + I(freq_prenom_i/sd(freq_prenom_i)) # + I((freq_prenom_i/sd(freq_prenom_i))^2), # data=ff[ff$voix/ff$exprimes<1],family=quasibinomial) # screenreg(mm,digits=4) # # # mm <- glm(I(1 -is.na(annee1))~ # # + I(freq_nom/sd(freq_nom)) # # + I((freq_nom/sd(freq_nom))^2) # + I(freq_nom_i/sd(freq_nom_i)) # + I((freq_nom_i/sd(freq_nom_i))^2) # + I(freq_prenom_i/sd(freq_prenom_i)) # + I((freq_prenom_i/sd(freq_prenom_i))^2) # + is.na(date_naissance_cor) # + I(voix/exprimes) # + I((voix/exprimes)^2) # + annee, # data=ff[ff$annee<2023,],family=quasibinomial) # screenreg(mm,digits=4) # freq_nom_d <- c(-1,quantile(ff$freq_nom_i,c(1:99)/100),max(ff$freq_nom_i)) freq_nom_d <- c(-1,quantile(ff$freq_nom_i,c(1:4)/5),max(ff$freq_nom_i)) freq_prenom_d <- c(-1,quantile(ff$freq_prenom_i,c(1:4)/5),max(ff$freq_prenom_i)) write.csv(freq_nom_d,"freq_nom_d.csv") write.csv(freq_prenom_d,"freq_prenom_d.csv") freq_nom_d freq_prenom_d ff$freq_nom_i_d <- cut(ff$freq_nom_i,breaks=unique(as.numeric(freq_nom_d))) ff$freq_prenom_i_d <- cut(ff$freq_prenom_i,breaks=as.numeric(freq_prenom_d)) poids_original <- tapply(ff$count/nrow(ff),paste(as.numeric(ff$freq_nom_i_d),as.numeric(ff$freq_prenom_i_d)),sum) # freq_nom_v <- c(-1,quantile(ff$freq_nom_i,c(1:19)/20),max(ff$freq_nom_i)) # freq_prenom_v <- c(-1,quantile(ff$freq_prenom_i,c(1:19)/20),max(ff$freq_prenom_i)) # ff$freq_nom_i_v <- cut(ff$freq_nom_i,breaks=as.numeric(freq_nom_v)) # ff$freq_prenom_i_v <- cut(ff$freq_prenom_i,breaks=as.numeric(freq_prenom_v)) # poids_original_b <- tapply(ff$count/nrow(ff),ff$freq_nom_i_d,sum) # Base de données gg où on ne garde que les individus avec candidatures multiples gg <- ff[is.na(ff$parti1)==F | is.na(ff$parti_1)==F,] nrow(gg) table(is.na(gg$parti1)) # Suppression ff (gain de place) gg <- gg[order(gg$id_personne,gg$date),] row.names(gg) <- NULL # Mouvance en t+1 gg$mouvance1 <- forward(gg$mouvance,by=gg$id_personne) addmargins(table(gg$mouvance1)) # Dernier parti précis vague_nuances <- c("2.6 Un.-Dr.", "3.2 Un.-Ctr","4.2 Un.-Ctr&Gau.", "4.7 Un.-Gau.") gg$der_dn <- retain(1-is.na(gg$date_naissance_cor), gg$id_personne != simplelag(gg$id_personne) | (gg$parti %in% vague_nuances)==F) gg$der_parti <- retain(gg$parti, gg$id_personne != simplelag(gg$id_personne) | (gg$parti %in% vague_nuances)==F) # gg$der_parti_1 <- simplelag(gg$der_parti,by=gg$id_personne) gg$der_parti1 <- forward(gg$der_parti,by=gg$id_personne) # Parti lors de la première apparition gg$prem_parti <- retain(gg$parti, gg$id_personne != simplelag(gg$id_personne)) # Variables oour analyser les changements de parti entre deux élections pour # le même type d'élection gg$election_s <- ifelse(gg$election %in% c("cantonale","departementale"), "cantonale-departementale", ifelse(gg$election %in% c("municipale (petites communes)"), "municipale",gg$election)) gg <- gg[order(gg$id_personne,gg$election_s,gg$date),] row.names(gg) <- NULL gg$mem_elec_parti1 <- forward(gg$parti,by=paste(gg$id_personne,gg$election_s)) gg$mem_elec_annee1 <- forward(gg$annee,by=paste(gg$id_personne,gg$election_s)) # gg$mem_elec_parti_1 <- simplelag(gg$parti,by=paste(gg$id_personne,gg$election_s)) # gg$mem_elec_annee_1 <- simplelag(gg$annee,by=paste(gg$id_personne,gg$election_s)) gg$mem_elec_date_naissance_cor1 <- forward(gg$date_naissance_cor,by=paste(gg$id_personne,gg$election_s)) gg$mem_elec_d2dn <- (is.na(gg$date_naissance_cor)==0 & is.na(gg$date_naissance_cor1)==0)*1 gg <- gg[order(gg$id_personne,gg$date),] row.names(gg) <- NULL gc() # Appartenir au FN/RN # en t+1 gg$fn_xd1 <- case_when(is.na(gg$parti1)==T~NA, gg$parti1 %in% c("1.2 FN-RN")~ "1. FN-RN", substr(gg$parti1,1,1) %in% c("1")~ "2. Autre XD", .default="3. Autre mouv") # en t gg$fn_xd <- case_when(is.na(gg$parti)==T~NA, gg$parti %in% c("1.2 FN-RN")~ "1. FN-RN", substr(gg$parti,1,1) %in% c("1")~ "2. Autre XD", .default="3. Autre mouv") # en t+1 gg$mem_elec_fn_xd1 <- case_when(is.na(gg$mem_elec_parti1)==T~NA, gg$mem_elec_parti1 %in% c("1.2 FN-RN")~ "1. FN-RN", substr(gg$mem_elec_parti1,1,1) %in% c("1")~ "2. Autre XD", .default="3. Autre mouv") # Evolution vers l'extrême droite # en t+1 gg$xd_evol1 <- case_when(is.na(gg$der_parti)| is.na(gg$der_parti1)~ NA, gg$der_parti1=="1.2 FN-RN"~"1. FN-RN", substr(gg$der_parti1,1,1)==1 ~ "2. Autre XD", gg$der_parti1==gg$der_parti ~"5. Même parti", substr(gg$der_parti1,1,1)==substr(gg$der_parti,1,1) ~"4. Même mouv", .default="3. Autre mouv") # Evolution vers l'extrême droite depuis le premier parti # en t+1 gg$xd_prem_evol1 <- case_when(is.na(gg$prem_parti)| is.na(gg$der_parti1)~ NA, gg$der_parti1=="1.2 FN-RN"~"1. FN-RN", substr(gg$der_parti1,1,1)==1 ~ "2. Autre XD", gg$der_parti1==gg$prem_parti ~"5. Même parti", substr(gg$der_parti1,1,1)==substr(gg$prem_parti,1,1) ~"4. Même mouv", .default="3. Autre mouv") # Evolution vers l'extrême droite pour les personnes non XD gg$hxd2xd_evol1 <- ifelse(substr(gg$der_parti,1,1) %in% "1" | is.na(gg$xd_evol1),NA,gg$xd_evol1) # Evolution vers l'extrême droite pour même type d'élection # entre t et t+1 gg$mem_elec_xd_evol1 <- case_when(is.na(gg$parti)| is.na(gg$mem_elec_parti1)~ NA, gg$mem_elec_parti1=="1.2 FN-RN"~"1. FN-RN", substr(gg$mem_elec_parti1,1,1)==1 ~ "2. Autre XD", gg$mem_elec_parti1==gg$parti ~"5. Même parti", substr(gg$mem_elec_parti1,1,1)==substr(gg$parti,1,1) ~"4. Même mouv.", .default="3. Autre mouv.") # Recodage sexe gg$score_cat <- cut(gg$voix / gg$exprimes, breaks = c(-0.1,0.01,0.05,0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.8, 1.0)) gg$suppleant_pres <- ave(gg$suppleant,gg$election_an,FUN=sum)>0 gg$rg <- cut(gg$rang_liste/gg$nb_liste,breaks=c(-0.1,0.25,0.5,0.75,1.1)) gg$annee_s <- cut(gg$annee,breaks=c(1992,2000,2006,2012,2018,2023)) gg$annee_s1 <- cut(gg$annee1,breaks=c(1992,2000,2006,2012,2018,2023)) table(gg$annee_s) gg$date_naissance_cor1 <- forward(gg$date_naissance_cor,by=gg$id_personne) gg$election_s1 <- forward(gg$election_s,by=gg$id_personne) gg$n_d2dn <- ifelse(is.na(gg$annee1)==T,NA, 1-(is.na(gg$date_naissance_cor)==0 & is.na(gg$date_naissance_cor1)==0)*1) gg$der_n_d2dn <- ifelse(is.na(gg$annee1)==T,NA, 1-(gg$der_dn==1 & is.na(gg$date_naissance_cor1)==0)*1) gg$fn1 <- case_when(is.na(gg$parti1)==T~NA, gg$parti1 %in% c("1.2 FN-RN")~ 1, .default=0) gg$fn <- case_when(is.na(gg$parti)==T~NA, gg$parti %in% c("1.2 FN-RN")~ 1, .default=0) gg$xd1 <- case_when(is.na(gg$parti1)==T~NA, substr(gg$parti1,1,1) %in% "1"~ 1, .default=0) addmargins(table(gg$annee1)) gg$xd <- case_when(is.na(gg$parti)==T~NA, substr(gg$parti,1,1) %in% "1"~ 1, .default=0) gg$rpr1 <- case_when(is.na(gg$parti1)==T~NA, gg$parti1 %in% c("2.5 RPR-UMP-LR")~ 1, .default=0) gg$ps1 <- case_when(is.na(gg$parti1)==T~NA, gg$parti1 %in% c("4.6 PS")~ 1, .default=0) gg$fn1 <- case_when(is.na(gg$parti1)==T~NA, gg$parti1 %in% c("1.2 FN-RN")~ 1, .default=0) gg$der_fn <- case_when(is.na(gg$der_parti)==T~NA, gg$der_parti %in% c("1.2 FN-RN")~ 1, .default=0) gg$der_xd1 <- case_when(is.na(gg$der_parti1)==T~NA, substr(gg$der_parti1,1,1) %in% "1"~ 1, .default=0) gg$der_xd <- case_when(is.na(gg$der_parti)==T~NA, substr(gg$der_parti,1,1) %in% "1"~ 1, .default=0) gg$der_rpr1 <- case_when(is.na(gg$der_parti1)==T~NA, gg$der_parti1 %in% c("2.5 RPR-UMP-LR")~ 1, .default=0) gg$der_ps1 <- case_when(is.na(gg$der_parti1)==T~NA, gg$der_parti1 %in% c("4.6 PS")~ 1, .default=0) gg$dif_mouv1 <- (gg$mouvance != gg$mouvance1)*1 gg$dif_mouv1 <- ifelse((gg$dif_mouv1==1 & gg$parti %in% "4.7 Un.-Gau." & gg$mouvance1 %in% "5. Gauche radicale") | (gg$dif_mouv1==1 & gg$parti1 %in% "4.7 Un.-Gau." & gg$mouvance %in% "5. Gauche radicale"),0,gg$dif_mouv1) # Champ 1 : pas de date de naissance ni en t, ni en t+1 f1 <- is.na(gg$date_naissance_cor) & is.na(gg$date_naissance_cor1) table(f1) # Champ 2 : date de naissance à la fois en t et en t+1 f2 <- (is.na(gg$date_naissance_cor)==0 & is.na(gg$date_naissance_cor1)==0) table(f2) # Champ 4 : manque au moins une date de naissance f4 <- ((1 - f2) ==0) br1 <- c(-1,quantile(gg$freq_nom,c(1:9)/10),max(gg$freq_nom)) br2 <- c(-1,quantile(gg$freq_nom_i,c(1:9)/10),max(gg$freq_nom_i)) br3 <- c(-1,quantile(gg$freq_prenom_i,c(1:9)/10),max(gg$freq_prenom_i)) poids_n_d2dn <- tapply(gg$n_d2dn/sum(gg$n_d2dn,na.rm=T), paste(as.numeric(gg$freq_nom_i_d),as.numeric(gg$freq_prenom_i_d)),sum,na.rm=T) poids_d2dn <- tapply((1-gg$n_d2dn)/sum(1-gg$n_d2dn,na.rm=T), paste(as.numeric(gg$freq_nom_i_d),as.numeric(gg$freq_prenom_i_d)),sum,na.rm=T) write.csv(poids_d2dn,"poids_d2dn.csv") # poids_n_d2dn_b <- tapply(gg$n_d2dn/sum(gg$n_d2dn,na.rm=T), # gg$freq_nom_i_d,sum,na.rm=T) # # poids_d2dn_b <- tapply((1-gg$n_d2dn)/sum(1-gg$n_d2dn,na.rm=T), # gg$freq_nom_i_d,sum,na.rm=T) # poids_n_d2dn_cor <- poids_original/poids_n_d2dn poids_d2dn_cor <- poids_original/poids_d2dn poids_n_d2dn_supcor <- poids_n_d2dn_cor/poids_d2dn_cor pds <- data.frame(poids_n_d2dn_cor,poids_d2dn_cor,poids_n_d2dn_supcor) pds$cat <- row.names(pds) gg$cat <- paste(as.numeric(gg$freq_nom_i_d),as.numeric(gg$freq_prenom_i_d)) gg <- merge(gg,pds,by="cat",all.x=T) tapply(gg$n_d2dn*gg$poids_n_d2dn_cor/sum(gg$n_d2dn*gg$poids_n_d2dn_cor,na.rm=T), gg$cat,sum,na.rm=T) gg$poids <- ifelse(gg$n_d2dn==1, gg$poids_n_d2dn_supcor/max(gg$poids_n_d2dn_supcor,na.rm=T) ,1) gg$poids_alt <- ifelse(gg$n_d2dn==1, gg$poids_n_d2dn_cor/max(gg$poids_n_d2dn_cor,na.rm=T) ,1) gg$poids_alt2 <- ifelse(gg$n_d2dn==1, gg$poids_n_d2dn_cor/max(gg$poids_n_d2dn_cor,na.rm=T), gg$poids_d2dn_cor/max(gg$poids_d2dn_cor,na.rm=T)) gg$risque_erreur <- 1/gg$poids-1 # gg$poids_alt <- gg$poids_alt/mean(gg$poids_alt,na.rm=T) # gg$poids <- gg$poids/mean(gg$poids,na.rm=T) # gg <- gg[order(gg$id_personne,gg$date),] row.names(gg) <- NULL gg$date_naissance_cor_fut <- obtain(gg$date_naissance_cor,((gg$id_personne != forward(gg$id_personne) | is.na(gg$date_naissance_cor)==F))) gg$date_naissance_cor_past <- retain(gg$date_naissance_cor,((gg$id_personne != simplelag(gg$id_personne) | is.na(gg$date_naissance_cor)==F))) gg$date_naissance_cor_fut <- ifelse(is.na(gg$date_naissance_cor_fut),gg$date_naissance_cor_past,gg$date_naissance_cor_fut) gg$age <- ifelse(is.na(gg$date_naissance_cor), gg$annee1 - as.numeric(substr(gg$date_naissance_cor_fut,1,4)), gg$annee1 - as.numeric(substr(gg$date_naissance_cor,1,4))) gg$age_cat <- cut(gg$age,breaks=c(17,40,50,60,70,100)) wtd.summary(gg$poids[is.na(gg$poids)==F],q=T) gg$freq_nom_i_mod <- pmax(gg$freq_nom_i-2,0) gg$freq_prenom_i_mod <- pmax(gg$freq_prenom_i-2,0) summary(gg$freq_nom_i) table(gg$freq_nom_i_d) tapply(gg$poids,gg$nom_rare_i,mean,na.rm=T) gg$cor <- gg$poids gg$score <- gg$voix/gg$exprimes gg$score1 <- forward(gg$score,by=paste(gg$id_personne)) gg$code_csp_std1 <- forward(gg$code_csp_std,by=paste(gg$id_personne)) gg$code_csp_std_fut <- obtain(gg$code_csp_std,(gg$id_personne != forward(gg$id_personne) | is.na(gg$code_csp_std)==F)) gg$code_csp_std_past <- retain(gg$code_csp_std,(gg$id_personne != lag(gg$id_personne) | is.na(gg$code_csp_std)==F)) gg$code_csp_std_fut <- ifelse(is.na(gg$code_csp_std_fut),gg$code_csp_std_past,gg$code_csp_std_fut) gg$cs1 <- case_when(substr(gg$code_csp_std1,1,2) %in% c("32","33","34","35")~"32", substr(gg$code_csp_std1,1,2) %in% c("30","31","37","38")~"36", substr(gg$code_csp_std1,1,2) %in% c("23","31")~"23", .default=substr(gg$code_csp_std1,1,1)) gg$cs_fut <- case_when(substr(gg$code_csp_std_fut,1,2) %in% c("32","33","34","35")~"32", substr(gg$code_csp_std_fut,1,2) %in% c("30","31","37","38")~"36", substr(gg$code_csp_std_fut,1,2) %in% c("23","31")~"23", .default=substr(gg$code_csp_std_fut,1,1)) gg$cs1b <- ifelse(is.na(gg$cs1),gg$cs_fut,gg$cs1) gg$dr1 <- (gg$mouvance1=="2. Droite")*1 gg$ctr1 <- (gg$mouvance1=="3. Centre")*1 gg$g1 <- ifelse(gg$mouvance=="5. Gauche radicale" & gg$parti1=="4.7 Un.-Gau." & gg$mouvance1=="4. Gauche", 0, (gg$mouvance1=="4. Gauche")*1) gg$gr1 <- ifelse(gg$mouvance=="5. Gauche radicale" & gg$parti1=="4.7 Un.-Gau." & gg$mouvance1=="4. Gauche", 1, (gg$mouvance1=="5. Gauche radicale")*1) gg$dr <- (gg$mouvance=="2. Droite")*1 gg$g <- (gg$mouvance=="4. Gauche")*1 # View(gg[,c("id_personne","date","cs_fut","cs1","date_naissance_cor","date_naissance_cor_fut","date_naissance_cor_past")]) hh <- gg[is.na(gg$annee_s1)==F,] #-------------------# # Analyses #### #-------------------# #---------------------------------------------------# # Tableau 1. Evolution dans le temps #### #---------------------------------------------------# f <- (is.na(hh$annee1)==F & hh$xd %in% 0) ### Estimations annee_s1 #### #### fn1 #### f <- (is.na(hh$annee1)==F & hh$xd %in% 0) tt1 <- tapply(hh$poids[f],list(hh$annee_s1[f], hh$fn1[f]),sum,na.rm=T) tt1 res_fn1 <- data.frame(my_rtable(tt1)) res_fn1$annee_s1 <- row.names(res_fn1) res_fn1 colnames(res_fn1)[4] <- "nobs_fn1" mm <- glm(fn1~ -1+ annee_s1 + annee_s1 : risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_fn1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_fn1$annee_s1 <- gsub("annee_s1","",row.names(glm_fn1)) glm_fn1[,c(1)] <- pro_log(glm_fn1[,c(1)]) glm_fn1[,c(2)] <- pro_log(glm_fn1[,c(2)]) glm_fn1[,c(3)] <- pro_log(glm_fn1[,c(3)]) rownames(glm_fn1) <- NULL glm_fn1 colnames(glm_fn1) <- c("cfn1","cfn1_i","cfn1_s","annee_s1") res_fn1 <- merge(res_fn1[,c(4,5)],glm_fn1,by="annee_s1",all.x=T) nc_fn1 <- table(hh$annee_s1[f], hh$fn1[f]) nc_fn1 <- data.frame(my_rtable(nc_fn1)) nc_fn1$annee_s1 <- rownames(nc_fn1) res_fn1 <- merge(res_fn1,nc_fn1[,c(2,4,5)],by="annee_s1",all.x=T) colnames(res_fn1) <- c("annee_s1","nobs_fn1","cfn1","cfn1_i","cfn1_s","nc_fn1","nc_nobs_fn1") res_fn1 <- rbind(res_fn1[res_fn1$annee_s1!="Ensemble",], res_fn1[res_fn1$annee_s1=="Ensemble",]) res_fn1$cfn1[nrow(res_fn1)] <- round(sum(res_fn1$cfn1*res_fn1$nobs_fn1,na.rm=T)/res_fn1$nobs_fn1[nrow(res_fn1)],2) res_fn1 #### xd1 #### f <- (is.na(hh$annee1)==F & hh$xd %in% 0) tt1 <- tapply(hh$poids[f],list(hh$annee_s1[f], hh$xd1[f]),sum,na.rm=T) tt1 res_xd1 <- data.frame(my_rtable(tt1)) res_xd1$annee_s1 <- row.names(res_xd1) res_xd1 colnames(res_xd1)[4] <- "nobs_xd1" mm <- glm(xd1~ -1+ annee_s1 + annee_s1 : risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_xd1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_xd1$annee_s1 <- gsub("annee_s1","",row.names(glm_xd1)) glm_xd1[,c(1)] <- pro_log(glm_xd1[,c(1)]) glm_xd1[,c(2)] <- pro_log(glm_xd1[,c(2)]) glm_xd1[,c(3)] <- pro_log(glm_xd1[,c(3)]) rownames(glm_xd1) <- NULL glm_xd1 colnames(glm_xd1) <- c("cxd1","cxd1_i","cxd1_s","annee_s1") res_xd1 <- merge(res_xd1[,c(4,5)],glm_xd1,by="annee_s1",all.x=T) nc_xd1 <- table(hh$annee_s1[f], hh$xd1[f]) nc_xd1 <- data.frame(my_rtable(nc_xd1)) nc_xd1$annee_s1 <- rownames(nc_xd1) res_xd1 <- merge(res_xd1,nc_xd1[,c(2,4,5)],by="annee_s1",all.x=T) colnames(res_xd1) <- c("annee_s1","nobs_xd1","cxd1","cxd1_i","cxd1_s","nc_xd1","nc_nobs_xd1") res_xd1 <- rbind(res_xd1[res_xd1$annee_s1!="Ensemble",], res_xd1[res_xd1$annee_s1=="Ensemble",]) res_xd1$cxd1[nrow(res_xd1)] <- round(sum(res_xd1$cxd1*res_xd1$nobs_xd1,na.rm=T)/res_xd1$nobs_xd1[nrow(res_xd1)],2) res_xd1 #### dr1 #### f <- (is.na(hh$annee1)==F & (substr(hh$parti,1,1) %in% 2)==F) tt1 <- tapply(hh$poids[f],list(hh$annee_s1[f], hh$dr1[f]),sum,na.rm=T) tt1 res_dr1 <- data.frame(my_rtable(tt1)) res_dr1$annee_s1 <- row.names(res_dr1) res_dr1 colnames(res_dr1)[4] <- "nobs_dr1" mm <- glm(dr1~ -1+ annee_s1 + annee_s1 : risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_dr1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_dr1$annee_s1 <- gsub("annee_s1","",row.names(glm_dr1)) glm_dr1[,c(1)] <- pro_log(glm_dr1[,c(1)]) glm_dr1[,c(2)] <- pro_log(glm_dr1[,c(2)]) glm_dr1[,c(3)] <- pro_log(glm_dr1[,c(3)]) rownames(glm_dr1) <- NULL glm_dr1 colnames(glm_dr1) <- c("cdr1","cdr1_i","cdr1_s","annee_s1") res_dr1 <- merge(res_dr1[,c(4,5)],glm_dr1,by="annee_s1",all.x=T) nc_dr1 <- table(hh$annee_s1[f], hh$dr1[f]) nc_dr1 <- data.frame(my_rtable(nc_dr1)) nc_dr1$annee_s1 <- rownames(nc_dr1) res_dr1 <- merge(res_dr1,nc_dr1[,c(2,4,5)],by="annee_s1",all.x=T) colnames(res_dr1) <- c("annee_s1","nobs_dr1","cdr1","cdr1_i","cdr1_s","nc_dr1","nc_nobs_dr1") res_dr1 <- rbind(res_dr1[res_dr1$annee_s1!="Ensemble",], res_dr1[res_dr1$annee_s1=="Ensemble",]) res_dr1$cdr1[nrow(res_dr1)] <- round(sum(res_dr1$cdr1*res_dr1$nobs_dr1,na.rm=T)/res_dr1$nobs_dr1[nrow(res_dr1)],2) res_dr1 #### rpr1 #### f <- (is.na(hh$annee1)==F & (substr(hh$parti,1,1) %in% 2)==F) tt1 <- tapply(hh$poids[f],list(hh$annee_s1[f], hh$rpr1[f]),sum,na.rm=T) tt1 res_rpr1 <- data.frame(my_rtable(tt1)) res_rpr1$annee_s1 <- row.names(res_rpr1) res_rpr1 colnames(res_rpr1)[4] <- "nobs_rpr1" mm <- glm(rpr1~ -1+ annee_s1 + annee_s1 : risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_rpr1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_rpr1$annee_s1 <- gsub("annee_s1","",row.names(glm_rpr1)) glm_rpr1[,c(1)] <- pro_log(glm_rpr1[,c(1)]) glm_rpr1[,c(2)] <- pro_log(glm_rpr1[,c(2)]) glm_rpr1[,c(3)] <- pro_log(glm_rpr1[,c(3)]) rownames(glm_rpr1) <- NULL glm_rpr1 colnames(glm_rpr1) <- c("crpr1","crpr1_i","crpr1_s","annee_s1") res_rpr1 <- merge(res_rpr1[,c(4,5)],glm_rpr1,by="annee_s1",all.x=T) nc_rpr1 <- table(hh$annee_s1[f], hh$rpr1[f]) nc_rpr1 <- data.frame(my_rtable(nc_rpr1)) nc_rpr1$annee_s1 <- rownames(nc_rpr1) res_rpr1 <- merge(res_rpr1,nc_rpr1[,c(2,4,5)],by="annee_s1",all.x=T) colnames(res_rpr1) <- c("annee_s1","nobs_rpr1","crpr1","crpr1_i","crpr1_s","nc_rpr1","nc_nobs_rpr1") res_rpr1 <- rbind(res_rpr1[res_rpr1$annee_s1!="Ensemble",], res_rpr1[res_rpr1$annee_s1=="Ensemble",]) res_rpr1$crpr1[nrow(res_rpr1)] <- round(sum(res_rpr1$crpr1*res_rpr1$nobs_rpr1,na.rm=T)/res_rpr1$nobs_rpr1[nrow(res_rpr1)],2) res_rpr1 #### g1 #### f <- (is.na(hh$annee1)==F & (substr(hh$parti,1,1) %in% 4)==F) tt1 <- tapply(hh$poids[f],list(hh$annee_s1[f], hh$g1[f]),sum,na.rm=T) tt1 res_g1 <- data.frame(my_rtable(tt1)) res_g1$annee_s1 <- row.names(res_g1) res_g1 colnames(res_g1)[4] <- "nobs_g1" mm <- glm(g1~ -1+ annee_s1 + annee_s1 : risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_g1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_g1$annee_s1 <- gsub("annee_s1","",row.names(glm_g1)) glm_g1[,c(1)] <- pro_log(glm_g1[,c(1)]) glm_g1[,c(2)] <- pro_log(glm_g1[,c(2)]) glm_g1[,c(3)] <- pro_log(glm_g1[,c(3)]) rownames(glm_g1) <- NULL glm_g1 colnames(glm_g1) <- c("cg1","cg1_i","cg1_s","annee_s1") res_g1 <- merge(res_g1[,c(4,5)],glm_g1,by="annee_s1",all.x=T) nc_g1 <- table(hh$annee_s1[f], hh$g1[f]) nc_g1 <- data.frame(my_rtable(nc_g1)) nc_g1$annee_s1 <- rownames(nc_g1) res_g1 <- merge(res_g1,nc_g1[,c(2,4,5)],by="annee_s1",all.x=T) colnames(res_g1) <- c("annee_s1","nobs_g1","cg1","cg1_i","cg1_s","nc_g1","nc_nobs_g1") res_g1 <- rbind(res_g1[res_g1$annee_s1!="Ensemble",], res_g1[res_g1$annee_s1=="Ensemble",]) res_g1$cg1[nrow(res_g1)] <- round(sum(res_g1$cg1*res_g1$nobs_g1,na.rm=T)/res_g1$nobs_g1[nrow(res_g1)],2) res_g1 #### ps1 #### f <- (is.na(hh$annee1)==F & (substr(hh$parti,1,1) %in% 4)==F) tt1 <- tapply(hh$poids[f],list(hh$annee_s1[f], hh$ps1[f]),sum,na.rm=T) tt1 res_ps1 <- data.frame(my_rtable(tt1)) res_ps1$annee_s1 <- row.names(res_ps1) res_ps1 colnames(res_ps1)[4] <- "nobs_ps1" mm <- glm(ps1~ -1+ annee_s1 + annee_s1 : risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_ps1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_ps1$annee_s1 <- gsub("annee_s1","",row.names(glm_ps1)) glm_ps1[,c(1)] <- pro_log(glm_ps1[,c(1)]) glm_ps1[,c(2)] <- pro_log(glm_ps1[,c(2)]) glm_ps1[,c(3)] <- pro_log(glm_ps1[,c(3)]) rownames(glm_ps1) <- NULL glm_ps1 colnames(glm_ps1) <- c("cps1","cps1_i","cps1_s","annee_s1") res_ps1 <- merge(res_ps1[,c(4,5)],glm_ps1,by="annee_s1",all.x=T) nc_ps1 <- table(hh$annee_s1[f], hh$ps1[f]) nc_ps1 <- data.frame(my_rtable(nc_ps1)) nc_ps1$annee_s1 <- rownames(nc_ps1) res_ps1 <- merge(res_ps1,nc_ps1[,c(2,4,5)],by="annee_s1",all.x=T) colnames(res_ps1) <- c("annee_s1","nobs_ps1","cps1","cps1_i","cps1_s","nc_ps1","nc_nobs_ps1") res_ps1 <- rbind(res_ps1[res_ps1$annee_s1!="Ensemble",], res_ps1[res_ps1$annee_s1=="Ensemble",]) res_ps1$cps1[nrow(res_ps1)] <- round(sum(res_ps1$cps1*res_ps1$nobs_ps1,na.rm=T)/res_ps1$nobs_ps1[nrow(res_ps1)],2) res_ps1 #### Compilation #### nobs <- tapply(hh$poids,list(hh$annee_s1, hh$fn1),sum,na.rm=T) nobs <- data.frame(my_rtable(nobs)) nobs$annee_s1 <- rownames(nobs) colnames(nobs)[4] <- "nobs_ens" tab_annee_s1 <- merge(res_xd1,res_fn1,by="annee_s1") tab_annee_s1 <- merge(tab_annee_s1,res_dr1,by="annee_s1") tab_annee_s1 <- merge(tab_annee_s1,res_rpr1,by="annee_s1") tab_annee_s1 <- merge(tab_annee_s1,res_g1,by="annee_s1") tab_annee_s1 <- merge(tab_annee_s1,res_ps1,by="annee_s1") tab_annee_s1 <- merge(tab_annee_s1,nobs[,c(4,5)],by="annee_s1") tab_annee_s1 tab_annee_s1 <- rbind(tab_annee_s1[tab_annee_s1$annee_s1!="Ensemble",], tab_annee_s1[tab_annee_s1$annee_s1=="Ensemble",]) HTML("Tableau 1 détail. Évolution vers l'extrême droite, le RPR, et le PS en fonction de annee_s1",outhtml,align="left") HTML(tab_annee_s1,outhtml,align="left",digits = 4,nsmall=2) tab_annee_s1_simp <- tab_annee_s1[,c("annee_s1","cxd1","cfn1", "cdr1","crpr1", "cg1","cps1", "nobs_ens")] HTML("Tableau 1. Évolution vers l'extrême droite, le RPR, et le PS en fonction de annee_s1",outhtml,align="left") HTML(tab_annee_s1_simp,outhtml,align="left",digits = 4,nsmall=2) tab_annee_s1_simp # Tableau 2. Caractéristiques Sociaux Démographiques #### ### Estimations sexe #### #### fn1 #### f <- (is.na(hh$annee1)==F & hh$xd %in% 0) tt1 <- tapply(hh$poids[f],list(hh$sexe[f], hh$fn1[f]),sum,na.rm=T) tt1 res_fn1 <- data.frame(my_rtable(tt1)) res_fn1$sexe <- row.names(res_fn1) res_fn1 colnames(res_fn1)[4] <- "nobs_fn1" mm <- glm(fn1~ -1+ sexe + sexe : risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_fn1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_fn1$sexe <- gsub("sexe","",row.names(glm_fn1)) glm_fn1[,c(1)] <- pro_log(glm_fn1[,c(1)]) glm_fn1[,c(2)] <- pro_log(glm_fn1[,c(2)]) glm_fn1[,c(3)] <- pro_log(glm_fn1[,c(3)]) rownames(glm_fn1) <- NULL glm_fn1 colnames(glm_fn1) <- c("cfn1","cfn1_i","cfn1_s","sexe") res_fn1 <- merge(res_fn1[,c(4,5)],glm_fn1,by="sexe",all.x=T) nc_fn1 <- table(hh$sexe[f], hh$fn1[f]) nc_fn1 <- data.frame(my_rtable(nc_fn1)) nc_fn1$sexe <- rownames(nc_fn1) res_fn1 <- merge(res_fn1,nc_fn1[,c(2,4,5)],by="sexe",all.x=T) colnames(res_fn1) <- c("sexe","nobs_fn1","cfn1","cfn1_i","cfn1_s","nc_fn1","nc_nobs_fn1") res_fn1 <- rbind(res_fn1[res_fn1$sexe!="Ensemble",], res_fn1[res_fn1$sexe=="Ensemble",]) res_fn1$cfn1[nrow(res_fn1)] <- round(sum(res_fn1$cfn1*res_fn1$nobs_fn1,na.rm=T)/res_fn1$nobs_fn1[nrow(res_fn1)],2) res_fn1 #### xd1 #### f <- (is.na(hh$annee1)==F & hh$xd %in% 0) tt1 <- tapply(hh$poids[f],list(hh$sexe[f], hh$xd1[f]),sum,na.rm=T) tt1 res_xd1 <- data.frame(my_rtable(tt1)) res_xd1$sexe <- row.names(res_xd1) res_xd1 colnames(res_xd1)[4] <- "nobs_xd1" mm <- glm(xd1~ -1+ sexe + sexe : risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_xd1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_xd1$sexe <- gsub("sexe","",row.names(glm_xd1)) glm_xd1[,c(1)] <- pro_log(glm_xd1[,c(1)]) glm_xd1[,c(2)] <- pro_log(glm_xd1[,c(2)]) glm_xd1[,c(3)] <- pro_log(glm_xd1[,c(3)]) rownames(glm_xd1) <- NULL glm_xd1 colnames(glm_xd1) <- c("cxd1","cxd1_i","cxd1_s","sexe") res_xd1 <- merge(res_xd1[,c(4,5)],glm_xd1,by="sexe",all.x=T) nc_xd1 <- table(hh$sexe[f], hh$xd1[f]) nc_xd1 <- data.frame(my_rtable(nc_xd1)) nc_xd1$sexe <- rownames(nc_xd1) res_xd1 <- merge(res_xd1,nc_xd1[,c(2,4,5)],by="sexe",all.x=T) colnames(res_xd1) <- c("sexe","nobs_xd1","cxd1","cxd1_i","cxd1_s","nc_xd1","nc_nobs_xd1") res_xd1 <- rbind(res_xd1[res_xd1$sexe!="Ensemble",], res_xd1[res_xd1$sexe=="Ensemble",]) res_xd1$cxd1[nrow(res_xd1)] <- round(sum(res_xd1$cxd1*res_xd1$nobs_xd1,na.rm=T)/res_xd1$nobs_xd1[nrow(res_xd1)],2) res_xd1 #### dr1 #### f <- (is.na(hh$annee1)==F & (substr(hh$parti,1,1) %in% 2)==F) tt1 <- tapply(hh$poids[f],list(hh$sexe[f], hh$dr1[f]),sum,na.rm=T) tt1 res_dr1 <- data.frame(my_rtable(tt1)) res_dr1$sexe <- row.names(res_dr1) res_dr1 colnames(res_dr1)[4] <- "nobs_dr1" mm <- glm(dr1~ -1+ sexe + sexe : risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_dr1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_dr1$sexe <- gsub("sexe","",row.names(glm_dr1)) glm_dr1[,c(1)] <- pro_log(glm_dr1[,c(1)]) glm_dr1[,c(2)] <- pro_log(glm_dr1[,c(2)]) glm_dr1[,c(3)] <- pro_log(glm_dr1[,c(3)]) rownames(glm_dr1) <- NULL glm_dr1 colnames(glm_dr1) <- c("cdr1","cdr1_i","cdr1_s","sexe") res_dr1 <- merge(res_dr1[,c(4,5)],glm_dr1,by="sexe",all.x=T) nc_dr1 <- table(hh$sexe[f], hh$dr1[f]) nc_dr1 <- data.frame(my_rtable(nc_dr1)) nc_dr1$sexe <- rownames(nc_dr1) res_dr1 <- merge(res_dr1,nc_dr1[,c(2,4,5)],by="sexe",all.x=T) colnames(res_dr1) <- c("sexe","nobs_dr1","cdr1","cdr1_i","cdr1_s","nc_dr1","nc_nobs_dr1") res_dr1 <- rbind(res_dr1[res_dr1$sexe!="Ensemble",], res_dr1[res_dr1$sexe=="Ensemble",]) res_dr1$cdr1[nrow(res_dr1)] <- round(sum(res_dr1$cdr1*res_dr1$nobs_dr1,na.rm=T)/res_dr1$nobs_dr1[nrow(res_dr1)],2) res_dr1 #### rpr1 #### f <- (is.na(hh$annee1)==F & (substr(hh$parti,1,1) %in% 2)==F) tt1 <- tapply(hh$poids[f],list(hh$sexe[f], hh$rpr1[f]),sum,na.rm=T) tt1 res_rpr1 <- data.frame(my_rtable(tt1)) res_rpr1$sexe <- row.names(res_rpr1) res_rpr1 colnames(res_rpr1)[4] <- "nobs_rpr1" mm <- glm(rpr1~ -1+ sexe + sexe : risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_rpr1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_rpr1$sexe <- gsub("sexe","",row.names(glm_rpr1)) glm_rpr1[,c(1)] <- pro_log(glm_rpr1[,c(1)]) glm_rpr1[,c(2)] <- pro_log(glm_rpr1[,c(2)]) glm_rpr1[,c(3)] <- pro_log(glm_rpr1[,c(3)]) rownames(glm_rpr1) <- NULL glm_rpr1 colnames(glm_rpr1) <- c("crpr1","crpr1_i","crpr1_s","sexe") res_rpr1 <- merge(res_rpr1[,c(4,5)],glm_rpr1,by="sexe",all.x=T) nc_rpr1 <- table(hh$sexe[f], hh$rpr1[f]) nc_rpr1 <- data.frame(my_rtable(nc_rpr1)) nc_rpr1$sexe <- rownames(nc_rpr1) res_rpr1 <- merge(res_rpr1,nc_rpr1[,c(2,4,5)],by="sexe",all.x=T) colnames(res_rpr1) <- c("sexe","nobs_rpr1","crpr1","crpr1_i","crpr1_s","nc_rpr1","nc_nobs_rpr1") res_rpr1 <- rbind(res_rpr1[res_rpr1$sexe!="Ensemble",], res_rpr1[res_rpr1$sexe=="Ensemble",]) res_rpr1$crpr1[nrow(res_rpr1)] <- round(sum(res_rpr1$crpr1*res_rpr1$nobs_rpr1,na.rm=T)/res_rpr1$nobs_rpr1[nrow(res_rpr1)],2) res_rpr1 #### g1 #### f <- (is.na(hh$annee1)==F & (substr(hh$parti,1,1) %in% 4)==F) tt1 <- tapply(hh$poids[f],list(hh$sexe[f], hh$g1[f]),sum,na.rm=T) tt1 res_g1 <- data.frame(my_rtable(tt1)) res_g1$sexe <- row.names(res_g1) res_g1 colnames(res_g1)[4] <- "nobs_g1" mm <- glm(g1~ -1+ sexe + sexe : risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_g1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_g1$sexe <- gsub("sexe","",row.names(glm_g1)) glm_g1[,c(1)] <- pro_log(glm_g1[,c(1)]) glm_g1[,c(2)] <- pro_log(glm_g1[,c(2)]) glm_g1[,c(3)] <- pro_log(glm_g1[,c(3)]) rownames(glm_g1) <- NULL glm_g1 colnames(glm_g1) <- c("cg1","cg1_i","cg1_s","sexe") res_g1 <- merge(res_g1[,c(4,5)],glm_g1,by="sexe",all.x=T) nc_g1 <- table(hh$sexe[f], hh$g1[f]) nc_g1 <- data.frame(my_rtable(nc_g1)) nc_g1$sexe <- rownames(nc_g1) res_g1 <- merge(res_g1,nc_g1[,c(2,4,5)],by="sexe",all.x=T) colnames(res_g1) <- c("sexe","nobs_g1","cg1","cg1_i","cg1_s","nc_g1","nc_nobs_g1") res_g1 <- rbind(res_g1[res_g1$sexe!="Ensemble",], res_g1[res_g1$sexe=="Ensemble",]) res_g1$cg1[nrow(res_g1)] <- round(sum(res_g1$cg1*res_g1$nobs_g1,na.rm=T)/res_g1$nobs_g1[nrow(res_g1)],2) res_g1 #### ps1 #### f <- (is.na(hh$annee1)==F & (substr(hh$parti,1,1) %in% 4)==F) tt1 <- tapply(hh$poids[f],list(hh$sexe[f], hh$ps1[f]),sum,na.rm=T) tt1 res_ps1 <- data.frame(my_rtable(tt1)) res_ps1$sexe <- row.names(res_ps1) res_ps1 colnames(res_ps1)[4] <- "nobs_ps1" mm <- glm(ps1~ -1+ sexe + sexe : risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_ps1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_ps1$sexe <- gsub("sexe","",row.names(glm_ps1)) glm_ps1[,c(1)] <- pro_log(glm_ps1[,c(1)]) glm_ps1[,c(2)] <- pro_log(glm_ps1[,c(2)]) glm_ps1[,c(3)] <- pro_log(glm_ps1[,c(3)]) rownames(glm_ps1) <- NULL glm_ps1 colnames(glm_ps1) <- c("cps1","cps1_i","cps1_s","sexe") res_ps1 <- merge(res_ps1[,c(4,5)],glm_ps1,by="sexe",all.x=T) nc_ps1 <- table(hh$sexe[f], hh$ps1[f]) nc_ps1 <- data.frame(my_rtable(nc_ps1)) nc_ps1$sexe <- rownames(nc_ps1) res_ps1 <- merge(res_ps1,nc_ps1[,c(2,4,5)],by="sexe",all.x=T) colnames(res_ps1) <- c("sexe","nobs_ps1","cps1","cps1_i","cps1_s","nc_ps1","nc_nobs_ps1") res_ps1 <- rbind(res_ps1[res_ps1$sexe!="Ensemble",], res_ps1[res_ps1$sexe=="Ensemble",]) res_ps1$cps1[nrow(res_ps1)] <- round(sum(res_ps1$cps1*res_ps1$nobs_ps1,na.rm=T)/res_ps1$nobs_ps1[nrow(res_ps1)],2) res_ps1 #### Compilation #### nobs <- tapply(hh$poids,list(hh$sexe, hh$fn1),sum,na.rm=T) nobs <- data.frame(my_rtable(nobs)) nobs$sexe <- rownames(nobs) colnames(nobs)[4] <- "nobs_ens" tab_sexe <- merge(res_xd1,res_fn1,by="sexe") tab_sexe <- merge(tab_sexe,res_dr1,by="sexe") tab_sexe <- merge(tab_sexe,res_rpr1,by="sexe") tab_sexe <- merge(tab_sexe,res_g1,by="sexe") tab_sexe <- merge(tab_sexe,res_ps1,by="sexe") tab_sexe <- merge(tab_sexe,nobs[,c(4,5)],by="sexe") tab_sexe tab_sexe <- rbind(tab_sexe[tab_sexe$sexe!="Ensemble",], tab_sexe[tab_sexe$sexe=="Ensemble",]) HTML("Tableau 2a détail. Évolution vers l'extrême droite, le RPR, et le PS en fonction de sexe",outhtml,align="left") HTML(tab_sexe,outhtml,align="left",digits = 4,nsmall=2) tab_sexe_simp <- tab_sexe[,c("sexe","cxd1","cfn1", "cdr1","crpr1", "cg1","cps1", "nobs_ens")] HTML("Tableau 2a. Évolution vers l'extrême droite, le RPR, et le PS en fonction de sexe",outhtml,align="left") HTML(tab_sexe_simp,outhtml,align="left",digits = 4,nsmall=2) tab_sexe_simp ## Tableau 2b. Par âge #### f <- (is.na(hh$annee1)==F & hh$xd %in% 0) ### Estimations age_cat #### #### fn1 #### f <- (is.na(hh$annee1)==F & hh$xd %in% 0) tt1 <- tapply(hh$poids[f],list(hh$age_cat[f], hh$fn1[f]),sum,na.rm=T) tt1 res_fn1 <- data.frame(my_rtable(tt1)) res_fn1$age_cat <- row.names(res_fn1) res_fn1 colnames(res_fn1)[4] <- "nobs_fn1" mm <- glm(fn1~ -1+ age_cat + age_cat : risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_fn1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_fn1$age_cat <- gsub("age_cat","",row.names(glm_fn1)) glm_fn1[,c(1)] <- pro_log(glm_fn1[,c(1)]) glm_fn1[,c(2)] <- pro_log(glm_fn1[,c(2)]) glm_fn1[,c(3)] <- pro_log(glm_fn1[,c(3)]) rownames(glm_fn1) <- NULL glm_fn1 colnames(glm_fn1) <- c("cfn1","cfn1_i","cfn1_s","age_cat") res_fn1 <- merge(res_fn1[,c(4,5)],glm_fn1,by="age_cat",all.x=T) nc_fn1 <- table(hh$age_cat[f], hh$fn1[f]) nc_fn1 <- data.frame(my_rtable(nc_fn1)) nc_fn1$age_cat <- rownames(nc_fn1) res_fn1 <- merge(res_fn1,nc_fn1[,c(2,4,5)],by="age_cat",all.x=T) colnames(res_fn1) <- c("age_cat","nobs_fn1","cfn1","cfn1_i","cfn1_s","nc_fn1","nc_nobs_fn1") res_fn1 <- rbind(res_fn1[res_fn1$age_cat!="Ensemble",], res_fn1[res_fn1$age_cat=="Ensemble",]) res_fn1$cfn1[nrow(res_fn1)] <- round(sum(res_fn1$cfn1*res_fn1$nobs_fn1,na.rm=T)/res_fn1$nobs_fn1[nrow(res_fn1)],2) res_fn1 #### xd1 #### f <- (is.na(hh$annee1)==F & hh$xd %in% 0) tt1 <- tapply(hh$poids[f],list(hh$age_cat[f], hh$xd1[f]),sum,na.rm=T) tt1 res_xd1 <- data.frame(my_rtable(tt1)) res_xd1$age_cat <- row.names(res_xd1) res_xd1 colnames(res_xd1)[4] <- "nobs_xd1" mm <- glm(xd1~ -1+ age_cat + age_cat : risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_xd1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_xd1$age_cat <- gsub("age_cat","",row.names(glm_xd1)) glm_xd1[,c(1)] <- pro_log(glm_xd1[,c(1)]) glm_xd1[,c(2)] <- pro_log(glm_xd1[,c(2)]) glm_xd1[,c(3)] <- pro_log(glm_xd1[,c(3)]) rownames(glm_xd1) <- NULL glm_xd1 colnames(glm_xd1) <- c("cxd1","cxd1_i","cxd1_s","age_cat") res_xd1 <- merge(res_xd1[,c(4,5)],glm_xd1,by="age_cat",all.x=T) nc_xd1 <- table(hh$age_cat[f], hh$xd1[f]) nc_xd1 <- data.frame(my_rtable(nc_xd1)) nc_xd1$age_cat <- rownames(nc_xd1) res_xd1 <- merge(res_xd1,nc_xd1[,c(2,4,5)],by="age_cat",all.x=T) colnames(res_xd1) <- c("age_cat","nobs_xd1","cxd1","cxd1_i","cxd1_s","nc_xd1","nc_nobs_xd1") res_xd1 <- rbind(res_xd1[res_xd1$age_cat!="Ensemble",], res_xd1[res_xd1$age_cat=="Ensemble",]) res_xd1$cxd1[nrow(res_xd1)] <- round(sum(res_xd1$cxd1*res_xd1$nobs_xd1,na.rm=T)/res_xd1$nobs_xd1[nrow(res_xd1)],2) res_xd1 #### dr1 #### f <- (is.na(hh$annee1)==F & (substr(hh$parti,1,1) %in% 2)==F) tt1 <- tapply(hh$poids[f],list(hh$age_cat[f], hh$dr1[f]),sum,na.rm=T) tt1 res_dr1 <- data.frame(my_rtable(tt1)) res_dr1$age_cat <- row.names(res_dr1) res_dr1 colnames(res_dr1)[4] <- "nobs_dr1" mm <- glm(dr1~ -1+ age_cat + age_cat : risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_dr1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_dr1$age_cat <- gsub("age_cat","",row.names(glm_dr1)) glm_dr1[,c(1)] <- pro_log(glm_dr1[,c(1)]) glm_dr1[,c(2)] <- pro_log(glm_dr1[,c(2)]) glm_dr1[,c(3)] <- pro_log(glm_dr1[,c(3)]) rownames(glm_dr1) <- NULL glm_dr1 colnames(glm_dr1) <- c("cdr1","cdr1_i","cdr1_s","age_cat") res_dr1 <- merge(res_dr1[,c(4,5)],glm_dr1,by="age_cat",all.x=T) nc_dr1 <- table(hh$age_cat[f], hh$dr1[f]) nc_dr1 <- data.frame(my_rtable(nc_dr1)) nc_dr1$age_cat <- rownames(nc_dr1) res_dr1 <- merge(res_dr1,nc_dr1[,c(2,4,5)],by="age_cat",all.x=T) colnames(res_dr1) <- c("age_cat","nobs_dr1","cdr1","cdr1_i","cdr1_s","nc_dr1","nc_nobs_dr1") res_dr1 <- rbind(res_dr1[res_dr1$age_cat!="Ensemble",], res_dr1[res_dr1$age_cat=="Ensemble",]) res_dr1$cdr1[nrow(res_dr1)] <- round(sum(res_dr1$cdr1*res_dr1$nobs_dr1,na.rm=T)/res_dr1$nobs_dr1[nrow(res_dr1)],2) res_dr1 #### rpr1 #### f <- (is.na(hh$annee1)==F & (substr(hh$parti,1,1) %in% 2)==F) tt1 <- tapply(hh$poids[f],list(hh$age_cat[f], hh$rpr1[f]),sum,na.rm=T) tt1 res_rpr1 <- data.frame(my_rtable(tt1)) res_rpr1$age_cat <- row.names(res_rpr1) res_rpr1 colnames(res_rpr1)[4] <- "nobs_rpr1" mm <- glm(rpr1~ -1+ age_cat + age_cat : risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_rpr1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_rpr1$age_cat <- gsub("age_cat","",row.names(glm_rpr1)) glm_rpr1[,c(1)] <- pro_log(glm_rpr1[,c(1)]) glm_rpr1[,c(2)] <- pro_log(glm_rpr1[,c(2)]) glm_rpr1[,c(3)] <- pro_log(glm_rpr1[,c(3)]) rownames(glm_rpr1) <- NULL glm_rpr1 colnames(glm_rpr1) <- c("crpr1","crpr1_i","crpr1_s","age_cat") res_rpr1 <- merge(res_rpr1[,c(4,5)],glm_rpr1,by="age_cat",all.x=T) nc_rpr1 <- table(hh$age_cat[f], hh$rpr1[f]) nc_rpr1 <- data.frame(my_rtable(nc_rpr1)) nc_rpr1$age_cat <- rownames(nc_rpr1) res_rpr1 <- merge(res_rpr1,nc_rpr1[,c(2,4,5)],by="age_cat",all.x=T) colnames(res_rpr1) <- c("age_cat","nobs_rpr1","crpr1","crpr1_i","crpr1_s","nc_rpr1","nc_nobs_rpr1") res_rpr1 <- rbind(res_rpr1[res_rpr1$age_cat!="Ensemble",], res_rpr1[res_rpr1$age_cat=="Ensemble",]) res_rpr1$crpr1[nrow(res_rpr1)] <- round(sum(res_rpr1$crpr1*res_rpr1$nobs_rpr1,na.rm=T)/res_rpr1$nobs_rpr1[nrow(res_rpr1)],2) res_rpr1 #### g1 #### f <- (is.na(hh$annee1)==F & (substr(hh$parti,1,1) %in% 4)==F) tt1 <- tapply(hh$poids[f],list(hh$age_cat[f], hh$g1[f]),sum,na.rm=T) tt1 res_g1 <- data.frame(my_rtable(tt1)) res_g1$age_cat <- row.names(res_g1) res_g1 colnames(res_g1)[4] <- "nobs_g1" mm <- glm(g1~ -1+ age_cat + age_cat : risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_g1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_g1$age_cat <- gsub("age_cat","",row.names(glm_g1)) glm_g1[,c(1)] <- pro_log(glm_g1[,c(1)]) glm_g1[,c(2)] <- pro_log(glm_g1[,c(2)]) glm_g1[,c(3)] <- pro_log(glm_g1[,c(3)]) rownames(glm_g1) <- NULL glm_g1 colnames(glm_g1) <- c("cg1","cg1_i","cg1_s","age_cat") res_g1 <- merge(res_g1[,c(4,5)],glm_g1,by="age_cat",all.x=T) nc_g1 <- table(hh$age_cat[f], hh$g1[f]) nc_g1 <- data.frame(my_rtable(nc_g1)) nc_g1$age_cat <- rownames(nc_g1) res_g1 <- merge(res_g1,nc_g1[,c(2,4,5)],by="age_cat",all.x=T) colnames(res_g1) <- c("age_cat","nobs_g1","cg1","cg1_i","cg1_s","nc_g1","nc_nobs_g1") res_g1 <- rbind(res_g1[res_g1$age_cat!="Ensemble",], res_g1[res_g1$age_cat=="Ensemble",]) res_g1$cg1[nrow(res_g1)] <- round(sum(res_g1$cg1*res_g1$nobs_g1,na.rm=T)/res_g1$nobs_g1[nrow(res_g1)],2) res_g1 #### ps1 #### f <- (is.na(hh$annee1)==F & (substr(hh$parti,1,1) %in% 4)==F) tt1 <- tapply(hh$poids[f],list(hh$age_cat[f], hh$ps1[f]),sum,na.rm=T) tt1 res_ps1 <- data.frame(my_rtable(tt1)) res_ps1$age_cat <- row.names(res_ps1) res_ps1 colnames(res_ps1)[4] <- "nobs_ps1" mm <- glm(ps1~ -1+ age_cat + age_cat : risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_ps1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_ps1$age_cat <- gsub("age_cat","",row.names(glm_ps1)) glm_ps1[,c(1)] <- pro_log(glm_ps1[,c(1)]) glm_ps1[,c(2)] <- pro_log(glm_ps1[,c(2)]) glm_ps1[,c(3)] <- pro_log(glm_ps1[,c(3)]) rownames(glm_ps1) <- NULL glm_ps1 colnames(glm_ps1) <- c("cps1","cps1_i","cps1_s","age_cat") res_ps1 <- merge(res_ps1[,c(4,5)],glm_ps1,by="age_cat",all.x=T) nc_ps1 <- table(hh$age_cat[f], hh$ps1[f]) nc_ps1 <- data.frame(my_rtable(nc_ps1)) nc_ps1$age_cat <- rownames(nc_ps1) res_ps1 <- merge(res_ps1,nc_ps1[,c(2,4,5)],by="age_cat",all.x=T) colnames(res_ps1) <- c("age_cat","nobs_ps1","cps1","cps1_i","cps1_s","nc_ps1","nc_nobs_ps1") res_ps1 <- rbind(res_ps1[res_ps1$age_cat!="Ensemble",], res_ps1[res_ps1$age_cat=="Ensemble",]) res_ps1$cps1[nrow(res_ps1)] <- round(sum(res_ps1$cps1*res_ps1$nobs_ps1,na.rm=T)/res_ps1$nobs_ps1[nrow(res_ps1)],2) res_ps1 #### Compilation #### nobs <- tapply(hh$poids,list(hh$age_cat, hh$fn1),sum,na.rm=T) nobs <- data.frame(my_rtable(nobs)) nobs$age_cat <- rownames(nobs) colnames(nobs)[4] <- "nobs_ens" tab_age_cat <- merge(res_xd1,res_fn1,by="age_cat") tab_age_cat <- merge(tab_age_cat,res_dr1,by="age_cat") tab_age_cat <- merge(tab_age_cat,res_rpr1,by="age_cat") tab_age_cat <- merge(tab_age_cat,res_g1,by="age_cat") tab_age_cat <- merge(tab_age_cat,res_ps1,by="age_cat") tab_age_cat <- merge(tab_age_cat,nobs[,c(4,5)],by="age_cat") tab_age_cat tab_age_cat <- rbind(tab_age_cat[tab_age_cat$age_cat!="Ensemble",], tab_age_cat[tab_age_cat$age_cat=="Ensemble",]) HTML("Tableau 2b détail. Évolution vers l'extrême droite, le RPR, et le PS en fonction de age_cat",outhtml,align="left") HTML(tab_age_cat,outhtml,align="left",digits = 4,nsmall=2) tab_age_cat_simp <- tab_age_cat[,c("age_cat","cxd1","cfn1", "cdr1","crpr1", "cg1","cps1", "nobs_ens")] HTML("Tableau 2b. Évolution vers l'extrême droite, le RPR, et le PS en fonction de age_cat",outhtml,align="left") HTML(tab_age_cat_simp,outhtml,align="left",digits = 4,nsmall=2) tab_age_cat_simp ## Tableau 2c. Par cs1b #### f <- (is.na(hh$annee1)==F & hh$xd %in% 0) ### Estimations cs1b #### #### fn1 #### f <- (is.na(hh$annee1)==F & hh$xd %in% 0) tt1 <- tapply(hh$poids[f],list(hh$cs1b[f], hh$fn1[f]),sum,na.rm=T) tt1 res_fn1 <- data.frame(my_rtable(tt1)) res_fn1$cs1b <- row.names(res_fn1) res_fn1 colnames(res_fn1)[4] <- "nobs_fn1" mm <- glm(fn1~ -1+ cs1b + cs1b : risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_fn1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_fn1$cs1b <- gsub("cs1b","",row.names(glm_fn1)) glm_fn1[,c(1)] <- pro_log(glm_fn1[,c(1)]) glm_fn1[,c(2)] <- pro_log(glm_fn1[,c(2)]) glm_fn1[,c(3)] <- pro_log(glm_fn1[,c(3)]) rownames(glm_fn1) <- NULL glm_fn1 colnames(glm_fn1) <- c("cfn1","cfn1_i","cfn1_s","cs1b") res_fn1 <- merge(res_fn1[,c(4,5)],glm_fn1,by="cs1b",all.x=T) nc_fn1 <- table(hh$cs1b[f], hh$fn1[f]) nc_fn1 <- data.frame(my_rtable(nc_fn1)) nc_fn1$cs1b <- rownames(nc_fn1) res_fn1 <- merge(res_fn1,nc_fn1[,c(2,4,5)],by="cs1b",all.x=T) colnames(res_fn1) <- c("cs1b","nobs_fn1","cfn1","cfn1_i","cfn1_s","nc_fn1","nc_nobs_fn1") res_fn1 <- rbind(res_fn1[res_fn1$cs1b!="Ensemble",], res_fn1[res_fn1$cs1b=="Ensemble",]) res_fn1$cfn1[nrow(res_fn1)] <- round(sum(res_fn1$cfn1*res_fn1$nobs_fn1,na.rm=T)/res_fn1$nobs_fn1[nrow(res_fn1)],2) res_fn1 #### xd1 #### f <- (is.na(hh$annee1)==F & hh$xd %in% 0) tt1 <- tapply(hh$poids[f],list(hh$cs1b[f], hh$xd1[f]),sum,na.rm=T) tt1 res_xd1 <- data.frame(my_rtable(tt1)) res_xd1$cs1b <- row.names(res_xd1) res_xd1 colnames(res_xd1)[4] <- "nobs_xd1" mm <- glm(xd1~ -1+ cs1b + cs1b : risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_xd1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_xd1$cs1b <- gsub("cs1b","",row.names(glm_xd1)) glm_xd1[,c(1)] <- pro_log(glm_xd1[,c(1)]) glm_xd1[,c(2)] <- pro_log(glm_xd1[,c(2)]) glm_xd1[,c(3)] <- pro_log(glm_xd1[,c(3)]) rownames(glm_xd1) <- NULL glm_xd1 colnames(glm_xd1) <- c("cxd1","cxd1_i","cxd1_s","cs1b") res_xd1 <- merge(res_xd1[,c(4,5)],glm_xd1,by="cs1b",all.x=T) nc_xd1 <- table(hh$cs1b[f], hh$xd1[f]) nc_xd1 <- data.frame(my_rtable(nc_xd1)) nc_xd1$cs1b <- rownames(nc_xd1) res_xd1 <- merge(res_xd1,nc_xd1[,c(2,4,5)],by="cs1b",all.x=T) colnames(res_xd1) <- c("cs1b","nobs_xd1","cxd1","cxd1_i","cxd1_s","nc_xd1","nc_nobs_xd1") res_xd1 <- rbind(res_xd1[res_xd1$cs1b!="Ensemble",], res_xd1[res_xd1$cs1b=="Ensemble",]) res_xd1$cxd1[nrow(res_xd1)] <- round(sum(res_xd1$cxd1*res_xd1$nobs_xd1,na.rm=T)/res_xd1$nobs_xd1[nrow(res_xd1)],2) res_xd1 #### dr1 #### f <- (is.na(hh$annee1)==F & (substr(hh$parti,1,1) %in% 2)==F) tt1 <- tapply(hh$poids[f],list(hh$cs1b[f], hh$dr1[f]),sum,na.rm=T) tt1 res_dr1 <- data.frame(my_rtable(tt1)) res_dr1$cs1b <- row.names(res_dr1) res_dr1 colnames(res_dr1)[4] <- "nobs_dr1" mm <- glm(dr1~ -1+ cs1b + cs1b : risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_dr1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_dr1$cs1b <- gsub("cs1b","",row.names(glm_dr1)) glm_dr1[,c(1)] <- pro_log(glm_dr1[,c(1)]) glm_dr1[,c(2)] <- pro_log(glm_dr1[,c(2)]) glm_dr1[,c(3)] <- pro_log(glm_dr1[,c(3)]) rownames(glm_dr1) <- NULL glm_dr1 colnames(glm_dr1) <- c("cdr1","cdr1_i","cdr1_s","cs1b") res_dr1 <- merge(res_dr1[,c(4,5)],glm_dr1,by="cs1b",all.x=T) nc_dr1 <- table(hh$cs1b[f], hh$dr1[f]) nc_dr1 <- data.frame(my_rtable(nc_dr1)) nc_dr1$cs1b <- rownames(nc_dr1) res_dr1 <- merge(res_dr1,nc_dr1[,c(2,4,5)],by="cs1b",all.x=T) colnames(res_dr1) <- c("cs1b","nobs_dr1","cdr1","cdr1_i","cdr1_s","nc_dr1","nc_nobs_dr1") res_dr1 <- rbind(res_dr1[res_dr1$cs1b!="Ensemble",], res_dr1[res_dr1$cs1b=="Ensemble",]) res_dr1$cdr1[nrow(res_dr1)] <- round(sum(res_dr1$cdr1*res_dr1$nobs_dr1,na.rm=T)/res_dr1$nobs_dr1[nrow(res_dr1)],2) res_dr1 #### rpr1 #### f <- (is.na(hh$annee1)==F & (substr(hh$parti,1,1) %in% 2)==F) tt1 <- tapply(hh$poids[f],list(hh$cs1b[f], hh$rpr1[f]),sum,na.rm=T) tt1 res_rpr1 <- data.frame(my_rtable(tt1)) res_rpr1$cs1b <- row.names(res_rpr1) res_rpr1 colnames(res_rpr1)[4] <- "nobs_rpr1" mm <- glm(rpr1~ -1+ cs1b + cs1b : risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_rpr1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_rpr1$cs1b <- gsub("cs1b","",row.names(glm_rpr1)) glm_rpr1[,c(1)] <- pro_log(glm_rpr1[,c(1)]) glm_rpr1[,c(2)] <- pro_log(glm_rpr1[,c(2)]) glm_rpr1[,c(3)] <- pro_log(glm_rpr1[,c(3)]) rownames(glm_rpr1) <- NULL glm_rpr1 colnames(glm_rpr1) <- c("crpr1","crpr1_i","crpr1_s","cs1b") res_rpr1 <- merge(res_rpr1[,c(4,5)],glm_rpr1,by="cs1b",all.x=T) nc_rpr1 <- table(hh$cs1b[f], hh$rpr1[f]) nc_rpr1 <- data.frame(my_rtable(nc_rpr1)) nc_rpr1$cs1b <- rownames(nc_rpr1) res_rpr1 <- merge(res_rpr1,nc_rpr1[,c(2,4,5)],by="cs1b",all.x=T) colnames(res_rpr1) <- c("cs1b","nobs_rpr1","crpr1","crpr1_i","crpr1_s","nc_rpr1","nc_nobs_rpr1") res_rpr1 <- rbind(res_rpr1[res_rpr1$cs1b!="Ensemble",], res_rpr1[res_rpr1$cs1b=="Ensemble",]) res_rpr1$crpr1[nrow(res_rpr1)] <- round(sum(res_rpr1$crpr1*res_rpr1$nobs_rpr1,na.rm=T)/res_rpr1$nobs_rpr1[nrow(res_rpr1)],2) res_rpr1 #### g1 #### f <- (is.na(hh$annee1)==F & (substr(hh$parti,1,1) %in% 4)==F) tt1 <- tapply(hh$poids[f],list(hh$cs1b[f], hh$g1[f]),sum,na.rm=T) tt1 res_g1 <- data.frame(my_rtable(tt1)) res_g1$cs1b <- row.names(res_g1) res_g1 colnames(res_g1)[4] <- "nobs_g1" mm <- glm(g1~ -1+ cs1b + cs1b : risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_g1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_g1$cs1b <- gsub("cs1b","",row.names(glm_g1)) glm_g1[,c(1)] <- pro_log(glm_g1[,c(1)]) glm_g1[,c(2)] <- pro_log(glm_g1[,c(2)]) glm_g1[,c(3)] <- pro_log(glm_g1[,c(3)]) rownames(glm_g1) <- NULL glm_g1 colnames(glm_g1) <- c("cg1","cg1_i","cg1_s","cs1b") res_g1 <- merge(res_g1[,c(4,5)],glm_g1,by="cs1b",all.x=T) nc_g1 <- table(hh$cs1b[f], hh$g1[f]) nc_g1 <- data.frame(my_rtable(nc_g1)) nc_g1$cs1b <- rownames(nc_g1) res_g1 <- merge(res_g1,nc_g1[,c(2,4,5)],by="cs1b",all.x=T) colnames(res_g1) <- c("cs1b","nobs_g1","cg1","cg1_i","cg1_s","nc_g1","nc_nobs_g1") res_g1 <- rbind(res_g1[res_g1$cs1b!="Ensemble",], res_g1[res_g1$cs1b=="Ensemble",]) res_g1$cg1[nrow(res_g1)] <- round(sum(res_g1$cg1*res_g1$nobs_g1,na.rm=T)/res_g1$nobs_g1[nrow(res_g1)],2) res_g1 #### ps1 #### f <- (is.na(hh$annee1)==F & (substr(hh$parti,1,1) %in% 4)==F) tt1 <- tapply(hh$poids[f],list(hh$cs1b[f], hh$ps1[f]),sum,na.rm=T) tt1 res_ps1 <- data.frame(my_rtable(tt1)) res_ps1$cs1b <- row.names(res_ps1) res_ps1 colnames(res_ps1)[4] <- "nobs_ps1" mm <- glm(ps1~ -1+ cs1b + cs1b : risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_ps1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_ps1$cs1b <- gsub("cs1b","",row.names(glm_ps1)) glm_ps1[,c(1)] <- pro_log(glm_ps1[,c(1)]) glm_ps1[,c(2)] <- pro_log(glm_ps1[,c(2)]) glm_ps1[,c(3)] <- pro_log(glm_ps1[,c(3)]) rownames(glm_ps1) <- NULL glm_ps1 colnames(glm_ps1) <- c("cps1","cps1_i","cps1_s","cs1b") res_ps1 <- merge(res_ps1[,c(4,5)],glm_ps1,by="cs1b",all.x=T) nc_ps1 <- table(hh$cs1b[f], hh$ps1[f]) nc_ps1 <- data.frame(my_rtable(nc_ps1)) nc_ps1$cs1b <- rownames(nc_ps1) res_ps1 <- merge(res_ps1,nc_ps1[,c(2,4,5)],by="cs1b",all.x=T) colnames(res_ps1) <- c("cs1b","nobs_ps1","cps1","cps1_i","cps1_s","nc_ps1","nc_nobs_ps1") res_ps1 <- rbind(res_ps1[res_ps1$cs1b!="Ensemble",], res_ps1[res_ps1$cs1b=="Ensemble",]) res_ps1$cps1[nrow(res_ps1)] <- round(sum(res_ps1$cps1*res_ps1$nobs_ps1,na.rm=T)/res_ps1$nobs_ps1[nrow(res_ps1)],2) res_ps1 #### Compilation #### nobs <- tapply(hh$poids,list(hh$cs1b, hh$fn1),sum,na.rm=T) nobs <- data.frame(my_rtable(nobs)) nobs$cs1b <- rownames(nobs) colnames(nobs)[4] <- "nobs_ens" tab_cs1b <- merge(res_xd1,res_fn1,by="cs1b") tab_cs1b <- merge(tab_cs1b,res_dr1,by="cs1b") tab_cs1b <- merge(tab_cs1b,res_rpr1,by="cs1b") tab_cs1b <- merge(tab_cs1b,res_g1,by="cs1b") tab_cs1b <- merge(tab_cs1b,res_ps1,by="cs1b") tab_cs1b <- merge(tab_cs1b,nobs[,c(4,5)],by="cs1b") tab_cs1b tab_cs1b <- rbind(tab_cs1b[tab_cs1b$cs1b!="Ensemble",], tab_cs1b[tab_cs1b$cs1b=="Ensemble",]) HTML("Tableau 2c (détail). Évolution vers l'extrême droite, le RPR, et le PS en fonction de cs1b",outhtml,align="left") HTML(tab_cs1b,outhtml,align="left",digits = 4,nsmall=2) tab_cs1b_simp <- tab_cs1b[,c("cs1b","cxd1","cfn1", "cdr1","crpr1", "cg1","cps1", "nobs_ens")] HTML("Tableau 2c. Évolution vers l'extrême droite, le RPR, et le PS en fonction de cs1b",outhtml,align="left") HTML(tab_cs1b_simp,outhtml,align="left",digits = 4,nsmall=2) tab_cs1b_simp # Figure 1. Graphique Réseau #### ### lien entre les partis #### tt1 <- tapply(hh$poids,list(hh$parti,hh$parti1),sum) tt1 tt1[is.na(tt1)] <- 0 my_rtable(tt1) dd <- as.data.frame.table(tt1) mm <- glm(Freq~Var1+Var2 # +I(Var1==Var2)*Var1 , family=poisson , data=dd) # # Modèle global avec neutralisation réélection dans le même parti # mm2 <- glm(Freq~Var1+Var2 # +I(Var1==Var2)*Var1 # , family=poisson # , data=dd) tt3 <- matrix(resid(mm),nrow=nrow(tt1),ncol=ncol(tt1)) rownames(tt3)<- rownames(tt1) colnames(tt3)<- colnames(tt1) net <- round(tt3) net[is.nan(net)] <-0 net[net<1.64] <- 0 lab <- rownames(net) colnames(net) <- substr(lab,5,nchar(lab)) rownames(net) <- substr(lab,5,nchar(lab)) network <- graph_from_adjacency_matrix(net , mode='directed', weighted =T) network <- simplify(network, remove.loops = TRUE) col <- c("gray","brown","cyan","orange","magenta","red") # Create a vector of color my_color <- col[as.numeric(substr(as.character(lab),1,1))+1] my_size <- round((((addmargins(tt1,2)[,(ncol(tt1)+1)]+addmargins(tt1,1)[(ncol(tt1)+1),]))^0.5)/10) par(mar = c(0, 0, 0, 0)) plot(network, layout=layout_with_fr, vertex.label.dist=1, edge.width=E(network)$weight**0.5, vertex.size=my_size, vertex.label.cex=0.6, vertex.label.color="black", vertex.color=my_color, edge.arrow.size=0.2) tkplot(network, layout=layout_with_fr, vertex.label.dist=0.5, margins=-10, edge.width=E(network)$weight**0.5, vertex.size=my_size, vertex.arrow.size=1, label.cex=0.6, vertex.color=my_color, edge.arrow.mode="->" ) HTML("Mobilité entre partis politiques",outhtml,align="left") HTML(my_rtable(tt1),outhtml,align="left",digits = 4, nsmall=2) tt2 <- tapply(hh$poids,list(hh$der_parti,hh$der_parti1),sum) tt2 tt2[is.na(tt2)] <- 0 my_rtable(tt2) HTML("Mobilité entre partis (Unions retraités) politiques",outhtml,align="left") HTML(my_rtable(tt2),outhtml,align="left",digits = 4, nsmall=2) # Tableau 3. Lien entre familles #### tt1 <- tapply(hh$poids,list(hh$mouvance,hh$mouvance1),sum) tt1 tt1[is.na(tt1)] <- 0 my_rtable(tt1) f <- (is.na(hh$annee1)==F) mm <- glm(fn1~ -1+ mouvance + mouvance:risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_fn1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_fn1$mouvance <- gsub("mouvance","",row.names(glm_fn1)) glm_fn1[,c(1)] <- pro_log(glm_fn1[,c(1)]) glm_fn1[,c(2)] <- pro_log(glm_fn1[,c(2)]) glm_fn1[,c(3)] <- pro_log(glm_fn1[,c(3)]) rownames(glm_fn1) <- NULL glm_fn1 f <- (is.na(hh$annee1)==F) mm <- glm(xd1~ -1+ mouvance + mouvance:risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_xd1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_xd1$mouvance <- gsub("mouvance","",row.names(glm_xd1)) glm_xd1[,c(1)] <- pro_log(glm_xd1[,c(1)]) glm_xd1[,c(2)] <- pro_log(glm_xd1[,c(2)]) glm_xd1[,c(3)] <- pro_log(glm_xd1[,c(3)]) rownames(glm_xd1) <- NULL glm_xd1 mm <- glm(I(mouvance1=="2. Droite")~ -1+ mouvance + mouvance:risque_erreur ,data=hh ,weights=hh$poids ,family=binomial) screenreg(mm) glm_d1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_d1$mouvance <- gsub("mouvance","",row.names(glm_d1)) glm_d1[,c(1)] <- pro_log(glm_d1[,c(1)]) glm_d1[,c(2)] <- pro_log(glm_d1[,c(2)]) glm_d1[,c(3)] <- pro_log(glm_d1[,c(3)]) rownames(glm_d1) <- NULL glm_d1 mm <- glm(I(mouvance1=="3. Centre")~ -1+ mouvance + mouvance:risque_erreur ,data=hh ,weights=hh$poids ,family=binomial) screenreg(mm) glm_c1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_c1$mouvance <- gsub("mouvance","",row.names(glm_c1)) glm_c1[,c(1)] <- pro_log(glm_c1[,c(1)]) glm_c1[,c(2)] <- pro_log(glm_c1[,c(2)]) glm_c1[,c(3)] <- pro_log(glm_c1[,c(3)]) rownames(glm_c1) <- NULL glm_c1 mm <- glm(g1~ -1+ mouvance + mouvance:risque_erreur ,data=hh ,weights=hh$poids ,family=binomial) screenreg(mm) glm_g1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_g1$mouvance <- gsub("mouvance","",row.names(glm_g1)) glm_g1[,c(1)] <- pro_log(glm_g1[,c(1)]) glm_g1[,c(2)] <- pro_log(glm_g1[,c(2)]) glm_g1[,c(3)] <- pro_log(glm_g1[,c(3)]) rownames(glm_g1) <- NULL glm_g1 mm <- glm(gr1~ -1+ mouvance + mouvance:risque_erreur ,data=hh ,weights=hh$poids ,family=binomial) screenreg(mm) glm_gr1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_gr1$mouvance <- gsub("mouvance","",row.names(glm_gr1)) glm_gr1[,c(1)] <- pro_log(glm_gr1[,c(1)]) glm_gr1[,c(2)] <- pro_log(glm_gr1[,c(2)]) glm_gr1[,c(3)] <- pro_log(glm_gr1[,c(3)]) rownames(glm_gr1) <- NULL glm_gr1 mm <- glm(I(mouvance1=="0. Autres")~ -1+ mouvance + mouvance:risque_erreur ,data=hh ,weights=hh$poids ,family=binomial) screenreg(mm) glm_a1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_a1$mouvance <- gsub("mouvance","",row.names(glm_a1)) glm_a1[,c(1)] <- pro_log(glm_a1[,c(1)]) glm_a1[,c(2)] <- pro_log(glm_a1[,c(2)]) glm_a1[,c(3)] <- pro_log(glm_a1[,c(3)]) rownames(glm_a1) <- NULL glm_a1 tt <- data.frame(glm_a1$mouvance,glm_a1$X1,glm_xd1$X1,glm_d1$X1,glm_c1$X1,glm_g1$X1,glm_gr1$X1) tt <- tt[c(1:6),] tt tt[,-1] <- round(100*tt[,-1]/rowSums(tt[,c(-1)]),2) tt colnames(tt) <- c("famille",'autre',"xd","droite","centre","gauche","gauche_rad") tt$fn <- glm_fn1$X1[c(1:6)] tt$ensemble <- 100 tt$nobs <- round(rowSums(tt1),0) ttens <- tt[1,] tt <- tt[c(2:3,1,4:6),c(1,3,8,4,2,5:7,9:10)] HTML("Mobilités entre familles politiques",outhtml,align="left") HTML(tt,outhtml,align="left",digits = 4, nsmall=2) # Figure 2 & Tableau A4. Par parti #### f <- (is.na(hh$annee1)==F) ### Estimations parti #### #### fn1 #### f <- (is.na(hh$annee1)==F) tt1 <- tapply(hh$poids[f],list(hh$parti[f], hh$fn1[f]),sum,na.rm=T) tt1 res_fn1 <- data.frame(my_rtable(tt1)) res_fn1$parti <- row.names(res_fn1) res_fn1 colnames(res_fn1)[4] <- "nobs_fn1" mm <- glm(fn1~ -1+ parti + parti : risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_fn1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_fn1$parti <- gsub("parti","",row.names(glm_fn1)) glm_fn1[,c(1)] <- pro_log(glm_fn1[,c(1)]) glm_fn1[,c(2)] <- pro_log(glm_fn1[,c(2)]) glm_fn1[,c(3)] <- pro_log(glm_fn1[,c(3)]) rownames(glm_fn1) <- NULL glm_fn1 colnames(glm_fn1) <- c("cfn1","cfn1_i","cfn1_s","parti") res_fn1 <- merge(res_fn1[,c(4,5)],glm_fn1,by="parti",all.x=T) nc_fn1 <- table(hh$parti[f], hh$fn1[f]) nc_fn1 <- data.frame(my_rtable(nc_fn1)) nc_fn1$parti <- rownames(nc_fn1) res_fn1 <- merge(res_fn1,nc_fn1[,c(2,4,5)],by="parti",all.x=T) colnames(res_fn1) <- c("parti","nobs_fn1","cfn1","cfn1_i","cfn1_s","nc_fn1","nc_nobs_fn1") res_fn1 <- rbind(res_fn1[res_fn1$parti!="Ensemble",], res_fn1[res_fn1$parti=="Ensemble",]) res_fn1$cfn1[nrow(res_fn1)] <- round(sum(res_fn1$cfn1*res_fn1$nobs_fn1,na.rm=T)/res_fn1$nobs_fn1[nrow(res_fn1)],2) res_fn1 #### xd1 #### f <- (is.na(hh$annee1)==F ) tt1 <- tapply(hh$poids[f],list(hh$parti[f], hh$xd1[f]),sum,na.rm=T) tt1 res_xd1 <- data.frame(my_rtable(tt1)) res_xd1$parti <- row.names(res_xd1) res_xd1 colnames(res_xd1)[4] <- "nobs_xd1" mm <- glm(xd1~ -1+ parti + parti : risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_xd1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_xd1$parti <- gsub("parti","",row.names(glm_xd1)) glm_xd1[,c(1)] <- pro_log(glm_xd1[,c(1)]) glm_xd1[,c(2)] <- pro_log(glm_xd1[,c(2)]) glm_xd1[,c(3)] <- pro_log(glm_xd1[,c(3)]) rownames(glm_xd1) <- NULL glm_xd1 colnames(glm_xd1) <- c("cxd1","cxd1_i","cxd1_s","parti") res_xd1 <- merge(res_xd1[,c(4,5)],glm_xd1,by="parti",all.x=T) nc_xd1 <- table(hh$parti[f], hh$xd1[f]) nc_xd1 <- data.frame(my_rtable(nc_xd1)) nc_xd1$parti <- rownames(nc_xd1) res_xd1 <- merge(res_xd1,nc_xd1[,c(2,4,5)],by="parti",all.x=T) colnames(res_xd1) <- c("parti","nobs_xd1","cxd1","cxd1_i","cxd1_s","nc_xd1","nc_nobs_xd1") res_xd1 <- rbind(res_xd1[res_xd1$parti!="Ensemble",], res_xd1[res_xd1$parti=="Ensemble",]) res_xd1$cxd1[nrow(res_xd1)] <- round(sum(res_xd1$cxd1*res_xd1$nobs_xd1,na.rm=T)/res_xd1$nobs_xd1[nrow(res_xd1)],2) res_xd1 #### dr1 #### f <- (is.na(hh$annee1)==F ) tt1 <- tapply(hh$poids[f],list(hh$parti[f], hh$dr1[f]),sum,na.rm=T) tt1 res_dr1 <- data.frame(my_rtable(tt1)) res_dr1$parti <- row.names(res_dr1) res_dr1 colnames(res_dr1)[4] <- "nobs_dr1" mm <- glm(dr1~ -1+ parti + parti : risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_dr1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_dr1$parti <- gsub("parti","",row.names(glm_dr1)) glm_dr1[,c(1)] <- pro_log(glm_dr1[,c(1)]) glm_dr1[,c(2)] <- pro_log(glm_dr1[,c(2)]) glm_dr1[,c(3)] <- pro_log(glm_dr1[,c(3)]) rownames(glm_dr1) <- NULL glm_dr1 colnames(glm_dr1) <- c("cdr1","cdr1_i","cdr1_s","parti") res_dr1 <- merge(res_dr1[,c(4,5)],glm_dr1,by="parti",all.x=T) nc_dr1 <- table(hh$parti[f], hh$dr1[f]) nc_dr1 <- data.frame(my_rtable(nc_dr1)) nc_dr1$parti <- rownames(nc_dr1) res_dr1 <- merge(res_dr1,nc_dr1[,c(2,4,5)],by="parti",all.x=T) colnames(res_dr1) <- c("parti","nobs_dr1","cdr1","cdr1_i","cdr1_s","nc_dr1","nc_nobs_dr1") res_dr1 <- rbind(res_dr1[res_dr1$parti!="Ensemble",], res_dr1[res_dr1$parti=="Ensemble",]) res_dr1$cdr1[nrow(res_dr1)] <- round(sum(res_dr1$cdr1*res_dr1$nobs_dr1,na.rm=T)/res_dr1$nobs_dr1[nrow(res_dr1)],2) res_dr1 #### rpr1 #### f <- (is.na(hh$annee1)==F ) tt1 <- tapply(hh$poids[f],list(hh$parti[f], hh$rpr1[f]),sum,na.rm=T) tt1 res_rpr1 <- data.frame(my_rtable(tt1)) res_rpr1$parti <- row.names(res_rpr1) res_rpr1 colnames(res_rpr1)[4] <- "nobs_rpr1" mm <- glm(rpr1~ -1+ parti + parti : risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_rpr1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_rpr1$parti <- gsub("parti","",row.names(glm_rpr1)) glm_rpr1[,c(1)] <- pro_log(glm_rpr1[,c(1)]) glm_rpr1[,c(2)] <- pro_log(glm_rpr1[,c(2)]) glm_rpr1[,c(3)] <- pro_log(glm_rpr1[,c(3)]) rownames(glm_rpr1) <- NULL glm_rpr1 colnames(glm_rpr1) <- c("crpr1","crpr1_i","crpr1_s","parti") res_rpr1 <- merge(res_rpr1[,c(4,5)],glm_rpr1,by="parti",all.x=T) nc_rpr1 <- table(hh$parti[f], hh$rpr1[f]) nc_rpr1 <- data.frame(my_rtable(nc_rpr1)) nc_rpr1$parti <- rownames(nc_rpr1) res_rpr1 <- merge(res_rpr1,nc_rpr1[,c(2,4,5)],by="parti",all.x=T) colnames(res_rpr1) <- c("parti","nobs_rpr1","crpr1","crpr1_i","crpr1_s","nc_rpr1","nc_nobs_rpr1") res_rpr1 <- rbind(res_rpr1[res_rpr1$parti!="Ensemble",], res_rpr1[res_rpr1$parti=="Ensemble",]) res_rpr1$crpr1[nrow(res_rpr1)] <- round(sum(res_rpr1$crpr1*res_rpr1$nobs_rpr1,na.rm=T)/res_rpr1$nobs_rpr1[nrow(res_rpr1)],2) res_rpr1 #### g1 #### f <- (is.na(hh$annee1)==F ) tt1 <- tapply(hh$poids[f],list(hh$parti[f], hh$g1[f]),sum,na.rm=T) tt1 res_g1 <- data.frame(my_rtable(tt1)) res_g1$parti <- row.names(res_g1) res_g1 colnames(res_g1)[4] <- "nobs_g1" mm <- glm(g1~ -1+ parti + parti : risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_g1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_g1$parti <- gsub("parti","",row.names(glm_g1)) glm_g1[,c(1)] <- pro_log(glm_g1[,c(1)]) glm_g1[,c(2)] <- pro_log(glm_g1[,c(2)]) glm_g1[,c(3)] <- pro_log(glm_g1[,c(3)]) rownames(glm_g1) <- NULL glm_g1 colnames(glm_g1) <- c("cg1","cg1_i","cg1_s","parti") res_g1 <- merge(res_g1[,c(4,5)],glm_g1,by="parti",all.x=T) nc_g1 <- table(hh$parti[f], hh$g1[f]) nc_g1 <- data.frame(my_rtable(nc_g1)) nc_g1$parti <- rownames(nc_g1) res_g1 <- merge(res_g1,nc_g1[,c(2,4,5)],by="parti",all.x=T) colnames(res_g1) <- c("parti","nobs_g1","cg1","cg1_i","cg1_s","nc_g1","nc_nobs_g1") res_g1 <- rbind(res_g1[res_g1$parti!="Ensemble",], res_g1[res_g1$parti=="Ensemble",]) res_g1$cg1[nrow(res_g1)] <- round(sum(res_g1$cg1*res_g1$nobs_g1,na.rm=T)/res_g1$nobs_g1[nrow(res_g1)],2) res_g1 #### ps1 #### f <- (is.na(hh$annee1)==F ) tt1 <- tapply(hh$poids[f],list(hh$parti[f], hh$ps1[f]),sum,na.rm=T) tt1 res_ps1 <- data.frame(my_rtable(tt1)) res_ps1$parti <- row.names(res_ps1) res_ps1 colnames(res_ps1)[4] <- "nobs_ps1" mm <- glm(ps1~ -1+ parti + parti : risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_ps1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_ps1$parti <- gsub("parti","",row.names(glm_ps1)) glm_ps1[,c(1)] <- pro_log(glm_ps1[,c(1)]) glm_ps1[,c(2)] <- pro_log(glm_ps1[,c(2)]) glm_ps1[,c(3)] <- pro_log(glm_ps1[,c(3)]) rownames(glm_ps1) <- NULL glm_ps1 colnames(glm_ps1) <- c("cps1","cps1_i","cps1_s","parti") res_ps1 <- merge(res_ps1[,c(4,5)],glm_ps1,by="parti",all.x=T) nc_ps1 <- table(hh$parti[f], hh$ps1[f]) nc_ps1 <- data.frame(my_rtable(nc_ps1)) nc_ps1$parti <- rownames(nc_ps1) res_ps1 <- merge(res_ps1,nc_ps1[,c(2,4,5)],by="parti",all.x=T) colnames(res_ps1) <- c("parti","nobs_ps1","cps1","cps1_i","cps1_s","nc_ps1","nc_nobs_ps1") res_ps1 <- rbind(res_ps1[res_ps1$parti!="Ensemble",], res_ps1[res_ps1$parti=="Ensemble",]) res_ps1$cps1[nrow(res_ps1)] <- round(sum(res_ps1$cps1*res_ps1$nobs_ps1,na.rm=T)/res_ps1$nobs_ps1[nrow(res_ps1)],2) res_ps1 #### Compilation #### nobs <- tapply(hh$poids,list(hh$parti, hh$fn1),sum,na.rm=T) nobs <- data.frame(my_rtable(nobs)) nobs$parti <- rownames(nobs) colnames(nobs)[4] <- "nobs_ens" tab_parti <- merge(res_xd1,res_fn1,by="parti") tab_parti <- merge(tab_parti,res_dr1,by="parti") tab_parti <- merge(tab_parti,res_rpr1,by="parti") tab_parti <- merge(tab_parti,res_g1,by="parti") tab_parti <- merge(tab_parti,res_ps1,by="parti") tab_parti <- merge(tab_parti,nobs[,c(4,5)],by="parti") tab_parti tab_parti <- rbind(tab_parti[tab_parti$parti!="Ensemble",], tab_parti[tab_parti$parti=="Ensemble",]) HTML("Tableau A6 (détail). Évolution vers l'extrême droite, le RPR, et le PS en fonction de parti",outhtml,align="left") HTML(tab_parti,outhtml,align="left",digits = 4,nsmall=2) tab_parti_simp <- tab_parti[,c("parti","cxd1","cfn1", "cdr1","crpr1", "cg1","cps1", "nobs_ens")] HTML("Tableau A6. Évolution vers l'extrême droite, le RPR, et le PS en fonction de parti",outhtml,align="left") HTML(tab_parti_simp,outhtml,align="left",digits = 4,nsmall=2) tab_parti_simp # Figure 2. Parti d'origine avec correction #### tt <- tab_parti tt <- tt[-nrow(tt),] tt$pfn <- tt$cfn1 tt$pfn_i <- tt$cfn1_i tt$pfn_s <- tt$cfn1_s tt$pxd <- tt$cxd1 tt$pxd_i <- tt$cxd1_i tt$pxd_s <- tt$cxd1_s tt_fn <- tt[,c("parti","pfn","pfn_i","pfn_s")] colnames(tt_fn) <- c("parti","Pct_cor","Pct_cor_inf","Pct_cor_sup") tt_fn$type <- "FN-RN" tt_xd <- tt[,c("parti","pxd","pxd_i","pxd_s")] colnames(tt_xd) <- c("parti","Pct_cor","Pct_cor_inf","Pct_cor_sup") tt_xd$type <- "Extrême droite" pp <- plyr::rbind.fill(tt_fn,tt_xd) pp$cat <- pp$parti pp$cat <- gsub("0.2","2.8",pp$cat) pp$cat <- gsub("0.1","2.9",pp$cat) pp$cat <- factor(pp$cat) levels(pp$cat) <- substr(levels(pp$cat),4,nchar(levels(pp$cat))) pp$type <- factor(pp$type) # stat="identity" , pp str(tab_parti) moy_fn1_xd0 <- sum(tab_parti$nobs_fn1[substr(tab_parti$parti,1,1) %in% c("0","2","3","4","5")]* tab_parti$cfn1[substr(tab_parti$parti,1,1) %in% c("0","2","3","4","5")])/ sum(tab_parti$nobs_fn1[substr(tab_parti$parti,1,1) %in% c("0","2","3","4","5")]) moy_xd1_xd0 <- sum(tab_parti$nobs_xd1[substr(tab_parti$parti,1,1) %in% c("0","2","3","4","5")]* tab_parti$cxd1[substr(tab_parti$parti,1,1) %in% c("0","2","3","4","5")])/ sum(tab_parti$nobs_xd1[substr(tab_parti$parti,1,1) %in% c("0","2","3","4","5")]) ## Graphique parti #### plot_party <- ggplot(pp[pp$Pct_cor>0,], aes(x=cat, y=Pct_cor,fill=type)) + geom_point(aes(colour = type,shape=type), position=position_dodge(0.5), alpha=0.7) + geom_errorbar( aes(x=cat, ymin=Pct_cor_inf, ymax=Pct_cor_sup, colour=type), width=0.2, position=position_dodge(.5), alpha=0.9, size=0.2)+ scale_color_manual(values=c("purple", "darkgreen"))+ theme(panel.grid.major = element_blank()) + geom_vline(xintercept=(c(0:30)+0.5), linewidth=0.2,linetype="dotted", colour="grey")+ scale_y_continuous(trans = 'log2', breaks=c(0.1,0.2,0.3,0.5,1,2,3,5,10,20,30,50,100)) + theme_minimal()+ ylab("Pourcentage corrigé (échelle logarithmique)") + xlab("") + theme(axis.text = element_text(size = 8)) + theme(axis.title.x = element_text(size = 8)) + geom_vline(xintercept=5.5,col="black",size=0.3) + geom_rect(ymin = -Inf, ymax = Inf, xmin = 0.5, xmax = 5.5, fill = "yellow", alpha = .005) + geom_segment(aes(y=moy_fn1_xd0,yend=moy_fn1_xd0,x=5.5,xend=30.5), color="darkgreen",linewidth=0.2,linetype="dotted") + annotate(geom="text",x=7.5,y=moy_fn1_xd0, label="Taux moyen de transition vers le FN → ", size=2.5,hjust=1,color="darkgreen") + geom_segment(aes(y=moy_xd1_xd0,yend=moy_xd1_xd0,x=5.5,xend=30.5), color="purple",linewidth=0.2,linetype="dotted") + annotate(geom="text",x=29.5,y=moy_xd1_xd0, label=" ← Taux moyen de transition vers l'extrême droite", color="purple",size=2.5,hjust=0) + coord_flip() + theme(legend.position="top") + theme(panel.grid.major = element_blank()) + theme(panel.grid.major.x = element_line(color = "grey80", size = 0.2, linetype = 2)) + theme(panel.grid.minor = element_blank()) + theme(legend.title = element_blank()) + guides( fill = guide_legend(reverse = TRUE), shape = guide_legend(reverse = TRUE), color = guide_legend(reverse = TRUE)) pdf("Figure_2_partis.pdf") plot_party dev.off() png("Figure_2_partis.png") plot_party dev.off() svg("Figure_2_partis.svg") plot_party dev.off() emf("Figure_2_partis.emf") plot_party dev.off() # Départ depuis le FN/RN #### tt2 <- tapply(hh$poids[hh$fn==1], hh$parti1[hh$fn==1],sum)/sum(hh$poids[hh$fn==1]) data.frame(round(100*tt2,2)) sum_poids <- sum(hh$poids[hh$fn==1]) nb_obs <- sum(hh$count[hh$fn==1]) names(sum_poids) <- "sum_poids" names(nb_obs) <- "nb_obs" freq <- c(round(100*addmargins(prop.table(tt2)),2),nb_obs,sum_poids) data.frame(freq) HTML("Complément. Départ depuis le FN",outhtml,align="left") HTML(data.frame(freq),outhtml,align="left",digits = 4,nsmall=2) tt2 <- table(hh$parti1[hh$fn==1 & is.na(hh$date_naissance_cor)==F & is.na(hh$date_naissance_cor1) ==F]) tt2 nb_obs <- addmargins(tt2)[(length(tt2)+1)] names(nb_obs) <- "nb_obs" freq <- c(round(100*addmargins(prop.table(tt2)),2),nb_obs) data.frame(freq) HTML("Complément. Départ depuis le FN (individus dont la date de naissance est connue)",outhtml,align="left") HTML(data.frame(freq),outhtml,align="left",digits = 4,nsmall=2) # Tableau 4. Par résultats électoraux #### ### Estimations score_cat #### #### fn1 #### f <- (is.na(hh$annee1)==F & hh$xd %in% 0) tt1 <- tapply(hh$poids[f],list(hh$score_cat[f], hh$fn1[f]),sum,na.rm=T) tt1 res_fn1 <- data.frame(my_rtable(tt1)) res_fn1$score_cat <- row.names(res_fn1) res_fn1 colnames(res_fn1)[4] <- "nobs_fn1" mm <- glm(fn1~ -1+ score_cat + score_cat : risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_fn1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_fn1$score_cat <- gsub("score_cat","",row.names(glm_fn1)) glm_fn1[,c(1)] <- pro_log(glm_fn1[,c(1)]) glm_fn1[,c(2)] <- pro_log(glm_fn1[,c(2)]) glm_fn1[,c(3)] <- pro_log(glm_fn1[,c(3)]) rownames(glm_fn1) <- NULL glm_fn1 colnames(glm_fn1) <- c("cfn1","cfn1_i","cfn1_s","score_cat") res_fn1 <- merge(res_fn1[,c(4,5)],glm_fn1,by="score_cat",all.x=T) nc_fn1 <- table(hh$score_cat[f], hh$fn1[f]) nc_fn1 <- data.frame(my_rtable(nc_fn1)) nc_fn1$score_cat <- rownames(nc_fn1) res_fn1 <- merge(res_fn1,nc_fn1[,c(2,4,5)],by="score_cat",all.x=T) colnames(res_fn1) <- c("score_cat","nobs_fn1","cfn1","cfn1_i","cfn1_s","nc_fn1","nc_nobs_fn1") res_fn1 <- rbind(res_fn1[res_fn1$score_cat!="Ensemble",], res_fn1[res_fn1$score_cat=="Ensemble",]) res_fn1$cfn1[nrow(res_fn1)] <- round(sum(res_fn1$cfn1*res_fn1$nobs_fn1,na.rm=T)/res_fn1$nobs_fn1[nrow(res_fn1)],2) res_fn1 #### xd1 #### f <- (is.na(hh$annee1)==F & hh$xd %in% 0) tt1 <- tapply(hh$poids[f],list(hh$score_cat[f], hh$xd1[f]),sum,na.rm=T) tt1 res_xd1 <- data.frame(my_rtable(tt1)) res_xd1$score_cat <- row.names(res_xd1) res_xd1 colnames(res_xd1)[4] <- "nobs_xd1" mm <- glm(xd1~ -1+ score_cat + score_cat : risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_xd1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_xd1$score_cat <- gsub("score_cat","",row.names(glm_xd1)) glm_xd1[,c(1)] <- pro_log(glm_xd1[,c(1)]) glm_xd1[,c(2)] <- pro_log(glm_xd1[,c(2)]) glm_xd1[,c(3)] <- pro_log(glm_xd1[,c(3)]) rownames(glm_xd1) <- NULL glm_xd1 colnames(glm_xd1) <- c("cxd1","cxd1_i","cxd1_s","score_cat") res_xd1 <- merge(res_xd1[,c(4,5)],glm_xd1,by="score_cat",all.x=T) nc_xd1 <- table(hh$score_cat[f], hh$xd1[f]) nc_xd1 <- data.frame(my_rtable(nc_xd1)) nc_xd1$score_cat <- rownames(nc_xd1) res_xd1 <- merge(res_xd1,nc_xd1[,c(2,4,5)],by="score_cat",all.x=T) colnames(res_xd1) <- c("score_cat","nobs_xd1","cxd1","cxd1_i","cxd1_s","nc_xd1","nc_nobs_xd1") res_xd1 <- rbind(res_xd1[res_xd1$score_cat!="Ensemble",], res_xd1[res_xd1$score_cat=="Ensemble",]) res_xd1$cxd1[nrow(res_xd1)] <- round(sum(res_xd1$cxd1*res_xd1$nobs_xd1,na.rm=T)/res_xd1$nobs_xd1[nrow(res_xd1)],2) res_xd1 #### dr1 #### f <- (is.na(hh$annee1)==F & (substr(hh$parti,1,1) %in% 2)==F) tt1 <- tapply(hh$poids[f],list(hh$score_cat[f], hh$dr1[f]),sum,na.rm=T) tt1 res_dr1 <- data.frame(my_rtable(tt1)) res_dr1$score_cat <- row.names(res_dr1) res_dr1 colnames(res_dr1)[4] <- "nobs_dr1" mm <- glm(dr1~ -1+ score_cat + score_cat : risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_dr1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_dr1$score_cat <- gsub("score_cat","",row.names(glm_dr1)) glm_dr1[,c(1)] <- pro_log(glm_dr1[,c(1)]) glm_dr1[,c(2)] <- pro_log(glm_dr1[,c(2)]) glm_dr1[,c(3)] <- pro_log(glm_dr1[,c(3)]) rownames(glm_dr1) <- NULL glm_dr1 colnames(glm_dr1) <- c("cdr1","cdr1_i","cdr1_s","score_cat") res_dr1 <- merge(res_dr1[,c(4,5)],glm_dr1,by="score_cat",all.x=T) nc_dr1 <- table(hh$score_cat[f], hh$dr1[f]) nc_dr1 <- data.frame(my_rtable(nc_dr1)) nc_dr1$score_cat <- rownames(nc_dr1) res_dr1 <- merge(res_dr1,nc_dr1[,c(2,4,5)],by="score_cat",all.x=T) colnames(res_dr1) <- c("score_cat","nobs_dr1","cdr1","cdr1_i","cdr1_s","nc_dr1","nc_nobs_dr1") res_dr1 <- rbind(res_dr1[res_dr1$score_cat!="Ensemble",], res_dr1[res_dr1$score_cat=="Ensemble",]) res_dr1$cdr1[nrow(res_dr1)] <- round(sum(res_dr1$cdr1*res_dr1$nobs_dr1,na.rm=T)/res_dr1$nobs_dr1[nrow(res_dr1)],2) res_dr1 #### rpr1 #### f <- (is.na(hh$annee1)==F & (substr(hh$parti,1,1) %in% 2)==F) tt1 <- tapply(hh$poids[f],list(hh$score_cat[f], hh$rpr1[f]),sum,na.rm=T) tt1 res_rpr1 <- data.frame(my_rtable(tt1)) res_rpr1$score_cat <- row.names(res_rpr1) res_rpr1 colnames(res_rpr1)[4] <- "nobs_rpr1" mm <- glm(rpr1~ -1+ score_cat + score_cat : risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_rpr1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_rpr1$score_cat <- gsub("score_cat","",row.names(glm_rpr1)) glm_rpr1[,c(1)] <- pro_log(glm_rpr1[,c(1)]) glm_rpr1[,c(2)] <- pro_log(glm_rpr1[,c(2)]) glm_rpr1[,c(3)] <- pro_log(glm_rpr1[,c(3)]) rownames(glm_rpr1) <- NULL glm_rpr1 colnames(glm_rpr1) <- c("crpr1","crpr1_i","crpr1_s","score_cat") res_rpr1 <- merge(res_rpr1[,c(4,5)],glm_rpr1,by="score_cat",all.x=T) nc_rpr1 <- table(hh$score_cat[f], hh$rpr1[f]) nc_rpr1 <- data.frame(my_rtable(nc_rpr1)) nc_rpr1$score_cat <- rownames(nc_rpr1) res_rpr1 <- merge(res_rpr1,nc_rpr1[,c(2,4,5)],by="score_cat",all.x=T) colnames(res_rpr1) <- c("score_cat","nobs_rpr1","crpr1","crpr1_i","crpr1_s","nc_rpr1","nc_nobs_rpr1") res_rpr1 <- rbind(res_rpr1[res_rpr1$score_cat!="Ensemble",], res_rpr1[res_rpr1$score_cat=="Ensemble",]) res_rpr1$crpr1[nrow(res_rpr1)] <- round(sum(res_rpr1$crpr1*res_rpr1$nobs_rpr1,na.rm=T)/res_rpr1$nobs_rpr1[nrow(res_rpr1)],2) res_rpr1 #### g1 #### f <- (is.na(hh$annee1)==F & (substr(hh$parti,1,1) %in% 4)==F) tt1 <- tapply(hh$poids[f],list(hh$score_cat[f], hh$g1[f]),sum,na.rm=T) tt1 res_g1 <- data.frame(my_rtable(tt1)) res_g1$score_cat <- row.names(res_g1) res_g1 colnames(res_g1)[4] <- "nobs_g1" mm <- glm(g1~ -1+ score_cat + score_cat : risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_g1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_g1$score_cat <- gsub("score_cat","",row.names(glm_g1)) glm_g1[,c(1)] <- pro_log(glm_g1[,c(1)]) glm_g1[,c(2)] <- pro_log(glm_g1[,c(2)]) glm_g1[,c(3)] <- pro_log(glm_g1[,c(3)]) rownames(glm_g1) <- NULL glm_g1 colnames(glm_g1) <- c("cg1","cg1_i","cg1_s","score_cat") res_g1 <- merge(res_g1[,c(4,5)],glm_g1,by="score_cat",all.x=T) nc_g1 <- table(hh$score_cat[f], hh$g1[f]) nc_g1 <- data.frame(my_rtable(nc_g1)) nc_g1$score_cat <- rownames(nc_g1) res_g1 <- merge(res_g1,nc_g1[,c(2,4,5)],by="score_cat",all.x=T) colnames(res_g1) <- c("score_cat","nobs_g1","cg1","cg1_i","cg1_s","nc_g1","nc_nobs_g1") res_g1 <- rbind(res_g1[res_g1$score_cat!="Ensemble",], res_g1[res_g1$score_cat=="Ensemble",]) res_g1$cg1[nrow(res_g1)] <- round(sum(res_g1$cg1*res_g1$nobs_g1,na.rm=T)/res_g1$nobs_g1[nrow(res_g1)],2) res_g1 #### ps1 #### f <- (is.na(hh$annee1)==F & (substr(hh$parti,1,1) %in% 4)==F) tt1 <- tapply(hh$poids[f],list(hh$score_cat[f], hh$ps1[f]),sum,na.rm=T) tt1 res_ps1 <- data.frame(my_rtable(tt1)) res_ps1$score_cat <- row.names(res_ps1) res_ps1 colnames(res_ps1)[4] <- "nobs_ps1" mm <- glm(ps1~ -1+ score_cat + score_cat : risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_ps1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_ps1$score_cat <- gsub("score_cat","",row.names(glm_ps1)) glm_ps1[,c(1)] <- pro_log(glm_ps1[,c(1)]) glm_ps1[,c(2)] <- pro_log(glm_ps1[,c(2)]) glm_ps1[,c(3)] <- pro_log(glm_ps1[,c(3)]) rownames(glm_ps1) <- NULL glm_ps1 colnames(glm_ps1) <- c("cps1","cps1_i","cps1_s","score_cat") res_ps1 <- merge(res_ps1[,c(4,5)],glm_ps1,by="score_cat",all.x=T) nc_ps1 <- table(hh$score_cat[f], hh$ps1[f]) nc_ps1 <- data.frame(my_rtable(nc_ps1)) nc_ps1$score_cat <- rownames(nc_ps1) res_ps1 <- merge(res_ps1,nc_ps1[,c(2,4,5)],by="score_cat",all.x=T) colnames(res_ps1) <- c("score_cat","nobs_ps1","cps1","cps1_i","cps1_s","nc_ps1","nc_nobs_ps1") res_ps1 <- rbind(res_ps1[res_ps1$score_cat!="Ensemble",], res_ps1[res_ps1$score_cat=="Ensemble",]) res_ps1$cps1[nrow(res_ps1)] <- round(sum(res_ps1$cps1*res_ps1$nobs_ps1,na.rm=T)/res_ps1$nobs_ps1[nrow(res_ps1)],2) res_ps1 #### Compilation #### nobs <- tapply(hh$poids,list(hh$score_cat, hh$fn1),sum,na.rm=T) nobs <- data.frame(my_rtable(nobs)) nobs$score_cat <- rownames(nobs) colnames(nobs)[4] <- "nobs_ens" tab_score_cat <- merge(res_xd1,res_fn1,by="score_cat") tab_score_cat <- merge(tab_score_cat,res_dr1,by="score_cat") tab_score_cat <- merge(tab_score_cat,res_rpr1,by="score_cat") tab_score_cat <- merge(tab_score_cat,res_g1,by="score_cat") tab_score_cat <- merge(tab_score_cat,res_ps1,by="score_cat") tab_score_cat <- merge(tab_score_cat,nobs[,c(4,5)],by="score_cat") tab_score_cat tab_score_cat <- rbind(tab_score_cat[tab_score_cat$score_cat!="Ensemble",], tab_score_cat[tab_score_cat$score_cat=="Ensemble",]) HTML("Tableau 4a (détails). Évolution vers l'extrême droite, le RPR, et le PS en fonction de score_cat",outhtml,align="left") HTML(tab_score_cat,outhtml,align="left",digits = 4,nsmall=2) tab_score_cat_simp <- tab_score_cat[,c("score_cat","cxd1","cfn1", "cdr1","crpr1", "cg1","cps1", "nobs_ens")] HTML("Tableau 4a. Évolution vers l'extrême droite, le RPR, et le PS en fonction de score_cat",outhtml,align="left") HTML(tab_score_cat_simp,outhtml,align="left",digits = 4,nsmall=2) tab_score_cat_simp ## Tableau 4b. Par le fait d'être élu #### hh$elu_in_fine <- factor(hh$elu_in_fine) f <- (is.na(hh$annee1)==F & hh$xd %in% 0) ### Estimations elu_in_fine #### #### fn1 #### f <- (is.na(hh$annee1)==F & hh$xd %in% 0) tt1 <- tapply(hh$poids[f],list(hh$elu_in_fine[f], hh$fn1[f]),sum,na.rm=T) tt1 res_fn1 <- data.frame(my_rtable(tt1)) res_fn1$elu_in_fine <- row.names(res_fn1) res_fn1 colnames(res_fn1)[4] <- "nobs_fn1" mm <- glm(fn1~ -1+ elu_in_fine + elu_in_fine : risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_fn1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_fn1$elu_in_fine <- gsub("elu_in_fine","",row.names(glm_fn1)) glm_fn1[,c(1)] <- pro_log(glm_fn1[,c(1)]) glm_fn1[,c(2)] <- pro_log(glm_fn1[,c(2)]) glm_fn1[,c(3)] <- pro_log(glm_fn1[,c(3)]) rownames(glm_fn1) <- NULL glm_fn1 colnames(glm_fn1) <- c("cfn1","cfn1_i","cfn1_s","elu_in_fine") res_fn1 <- merge(res_fn1[,c(4,5)],glm_fn1,by="elu_in_fine",all.x=T) nc_fn1 <- table(hh$elu_in_fine[f], hh$fn1[f]) nc_fn1 <- data.frame(my_rtable(nc_fn1)) nc_fn1$elu_in_fine <- rownames(nc_fn1) res_fn1 <- merge(res_fn1,nc_fn1[,c(2,4,5)],by="elu_in_fine",all.x=T) colnames(res_fn1) <- c("elu_in_fine","nobs_fn1","cfn1","cfn1_i","cfn1_s","nc_fn1","nc_nobs_fn1") res_fn1 <- rbind(res_fn1[res_fn1$elu_in_fine!="Ensemble",], res_fn1[res_fn1$elu_in_fine=="Ensemble",]) res_fn1$cfn1[nrow(res_fn1)] <- round(sum(res_fn1$cfn1*res_fn1$nobs_fn1,na.rm=T)/res_fn1$nobs_fn1[nrow(res_fn1)],2) res_fn1 #### xd1 #### f <- (is.na(hh$annee1)==F & hh$xd %in% 0) tt1 <- tapply(hh$poids[f],list(hh$elu_in_fine[f], hh$xd1[f]),sum,na.rm=T) tt1 res_xd1 <- data.frame(my_rtable(tt1)) res_xd1$elu_in_fine <- row.names(res_xd1) res_xd1 colnames(res_xd1)[4] <- "nobs_xd1" mm <- glm(xd1~ -1+ elu_in_fine + elu_in_fine : risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_xd1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_xd1$elu_in_fine <- gsub("elu_in_fine","",row.names(glm_xd1)) glm_xd1[,c(1)] <- pro_log(glm_xd1[,c(1)]) glm_xd1[,c(2)] <- pro_log(glm_xd1[,c(2)]) glm_xd1[,c(3)] <- pro_log(glm_xd1[,c(3)]) rownames(glm_xd1) <- NULL glm_xd1 colnames(glm_xd1) <- c("cxd1","cxd1_i","cxd1_s","elu_in_fine") res_xd1 <- merge(res_xd1[,c(4,5)],glm_xd1,by="elu_in_fine",all.x=T) nc_xd1 <- table(hh$elu_in_fine[f], hh$xd1[f]) nc_xd1 <- data.frame(my_rtable(nc_xd1)) nc_xd1$elu_in_fine <- rownames(nc_xd1) res_xd1 <- merge(res_xd1,nc_xd1[,c(2,4,5)],by="elu_in_fine",all.x=T) colnames(res_xd1) <- c("elu_in_fine","nobs_xd1","cxd1","cxd1_i","cxd1_s","nc_xd1","nc_nobs_xd1") res_xd1 <- rbind(res_xd1[res_xd1$elu_in_fine!="Ensemble",], res_xd1[res_xd1$elu_in_fine=="Ensemble",]) res_xd1$cxd1[nrow(res_xd1)] <- round(sum(res_xd1$cxd1*res_xd1$nobs_xd1,na.rm=T)/res_xd1$nobs_xd1[nrow(res_xd1)],2) res_xd1 #### dr1 #### f <- (is.na(hh$annee1)==F & (substr(hh$parti,1,1) %in% 2)==F) tt1 <- tapply(hh$poids[f],list(hh$elu_in_fine[f], hh$dr1[f]),sum,na.rm=T) tt1 res_dr1 <- data.frame(my_rtable(tt1)) res_dr1$elu_in_fine <- row.names(res_dr1) res_dr1 colnames(res_dr1)[4] <- "nobs_dr1" mm <- glm(dr1~ -1+ elu_in_fine + elu_in_fine : risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_dr1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_dr1$elu_in_fine <- gsub("elu_in_fine","",row.names(glm_dr1)) glm_dr1[,c(1)] <- pro_log(glm_dr1[,c(1)]) glm_dr1[,c(2)] <- pro_log(glm_dr1[,c(2)]) glm_dr1[,c(3)] <- pro_log(glm_dr1[,c(3)]) rownames(glm_dr1) <- NULL glm_dr1 colnames(glm_dr1) <- c("cdr1","cdr1_i","cdr1_s","elu_in_fine") res_dr1 <- merge(res_dr1[,c(4,5)],glm_dr1,by="elu_in_fine",all.x=T) nc_dr1 <- table(hh$elu_in_fine[f], hh$dr1[f]) nc_dr1 <- data.frame(my_rtable(nc_dr1)) nc_dr1$elu_in_fine <- rownames(nc_dr1) res_dr1 <- merge(res_dr1,nc_dr1[,c(2,4,5)],by="elu_in_fine",all.x=T) colnames(res_dr1) <- c("elu_in_fine","nobs_dr1","cdr1","cdr1_i","cdr1_s","nc_dr1","nc_nobs_dr1") res_dr1 <- rbind(res_dr1[res_dr1$elu_in_fine!="Ensemble",], res_dr1[res_dr1$elu_in_fine=="Ensemble",]) res_dr1$cdr1[nrow(res_dr1)] <- round(sum(res_dr1$cdr1*res_dr1$nobs_dr1,na.rm=T)/res_dr1$nobs_dr1[nrow(res_dr1)],2) res_dr1 #### rpr1 #### f <- (is.na(hh$annee1)==F & (substr(hh$parti,1,1) %in% 2)==F) tt1 <- tapply(hh$poids[f],list(hh$elu_in_fine[f], hh$rpr1[f]),sum,na.rm=T) tt1 res_rpr1 <- data.frame(my_rtable(tt1)) res_rpr1$elu_in_fine <- row.names(res_rpr1) res_rpr1 colnames(res_rpr1)[4] <- "nobs_rpr1" mm <- glm(rpr1~ -1+ elu_in_fine + elu_in_fine : risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_rpr1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_rpr1$elu_in_fine <- gsub("elu_in_fine","",row.names(glm_rpr1)) glm_rpr1[,c(1)] <- pro_log(glm_rpr1[,c(1)]) glm_rpr1[,c(2)] <- pro_log(glm_rpr1[,c(2)]) glm_rpr1[,c(3)] <- pro_log(glm_rpr1[,c(3)]) rownames(glm_rpr1) <- NULL glm_rpr1 colnames(glm_rpr1) <- c("crpr1","crpr1_i","crpr1_s","elu_in_fine") res_rpr1 <- merge(res_rpr1[,c(4,5)],glm_rpr1,by="elu_in_fine",all.x=T) nc_rpr1 <- table(hh$elu_in_fine[f], hh$rpr1[f]) nc_rpr1 <- data.frame(my_rtable(nc_rpr1)) nc_rpr1$elu_in_fine <- rownames(nc_rpr1) res_rpr1 <- merge(res_rpr1,nc_rpr1[,c(2,4,5)],by="elu_in_fine",all.x=T) colnames(res_rpr1) <- c("elu_in_fine","nobs_rpr1","crpr1","crpr1_i","crpr1_s","nc_rpr1","nc_nobs_rpr1") res_rpr1 <- rbind(res_rpr1[res_rpr1$elu_in_fine!="Ensemble",], res_rpr1[res_rpr1$elu_in_fine=="Ensemble",]) res_rpr1$crpr1[nrow(res_rpr1)] <- round(sum(res_rpr1$crpr1*res_rpr1$nobs_rpr1,na.rm=T)/res_rpr1$nobs_rpr1[nrow(res_rpr1)],2) res_rpr1 #### g1 #### f <- (is.na(hh$annee1)==F & (substr(hh$parti,1,1) %in% 4)==F) tt1 <- tapply(hh$poids[f],list(hh$elu_in_fine[f], hh$g1[f]),sum,na.rm=T) tt1 res_g1 <- data.frame(my_rtable(tt1)) res_g1$elu_in_fine <- row.names(res_g1) res_g1 colnames(res_g1)[4] <- "nobs_g1" mm <- glm(g1~ -1+ elu_in_fine + elu_in_fine : risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_g1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_g1$elu_in_fine <- gsub("elu_in_fine","",row.names(glm_g1)) glm_g1[,c(1)] <- pro_log(glm_g1[,c(1)]) glm_g1[,c(2)] <- pro_log(glm_g1[,c(2)]) glm_g1[,c(3)] <- pro_log(glm_g1[,c(3)]) rownames(glm_g1) <- NULL glm_g1 colnames(glm_g1) <- c("cg1","cg1_i","cg1_s","elu_in_fine") res_g1 <- merge(res_g1[,c(4,5)],glm_g1,by="elu_in_fine",all.x=T) nc_g1 <- table(hh$elu_in_fine[f], hh$g1[f]) nc_g1 <- data.frame(my_rtable(nc_g1)) nc_g1$elu_in_fine <- rownames(nc_g1) res_g1 <- merge(res_g1,nc_g1[,c(2,4,5)],by="elu_in_fine",all.x=T) colnames(res_g1) <- c("elu_in_fine","nobs_g1","cg1","cg1_i","cg1_s","nc_g1","nc_nobs_g1") res_g1 <- rbind(res_g1[res_g1$elu_in_fine!="Ensemble",], res_g1[res_g1$elu_in_fine=="Ensemble",]) res_g1$cg1[nrow(res_g1)] <- round(sum(res_g1$cg1*res_g1$nobs_g1,na.rm=T)/res_g1$nobs_g1[nrow(res_g1)],2) res_g1 #### ps1 #### f <- (is.na(hh$annee1)==F & (substr(hh$parti,1,1) %in% 4)==F) tt1 <- tapply(hh$poids[f],list(hh$elu_in_fine[f], hh$ps1[f]),sum,na.rm=T) tt1 res_ps1 <- data.frame(my_rtable(tt1)) res_ps1$elu_in_fine <- row.names(res_ps1) res_ps1 colnames(res_ps1)[4] <- "nobs_ps1" mm <- glm(ps1~ -1+ elu_in_fine + elu_in_fine : risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_ps1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_ps1$elu_in_fine <- gsub("elu_in_fine","",row.names(glm_ps1)) glm_ps1[,c(1)] <- pro_log(glm_ps1[,c(1)]) glm_ps1[,c(2)] <- pro_log(glm_ps1[,c(2)]) glm_ps1[,c(3)] <- pro_log(glm_ps1[,c(3)]) rownames(glm_ps1) <- NULL glm_ps1 colnames(glm_ps1) <- c("cps1","cps1_i","cps1_s","elu_in_fine") res_ps1 <- merge(res_ps1[,c(4,5)],glm_ps1,by="elu_in_fine",all.x=T) nc_ps1 <- table(hh$elu_in_fine[f], hh$ps1[f]) nc_ps1 <- data.frame(my_rtable(nc_ps1)) nc_ps1$elu_in_fine <- rownames(nc_ps1) res_ps1 <- merge(res_ps1,nc_ps1[,c(2,4,5)],by="elu_in_fine",all.x=T) colnames(res_ps1) <- c("elu_in_fine","nobs_ps1","cps1","cps1_i","cps1_s","nc_ps1","nc_nobs_ps1") res_ps1 <- rbind(res_ps1[res_ps1$elu_in_fine!="Ensemble",], res_ps1[res_ps1$elu_in_fine=="Ensemble",]) res_ps1$cps1[nrow(res_ps1)] <- round(sum(res_ps1$cps1*res_ps1$nobs_ps1,na.rm=T)/res_ps1$nobs_ps1[nrow(res_ps1)],2) res_ps1 #### Compilation #### nobs <- tapply(hh$poids,list(hh$elu_in_fine, hh$fn1),sum,na.rm=T) nobs <- data.frame(my_rtable(nobs)) nobs$elu_in_fine <- rownames(nobs) colnames(nobs)[4] <- "nobs_ens" tab_elu_in_fine <- merge(res_xd1,res_fn1,by="elu_in_fine") tab_elu_in_fine <- merge(tab_elu_in_fine,res_dr1,by="elu_in_fine") tab_elu_in_fine <- merge(tab_elu_in_fine,res_rpr1,by="elu_in_fine") tab_elu_in_fine <- merge(tab_elu_in_fine,res_g1,by="elu_in_fine") tab_elu_in_fine <- merge(tab_elu_in_fine,res_ps1,by="elu_in_fine") tab_elu_in_fine <- merge(tab_elu_in_fine,nobs[,c(4,5)],by="elu_in_fine") tab_elu_in_fine tab_elu_in_fine <- rbind(tab_elu_in_fine[tab_elu_in_fine$elu_in_fine!="Ensemble",], tab_elu_in_fine[tab_elu_in_fine$elu_in_fine=="Ensemble",]) HTML("Tableau 4b (détails). Évolution vers l'extrême droite, le RPR, et le PS en fonction de elu_in_fine",outhtml,align="left") HTML(tab_elu_in_fine,outhtml,align="left",digits = 4,nsmall=2) tab_elu_in_fine_simp <- tab_elu_in_fine[,c("elu_in_fine","cxd1","cfn1", "cdr1","crpr1", "cg1","cps1", "nobs_ens")] HTML("Tableau 4b. Évolution vers l'extrême droite, le RPR, et le PS en fonction de elu_in_fine",outhtml,align="left") HTML(tab_elu_in_fine_simp,outhtml,align="left",digits = 4,nsmall=2) tab_elu_in_fine_simp ## Tableau 4c. Par scrutin liste #### hh$rg_b <- hh$rg hh$rg_b[hh$scrutin!="liste"] <- NA table(hh$rg_b) ### Estimations rg_b #### #### fn1 #### f <- (is.na(hh$annee1)==F & hh$xd %in% 0) tt1 <- tapply(hh$poids[f],list(hh$rg_b[f], hh$fn1[f]),sum,na.rm=T) tt1 res_fn1 <- data.frame(my_rtable(tt1)) res_fn1$rg_b <- row.names(res_fn1) res_fn1 colnames(res_fn1)[4] <- "nobs_fn1" mm <- glm(fn1~ -1+ rg_b + rg_b : risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_fn1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_fn1$rg_b <- gsub("rg_b","",row.names(glm_fn1)) glm_fn1[,c(1)] <- pro_log(glm_fn1[,c(1)]) glm_fn1[,c(2)] <- pro_log(glm_fn1[,c(2)]) glm_fn1[,c(3)] <- pro_log(glm_fn1[,c(3)]) rownames(glm_fn1) <- NULL glm_fn1 colnames(glm_fn1) <- c("cfn1","cfn1_i","cfn1_s","rg_b") res_fn1 <- merge(res_fn1[,c(4,5)],glm_fn1,by="rg_b",all.x=T) nc_fn1 <- table(hh$rg_b[f], hh$fn1[f]) nc_fn1 <- data.frame(my_rtable(nc_fn1)) nc_fn1$rg_b <- rownames(nc_fn1) res_fn1 <- merge(res_fn1,nc_fn1[,c(2,4,5)],by="rg_b",all.x=T) colnames(res_fn1) <- c("rg_b","nobs_fn1","cfn1","cfn1_i","cfn1_s","nc_fn1","nc_nobs_fn1") res_fn1 <- rbind(res_fn1[res_fn1$rg_b!="Ensemble",], res_fn1[res_fn1$rg_b=="Ensemble",]) res_fn1$cfn1[nrow(res_fn1)] <- round(sum(res_fn1$cfn1*res_fn1$nobs_fn1,na.rm=T)/res_fn1$nobs_fn1[nrow(res_fn1)],2) res_fn1 #### xd1 #### f <- (is.na(hh$annee1)==F & hh$xd %in% 0) tt1 <- tapply(hh$poids[f],list(hh$rg_b[f], hh$xd1[f]),sum,na.rm=T) tt1 res_xd1 <- data.frame(my_rtable(tt1)) res_xd1$rg_b <- row.names(res_xd1) res_xd1 colnames(res_xd1)[4] <- "nobs_xd1" mm <- glm(xd1~ -1+ rg_b + rg_b : risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_xd1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_xd1$rg_b <- gsub("rg_b","",row.names(glm_xd1)) glm_xd1[,c(1)] <- pro_log(glm_xd1[,c(1)]) glm_xd1[,c(2)] <- pro_log(glm_xd1[,c(2)]) glm_xd1[,c(3)] <- pro_log(glm_xd1[,c(3)]) rownames(glm_xd1) <- NULL glm_xd1 colnames(glm_xd1) <- c("cxd1","cxd1_i","cxd1_s","rg_b") res_xd1 <- merge(res_xd1[,c(4,5)],glm_xd1,by="rg_b",all.x=T) nc_xd1 <- table(hh$rg_b[f], hh$xd1[f]) nc_xd1 <- data.frame(my_rtable(nc_xd1)) nc_xd1$rg_b <- rownames(nc_xd1) res_xd1 <- merge(res_xd1,nc_xd1[,c(2,4,5)],by="rg_b",all.x=T) colnames(res_xd1) <- c("rg_b","nobs_xd1","cxd1","cxd1_i","cxd1_s","nc_xd1","nc_nobs_xd1") res_xd1 <- rbind(res_xd1[res_xd1$rg_b!="Ensemble",], res_xd1[res_xd1$rg_b=="Ensemble",]) res_xd1$cxd1[nrow(res_xd1)] <- round(sum(res_xd1$cxd1*res_xd1$nobs_xd1,na.rm=T)/res_xd1$nobs_xd1[nrow(res_xd1)],2) res_xd1 #### dr1 #### f <- (is.na(hh$annee1)==F & (substr(hh$parti,1,1) %in% 2)==F) tt1 <- tapply(hh$poids[f],list(hh$rg_b[f], hh$dr1[f]),sum,na.rm=T) tt1 res_dr1 <- data.frame(my_rtable(tt1)) res_dr1$rg_b <- row.names(res_dr1) res_dr1 colnames(res_dr1)[4] <- "nobs_dr1" mm <- glm(dr1~ -1+ rg_b + rg_b : risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_dr1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_dr1$rg_b <- gsub("rg_b","",row.names(glm_dr1)) glm_dr1[,c(1)] <- pro_log(glm_dr1[,c(1)]) glm_dr1[,c(2)] <- pro_log(glm_dr1[,c(2)]) glm_dr1[,c(3)] <- pro_log(glm_dr1[,c(3)]) rownames(glm_dr1) <- NULL glm_dr1 colnames(glm_dr1) <- c("cdr1","cdr1_i","cdr1_s","rg_b") res_dr1 <- merge(res_dr1[,c(4,5)],glm_dr1,by="rg_b",all.x=T) nc_dr1 <- table(hh$rg_b[f], hh$dr1[f]) nc_dr1 <- data.frame(my_rtable(nc_dr1)) nc_dr1$rg_b <- rownames(nc_dr1) res_dr1 <- merge(res_dr1,nc_dr1[,c(2,4,5)],by="rg_b",all.x=T) colnames(res_dr1) <- c("rg_b","nobs_dr1","cdr1","cdr1_i","cdr1_s","nc_dr1","nc_nobs_dr1") res_dr1 <- rbind(res_dr1[res_dr1$rg_b!="Ensemble",], res_dr1[res_dr1$rg_b=="Ensemble",]) res_dr1$cdr1[nrow(res_dr1)] <- round(sum(res_dr1$cdr1*res_dr1$nobs_dr1,na.rm=T)/res_dr1$nobs_dr1[nrow(res_dr1)],2) res_dr1 #### rpr1 #### f <- (is.na(hh$annee1)==F & (substr(hh$parti,1,1) %in% 2)==F) tt1 <- tapply(hh$poids[f],list(hh$rg_b[f], hh$rpr1[f]),sum,na.rm=T) tt1 res_rpr1 <- data.frame(my_rtable(tt1)) res_rpr1$rg_b <- row.names(res_rpr1) res_rpr1 colnames(res_rpr1)[4] <- "nobs_rpr1" mm <- glm(rpr1~ -1+ rg_b + rg_b : risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_rpr1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_rpr1$rg_b <- gsub("rg_b","",row.names(glm_rpr1)) glm_rpr1[,c(1)] <- pro_log(glm_rpr1[,c(1)]) glm_rpr1[,c(2)] <- pro_log(glm_rpr1[,c(2)]) glm_rpr1[,c(3)] <- pro_log(glm_rpr1[,c(3)]) rownames(glm_rpr1) <- NULL glm_rpr1 colnames(glm_rpr1) <- c("crpr1","crpr1_i","crpr1_s","rg_b") res_rpr1 <- merge(res_rpr1[,c(4,5)],glm_rpr1,by="rg_b",all.x=T) nc_rpr1 <- table(hh$rg_b[f], hh$rpr1[f]) nc_rpr1 <- data.frame(my_rtable(nc_rpr1)) nc_rpr1$rg_b <- rownames(nc_rpr1) res_rpr1 <- merge(res_rpr1,nc_rpr1[,c(2,4,5)],by="rg_b",all.x=T) colnames(res_rpr1) <- c("rg_b","nobs_rpr1","crpr1","crpr1_i","crpr1_s","nc_rpr1","nc_nobs_rpr1") res_rpr1 <- rbind(res_rpr1[res_rpr1$rg_b!="Ensemble",], res_rpr1[res_rpr1$rg_b=="Ensemble",]) res_rpr1$crpr1[nrow(res_rpr1)] <- round(sum(res_rpr1$crpr1*res_rpr1$nobs_rpr1,na.rm=T)/res_rpr1$nobs_rpr1[nrow(res_rpr1)],2) res_rpr1 #### g1 #### f <- (is.na(hh$annee1)==F & (substr(hh$parti,1,1) %in% 4)==F) tt1 <- tapply(hh$poids[f],list(hh$rg_b[f], hh$g1[f]),sum,na.rm=T) tt1 res_g1 <- data.frame(my_rtable(tt1)) res_g1$rg_b <- row.names(res_g1) res_g1 colnames(res_g1)[4] <- "nobs_g1" mm <- glm(g1~ -1+ rg_b + rg_b : risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_g1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_g1$rg_b <- gsub("rg_b","",row.names(glm_g1)) glm_g1[,c(1)] <- pro_log(glm_g1[,c(1)]) glm_g1[,c(2)] <- pro_log(glm_g1[,c(2)]) glm_g1[,c(3)] <- pro_log(glm_g1[,c(3)]) rownames(glm_g1) <- NULL glm_g1 colnames(glm_g1) <- c("cg1","cg1_i","cg1_s","rg_b") res_g1 <- merge(res_g1[,c(4,5)],glm_g1,by="rg_b",all.x=T) nc_g1 <- table(hh$rg_b[f], hh$g1[f]) nc_g1 <- data.frame(my_rtable(nc_g1)) nc_g1$rg_b <- rownames(nc_g1) res_g1 <- merge(res_g1,nc_g1[,c(2,4,5)],by="rg_b",all.x=T) colnames(res_g1) <- c("rg_b","nobs_g1","cg1","cg1_i","cg1_s","nc_g1","nc_nobs_g1") res_g1 <- rbind(res_g1[res_g1$rg_b!="Ensemble",], res_g1[res_g1$rg_b=="Ensemble",]) res_g1$cg1[nrow(res_g1)] <- round(sum(res_g1$cg1*res_g1$nobs_g1,na.rm=T)/res_g1$nobs_g1[nrow(res_g1)],2) res_g1 #### ps1 #### f <- (is.na(hh$annee1)==F & (substr(hh$parti,1,1) %in% 4)==F) tt1 <- tapply(hh$poids[f],list(hh$rg_b[f], hh$ps1[f]),sum,na.rm=T) tt1 res_ps1 <- data.frame(my_rtable(tt1)) res_ps1$rg_b <- row.names(res_ps1) res_ps1 colnames(res_ps1)[4] <- "nobs_ps1" mm <- glm(ps1~ -1+ rg_b + rg_b : risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_ps1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_ps1$rg_b <- gsub("rg_b","",row.names(glm_ps1)) glm_ps1[,c(1)] <- pro_log(glm_ps1[,c(1)]) glm_ps1[,c(2)] <- pro_log(glm_ps1[,c(2)]) glm_ps1[,c(3)] <- pro_log(glm_ps1[,c(3)]) rownames(glm_ps1) <- NULL glm_ps1 colnames(glm_ps1) <- c("cps1","cps1_i","cps1_s","rg_b") res_ps1 <- merge(res_ps1[,c(4,5)],glm_ps1,by="rg_b",all.x=T) nc_ps1 <- table(hh$rg_b[f], hh$ps1[f]) nc_ps1 <- data.frame(my_rtable(nc_ps1)) nc_ps1$rg_b <- rownames(nc_ps1) res_ps1 <- merge(res_ps1,nc_ps1[,c(2,4,5)],by="rg_b",all.x=T) colnames(res_ps1) <- c("rg_b","nobs_ps1","cps1","cps1_i","cps1_s","nc_ps1","nc_nobs_ps1") res_ps1 <- rbind(res_ps1[res_ps1$rg_b!="Ensemble",], res_ps1[res_ps1$rg_b=="Ensemble",]) res_ps1$cps1[nrow(res_ps1)] <- round(sum(res_ps1$cps1*res_ps1$nobs_ps1,na.rm=T)/res_ps1$nobs_ps1[nrow(res_ps1)],2) res_ps1 #### Compilation #### nobs <- tapply(hh$poids,list(hh$rg_b, hh$fn1),sum,na.rm=T) nobs <- data.frame(my_rtable(nobs)) nobs$rg_b <- rownames(nobs) colnames(nobs)[4] <- "nobs_ens" tab_rg_b <- merge(res_xd1,res_fn1,by="rg_b") tab_rg_b <- merge(tab_rg_b,res_dr1,by="rg_b") tab_rg_b <- merge(tab_rg_b,res_rpr1,by="rg_b") tab_rg_b <- merge(tab_rg_b,res_g1,by="rg_b") tab_rg_b <- merge(tab_rg_b,res_ps1,by="rg_b") tab_rg_b <- merge(tab_rg_b,nobs[,c(4,5)],by="rg_b") tab_rg_b tab_rg_b <- rbind(tab_rg_b[tab_rg_b$rg_b!="Ensemble",], tab_rg_b[tab_rg_b$rg_b=="Ensemble",]) HTML("Tableau 4c (détails). Évolution vers l'extrême droite, le RPR, et le PS en fonction de rg_b",outhtml,align="left") HTML(tab_rg_b,outhtml,align="left",digits = 4,nsmall=2) tab_rg_b_simp <- tab_rg_b[,c("rg_b","cxd1","cfn1", "cdr1","crpr1", "cg1","cps1", "nobs_ens")] HTML("Tableau 4c. Évolution vers l'extrême droite, le RPR, et le PS en fonction de rg_b",outhtml,align="left") HTML(tab_rg_b_simp,outhtml,align="left",digits = 4,nsmall=2) tab_rg_b_simp ## Tableau 4d. Par suppléant #### hh$suppleant_b <- ifelse(hh$suppleant_pres==1,hh$suppleant,NA) hh$suppleant_b <- factor(hh$suppleant_b) ### Estimations suppleant_b #### #### fn1 #### f <- (is.na(hh$annee1)==F & hh$xd %in% 0) tt1 <- tapply(hh$poids[f],list(hh$suppleant_b[f], hh$fn1[f]),sum,na.rm=T) tt1 res_fn1 <- data.frame(my_rtable(tt1)) res_fn1$suppleant_b <- row.names(res_fn1) res_fn1 colnames(res_fn1)[4] <- "nobs_fn1" mm <- glm(fn1~ -1+ suppleant_b + suppleant_b : risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_fn1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_fn1$suppleant_b <- gsub("suppleant_b","",row.names(glm_fn1)) glm_fn1[,c(1)] <- pro_log(glm_fn1[,c(1)]) glm_fn1[,c(2)] <- pro_log(glm_fn1[,c(2)]) glm_fn1[,c(3)] <- pro_log(glm_fn1[,c(3)]) rownames(glm_fn1) <- NULL glm_fn1 colnames(glm_fn1) <- c("cfn1","cfn1_i","cfn1_s","suppleant_b") res_fn1 <- merge(res_fn1[,c(4,5)],glm_fn1,by="suppleant_b",all.x=T) nc_fn1 <- table(hh$suppleant_b[f], hh$fn1[f]) nc_fn1 <- data.frame(my_rtable(nc_fn1)) nc_fn1$suppleant_b <- rownames(nc_fn1) res_fn1 <- merge(res_fn1,nc_fn1[,c(2,4,5)],by="suppleant_b",all.x=T) colnames(res_fn1) <- c("suppleant_b","nobs_fn1","cfn1","cfn1_i","cfn1_s","nc_fn1","nc_nobs_fn1") res_fn1 <- rbind(res_fn1[res_fn1$suppleant_b!="Ensemble",], res_fn1[res_fn1$suppleant_b=="Ensemble",]) res_fn1$cfn1[nrow(res_fn1)] <- round(sum(res_fn1$cfn1*res_fn1$nobs_fn1,na.rm=T)/res_fn1$nobs_fn1[nrow(res_fn1)],2) res_fn1 #### xd1 #### f <- (is.na(hh$annee1)==F & hh$xd %in% 0) tt1 <- tapply(hh$poids[f],list(hh$suppleant_b[f], hh$xd1[f]),sum,na.rm=T) tt1 res_xd1 <- data.frame(my_rtable(tt1)) res_xd1$suppleant_b <- row.names(res_xd1) res_xd1 colnames(res_xd1)[4] <- "nobs_xd1" mm <- glm(xd1~ -1+ suppleant_b + suppleant_b : risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_xd1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_xd1$suppleant_b <- gsub("suppleant_b","",row.names(glm_xd1)) glm_xd1[,c(1)] <- pro_log(glm_xd1[,c(1)]) glm_xd1[,c(2)] <- pro_log(glm_xd1[,c(2)]) glm_xd1[,c(3)] <- pro_log(glm_xd1[,c(3)]) rownames(glm_xd1) <- NULL glm_xd1 colnames(glm_xd1) <- c("cxd1","cxd1_i","cxd1_s","suppleant_b") res_xd1 <- merge(res_xd1[,c(4,5)],glm_xd1,by="suppleant_b",all.x=T) nc_xd1 <- table(hh$suppleant_b[f], hh$xd1[f]) nc_xd1 <- data.frame(my_rtable(nc_xd1)) nc_xd1$suppleant_b <- rownames(nc_xd1) res_xd1 <- merge(res_xd1,nc_xd1[,c(2,4,5)],by="suppleant_b",all.x=T) colnames(res_xd1) <- c("suppleant_b","nobs_xd1","cxd1","cxd1_i","cxd1_s","nc_xd1","nc_nobs_xd1") res_xd1 <- rbind(res_xd1[res_xd1$suppleant_b!="Ensemble",], res_xd1[res_xd1$suppleant_b=="Ensemble",]) res_xd1$cxd1[nrow(res_xd1)] <- round(sum(res_xd1$cxd1*res_xd1$nobs_xd1,na.rm=T)/res_xd1$nobs_xd1[nrow(res_xd1)],2) res_xd1 #### dr1 #### f <- (is.na(hh$annee1)==F & (substr(hh$parti,1,1) %in% 2)==F) tt1 <- tapply(hh$poids[f],list(hh$suppleant_b[f], hh$dr1[f]),sum,na.rm=T) tt1 res_dr1 <- data.frame(my_rtable(tt1)) res_dr1$suppleant_b <- row.names(res_dr1) res_dr1 colnames(res_dr1)[4] <- "nobs_dr1" mm <- glm(dr1~ -1+ suppleant_b + suppleant_b : risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_dr1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_dr1$suppleant_b <- gsub("suppleant_b","",row.names(glm_dr1)) glm_dr1[,c(1)] <- pro_log(glm_dr1[,c(1)]) glm_dr1[,c(2)] <- pro_log(glm_dr1[,c(2)]) glm_dr1[,c(3)] <- pro_log(glm_dr1[,c(3)]) rownames(glm_dr1) <- NULL glm_dr1 colnames(glm_dr1) <- c("cdr1","cdr1_i","cdr1_s","suppleant_b") res_dr1 <- merge(res_dr1[,c(4,5)],glm_dr1,by="suppleant_b",all.x=T) nc_dr1 <- table(hh$suppleant_b[f], hh$dr1[f]) nc_dr1 <- data.frame(my_rtable(nc_dr1)) nc_dr1$suppleant_b <- rownames(nc_dr1) res_dr1 <- merge(res_dr1,nc_dr1[,c(2,4,5)],by="suppleant_b",all.x=T) colnames(res_dr1) <- c("suppleant_b","nobs_dr1","cdr1","cdr1_i","cdr1_s","nc_dr1","nc_nobs_dr1") res_dr1 <- rbind(res_dr1[res_dr1$suppleant_b!="Ensemble",], res_dr1[res_dr1$suppleant_b=="Ensemble",]) res_dr1$cdr1[nrow(res_dr1)] <- round(sum(res_dr1$cdr1*res_dr1$nobs_dr1,na.rm=T)/res_dr1$nobs_dr1[nrow(res_dr1)],2) res_dr1 #### rpr1 #### f <- (is.na(hh$annee1)==F & (substr(hh$parti,1,1) %in% 2)==F) tt1 <- tapply(hh$poids[f],list(hh$suppleant_b[f], hh$rpr1[f]),sum,na.rm=T) tt1 res_rpr1 <- data.frame(my_rtable(tt1)) res_rpr1$suppleant_b <- row.names(res_rpr1) res_rpr1 colnames(res_rpr1)[4] <- "nobs_rpr1" mm <- glm(rpr1~ -1+ suppleant_b + suppleant_b : risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_rpr1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_rpr1$suppleant_b <- gsub("suppleant_b","",row.names(glm_rpr1)) glm_rpr1[,c(1)] <- pro_log(glm_rpr1[,c(1)]) glm_rpr1[,c(2)] <- pro_log(glm_rpr1[,c(2)]) glm_rpr1[,c(3)] <- pro_log(glm_rpr1[,c(3)]) rownames(glm_rpr1) <- NULL glm_rpr1 colnames(glm_rpr1) <- c("crpr1","crpr1_i","crpr1_s","suppleant_b") res_rpr1 <- merge(res_rpr1[,c(4,5)],glm_rpr1,by="suppleant_b",all.x=T) nc_rpr1 <- table(hh$suppleant_b[f], hh$rpr1[f]) nc_rpr1 <- data.frame(my_rtable(nc_rpr1)) nc_rpr1$suppleant_b <- rownames(nc_rpr1) res_rpr1 <- merge(res_rpr1,nc_rpr1[,c(2,4,5)],by="suppleant_b",all.x=T) colnames(res_rpr1) <- c("suppleant_b","nobs_rpr1","crpr1","crpr1_i","crpr1_s","nc_rpr1","nc_nobs_rpr1") res_rpr1 <- rbind(res_rpr1[res_rpr1$suppleant_b!="Ensemble",], res_rpr1[res_rpr1$suppleant_b=="Ensemble",]) res_rpr1$crpr1[nrow(res_rpr1)] <- round(sum(res_rpr1$crpr1*res_rpr1$nobs_rpr1,na.rm=T)/res_rpr1$nobs_rpr1[nrow(res_rpr1)],2) res_rpr1 #### g1 #### f <- (is.na(hh$annee1)==F & (substr(hh$parti,1,1) %in% 4)==F) tt1 <- tapply(hh$poids[f],list(hh$suppleant_b[f], hh$g1[f]),sum,na.rm=T) tt1 res_g1 <- data.frame(my_rtable(tt1)) res_g1$suppleant_b <- row.names(res_g1) res_g1 colnames(res_g1)[4] <- "nobs_g1" mm <- glm(g1~ -1+ suppleant_b + suppleant_b : risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_g1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_g1$suppleant_b <- gsub("suppleant_b","",row.names(glm_g1)) glm_g1[,c(1)] <- pro_log(glm_g1[,c(1)]) glm_g1[,c(2)] <- pro_log(glm_g1[,c(2)]) glm_g1[,c(3)] <- pro_log(glm_g1[,c(3)]) rownames(glm_g1) <- NULL glm_g1 colnames(glm_g1) <- c("cg1","cg1_i","cg1_s","suppleant_b") res_g1 <- merge(res_g1[,c(4,5)],glm_g1,by="suppleant_b",all.x=T) nc_g1 <- table(hh$suppleant_b[f], hh$g1[f]) nc_g1 <- data.frame(my_rtable(nc_g1)) nc_g1$suppleant_b <- rownames(nc_g1) res_g1 <- merge(res_g1,nc_g1[,c(2,4,5)],by="suppleant_b",all.x=T) colnames(res_g1) <- c("suppleant_b","nobs_g1","cg1","cg1_i","cg1_s","nc_g1","nc_nobs_g1") res_g1 <- rbind(res_g1[res_g1$suppleant_b!="Ensemble",], res_g1[res_g1$suppleant_b=="Ensemble",]) res_g1$cg1[nrow(res_g1)] <- round(sum(res_g1$cg1*res_g1$nobs_g1,na.rm=T)/res_g1$nobs_g1[nrow(res_g1)],2) res_g1 #### ps1 #### f <- (is.na(hh$annee1)==F & (substr(hh$parti,1,1) %in% 4)==F) tt1 <- tapply(hh$poids[f],list(hh$suppleant_b[f], hh$ps1[f]),sum,na.rm=T) tt1 res_ps1 <- data.frame(my_rtable(tt1)) res_ps1$suppleant_b <- row.names(res_ps1) res_ps1 colnames(res_ps1)[4] <- "nobs_ps1" mm <- glm(ps1~ -1+ suppleant_b + suppleant_b : risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_ps1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_ps1$suppleant_b <- gsub("suppleant_b","",row.names(glm_ps1)) glm_ps1[,c(1)] <- pro_log(glm_ps1[,c(1)]) glm_ps1[,c(2)] <- pro_log(glm_ps1[,c(2)]) glm_ps1[,c(3)] <- pro_log(glm_ps1[,c(3)]) rownames(glm_ps1) <- NULL glm_ps1 colnames(glm_ps1) <- c("cps1","cps1_i","cps1_s","suppleant_b") res_ps1 <- merge(res_ps1[,c(4,5)],glm_ps1,by="suppleant_b",all.x=T) nc_ps1 <- table(hh$suppleant_b[f], hh$ps1[f]) nc_ps1 <- data.frame(my_rtable(nc_ps1)) nc_ps1$suppleant_b <- rownames(nc_ps1) res_ps1 <- merge(res_ps1,nc_ps1[,c(2,4,5)],by="suppleant_b",all.x=T) colnames(res_ps1) <- c("suppleant_b","nobs_ps1","cps1","cps1_i","cps1_s","nc_ps1","nc_nobs_ps1") res_ps1 <- rbind(res_ps1[res_ps1$suppleant_b!="Ensemble",], res_ps1[res_ps1$suppleant_b=="Ensemble",]) res_ps1$cps1[nrow(res_ps1)] <- round(sum(res_ps1$cps1*res_ps1$nobs_ps1,na.rm=T)/res_ps1$nobs_ps1[nrow(res_ps1)],2) res_ps1 #### Compilation #### nobs <- tapply(hh$poids,list(hh$suppleant_b, hh$fn1),sum,na.rm=T) nobs <- data.frame(my_rtable(nobs)) nobs$suppleant_b <- rownames(nobs) colnames(nobs)[4] <- "nobs_ens" tab_suppleant_b <- merge(res_xd1,res_fn1,by="suppleant_b") tab_suppleant_b <- merge(tab_suppleant_b,res_dr1,by="suppleant_b") tab_suppleant_b <- merge(tab_suppleant_b,res_rpr1,by="suppleant_b") tab_suppleant_b <- merge(tab_suppleant_b,res_g1,by="suppleant_b") tab_suppleant_b <- merge(tab_suppleant_b,res_ps1,by="suppleant_b") tab_suppleant_b <- merge(tab_suppleant_b,nobs[,c(4,5)],by="suppleant_b") tab_suppleant_b tab_suppleant_b <- rbind(tab_suppleant_b[tab_suppleant_b$suppleant_b!="Ensemble",], tab_suppleant_b[tab_suppleant_b$suppleant_b=="Ensemble",]) HTML("Tableau 4d (détails). Évolution vers l'extrême droite, le RPR, et le PS en fonction de suppleant_b",outhtml,align="left") HTML(tab_suppleant_b,outhtml,align="left",digits = 4,nsmall=2) tab_suppleant_b_simp <- tab_suppleant_b[,c("suppleant_b","cxd1","cfn1", "cdr1","crpr1", "cg1","cps1", "nobs_ens")] HTML("Tableau 4d. Évolution vers l'extrême droite, le RPR, et le PS en fonction de suppleant_b",outhtml,align="left") HTML(tab_suppleant_b_simp,outhtml,align="left",digits = 4,nsmall=2) tab_suppleant_b_simp # Tableau 5. Rendement electoral #### f1<- (is.na(hh$annee1)==F & (hh$score >0) & (hh$score1>0) & (hh$score<1) & (hh$score1<1) & is.na(hh$score1)==F & hh$n_d2dn==0 & hh$xd==0 ) f2<- (is.na(hh$annee1)==F & (hh$score >0) & (hh$score1>0) & (hh$score<1) & (hh$score1<1) & is.na(hh$score1)==F # & hh$n_d2dn==0 & hh$xd==0 ) mm1 <- feols(I(logodds(score1)-logodds(score))~ + I(dif_mouv1*(1-xd1)) + I(dif_mouv1*xd1) + annee_s1 + election_s + election_s1 ,data=hh[f1,] ,weights=hh$poids[f1] ,cluster=~id_personne ) mm2 <- feols(I(logodds(score1)-logodds(score))~ + I(dif_mouv1*(1-xd1)) + I(dif_mouv1*fn1) + I(dif_mouv1*(xd1-fn1)) + annee_s1 + election_s + election_s1 ,data=hh[f1,] ,weights=hh$poids[f1] ,cluster=~id_personne ) mm3 <- feols(I(logodds(score1)-logodds(score))~ + I(dif_mouv1*(1-xd1)) + I(dif_mouv1*xd1) + annee_s1 + election_s + election_s1 + dif_mouv1:risque_erreur + dif_mouv1:xd1:risque_erreur + election_s:risque_erreur + election_s1:risque_erreur + annee_s1:risque_erreur ,data=hh[f2,] ,weights=hh$poids[f2] # ,cluster=~id_personne ) mm4 <- feols(I(logodds(score1)-logodds(score))~ + I(dif_mouv1*(1-xd1)) + I(dif_mouv1*fn1) + I(dif_mouv1*(xd1-fn1)) + annee_s1 + election_s + election_s1 + dif_mouv1:risque_erreur + dif_mouv1:xd1:risque_erreur + dif_mouv1:fn1:risque_erreur + election_s:risque_erreur + election_s1:risque_erreur + annee_s1:risque_erreur ,data=hh[f2,] ,weights=hh$poids[f2] # ,cluster=~id_personne ) screenreg(list(mm1,mm2,mm3,mm4)) HTML("Tableau 5. Rendement électoral",outhtml,align="left") HTML(htmlreg(list(mm1,mm2,mm3,mm4)),outhtml,align="left",digits = 4,nsmall=2) # Comparaison des scores avant et après avant <- feols(score~ + I(dif_mouv1*(1-xd1)) + I(dif_mouv1*fn1) + I(dif_mouv1*(xd1-fn1)) + annee_s1 + election_s + election_s1 ,data=hh[f1,] ,weights=hh$poids[f1] ,cluster=~id_personne ) apres <- feols(score1~ + I(dif_mouv1*(1-xd1)) + I(dif_mouv1*fn1) + I(dif_mouv1*(xd1-fn1)) + annee_s1 + election_s + election_s1 ,data=hh[f1,] ,weights=hh$poids[f1] ,cluster=~id_personne ) screenreg(list(avant,apres),digits=3,custom.model.names = c("avant","apres")) HTML("Complément. Comparaison du score avant / après",outhtml,align="left") HTML(htmlreg(list(avant,apres),digits=3,custom.model.names = c("avant","apres")),outhtml,align="left",digits = 4,nsmall=2) mean(hh$score[f1]) mean(hh$score1[f1]) tapply(hh$poids[f1],hh$dif_mouv1[f1],function(x) wtd.summary(x)) tapply(hh$poids[f1],hh$dif_mouv1[f1]*hh$fn1[f1],function(x) wtd.summary(x)) tapply(hh$poids[f1],hh$dif_mouv1[f1]*(hh$xd1[f1]-hh$fn1[f1]),function(x) wtd.summary(x)) # tapply(hh$score[f1],hh$dif_mouv1[f1],function(x) wtd.summary(x)) # tapply(hh$score[f1],hh$dif_mouv1[f1]*hh$fn1[f1],function(x) wtd.summary(x)) # tapply(hh$score[f1],hh$dif_mouv1[f1]*(hh$xd1[f1]-hh$fn1[f1]),function(x) wtd.summary(x)) # # tapply(hh$score1[f1],hh$dif_mouv1[f1],function(x) wtd.summary(x)) # tapply(hh$score1[f1],hh$dif_mouv1[f1]*hh$fn1[f1],function(x) wtd.summary(x)) # tapply(hh$score1[f1],hh$dif_mouv1[f1]*(hh$xd1[f1]-hh$fn1[f1]),function(x) wtd.summary(x)) # Tableau A3. Importance de corriger les erreurs #### ## xd1 #### hh$xd_b <- factor(hh$xd) f <- (is.na(hh$annee1)==F ) tt0 <- table(hh$xd_b,hh$xd1) tab_xd1_nc <- data.frame(my_rtable(tt0)) tab_xd1_nc$xd_b <- row.names(tab_xd1_nc) tab_xd1_nc tt1 <- tapply(hh$poids[f],list(hh$xd_b[f], hh$xd1[f]),sum,na.rm=T) tt1 tab_xd1_p <- data.frame(my_rtable(tt1)) tab_xd1_p$xd_b <- row.names(tab_xd1_p) tab_xd1_p f <- (is.na(hh$annee1)==F) mm <- glm(xd1~ -1+ xd_b + xd_b:risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_xd1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_xd1$mouvance <- gsub("mouvance","",row.names(glm_xd1)) glm_xd1[,c(1)] <- pro_log(glm_xd1[,c(1)]) glm_xd1[,c(2)] <- pro_log(glm_xd1[,c(2)]) glm_xd1[,c(3)] <- pro_log(glm_xd1[,c(3)]) rownames(glm_xd1) <- NULL glm_xd1 colnames(glm_xd1) <- c("cxd1","cxd1_i","cxd1_s","xd_b") glm_xd1$xd_b <- gsub("xd_b","",glm_xd1$xd_b) res_xd1 <- merge(tab_xd1_nc[,c(2,4:5)],glm_xd1[,c(1,4)],by="xd_b",all.x=T) res_xd1 <- merge(res_xd1,tab_xd1_p[,c(4,5)],by="xd_b",all.x=T) colnames(res_xd1) <- c("de_la_famille","tx_nc","nbobs_nc","tx_c","nbobs_c") res_xd1$destinee <- "xd1" res_xd1$tx_c[3] <- (res_xd1$tx_c[1]*res_xd1$nbobs_c[1]+res_xd1$tx_c[2]*res_xd1$nbobs_c[2])/res_xd1$nbobs_c[3] ## fn1 #### hh$xd_b <- factor(hh$xd) f <- (is.na(hh$annee1)==F ) tt0 <- table(hh$xd_b,hh$fn1) tab_fn1_nc <- data.frame(my_rtable(tt0)) tab_fn1_nc$xd_b <- row.names(tab_fn1_nc) tab_fn1_nc tt1 <- tapply(hh$poids[f],list(hh$xd_b[f], hh$fn1[f]),sum,na.rm=T) tt1 tab_fn1_p <- data.frame(my_rtable(tt1)) tab_fn1_p$xd_b <- row.names(tab_fn1_p) tab_fn1_p f <- (is.na(hh$annee1)==F) mm <- glm(fn1~ -1+ xd_b + xd_b:risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_fn1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_fn1$mouvance <- gsub("mouvance","",row.names(glm_fn1)) glm_fn1[,c(1)] <- pro_log(glm_fn1[,c(1)]) glm_fn1[,c(2)] <- pro_log(glm_fn1[,c(2)]) glm_fn1[,c(3)] <- pro_log(glm_fn1[,c(3)]) rownames(glm_fn1) <- NULL glm_fn1 colnames(glm_fn1) <- c("cfn1","cfn1_i","cfn1_s","xd_b") glm_fn1$xd_b <- gsub("xd_b","",glm_fn1$xd_b) res_fn1 <- merge(tab_fn1_nc[,c(2,4:5)],glm_fn1[,c(1,4)],by="xd_b",all.x=T) res_fn1 <- merge(res_fn1,tab_fn1_p[,c(4,5)],by="xd_b",all.x=T) colnames(res_fn1) <- c("de_la_famille","tx_nc","nbobs_nc","tx_c","nbobs_c") res_fn1$destinee <- "fn1" res_fn1$tx_c[3] <- (res_fn1$tx_c[1]*res_fn1$nbobs_c[1]+res_fn1$tx_c[2]*res_fn1$nbobs_c[2])/res_fn1$nbobs_c[3] ## dr1 #### hh$dr_b <- factor(hh$dr) f <- (is.na(hh$annee1)==F ) tt0 <- table(hh$dr_b,hh$dr1) tab_dr1_nc <- data.frame(my_rtable(tt0)) tab_dr1_nc$dr_b <- row.names(tab_dr1_nc) tab_dr1_nc tt1 <- tapply(hh$poids[f],list(hh$dr_b[f], hh$dr1[f]),sum,na.rm=T) tt1 tab_dr1_p <- data.frame(my_rtable(tt1)) tab_dr1_p$dr_b <- row.names(tab_dr1_p) tab_dr1_p f <- (is.na(hh$annee1)==F) mm <- glm(dr1~ -1+ dr_b + dr_b:risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_dr1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_dr1$mouvance <- gsub("mouvance","",row.names(glm_dr1)) glm_dr1[,c(1)] <- pro_log(glm_dr1[,c(1)]) glm_dr1[,c(2)] <- pro_log(glm_dr1[,c(2)]) glm_dr1[,c(3)] <- pro_log(glm_dr1[,c(3)]) rownames(glm_dr1) <- NULL glm_dr1 colnames(glm_dr1) <- c("cdr1","cdr1_i","cdr1_s","dr_b") glm_dr1$dr_b <- gsub("dr_b","",glm_dr1$dr_b) res_dr1 <- merge(tab_dr1_nc[,c(2,4:5)],glm_dr1[,c(1,4)],by="dr_b",all.x=T) res_dr1 <- merge(res_dr1,tab_dr1_p[,c(4,5)],by="dr_b",all.x=T) colnames(res_dr1) <- c("de_la_famille","tx_nc","nbobs_nc","tx_c","nbobs_c") res_dr1$destinee <- "dr1" res_dr1$tx_c[3] <- (res_dr1$tx_c[1]*res_dr1$nbobs_c[1]+res_dr1$tx_c[2]*res_dr1$nbobs_c[2])/res_dr1$nbobs_c[3] ## rpr1 #### hh$dr_b <- factor(hh$dr) f <- (is.na(hh$annee1)==F ) tt0 <- table(hh$dr_b,hh$rpr1) tab_rpr1_nc <- data.frame(my_rtable(tt0)) tab_rpr1_nc$dr_b <- row.names(tab_rpr1_nc) tab_rpr1_nc tt1 <- tapply(hh$poids[f],list(hh$dr_b[f], hh$rpr1[f]),sum,na.rm=T) tt1 tab_rpr1_p <- data.frame(my_rtable(tt1)) tab_rpr1_p$dr_b <- row.names(tab_rpr1_p) tab_rpr1_p f <- (is.na(hh$annee1)==F) mm <- glm(rpr1~ -1+ dr_b + dr_b:risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_rpr1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_rpr1$mouvance <- gsub("mouvance","",row.names(glm_rpr1)) glm_rpr1[,c(1)] <- pro_log(glm_rpr1[,c(1)]) glm_rpr1[,c(2)] <- pro_log(glm_rpr1[,c(2)]) glm_rpr1[,c(3)] <- pro_log(glm_rpr1[,c(3)]) rownames(glm_rpr1) <- NULL glm_rpr1 colnames(glm_rpr1) <- c("crpr1","crpr1_i","crpr1_s","dr_b") glm_rpr1$dr_b <- gsub("dr_b","",glm_rpr1$dr_b) res_rpr1 <- merge(tab_rpr1_nc[,c(2,4:5)],glm_rpr1[,c(1,4)],by="dr_b",all.x=T) res_rpr1 <- merge(res_rpr1,tab_rpr1_p[,c(4,5)],by="dr_b",all.x=T) colnames(res_rpr1) <- c("de_la_famille","tx_nc","nbobs_nc","tx_c","nbobs_c") res_rpr1$destinee <- "rpr1" res_rpr1$tx_c[3] <- (res_rpr1$tx_c[1]*res_rpr1$nbobs_c[1]+res_rpr1$tx_c[2]*res_rpr1$nbobs_c[2])/res_rpr1$nbobs_c[3] ## g1 #### hh$g_b <- factor(hh$g) f <- (is.na(hh$annee1)==F ) tt0 <- table(hh$g_b,hh$g1) tab_g1_nc <- data.frame(my_rtable(tt0)) tab_g1_nc$g_b <- row.names(tab_g1_nc) tab_g1_nc tt1 <- tapply(hh$poids[f],list(hh$g_b[f], hh$g1[f]),sum,na.rm=T) tt1 tab_g1_p <- data.frame(my_rtable(tt1)) tab_g1_p$g_b <- row.names(tab_g1_p) tab_g1_p f <- (is.na(hh$annee1)==F) mm <- glm(g1~ -1+ g_b + g_b:risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_g1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_g1$mouvance <- gsub("mouvance","",row.names(glm_g1)) glm_g1[,c(1)] <- pro_log(glm_g1[,c(1)]) glm_g1[,c(2)] <- pro_log(glm_g1[,c(2)]) glm_g1[,c(3)] <- pro_log(glm_g1[,c(3)]) rownames(glm_g1) <- NULL glm_g1 colnames(glm_g1) <- c("cg1","cg1_i","cg1_s","g_b") glm_g1$g_b <- gsub("g_b","",glm_g1$g_b) res_g1 <- merge(tab_g1_nc[,c(2,4:5)],glm_g1[,c(1,4)],by="g_b",all.x=T) res_g1 <- merge(res_g1,tab_g1_p[,c(4,5)],by="g_b",all.x=T) colnames(res_g1) <- c("de_la_famille","tx_nc","nbobs_nc","tx_c","nbobs_c") res_g1$destinee <- "g1" res_g1$tx_c[3] <- (res_g1$tx_c[1]*res_g1$nbobs_c[1]+res_g1$tx_c[2]*res_g1$nbobs_c[2])/res_g1$nbobs_c[3] ## ps1 #### hh$g_b <- factor(hh$g) f <- (is.na(hh$annee1)==F ) tt0 <- table(hh$g_b,hh$ps1) tab_ps1_nc <- data.frame(my_rtable(tt0)) tab_ps1_nc$g_b <- row.names(tab_ps1_nc) tab_ps1_nc tt1 <- tapply(hh$poids[f],list(hh$g_b[f], hh$ps1[f]),sum,na.rm=T) tt1 tab_ps1_p <- data.frame(my_rtable(tt1)) tab_ps1_p$g_b <- row.names(tab_ps1_p) tab_ps1_p f <- (is.na(hh$annee1)==F) mm <- glm(ps1~ -1+ g_b + g_b:risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_ps1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_ps1$mouvance <- gsub("mouvance","",row.names(glm_ps1)) glm_ps1[,c(1)] <- pro_log(glm_ps1[,c(1)]) glm_ps1[,c(2)] <- pro_log(glm_ps1[,c(2)]) glm_ps1[,c(3)] <- pro_log(glm_ps1[,c(3)]) rownames(glm_ps1) <- NULL glm_ps1 colnames(glm_ps1) <- c("cps1","cps1_i","cps1_s","g_b") glm_ps1$g_b <- gsub("g_b","",glm_ps1$g_b) res_ps1 <- merge(tab_ps1_nc[,c(2,4:5)],glm_ps1[,c(1,4)],by="g_b",all.x=T) res_ps1 <- merge(res_ps1,tab_ps1_p[,c(4,5)],by="g_b",all.x=T) colnames(res_ps1) <- c("de_la_famille","tx_nc","nbobs_nc","tx_c","nbobs_c") res_ps1$destinee <- "ps1" res_ps1$tx_c[3] <- (res_ps1$tx_c[1]*res_ps1$nbobs_c[1]+res_ps1$tx_c[2]*res_ps1$nbobs_c[2])/res_ps1$nbobs_c[3] ## Compilation #### tab_cor_homonymie <- rbind(res_xd1,res_fn1,res_dr1,res_rpr1,res_g1,res_ps1) HTML("Tableau A3. Transition avec ou sans correction de l'homonymie",outhtml,align="left") HTML(tab_cor_homonymie,outhtml,align="left",digits = 4,nsmall=2) # Tableau A4. Par type d'élection #### ## Tableau A4a. Par election d'origine #### f <- (is.na(hh$annee1)==F & hh$xd %in% 0) ### Estimations election_s #### #### fn1 #### f <- (is.na(hh$annee1)==F & hh$xd %in% 0) tt1 <- tapply(hh$poids[f],list(hh$election_s[f], hh$fn1[f]),sum,na.rm=T) tt1 res_fn1 <- data.frame(my_rtable(tt1)) res_fn1$election_s <- row.names(res_fn1) res_fn1 colnames(res_fn1)[4] <- "nobs_fn1" mm <- glm(fn1~ -1+ election_s + election_s : risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_fn1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_fn1$election_s <- gsub("election_s","",row.names(glm_fn1)) glm_fn1[,c(1)] <- pro_log(glm_fn1[,c(1)]) glm_fn1[,c(2)] <- pro_log(glm_fn1[,c(2)]) glm_fn1[,c(3)] <- pro_log(glm_fn1[,c(3)]) rownames(glm_fn1) <- NULL glm_fn1 colnames(glm_fn1) <- c("cfn1","cfn1_i","cfn1_s","election_s") res_fn1 <- merge(res_fn1[,c(4,5)],glm_fn1,by="election_s",all.x=T) nc_fn1 <- table(hh$election_s[f], hh$fn1[f]) nc_fn1 <- data.frame(my_rtable(nc_fn1)) nc_fn1$election_s <- rownames(nc_fn1) res_fn1 <- merge(res_fn1,nc_fn1[,c(2,4,5)],by="election_s",all.x=T) colnames(res_fn1) <- c("election_s","nobs_fn1","cfn1","cfn1_i","cfn1_s","nc_fn1","nc_nobs_fn1") res_fn1 <- rbind(res_fn1[res_fn1$election_s!="Ensemble",], res_fn1[res_fn1$election_s=="Ensemble",]) res_fn1$cfn1[nrow(res_fn1)] <- round(sum(res_fn1$cfn1*res_fn1$nobs_fn1,na.rm=T)/res_fn1$nobs_fn1[nrow(res_fn1)],2) res_fn1 #### xd1 #### f <- (is.na(hh$annee1)==F & hh$xd %in% 0) tt1 <- tapply(hh$poids[f],list(hh$election_s[f], hh$xd1[f]),sum,na.rm=T) tt1 res_xd1 <- data.frame(my_rtable(tt1)) res_xd1$election_s <- row.names(res_xd1) res_xd1 colnames(res_xd1)[4] <- "nobs_xd1" mm <- glm(xd1~ -1+ election_s + election_s : risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_xd1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_xd1$election_s <- gsub("election_s","",row.names(glm_xd1)) glm_xd1[,c(1)] <- pro_log(glm_xd1[,c(1)]) glm_xd1[,c(2)] <- pro_log(glm_xd1[,c(2)]) glm_xd1[,c(3)] <- pro_log(glm_xd1[,c(3)]) rownames(glm_xd1) <- NULL glm_xd1 colnames(glm_xd1) <- c("cxd1","cxd1_i","cxd1_s","election_s") res_xd1 <- merge(res_xd1[,c(4,5)],glm_xd1,by="election_s",all.x=T) nc_xd1 <- table(hh$election_s[f], hh$xd1[f]) nc_xd1 <- data.frame(my_rtable(nc_xd1)) nc_xd1$election_s <- rownames(nc_xd1) res_xd1 <- merge(res_xd1,nc_xd1[,c(2,4,5)],by="election_s",all.x=T) colnames(res_xd1) <- c("election_s","nobs_xd1","cxd1","cxd1_i","cxd1_s","nc_xd1","nc_nobs_xd1") res_xd1 <- rbind(res_xd1[res_xd1$election_s!="Ensemble",], res_xd1[res_xd1$election_s=="Ensemble",]) res_xd1$cxd1[nrow(res_xd1)] <- round(sum(res_xd1$cxd1*res_xd1$nobs_xd1,na.rm=T)/res_xd1$nobs_xd1[nrow(res_xd1)],2) res_xd1 #### dr1 #### f <- (is.na(hh$annee1)==F & (substr(hh$parti,1,1) %in% 2)==F) tt1 <- tapply(hh$poids[f],list(hh$election_s[f], hh$dr1[f]),sum,na.rm=T) tt1 res_dr1 <- data.frame(my_rtable(tt1)) res_dr1$election_s <- row.names(res_dr1) res_dr1 colnames(res_dr1)[4] <- "nobs_dr1" mm <- glm(dr1~ -1+ election_s + election_s : risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_dr1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_dr1$election_s <- gsub("election_s","",row.names(glm_dr1)) glm_dr1[,c(1)] <- pro_log(glm_dr1[,c(1)]) glm_dr1[,c(2)] <- pro_log(glm_dr1[,c(2)]) glm_dr1[,c(3)] <- pro_log(glm_dr1[,c(3)]) rownames(glm_dr1) <- NULL glm_dr1 colnames(glm_dr1) <- c("cdr1","cdr1_i","cdr1_s","election_s") res_dr1 <- merge(res_dr1[,c(4,5)],glm_dr1,by="election_s",all.x=T) nc_dr1 <- table(hh$election_s[f], hh$dr1[f]) nc_dr1 <- data.frame(my_rtable(nc_dr1)) nc_dr1$election_s <- rownames(nc_dr1) res_dr1 <- merge(res_dr1,nc_dr1[,c(2,4,5)],by="election_s",all.x=T) colnames(res_dr1) <- c("election_s","nobs_dr1","cdr1","cdr1_i","cdr1_s","nc_dr1","nc_nobs_dr1") res_dr1 <- rbind(res_dr1[res_dr1$election_s!="Ensemble",], res_dr1[res_dr1$election_s=="Ensemble",]) res_dr1$cdr1[nrow(res_dr1)] <- round(sum(res_dr1$cdr1*res_dr1$nobs_dr1,na.rm=T)/res_dr1$nobs_dr1[nrow(res_dr1)],2) res_dr1 #### rpr1 #### f <- (is.na(hh$annee1)==F & (substr(hh$parti,1,1) %in% 2)==F) tt1 <- tapply(hh$poids[f],list(hh$election_s[f], hh$rpr1[f]),sum,na.rm=T) tt1 res_rpr1 <- data.frame(my_rtable(tt1)) res_rpr1$election_s <- row.names(res_rpr1) res_rpr1 colnames(res_rpr1)[4] <- "nobs_rpr1" mm <- glm(rpr1~ -1+ election_s + election_s : risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_rpr1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_rpr1$election_s <- gsub("election_s","",row.names(glm_rpr1)) glm_rpr1[,c(1)] <- pro_log(glm_rpr1[,c(1)]) glm_rpr1[,c(2)] <- pro_log(glm_rpr1[,c(2)]) glm_rpr1[,c(3)] <- pro_log(glm_rpr1[,c(3)]) rownames(glm_rpr1) <- NULL glm_rpr1 colnames(glm_rpr1) <- c("crpr1","crpr1_i","crpr1_s","election_s") res_rpr1 <- merge(res_rpr1[,c(4,5)],glm_rpr1,by="election_s",all.x=T) nc_rpr1 <- table(hh$election_s[f], hh$rpr1[f]) nc_rpr1 <- data.frame(my_rtable(nc_rpr1)) nc_rpr1$election_s <- rownames(nc_rpr1) res_rpr1 <- merge(res_rpr1,nc_rpr1[,c(2,4,5)],by="election_s",all.x=T) colnames(res_rpr1) <- c("election_s","nobs_rpr1","crpr1","crpr1_i","crpr1_s","nc_rpr1","nc_nobs_rpr1") res_rpr1 <- rbind(res_rpr1[res_rpr1$election_s!="Ensemble",], res_rpr1[res_rpr1$election_s=="Ensemble",]) res_rpr1$crpr1[nrow(res_rpr1)] <- round(sum(res_rpr1$crpr1*res_rpr1$nobs_rpr1,na.rm=T)/res_rpr1$nobs_rpr1[nrow(res_rpr1)],2) res_rpr1 #### g1 #### f <- (is.na(hh$annee1)==F & (substr(hh$parti,1,1) %in% 4)==F) tt1 <- tapply(hh$poids[f],list(hh$election_s[f], hh$g1[f]),sum,na.rm=T) tt1 res_g1 <- data.frame(my_rtable(tt1)) res_g1$election_s <- row.names(res_g1) res_g1 colnames(res_g1)[4] <- "nobs_g1" mm <- glm(g1~ -1+ election_s + election_s : risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_g1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_g1$election_s <- gsub("election_s","",row.names(glm_g1)) glm_g1[,c(1)] <- pro_log(glm_g1[,c(1)]) glm_g1[,c(2)] <- pro_log(glm_g1[,c(2)]) glm_g1[,c(3)] <- pro_log(glm_g1[,c(3)]) rownames(glm_g1) <- NULL glm_g1 colnames(glm_g1) <- c("cg1","cg1_i","cg1_s","election_s") res_g1 <- merge(res_g1[,c(4,5)],glm_g1,by="election_s",all.x=T) nc_g1 <- table(hh$election_s[f], hh$g1[f]) nc_g1 <- data.frame(my_rtable(nc_g1)) nc_g1$election_s <- rownames(nc_g1) res_g1 <- merge(res_g1,nc_g1[,c(2,4,5)],by="election_s",all.x=T) colnames(res_g1) <- c("election_s","nobs_g1","cg1","cg1_i","cg1_s","nc_g1","nc_nobs_g1") res_g1 <- rbind(res_g1[res_g1$election_s!="Ensemble",], res_g1[res_g1$election_s=="Ensemble",]) res_g1$cg1[nrow(res_g1)] <- round(sum(res_g1$cg1*res_g1$nobs_g1,na.rm=T)/res_g1$nobs_g1[nrow(res_g1)],2) res_g1 #### ps1 #### f <- (is.na(hh$annee1)==F & (substr(hh$parti,1,1) %in% 4)==F) tt1 <- tapply(hh$poids[f],list(hh$election_s[f], hh$ps1[f]),sum,na.rm=T) tt1 res_ps1 <- data.frame(my_rtable(tt1)) res_ps1$election_s <- row.names(res_ps1) res_ps1 colnames(res_ps1)[4] <- "nobs_ps1" mm <- glm(ps1~ -1+ election_s + election_s : risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_ps1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_ps1$election_s <- gsub("election_s","",row.names(glm_ps1)) glm_ps1[,c(1)] <- pro_log(glm_ps1[,c(1)]) glm_ps1[,c(2)] <- pro_log(glm_ps1[,c(2)]) glm_ps1[,c(3)] <- pro_log(glm_ps1[,c(3)]) rownames(glm_ps1) <- NULL glm_ps1 colnames(glm_ps1) <- c("cps1","cps1_i","cps1_s","election_s") res_ps1 <- merge(res_ps1[,c(4,5)],glm_ps1,by="election_s",all.x=T) nc_ps1 <- table(hh$election_s[f], hh$ps1[f]) nc_ps1 <- data.frame(my_rtable(nc_ps1)) nc_ps1$election_s <- rownames(nc_ps1) res_ps1 <- merge(res_ps1,nc_ps1[,c(2,4,5)],by="election_s",all.x=T) colnames(res_ps1) <- c("election_s","nobs_ps1","cps1","cps1_i","cps1_s","nc_ps1","nc_nobs_ps1") res_ps1 <- rbind(res_ps1[res_ps1$election_s!="Ensemble",], res_ps1[res_ps1$election_s=="Ensemble",]) res_ps1$cps1[nrow(res_ps1)] <- round(sum(res_ps1$cps1*res_ps1$nobs_ps1,na.rm=T)/res_ps1$nobs_ps1[nrow(res_ps1)],2) res_ps1 #### Compilation #### nobs <- tapply(hh$poids,list(hh$election_s, hh$fn1),sum,na.rm=T) nobs <- data.frame(my_rtable(nobs)) nobs$election_s <- rownames(nobs) colnames(nobs)[4] <- "nobs_ens" tab_election_s <- merge(res_xd1,res_fn1,by="election_s") tab_election_s <- merge(tab_election_s,res_dr1,by="election_s") tab_election_s <- merge(tab_election_s,res_rpr1,by="election_s") tab_election_s <- merge(tab_election_s,res_g1,by="election_s") tab_election_s <- merge(tab_election_s,res_ps1,by="election_s") tab_election_s <- merge(tab_election_s,nobs[,c(4,5)],by="election_s") tab_election_s tab_election_s <- rbind(tab_election_s[tab_election_s$election_s!="Ensemble",], tab_election_s[tab_election_s$election_s=="Ensemble",]) HTML("Tableau A4 (détail). Évolution vers l'extrême droite, le RPR, et le PS en fonction de election_s",outhtml,align="left") HTML(tab_election_s,outhtml,align="left",digits = 4,nsmall=2) tab_election_s_simp <- tab_election_s[,c("election_s","cxd1","cfn1", "cdr1","crpr1", "cg1","cps1", "nobs_ens")] HTML("Tableau A4. Évolution vers l'extrême droite, le RPR, et le PS en fonction de election_s",outhtml,align="left") HTML(tab_election_s_simp,outhtml,align="left",digits = 4,nsmall=2) tab_election_s_simp ## Tableau A4b. Par election de destination #### f <- (is.na(hh$annee1)==F & hh$xd %in% 0) ### Estimations election_s1 #### #### fn1 #### f <- (is.na(hh$annee1)==F & hh$xd %in% 0) tt1 <- tapply(hh$poids[f],list(hh$election_s1[f], hh$fn1[f]),sum,na.rm=T) tt1 res_fn1 <- data.frame(my_rtable(tt1)) res_fn1$election_s1 <- row.names(res_fn1) res_fn1 colnames(res_fn1)[4] <- "nobs_fn1" mm <- glm(fn1~ -1+ election_s1 + election_s1 : risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_fn1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_fn1$election_s1 <- gsub("election_s1","",row.names(glm_fn1)) glm_fn1[,c(1)] <- pro_log(glm_fn1[,c(1)]) glm_fn1[,c(2)] <- pro_log(glm_fn1[,c(2)]) glm_fn1[,c(3)] <- pro_log(glm_fn1[,c(3)]) rownames(glm_fn1) <- NULL glm_fn1 colnames(glm_fn1) <- c("cfn1","cfn1_i","cfn1_s","election_s1") res_fn1 <- merge(res_fn1[,c(4,5)],glm_fn1,by="election_s1",all.x=T) nc_fn1 <- table(hh$election_s1[f], hh$fn1[f]) nc_fn1 <- data.frame(my_rtable(nc_fn1)) nc_fn1$election_s1 <- rownames(nc_fn1) res_fn1 <- merge(res_fn1,nc_fn1[,c(2,4,5)],by="election_s1",all.x=T) colnames(res_fn1) <- c("election_s1","nobs_fn1","cfn1","cfn1_i","cfn1_s","nc_fn1","nc_nobs_fn1") res_fn1 <- rbind(res_fn1[res_fn1$election_s1!="Ensemble",], res_fn1[res_fn1$election_s1=="Ensemble",]) res_fn1$cfn1[nrow(res_fn1)] <- round(sum(res_fn1$cfn1*res_fn1$nobs_fn1,na.rm=T)/res_fn1$nobs_fn1[nrow(res_fn1)],2) res_fn1 #### xd1 #### f <- (is.na(hh$annee1)==F & hh$xd %in% 0) tt1 <- tapply(hh$poids[f],list(hh$election_s1[f], hh$xd1[f]),sum,na.rm=T) tt1 res_xd1 <- data.frame(my_rtable(tt1)) res_xd1$election_s1 <- row.names(res_xd1) res_xd1 colnames(res_xd1)[4] <- "nobs_xd1" mm <- glm(xd1~ -1+ election_s1 + election_s1 : risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_xd1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_xd1$election_s1 <- gsub("election_s1","",row.names(glm_xd1)) glm_xd1[,c(1)] <- pro_log(glm_xd1[,c(1)]) glm_xd1[,c(2)] <- pro_log(glm_xd1[,c(2)]) glm_xd1[,c(3)] <- pro_log(glm_xd1[,c(3)]) rownames(glm_xd1) <- NULL glm_xd1 colnames(glm_xd1) <- c("cxd1","cxd1_i","cxd1_s","election_s1") res_xd1 <- merge(res_xd1[,c(4,5)],glm_xd1,by="election_s1",all.x=T) nc_xd1 <- table(hh$election_s1[f], hh$xd1[f]) nc_xd1 <- data.frame(my_rtable(nc_xd1)) nc_xd1$election_s1 <- rownames(nc_xd1) res_xd1 <- merge(res_xd1,nc_xd1[,c(2,4,5)],by="election_s1",all.x=T) colnames(res_xd1) <- c("election_s1","nobs_xd1","cxd1","cxd1_i","cxd1_s","nc_xd1","nc_nobs_xd1") res_xd1 <- rbind(res_xd1[res_xd1$election_s1!="Ensemble",], res_xd1[res_xd1$election_s1=="Ensemble",]) res_xd1$cxd1[nrow(res_xd1)] <- round(sum(res_xd1$cxd1*res_xd1$nobs_xd1,na.rm=T)/res_xd1$nobs_xd1[nrow(res_xd1)],2) res_xd1 #### dr1 #### f <- (is.na(hh$annee1)==F & (substr(hh$parti,1,1) %in% 2)==F) tt1 <- tapply(hh$poids[f],list(hh$election_s1[f], hh$dr1[f]),sum,na.rm=T) tt1 res_dr1 <- data.frame(my_rtable(tt1)) res_dr1$election_s1 <- row.names(res_dr1) res_dr1 colnames(res_dr1)[4] <- "nobs_dr1" mm <- glm(dr1~ -1+ election_s1 + election_s1 : risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_dr1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_dr1$election_s1 <- gsub("election_s1","",row.names(glm_dr1)) glm_dr1[,c(1)] <- pro_log(glm_dr1[,c(1)]) glm_dr1[,c(2)] <- pro_log(glm_dr1[,c(2)]) glm_dr1[,c(3)] <- pro_log(glm_dr1[,c(3)]) rownames(glm_dr1) <- NULL glm_dr1 colnames(glm_dr1) <- c("cdr1","cdr1_i","cdr1_s","election_s1") res_dr1 <- merge(res_dr1[,c(4,5)],glm_dr1,by="election_s1",all.x=T) nc_dr1 <- table(hh$election_s1[f], hh$dr1[f]) nc_dr1 <- data.frame(my_rtable(nc_dr1)) nc_dr1$election_s1 <- rownames(nc_dr1) res_dr1 <- merge(res_dr1,nc_dr1[,c(2,4,5)],by="election_s1",all.x=T) colnames(res_dr1) <- c("election_s1","nobs_dr1","cdr1","cdr1_i","cdr1_s","nc_dr1","nc_nobs_dr1") res_dr1 <- rbind(res_dr1[res_dr1$election_s1!="Ensemble",], res_dr1[res_dr1$election_s1=="Ensemble",]) res_dr1$cdr1[nrow(res_dr1)] <- round(sum(res_dr1$cdr1*res_dr1$nobs_dr1,na.rm=T)/res_dr1$nobs_dr1[nrow(res_dr1)],2) res_dr1 #### rpr1 #### f <- (is.na(hh$annee1)==F & (substr(hh$parti,1,1) %in% 2)==F) tt1 <- tapply(hh$poids[f],list(hh$election_s1[f], hh$rpr1[f]),sum,na.rm=T) tt1 res_rpr1 <- data.frame(my_rtable(tt1)) res_rpr1$election_s1 <- row.names(res_rpr1) res_rpr1 colnames(res_rpr1)[4] <- "nobs_rpr1" mm <- glm(rpr1~ -1+ election_s1 + election_s1 : risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_rpr1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_rpr1$election_s1 <- gsub("election_s1","",row.names(glm_rpr1)) glm_rpr1[,c(1)] <- pro_log(glm_rpr1[,c(1)]) glm_rpr1[,c(2)] <- pro_log(glm_rpr1[,c(2)]) glm_rpr1[,c(3)] <- pro_log(glm_rpr1[,c(3)]) rownames(glm_rpr1) <- NULL glm_rpr1 colnames(glm_rpr1) <- c("crpr1","crpr1_i","crpr1_s","election_s1") res_rpr1 <- merge(res_rpr1[,c(4,5)],glm_rpr1,by="election_s1",all.x=T) nc_rpr1 <- table(hh$election_s1[f], hh$rpr1[f]) nc_rpr1 <- data.frame(my_rtable(nc_rpr1)) nc_rpr1$election_s1 <- rownames(nc_rpr1) res_rpr1 <- merge(res_rpr1,nc_rpr1[,c(2,4,5)],by="election_s1",all.x=T) colnames(res_rpr1) <- c("election_s1","nobs_rpr1","crpr1","crpr1_i","crpr1_s","nc_rpr1","nc_nobs_rpr1") res_rpr1 <- rbind(res_rpr1[res_rpr1$election_s1!="Ensemble",], res_rpr1[res_rpr1$election_s1=="Ensemble",]) res_rpr1$crpr1[nrow(res_rpr1)] <- round(sum(res_rpr1$crpr1*res_rpr1$nobs_rpr1,na.rm=T)/res_rpr1$nobs_rpr1[nrow(res_rpr1)],2) res_rpr1 #### g1 #### f <- (is.na(hh$annee1)==F & (substr(hh$parti,1,1) %in% 4)==F) tt1 <- tapply(hh$poids[f],list(hh$election_s1[f], hh$g1[f]),sum,na.rm=T) tt1 res_g1 <- data.frame(my_rtable(tt1)) res_g1$election_s1 <- row.names(res_g1) res_g1 colnames(res_g1)[4] <- "nobs_g1" mm <- glm(g1~ -1+ election_s1 + election_s1 : risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_g1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_g1$election_s1 <- gsub("election_s1","",row.names(glm_g1)) glm_g1[,c(1)] <- pro_log(glm_g1[,c(1)]) glm_g1[,c(2)] <- pro_log(glm_g1[,c(2)]) glm_g1[,c(3)] <- pro_log(glm_g1[,c(3)]) rownames(glm_g1) <- NULL glm_g1 colnames(glm_g1) <- c("cg1","cg1_i","cg1_s","election_s1") res_g1 <- merge(res_g1[,c(4,5)],glm_g1,by="election_s1",all.x=T) nc_g1 <- table(hh$election_s1[f], hh$g1[f]) nc_g1 <- data.frame(my_rtable(nc_g1)) nc_g1$election_s1 <- rownames(nc_g1) res_g1 <- merge(res_g1,nc_g1[,c(2,4,5)],by="election_s1",all.x=T) colnames(res_g1) <- c("election_s1","nobs_g1","cg1","cg1_i","cg1_s","nc_g1","nc_nobs_g1") res_g1 <- rbind(res_g1[res_g1$election_s1!="Ensemble",], res_g1[res_g1$election_s1=="Ensemble",]) res_g1$cg1[nrow(res_g1)] <- round(sum(res_g1$cg1*res_g1$nobs_g1,na.rm=T)/res_g1$nobs_g1[nrow(res_g1)],2) res_g1 #### ps1 #### f <- (is.na(hh$annee1)==F & (substr(hh$parti,1,1) %in% 4)==F) tt1 <- tapply(hh$poids[f],list(hh$election_s1[f], hh$ps1[f]),sum,na.rm=T) tt1 res_ps1 <- data.frame(my_rtable(tt1)) res_ps1$election_s1 <- row.names(res_ps1) res_ps1 colnames(res_ps1)[4] <- "nobs_ps1" mm <- glm(ps1~ -1+ election_s1 + election_s1 : risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) glm_ps1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) glm_ps1$election_s1 <- gsub("election_s1","",row.names(glm_ps1)) glm_ps1[,c(1)] <- pro_log(glm_ps1[,c(1)]) glm_ps1[,c(2)] <- pro_log(glm_ps1[,c(2)]) glm_ps1[,c(3)] <- pro_log(glm_ps1[,c(3)]) rownames(glm_ps1) <- NULL glm_ps1 colnames(glm_ps1) <- c("cps1","cps1_i","cps1_s","election_s1") res_ps1 <- merge(res_ps1[,c(4,5)],glm_ps1,by="election_s1",all.x=T) nc_ps1 <- table(hh$election_s1[f], hh$ps1[f]) nc_ps1 <- data.frame(my_rtable(nc_ps1)) nc_ps1$election_s1 <- rownames(nc_ps1) res_ps1 <- merge(res_ps1,nc_ps1[,c(2,4,5)],by="election_s1",all.x=T) colnames(res_ps1) <- c("election_s1","nobs_ps1","cps1","cps1_i","cps1_s","nc_ps1","nc_nobs_ps1") res_ps1 <- rbind(res_ps1[res_ps1$election_s1!="Ensemble",], res_ps1[res_ps1$election_s1=="Ensemble",]) res_ps1$cps1[nrow(res_ps1)] <- round(sum(res_ps1$cps1*res_ps1$nobs_ps1,na.rm=T)/res_ps1$nobs_ps1[nrow(res_ps1)],2) res_ps1 #### Compilation #### nobs <- tapply(hh$poids,list(hh$election_s1, hh$fn1),sum,na.rm=T) nobs <- data.frame(my_rtable(nobs)) nobs$election_s1 <- rownames(nobs) colnames(nobs)[4] <- "nobs_ens" tab_election_s1 <- merge(res_xd1,res_fn1,by="election_s1") tab_election_s1 <- merge(tab_election_s1,res_dr1,by="election_s1") tab_election_s1 <- merge(tab_election_s1,res_rpr1,by="election_s1") tab_election_s1 <- merge(tab_election_s1,res_g1,by="election_s1") tab_election_s1 <- merge(tab_election_s1,res_ps1,by="election_s1") tab_election_s1 <- merge(tab_election_s1,nobs[,c(4,5)],by="election_s1") tab_election_s1 tab_election_s1 <- rbind(tab_election_s1[tab_election_s1$election_s1!="Ensemble",], tab_election_s1[tab_election_s1$election_s1=="Ensemble",]) HTML("Tableau A4b (détails). Évolution vers l'extrême droite, le RPR, et le PS en fonction de election_s1",outhtml,align="left") HTML(tab_election_s1,outhtml,align="left",digits = 4,nsmall=2) tab_election_s1_simp <- tab_election_s1[,c("election_s1","cxd1","cfn1", "cdr1","crpr1", "cg1","cps1", "nobs_ens")] HTML("Tableau A4b. Évolution vers l'extrême droite, le RPR, et le PS en fonction de election_s1",outhtml,align="left") HTML(tab_election_s1_simp,outhtml,align="left",digits = 4,nsmall=2) tab_election_s1_simp # Tableau A7. Regression ensemble #### hh$div <- (regexpr("Div.",hh$parti)>0 & hh$parti !="5.3 Div.-Ext Gau.")*1 table(hh$div,hh$parti) f <- (is.na(hh$annee1)==F & hh$xd %in% 0) mm1 <- glm(fn1~ + (relevel(factor(election_s1),ref="municipale") + annee_s1 + relevel(factor(age_cat),ref="(40,50]") + sexe # + relevel(factor(cs1b),ref="32") # + relevel(factor(mouvance),ref="5. Gauche radicale") # + relevel(factor(score_cat),ref="(0.8,1]") # + div ) * risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm1) mm2 <- glm(fn1~ + (relevel(factor(election_s1),ref="municipale") + annee_s1 + relevel(factor(age_cat),ref="(40,50]") + sexe + relevel(factor(cs1b),ref="32") # + relevel(factor(mouvance),ref="5. Gauche radicale") # + relevel(factor(score_cat),ref="(0.8,1]") # + div ) * risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm2,omit.coef = "risque_erreur") mm3 <- glm(fn1~ + (relevel(factor(election_s1),ref="municipale") + annee_s1 # + relevel(factor(age_cat),ref="(40,50]") # + sexe # + relevel(factor(cs1b),ref="32") + relevel(factor(mouvance),ref="5. Gauche radicale") # + relevel(factor(score_cat),ref="(0.8,1]") # + div ) * risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm3,omit.coef = "risque_erreur") mm4 <- glm(fn1~ + (relevel(factor(election_s1),ref="municipale") + annee_s1 # + relevel(factor(age_cat),ref="(40,50]") # + sexe # + relevel(factor(cs1b),ref="32") # + relevel(factor(mouvance),ref="5. Gauche radicale") + relevel(factor(score_cat),ref="(0.8,1]") # + div ) * risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm4,omit.coef = "risque_erreur") mm5 <- glm(fn1~ + (relevel(factor(election_s1),ref="municipale") + annee_s1 + sexe + relevel(factor(age_cat),ref="(40,50]") # + relevel(factor(cs1b),ref="32") + relevel(factor(mouvance),ref="5. Gauche radicale") + relevel(factor(score_cat),ref="(0.8,1]") # + div ) * risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm5,omit.coef = "risque_erreur") mm6 <- glm(fn1~ + (relevel(factor(election_s1),ref="municipale") + annee_s1 + sexe + relevel(factor(age_cat),ref="(40,50]") + relevel(factor(cs1b),ref="32") # + relevel(factor(mouvance),ref="5. Gauche radicale") + relevel(factor(score_cat),ref="(0.8,1]") # + div ) * risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm6,omit.coef = "risque_erreur") screenreg(list(mm1,mm2,mm3,mm4,mm5,mm6), omit.coef = "risque_erreur") HTML("Tableau A7. Régressions",outhtml,align="left") HTML(htmlreg(list(mm1,mm2,mm3,mm4,mm5,mm6), omit.coef = "risque_erreur"), outhtml,align="left",digits = 4,nsmall=2) # Vérification score & Rang f <- (is.na(hh$annee1)==F & hh$xd %in% 0 & hh$scrutin=="liste") mm <- glm(fn1~ + (rg + score_cat ) * risque_erreur ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) screenreg(mm) #checks f <- (is.na(hh$annee1)==F & hh$xd %in% 0) mm <- glm(fn1~ -1+ paste(election_s1,annee1) + + risque_erreur:paste(election_s1,annee1) ,data=hh[f,] ,weights=hh$poids[f] ,family=binomial) ci_fn1 <- data.frame(cbind(mm$coefficients,mm$coefficients-1.96*sqrt(diag(vcov(mm))),mm$coefficients+1.96*sqrt(diag(vcov(mm))))) ci_fn1$election_s1 <- gsub("election_s1","",row.names(ci_fn1)) ci_fn1[,c(1)] <- pro_log(ci_fn1[,c(1)]) ci_fn1[,c(2)] <- pro_log(ci_fn1[,c(2)]) ci_fn1[,c(3)] <- pro_log(ci_fn1[,c(3)]) rownames(ci_fn1) <- NULL ci_fn1 #---------------------------------------------------# # Précision texte: Décompte Candidatures #### #---------------------------------------------------# tt <-data.frame( addmargins(table(aa$nb_id))) colnames(tt) <- c("nb_cand_ind","nb_cand") str(tt) tt$nb_ind <- tt$nb_cand/as.numeric(as.character(tt$nb_cand_ind)) tt$nb_ind[nrow(tt)] <- sum(tt$nb_ind,na.rm=T) HTML("Précision Décompte des candidatures",outhtml,align="left") HTML(tt,outhtml,align="left",digits = 4,nsmall=2)