rm(list=ls(all=TRUE)) ### LOAD /INSTALL PACKAGES pacman::p_load( cregg, dplyr, ggpubr, cowplot ) ### SET WORKING DIRECTORY TO FILE LOCATION setwd("C:/Users/luigi/Dropbox/TOPIC MODEL/Survey Experiments/from the lab replication") ## OPEN DATASET pop <- readRDS(file = "my_dataEJPROK.rds") ls() ###################### # Codebook ###################### # pol_popOK: wich of the two profiles of the vignette is considered as ‘more populist’ (0/1) # RHETORIC: politician's statement # GENDER: politician's gender # OCCUPATION: politician's occupation # IDEOLOGY: politician's ideology # peso: survey weight for each respondent # id: index for each respondent # Education: education level for each respondent (a dummy variable equals to 1 if the respondent has at least a college degree and 0 otherwise) # interesse_bis: dummy equals to 1 if the respondent is highly or quite interested in politics and 0 otherwise # popFA2: populist attitudes of the respondents as they result from a factor analysis on the two questions on anti-elite and people-centric populism # fiducia_parlamento2: trust in the Italian Parliament recoded as 1 if the respondent on a scale from 0 (no trust) to 10 (total trust) gives an answer larger or equal to 6, and 0 otherwise # vignette: index of the vignette administred to each respondent # tot: seconds spent on the vignettes by a respondent # lettura_politica_ore: time (hours) spent to read/watch/listen to political news # lettura: dummy for the hours spent to read/watch/listen to political news (0=less than 1 hour; 1=otherwise) # pop1: people-centric populism question # pop2: anti-elite question # fiducia_parlamento3: trust in the Italian Parliament recoded as 1 for any value larger than the mean (i.e., 4.35) and 0 otherwise ########################################### ########################################### ### CONJOINT ANALSYS ########################################### ########################################### ########################################### # Main Model ########################################### mm_gp <- pol_popOK ~ RHETORIC + GENDER + OCCUPATION + IDEOLOGY mm(pop, mm_gp, weights = ~peso, id = ~id) ########## # FIGURE 2 in the paper ########## mm_gp_graph <- plot(mm(pop, mm_gp, weights = ~peso, id = ~id), vline = 0.5) + ggplot2::theme(legend.position = "none") + labs(title = "Effects of politicians statements/attributes", subtitle = "on perception of Populism") + theme(text = element_text(size = 20)) mm_gp_graph ################################################## # INTERACTIONS ################################################## # Interaction between Rhetoric and Ideology pop$Interaction <- interaction(pop$RHETORIC, pop$IDEOLOGY, sep = "_") inter <- cj(pop, pol_popOK ~ Interaction , id = ~id, weights = ~ peso, estimate = "mm", h0 = 0.5) inter1 <- plot(inter, vline = 0.5) + ggplot2::theme(legend.position = "none") + labs(title = "Perception of Populism", subtitle = "Interaction between Rhetoric and Ideology") + theme(text = element_text(size = 14)) # Interaction between Rhetoric and Gender pop$Interaction <- interaction(pop$RHETORIC, pop$GENDER , sep = "_") inter <- cj(pop, pol_popOK ~ Interaction , id = ~id, weights = ~ peso, estimate = "mm", h0 = 0.5) str(inter) table(inter$level) inter2 <- plot(inter, vline = 0.5) + ggplot2::theme(legend.position = "none") + labs(title = "Perception of Populism", subtitle = "Interaction between Rhetoric and Gender") + theme(text = element_text(size = 14)) # Interaction between Rhetoric and Occoupation pop$Interaction <- interaction(pop$RHETORIC, pop$OCCUPATION , sep = "_") str(pop$Interaction ) inter <- cj(pop, pol_popOK ~ Interaction , id = ~id, weights = ~ peso, estimate = "mm", h0 = 0.5) inter3 <- plot(inter, vline = 0.5) + ggplot2::theme(legend.position = "none") + labs(title = "Perception of Populism", subtitle = "Interaction between Rhetoric and Occupation") + theme(text = element_text(size = 14)) ########## # FIGURE 3 in the paper ########### plot_grid(inter1 , inter2, inter3) ########################################### ########################################### ########### # SUB-GROUP analysis ########################################### ########################################### ########################################### ########### # Education ########################################### cj_anova(pop, pol_popOK~RHETORIC + GENDER + OCCUPATION + IDEOLOGY, id = ~id, by = ~Education ) cj_anova(pop, pol_popOK~ IDEOLOGY, id = ~id, by = ~Education ) cj_anova(pop, pol_popOK~ RHETORIC , id = ~id, by = ~Education ) cj_anova(pop, pol_popOK~ GENDER , id = ~id, by = ~Education ) cj_anova(pop, pol_popOK~ OCCUPATION , id = ~id, by = ~Education ) mm_pop_by_pop2 <- cj( subset(pop, !is.na(Education )), pol_popOK ~ RHETORIC + GENDER + OCCUPATION + IDEOLOGY, id = ~id, weights = ~ peso, estimate = "mm", by = ~ Education ) mm_pop_diff_pop2 <- cj( subset(pop, !is.na(Education )), pol_popOK ~ RHETORIC + GENDER + OCCUPATION + IDEOLOGY, id = ~id, weights = ~ peso, estimate = "mm_diff", by = ~ Education ) mm_pop_diff_pop3 <- mm_pop_diff_pop2[c(1:4),] y <- plot(mm_pop_diff_pop3) + ggplot2::theme(legend.position = "none") + labs(title = "Perception of Populism:", subtitle = " by Education (High-Low)") + theme(text = element_text(size = 20)) x <- cj(pop, pol_popOK~RHETORIC + GENDER + OCCUPATION + IDEOLOGY, id = ~ id, estimate = "mm", h0 = 0.5, by = ~ Education ) x <- cj(pop, pol_popOK~RHETORIC , id = ~ id, estimate = "mm", h0 = 0.5, by = ~ Education ) x <- plot(x, group = "Education", vline = 0.5) + labs(title = "Perception of Populism:", subtitle = " by Education (High-Low)") + theme(text = element_text(size = 20)) + theme(legend.position = c(0.7, 0.1)) ########## # FIGURE 4 in the paper ########### plot_grid(x , y ) ########################################### ########### Political Interest ########################################### cj_anova(pop, pol_popOK~RHETORIC + GENDER + OCCUPATION + IDEOLOGY, id = ~id, by = ~interesse_bis) cj_anova(pop, pol_popOK~ IDEOLOGY, id = ~id, by = ~interesse_bis) cj_anova(pop, pol_popOK~ RHETORIC , id = ~id, by = ~interesse_bis) cj_anova(pop, pol_popOK~ GENDER , id = ~id, by = ~interesse_bis) cj_anova(pop, pol_popOK~ OCCUPATION , id = ~id, by = ~interesse_bis) ########################################### ########### Proximity ########################################### cj_anova(pop, pol_popOK~RHETORIC + GENDER + OCCUPATION + IDEOLOGY, id = ~id, by = ~proximity2 ) cj_anova(pop, pol_popOK~ IDEOLOGY, id = ~id, by = ~proximity2 ) cj_anova(pop, pol_popOK~ RHETORIC , id = ~id, by = ~proximity2 ) cj_anova(pop, pol_popOK~ GENDER , id = ~id, by = ~proximity2 ) cj_anova(pop, pol_popOK~ OCCUPATION , id = ~id, by = ~proximity2 ) ########################################### ########### Populism ########################################### cj_anova(pop, pol_popOK~RHETORIC + GENDER + OCCUPATION + IDEOLOGY, id = ~id, by = ~popFA2) cj_anova(pop, pol_popOK~ IDEOLOGY, id = ~id, by = ~popFA2) cj_anova(pop, pol_popOK~ RHETORIC , id = ~id, by = ~popFA2) cj_anova(pop, pol_popOK~ GENDER , id = ~id, by = ~popFA2) cj_anova(pop, pol_popOK~ OCCUPATION , id = ~id, by = ~popFA2) mm_pop_diff_pop2 <- cj( subset(pop, !is.na(pop1)), pol_popOK ~ RHETORIC + GENDER + OCCUPATION + IDEOLOGY, id = ~id, weights = ~ peso, estimate = "mm_diff", by = ~ popFA2 ) mm_pop_diff_pop3 <- mm_pop_diff_pop2[c(1:4),] y <- plot(mm_pop_diff_pop3) + ggplot2::theme(legend.position = "none") + labs(title = "Perception of Populism:", subtitle = "by Populist Attitudes (High-Low)") + theme(text = element_text(size = 20)) x <- cj(pop, pol_popOK~RHETORIC , id = ~ id, estimate = "mm", h0 = 0.5, by = ~ popFA2) x <- plot(x, group = "popFA2", vline = 0.5) + labs(title = "Perception of Populism:", subtitle = " by Populist Attitudes (High & Low)") + theme(text = element_text(size = 20)) + theme(legend.position = c(0.75, 0.1)) + guides(col=guide_legend("Populist Attitudes")) ########## # FIGURE 5 in the paper ########### plot_grid(x , y ) ########################################### ########### Trust in political institutions ########################################### cj_anova(pop, pol_popOK~RHETORIC + GENDER + OCCUPATION + IDEOLOGY, id = ~id, by = ~fiducia_parlamento2) cj_anova(pop, pol_popOK~ IDEOLOGY, id = ~id, by = ~fiducia_parlamento2) cj_anova(pop, pol_popOK~ RHETORIC , id = ~id, by = ~fiducia_parlamento2) cj_anova(pop, pol_popOK~ GENDER , id = ~id, by = ~fiducia_parlamento2) cj_anova(pop, pol_popOK~ OCCUPATION , id = ~id, by = ~fiducia_parlamento2) ########################################### ########################################### # DIAGNOSTIC & ROBUSTNESS CHECKS ########################################### ########################################### ######################################## # Checking for balance in the frequencies of attributes by experimental trait ######################################## plot(cj_freqs(pop, pol_popOK ~ RHETORIC + GENDER + OCCUPATION + IDEOLOGY, id = ~id)) ######################################## # Stability in respondents' preferences ######################################## # MMs split by vignette stacked <- cj(pop, mm_gp, weights = ~peso, id = ~id, estimate = "mm", by= ~ vignette) plot(stacked, group = "vignette", vline = 0.5, feature_headers = FALSE) + ggtitle("Stability in respondents' preferences") ######################################## # Conjoint experiment excluding those failing attention checks # (i.e., those respondents who spent less than 36 seconds (i.e., the first quartile in the distribution of our sample) # on the 2-vignettes administered during the experiment) ######################################## pop_tot <- pop[ which(pop$tot>36.11), ] nrow(pop) nrow(pop_tot) # MM - main model mm_gp <- pol_popOK ~ RHETORIC + GENDER + OCCUPATION + IDEOLOGY mm_gp_graph <- plot(mm(pop_tot, mm_gp, weights = ~peso, id = ~id), vline = 0.5) + ggplot2::theme(legend.position = "none") + ggtitle("Perception of Populism") mm_gp_graph ######################################## # . Conjoint experiment excluding those providing blatantly inaccurate answers # (i.e., respondents who claimed they usually spend more than 15 hours per-day watching or reading political news) ######################################## pop_tot2 <- pop[ which(pop$lettura_politica_ore<15), ] nrow(pop) nrow(pop_tot2) mm_gp <- pol_popOK ~ RHETORIC + GENDER + OCCUPATION + IDEOLOGY mm_gp_graph <- plot(mm(pop_tot2, mm_gp, weights = ~peso, id = ~id), vline = 0.5) + ggplot2::theme(legend.position = "none") + ggtitle("Perception of Populism") mm_gp_graph ########################################### ########### Robustness check: time spent to read/watch/listen to political news ########################################### pop$lettura<- recode(pop$lettura_politica_ore, "0"=0, "1"=1, "2"=1, "3"=1, "4"=1, "5"=1, "6"=1, "7"=1, "8"=1, "9"=1, "10"=1, "11"=1, "12"=1, "15"=1, "20"=1, "22"=1, "23"=1) table(pop$lettura) prop.table(table(pop$lettura)) pop$lettura<- factor(pop$lettura, levels=c("0", "1"), labels=c("Less than 1 hour a day", "More than 1 hour a day")) table(pop$lettura) cj_anova(pop, pol_popOK~RHETORIC + GENDER + OCCUPATION + IDEOLOGY, id = ~id, by = ~lettura) cj_anova(pop, pol_popOK~ IDEOLOGY, id = ~id, by = ~lettura) cj_anova(pop, pol_popOK~ RHETORIC , id = ~id, by = ~lettura) cj_anova(pop, pol_popOK~ GENDER , id = ~id, by = ~lettura) cj_anova(pop, pol_popOK~ OCCUPATION , id = ~id, by = ~lettura) ########################################### ########### Robustness check: pop1 & pop2 ########################################### cj_anova(pop, pol_popOK~RHETORIC + GENDER + OCCUPATION + IDEOLOGY, id = ~id, by = ~pop1) cj_anova(pop, pol_popOK~ IDEOLOGY, id = ~id, by = ~pop1) cj_anova(pop, pol_popOK~ RHETORIC , id = ~id, by = ~pop1) cj_anova(pop, pol_popOK~ GENDER , id = ~id, by = ~pop1) cj_anova(pop, pol_popOK~ OCCUPATION , id = ~id, by = ~pop1) mm_pop_diff_pop2 <- cj( subset(pop, !is.na(pop1)), pol_popOK ~ RHETORIC + GENDER + OCCUPATION + IDEOLOGY, id = ~id, weights = ~ peso, estimate = "mm_diff", by = ~ pop1 ) mm_pop_diff_pop3 <- mm_pop_diff_pop2[c(1:4),] y <- plot(mm_pop_diff_pop3) + ggplot2::theme(legend.position = "none") + ggtitle("Perception of Populism: by Populism (High-Low)") x <- cj(pop, pol_popOK~RHETORIC , id = ~ id, estimate = "mm", h0 = 0.5, by = ~ pop1) x <- plot(x, group = "pop1", vline = 0.5) + ggtitle("Perception of Populism: by Populism (High & Low)") + theme(legend.position = c(0.85, 0.07)) + guides(col=guide_legend("Populist Attitude 1")) plot_grid(x , y ) cj_anova(pop, pol_popOK~RHETORIC + GENDER + OCCUPATION + IDEOLOGY, id = ~id, by = ~pop2) cj_anova(pop, pol_popOK~ IDEOLOGY, id = ~id, by = ~pop2) cj_anova(pop, pol_popOK~ RHETORIC , id = ~id, by = ~pop2) cj_anova(pop, pol_popOK~ GENDER , id = ~id, by = ~pop2) cj_anova(pop, pol_popOK~ OCCUPATION , id = ~id, by = ~pop2) mm_pop_diff_pop2 <- cj( subset(pop, !is.na(pop2)), pol_popOK ~ RHETORIC + GENDER + OCCUPATION + IDEOLOGY, id = ~id, weights = ~ peso, estimate = "mm_diff", by = ~ pop2 ) mm_pop_diff_pop3 <- mm_pop_diff_pop2[c(1:4),] y <- plot(mm_pop_diff_pop3) + ggplot2::theme(legend.position = "none") + ggtitle("Perception of Populism: by Populism (High-Low)") x <- cj(pop, pol_popOK~RHETORIC , id = ~ id, estimate = "mm", h0 = 0.5, by = ~ pop2) x <- plot(x, group = "pop2", vline = 0.5) + ggtitle("Perception of Populism: by Populism (High & Low)") + theme(legend.position = c(0.85, 0.07)) + guides(col=guide_legend("Populist Attitude 2")) plot_grid(x , y ) ########################################### ########### Robustness check: Trust in political institutions (below or above the mean) ########################################### cj_anova(pop, pol_popOK~RHETORIC + GENDER + OCCUPATION + IDEOLOGY, id = ~id, by = ~fiducia_parlamento3 ) cj_anova(pop, pol_popOK~ IDEOLOGY, id = ~id, by = ~fiducia_parlamento3 ) cj_anova(pop, pol_popOK~ RHETORIC , id = ~id, by = ~fiducia_parlamento3 ) cj_anova(pop, pol_popOK~ GENDER , id = ~id, by = ~fiducia_parlamento3 ) cj_anova(pop, pol_popOK~ OCCUPATION , id = ~id, by = ~fiducia_parlamento3 ) ########################################### ########### Robustness check: Politicians' ideology ########################################### # Moderate vs. Extreme positions pop$IdeologyCOL <- as.integer(pop$IDEOLOGY) pop$IdeologyCOL2 <- recode(pop$IdeologyCOL, "1"=1, "2"=0, "3"=0, "4"=0, "5"=1) pop$IdeologyCOL2 <- factor(pop$IdeologyCOL2 , levels=c("0", "1"), labels=c("Moderate", "Extreme")) pop$IDEOLOGY2 <-pop$IdeologyCOL2 # MM - main model mm_gp <- pol_popOK ~ RHETORIC + GENDER + OCCUPATION + IDEOLOGY2 mm(pop, mm_gp, weights = ~peso, id = ~id) mm_gp_graph <- plot(mm(pop, mm_gp, weights = ~peso, id = ~id), vline = 0.5) + ggplot2::theme(legend.position = "none") + labs(title = "Effects of politicians statements/attributes", subtitle = "on perception of Populism") + theme(text = element_text(size = 20)) mm_gp_graph # Rightists vs. the rest pop$IdeologyCOL3 <- recode(pop$IdeologyCOL, "1"=0, "2"=0, "3"=0, "4"=0, "5"=1) pop$IdeologyCOL3 <- factor(pop$IdeologyCOL3 , levels=c("0", "1"), labels=c("Not-right", "Right")) pop$IDEOLOGY3 <-pop$IdeologyCOL3 # MM - main model mm_gp <- pol_popOK ~ RHETORIC + GENDER + OCCUPATION + IDEOLOGY3 mm(pop, mm_gp, weights = ~peso, id = ~id) mm_gp_graph <- plot(mm(pop, mm_gp, weights = ~peso, id = ~id), vline = 0.5) + ggplot2::theme(legend.position = "none") + labs(title = "Effects of politicians statements/attributes", subtitle = "on perception of Populism") + theme(text = element_text(size = 20)) mm_gp_graph ########################################### ########################################### # Re-running the analysis with two sub-samples (i.e., considering either respondents displaying ideological proximity or otherwise). ########################################### ########################################### pop_PROX <- pop[ which(pop$proximity2 =="Proximity"), ] pop_NOPROX <- pop[ which(pop$proximity2 =="No Proximity"), ] cj_anova(pop_PROX, pol_popOK~RHETORIC + GENDER + OCCUPATION + IDEOLOGY, id = ~id, by = ~popFA2) cj_anova(pop_PROX, pol_popOK~ IDEOLOGY, id = ~id, by = ~popFA2) cj_anova(pop_PROX, pol_popOK~ RHETORIC , id = ~id, by = ~popFA2) cj_anova(pop_PROX, pol_popOK~ GENDER , id = ~id, by = ~popFA2) cj_anova(pop_PROX, pol_popOK~ OCCUPATION , id = ~id, by = ~popFA2) cj_anova(pop_NOPROX , pol_popOK~RHETORIC + GENDER + OCCUPATION + IDEOLOGY, id = ~id, by = ~popFA2) cj_anova(pop_NOPROX , pol_popOK~ IDEOLOGY, id = ~id, by = ~popFA2) cj_anova(pop_NOPROX , pol_popOK~ RHETORIC , id = ~id, by = ~popFA2) cj_anova(pop_NOPROX , pol_popOK~ GENDER , id = ~id, by = ~popFA2) cj_anova(pop_NOPROX , pol_popOK~ OCCUPATION , id = ~id, by = ~popFA2)