Conjoint_Appendix.Rmd

---
title: "Online Appendix for the Paper Issue Frustration, Ideology, and Populist Radical Right Vote in Europe"
author: "Nora Kirkizh and Sebastian Stier"
date: "01/04/2020"
output:
  pdf_document: default
  html_document: default
---

```{r, include=FALSE}

rm(list=ls())
library(tidyverse)
library(jtools)
library(rio)
library(cregg)
library(ggplot2)
library(gridExtra)
library(grid)
library(expss)
library(tidyr)
library(data.table)
requireNamespace("xtable", quietly = TRUE)
# load data
conjoint <- cj_df(rio::import("../Output/conjoint_plotting_data.RData"))
conjoint[, 2:16] <- NULL

```


```{r setup, include=FALSE}
knitr::opts_chunk$set(echo=FALSE, fig.width=13, fig.height=5, message=FALSE, warning=FALSE, error=FALSE)
```

## Introduction

This is an R Markdown report on preliminary analysis of conjoint survey experiment output. The conjoint survey experiment aimed to test hypotheses on populist radical right voters policy preferences. Voters were asked to evaluate eight pairs of profiles of candidates for a parliament seat in a corresponding country. Voters from France, italy, Spain, and Germany took part in the survey experiment or 1951 voters in total, whcih resulted in 31216 evaluated candidate rofiles. We are adopting the code from <https://github.com/leeper/conjoint-subgroups>. Plots by party identification, country of residence, and other political attitudes and sociodemographic background features can be found here.

```{r PRRV vs nonPRRV and most important issue}

surveys <- readRDS("../Data/paneldata.Rds") # survey data
load("../Output/conjoint_sample.Rda") # respondents with party ids from conjoint
df <- merge(surveys, conjoint_sample, by = "panelist_id") # merge with conjoint sample

library(plyr)
df$issue_recode <- revalue(df$issuesfirstW1, c(
                                  "Rising prices / cost of living"="Living costs",
                                  "The education system"="Education",
                                  "Environment, climate and energy"="Environment",
                                  "Economic situation"="Economy",
                                  "Health and social security"="Social security",
                                  "Brexit (only asked in UK)"="Brexit"))

df$group <- revalue(df$group, c("nonPRVV"="non-PRRV"))

# de install plyr package
# remove.packages("plyr")

# All countries Wave 1: PRRV vs non PRRV
mi_issue <- df %>% 
  filter(!is.na(issue_recode) & issue_recode != "Don't know/no responce") %>%
  group_by(group, issue_recode) %>% 
  summarise(count=n()) %>%
  mutate(perc=count/sum(count)) %>% 
  ggplot(aes(x=issue_recode, y=perc*100, 
             fill=ifelse(issue_recode=="Immigration", "Highlighted", "Normal"))) + 
  geom_bar(stat="identity", width=0.7) +
  theme_bw() +
  theme(axis.text.x=element_text(angle=45, hjust=1), legend.position="none") +
  facet_wrap(~group, scales="free_x") +
    coord_cartesian(ylim = c(0, 30)) +
  labs(title="Most important issue facing the country", x="", y="Percent") + 
  scale_fill_manual(values=c("Darkred", "#666666")) +
  theme(axis.text = element_text(size=6), axis.title = element_text(size=6),
        title=element_text(size=8))
  # theme(panel.border=element_blank())


# without Germany
df %>% filter(country.x != "Germany") %>%  
  filter(!is.na(issue_recode) & issue_recode != "Don't know/no responce") %>%
  group_by(group, issue_recode) %>% 
  summarise(count=n()) %>%
  mutate(perc=count/sum(count)) %>% 
  ggplot(aes(x=issue_recode, y=perc*100, fill=ifelse(issue_recode=="Immigration",      
                                                     "Highlighted", "Normal"))) + 
  geom_bar(stat="identity", width=0.7) +
  theme_bw() +
  theme(axis.text.x=element_text(angle=45, hjust=1), legend.positio="none") +
  facet_wrap(~group, scales="free_x") +
  coord_cartesian(ylim = c(0, 30)) +
  labs(title="Most important issue facing the country (without Germany)", x="", 
       y="Percent") + 
  scale_fill_manual(values=c("red", "#666666")) +
  theme(axis.text = element_text(size=8), axis.title=element_text(size=8),
        title=element_text(size=10))


```


```{r Issuefirst Wave 2}

df$issuesfirstW2 <- factor(df$issuesfirstW2)
df$issuesfirstW2_recode <- revalue(df$issuesfirstW2, c("1"="Crime",
                                                       "2"="Economy",
                                                       "3"="Living costs",
                                                       "4"="Taxation",
                                                       "5"="Unemployment",
                                                       "6"="Terrorism",
                                                       "7"="Housing",
                                                       "8"="Government debt",
                                                       "9"="Immigration",
                                                       "10"="Social security",
                                                       "11"="Education",
                                                       "12"="Pensions",
                                                       "13"="Environment",
                                                       "14"="Brexit",
                                                       "15"="Other issue"))


# All countries Wave 1 next to Wave 2
df_issue <- df %>% select(issue_recode,issuesfirstW2_recode, group) %>%
  filter(group=="PRRV")

df_issue <- na.omit(df_issue)

issueW1_share = table(df_issue$issue_recode)/nrow(df_issue)*100
issueW2_share = table(df_issue$issuesfirstW2_recode)/nrow(df_issue)*100

df_sharesW1 <- data.frame(issueW1_share, Wave=rep("Wave 1", nrow(issueW1_share)))
df_sharesW2 <- data.frame(issueW2_share, Wave=rep("Wave 2", nrow(issueW2_share)))

df_issuesW <- rbind(df_sharesW1, df_sharesW2)
df_issuesW <- df_issuesW %>% filter(Var1 != "0" & Var1 != "Brexit") 

ggplot(df_issuesW, aes(Var1, Freq, fill=Wave, col=Wave, linetype=Wave)) +
  geom_bar(aes(fill=Wave),stat="identity",position="identity") +
  scale_fill_manual(values = alpha(c("#666666", "#CCCCCC"), 0.3)) +
  scale_color_manual(values = c("black","black")) +
  scale_linetype_manual(values = c("blank", "dashed")) +
  theme_bw() +
  scale_size_manual(values=c(0.2, 0.2)) +
  theme(axis.text.x=element_text(angle=45, hjust=1)) +
  coord_cartesian(ylim = c(0, 30)) +
  labs(title="PRRV: Most important issue facing the country", y="Percent", x="") +
  theme(axis.text = element_text(size=8), axis.title=element_text(size=8),
        title=element_text(size=8), legend.title = element_blank())

```


```{r Issue divergence plot, }

library(ggalt) # devtools::install_github("hrbrmstr/ggalt")

df_pew <- df %>% 
  filter(!is.na(issue_recode) & issue_recode != "Don't know/no responce") %>%
  select(issue_recode, group) %>% 
  filter(!is.na(issue_recode)) %>%
  group_by(group, issue_recode) %>% 
  summarise(count=n()) %>% 
  mutate(perc=(count/sum(count))*100) %>% 
  select(-count)

df_pew <- spread(df_pew, "group", "perc")
df_pew$nonPRRV <- df_pew$`non-PRRV`
df_pew$`non-PRRV` <- NULL
df_pew$diff <- sprintf("%d", as.integer((df_pew$PRRV-df_pew$nonPRRV)))

# we want to keep the order in the plot, so we use a factor for country
df_pew <- arrange(df_pew, desc(diff))
df_pew$issue_recode <- factor(df_pew$issue_recode, levels=rev(df_pew$issue_recode))

# we only want the first line values with "%" symbols (to avoid chart junk)
# quick hack; there is a more efficient way to do this
percent_first <- function(x) {
  x <- sprintf("%d%%", round(x))
  x[2:length(x)] <- sub("%$", "", x[2:length(x)])
  x
}

policy_gap <- ggplot()+ 
  geom_segment(data=df_pew, aes(y=issue_recode, yend=issue_recode, 
                                             x=0, xend=0.3), color="#b2b2b2", size=0.15) +
  geom_dumbbell(data=df_pew, aes(y=issue_recode, x=PRRV, xend=nonPRRV),
                         color="#b2b2b2", size=1.5, colour_x = "darkred", 
                         colour_xend = "black", size_x = 1.5, size_xend = 1.5) +
  geom_text(data=filter(df_pew, issue_recode=="Living costs"),
                     aes(x=nonPRRV, y=issue_recode, label="nonPRRV"),
                     color="black", size=2, vjust=-1.5, fontface="bold") + 
  geom_text(data=filter(df_pew, issue_recode=="Living costs"),
                     aes(x=PRRV, y=issue_recode, label="PRRV"),
                     color="darkred", size=2, vjust=-1.5, fontface="bold") +
  geom_text(data=df_pew, aes(x=nonPRRV, y=issue_recode, label=percent_first(nonPRRV)),
                     color="black", size=2, vjust=2.5) + 
  geom_text(data=df_pew, color="darkred", size=2, vjust=2.5, aes(x=PRRV, y=issue_recode,                                              label=percent_first(PRRV))) +
  labs(x="Percent", y=NULL, title="Most important issue gap", subtitle="", caption="") + 
  theme_bw() +
  theme(axis.text = element_text(size=8), axis.title=element_text(size=8),
        title=element_text(size=8)) +
  theme(panel.border=element_blank()) +
  theme(axis.ticks=element_blank())

```

```{r dunbbell plot by country, }

# Germany
pew_ger <- df %>% filter(country.x=="Germany") %>% 
  filter(!is.na(issue_recode) & issue_recode != "Don't know/no responce") %>%
  select(issue_recode, group) %>% 
  group_by(group, issue_recode) %>% 
  summarise(count=n()) %>% 
  mutate(perc=(count/sum(count))*100) %>% 
  select(-count)

pew_ger <- spread(pew_ger, "group", "perc")
pew_ger$nonPRRV <- pew_ger$`non-PRRV`
pew_ger$`non-PRRV` <- NULL
pew_ger$diff <- sprintf("%d", as.integer((pew_ger$PRRV-pew_ger$nonPRRV)))

# we want to keep the order in the plot, so we use a factor for country
pew_ger <- arrange(pew_ger, desc(diff))
pew_ger$issue_recode <- factor(pew_ger$issue_recode, levels=rev(pew_ger$issue_recode))

# plot
policygap_ger <- ggplot()+ 
  geom_segment(data=pew_ger, aes(y=issue_recode, yend=issue_recode, 
                                             x=0, xend=0.3), color="#b2b2b2", size=0.15) +
  geom_dumbbell(data=pew_ger, aes(y=issue_recode, x=PRRV, xend=nonPRRV),
                         color="#b2b2b2", size=1.5, colour_x = "darkred", 
                         colour_xend = "black", size_x = 1.5, size_xend = 1.5) +
  geom_text(data=filter(pew_ger, issue_recode=="Living costs"),
                     aes(x=nonPRRV, y=issue_recode, label=""),
                     color="black", size=2, vjust=-1.5, fontface="bold") + 
  geom_text(data=filter(pew_ger, issue_recode=="Living costs"),
                     aes(x=PRRV, y=issue_recode, label=""),
                     color="darkred", size=2, vjust=-1.5, fontface="bold") +
  geom_text(data=pew_ger, aes(x=nonPRRV, y=issue_recode, label=percent_first(nonPRRV)),
                     color="black", size=2, vjust=2.5) + 
  geom_text(data=pew_ger, color="darkred", size=2, vjust=2.5, aes(x=PRRV, y=issue_recode,                                              label=percent_first(PRRV))) +
  labs(x="Percent", y=NULL, title="Germany: Most important issue gap", subtitle="", caption="") + 
  theme_bw() +
  theme(axis.text = element_text(size=8), axis.title=element_text(size=8),
        title=element_text(size=8)) +
  theme(panel.border=element_blank()) +
  theme(axis.ticks=element_blank())


# France
pew_fr <- df %>% filter(country.x=="France") %>% 
  filter(!is.na(issue_recode) & issue_recode != "Don't know/no responce") %>%
  select(issue_recode, group) %>% 
  group_by(group, issue_recode) %>% 
  summarise(count=n()) %>% 
  mutate(perc=(count/sum(count))*100) %>% 
  select(-count)

pew_fr <- spread(pew_fr, "group", "perc")
pew_fr$nonPRRV <- pew_fr$`non-PRRV`
pew_fr$`non-PRRV` <- NULL
pew_fr$diff <- sprintf("%d", as.integer((pew_fr$PRRV-pew_fr$nonPRRV)))

# we want to keep the order in the plot, so we use a factor for country
pew_fr <- arrange(pew_fr, desc(diff))
pew_fr$issue_recode <- factor(pew_fr$issue_recode, levels=rev(pew_fr$issue_recode))

# plot
policygap_fr <- ggplot()+ 
  geom_segment(data=pew_fr, aes(y=issue_recode, yend=issue_recode, 
                                             x=0, xend=0.3), color="#b2b2b2", size=0.15) +
  geom_dumbbell(data=pew_fr, aes(y=issue_recode, x=PRRV, xend=nonPRRV),
                         color="#b2b2b2", size=1.5, colour_x = "darkred", 
                         colour_xend = "black", size_x = 1.5, size_xend = 1.5) +
  geom_text(data=filter(pew_fr, issue_recode=="Living costs"),
                     aes(x=nonPRRV, y=issue_recode, label=""),
                     color="black", size=2, vjust=-1.5, fontface="bold") + 
  geom_text(data=filter(pew_fr, issue_recode=="Living costs"),
                     aes(x=PRRV, y=issue_recode, label=""),
                     color="darkred", size=2, vjust=-1.5, fontface="bold") +
  geom_text(data=pew_fr, aes(x=nonPRRV, y=issue_recode, label=percent_first(nonPRRV)),
                     color="black", size=2, vjust=2.5) + 
  geom_text(data=pew_fr, color="darkred", size=2, vjust=2.5, aes(x=PRRV, y=issue_recode,                                              label=percent_first(PRRV))) +
  labs(x="Percent", y=NULL, title="France: Most important issue gap", subtitle="", caption="") + 
  theme_bw() +
  theme(axis.text = element_text(size=8), axis.title=element_text(size=8),
        title=element_text(size=8)) +
  theme(panel.border=element_blank()) +
  theme(axis.ticks=element_blank())

# Italy
pew_it <- df %>% filter(country.x=="Italy") %>% 
  filter(!is.na(issue_recode) & issue_recode != "Don't know/no responce") %>% 
  select(issue_recode, group) %>% 
  group_by(group, issue_recode) %>% 
  summarise(count=n()) %>% 
  mutate(perc=(count/sum(count))*100) %>% 
  select(-count)

pew_it <- spread(pew_it, "group", "perc")
pew_it$nonPRRV <- pew_it$`non-PRRV`
pew_it$`non-PRRV` <- NULL
pew_it$diff <- sprintf("%d", as.integer((pew_it$PRRV-pew_it$nonPRRV)))

# we want to keep the order in the plot, so we use a factor for country
pew_it <- arrange(pew_it, desc(diff))
pew_it$issue_recode <- factor(pew_it$issue_recode, levels=rev(pew_it$issue_recode))

# plot
policygap_it <- ggplot()+ 
  geom_segment(data=pew_it, aes(y=issue_recode, yend=issue_recode, 
                                             x=0, xend=0.3), color="#b2b2b2", size=0.15) +
  geom_dumbbell(data=pew_it, aes(y=issue_recode, x=PRRV, xend=nonPRRV),
                         color="#b2b2b2", size=1.5, colour_x = "darkred", 
                         colour_xend = "black", size_x = 1.5, size_xend = 1.5) +
  geom_text(data=filter(pew_it, issue_recode=="Living costs"),
                     aes(x=nonPRRV, y=issue_recode, label=""),
                     color="black", size=2, vjust=-1.5, fontface="bold") + 
  geom_text(data=filter(pew_it, issue_recode=="Living costs"),
                     aes(x=PRRV, y=issue_recode, label=""),
                     color="darkred", size=2, vjust=-1.5, fontface="bold") +
  geom_text(data=pew_it, aes(x=nonPRRV, y=issue_recode, label=percent_first(nonPRRV)),
                     color="black", size=2, vjust=2.5) + 
  geom_text(data=pew_it, color="darkred", size=2, vjust=2.5, aes(x=PRRV, y=issue_recode,                                              label=percent_first(PRRV))) +
  labs(x="Percent", y=NULL, title="Italy: Most important issue gap", subtitle="", caption="") + 
  theme_bw() +
  theme(axis.text = element_text(size=8), axis.title=element_text(size=8),
        title=element_text(size=8)) +
  theme(panel.border=element_blank()) +
  theme(axis.ticks=element_blank())


# Spain
pew_es <- df %>% filter(country.x=="Spain") %>% 
  filter(!is.na(issue_recode) & issue_recode != "Don't know/no responce") %>% 
  select(issue_recode, group) %>% 
  group_by(group, issue_recode) %>% 
  summarise(count=n()) %>% 
  mutate(perc=(count/sum(count))*100) %>% 
  select(-count)

pew_es <- spread(pew_es, "group", "perc")
pew_es$nonPRRV <- pew_es$`non-PRRV`
pew_es$`non-PRRV` <- NULL
pew_es$diff <- sprintf("%d", as.integer((pew_es$PRRV-pew_es$nonPRRV)))

# we want to keep the order in the plot, so we use a factor for country
pew_es <- arrange(pew_es, desc(diff))
pew_es$issue_recode <- factor(pew_es$issue_recode, levels=rev(pew_es$issue_recode))

# plot
policygap_es <- ggplot()+ 
  geom_segment(data=pew_es, aes(y=issue_recode, yend=issue_recode, 
                                             x=0, xend=0.3), color="#b2b2b2", size=0.15) +
  geom_dumbbell(data=pew_es, aes(y=issue_recode, x=PRRV, xend=nonPRRV),
                         color="#b2b2b2", size=1.5, colour_x = "darkred", 
                         colour_xend = "black", size_x = 1.5, size_xend = 1.5) +
  geom_text(data=filter(pew_es, issue_recode=="Living costs"),
                     aes(x=nonPRRV, y=issue_recode, label=""),
                     color="black", size=2, vjust=-1.5, fontface="bold") + 
  geom_text(data=filter(pew_es, issue_recode=="Living costs"),
                     aes(x=PRRV, y=issue_recode, label=""),
                     color="darkred", size=2, vjust=-1.5, fontface="bold") +
  geom_text(data=pew_es, aes(x=nonPRRV, y=issue_recode, label=percent_first(nonPRRV)),
                     color="black", size=2, vjust=2.5) + 
  geom_text(data=pew_es, color="darkred", size=2, vjust=2.5, aes(x=PRRV, y=issue_recode,                                              label=percent_first(PRRV))) +
  labs(x="Percent", y=NULL, title="Italy: Most important issue gap", subtitle="", caption="") + 
  theme_bw() +
  theme(axis.text = element_text(size=8), axis.title=element_text(size=8),
        title=element_text(size=8)) +
  theme(panel.border=element_blank()) +
  theme(axis.ticks=element_blank())

library(ggpubr)
ggarrange(policygap_ger, policygap_fr, policygap_it, policygap_es, ncol = 2, nrow = 2)

```


```{r Figure 1 PRRV vs nonPRRV and most important issue by COUNTRY}

# France: PRRV vs nonPRRV
fr_issue <- df %>% filter(country.x=="France") %>% 
  filter(!is.na(issue_recode) & issue_recode != "Don't know/no responce") %>%
  group_by(group, issue_recode) %>% 
  summarise(count=n()) %>%
  mutate(perc=count/sum(count)) %>% 
  ggplot(aes(x=issue_recode, y=perc*100, 
             fill=ifelse(issue_recode=="Immigration", "Highlighted", "Normal"))) + 
  geom_bar(stat="identity", width=0.7) +
  theme_bw() +
  theme(axis.text.x=element_text(angle=45, hjust=1), legend.position="none") +
  facet_wrap(~group, scales="free_x") +
  labs(title="France", x="", y="Percent") + 
  scale_fill_manual(values=c("Darkred", "#666666")) +
  theme(axis.text = element_text(size=6), axis.title = element_text(size=8),
        title=element_text(size=8))

# Most important issue facing the country

# Italy: PRRV vs nonPRRV
it_issue <- df %>% filter(country.x=="Italy") %>% 
  filter(!is.na(issue_recode) & issue_recode != "Don't know/no responce") %>%
  group_by(group, issue_recode) %>% 
  summarise(count=n()) %>%
  mutate(perc=count/sum(count)) %>% 
  ggplot(aes(x=issue_recode, y=perc*100, 
             fill=ifelse(issue_recode=="Immigration", "Highlighted", "Normal"))) + 
  geom_bar(stat="identity", width=0.7) +
  theme_bw() +
  theme(axis.text.x=element_text(angle=45, hjust=1), legend.position="none") +
  facet_wrap(~group, scales="free_x") +
  labs(title="Italy", x="", y="") + 
  scale_fill_manual(values=c("Darkred", "#666666")) +
  theme(axis.text = element_text(size=6), axis.title = element_text(size=8),
        title=element_text(size=8))


# Germany: PRRV vs nonPRRV
ger_issue <- df %>% filter(country.x=="Germany") %>% 
  filter(!is.na(issue_recode) & issue_recode != "Don't know/no responce") %>%
  group_by(group, issue_recode) %>% 
  summarise(count=n()) %>%
  mutate(perc=count/sum(count)) %>% 
  ggplot(aes(x=issue_recode, y=perc*100, fill=ifelse(issue_recode=="Immigration",      "Highlighted", "Normal"))) + 
  geom_bar(stat="identity", width=0.7) +
  theme_bw() +
  theme(axis.text.x=element_text(angle=45, hjust=1), 
        legend.position = "none") +
  facet_wrap(~group, scales="free_x") +
  labs(title="Germany", x="", y="Percent") + 
  scale_fill_manual(values = c("Darkred", "#666666")) +
  theme(axis.text = element_text(size=6), axis.title = element_text(size=8),
        title=element_text(size=8))


# Spain: PRRV vs nonPRRV
spain_issue <- df %>% filter(country.x=="Spain") %>% 
  filter(!is.na(issue_recode) & issue_recode != "Don't know/no responce") %>%
  group_by(group, issue_recode) %>% 
  summarise(count=n()) %>%
  mutate(perc=count/sum(count)) %>% 
  ggplot(aes(x=issue_recode, y=perc*100,
             fill=ifelse(issue_recode=="Immigration", "Highlighted", "Normal"))) + 
  geom_bar(stat="identity", width=0.7) +
  theme_bw() +
  theme(axis.text.x=element_text(angle=45, hjust=1), legend.position="none") +
  facet_wrap(~group, scales="free_x") +
  labs(title="Spain", x="", y="") + 
  scale_fill_manual(values=c("Darkred", "#666666")) +
  theme(axis.text = element_text(size=6), axis.title = element_text(size=8),
        title=element_text(size=8))

ggarrange(fr_issue, it_issue, ger_issue, spain_issue, ncol = 2, nrow = 2)


```

# Most important issue and ideology

```{r Immigration Climate Living costs EU Populism}

# combining left-right variable for Germany from Wave 0 with Wave 1
df$leftrightW0[is.na(df$leftrightW0)] = 0
df$leftrightW1[is.na(df$leftrightW1)] = 0
df$lf <- df$leftrightW1 + df$leftrightW0

df$lr <- car::recode(df$lf, "1=0; 2=1; 3=2; 4=3; 5=4; 6=5; 7=6; 8=7; 9=8; 10=9; 11=10; else=NA")

df$imm_index <- (df$immprobs_socialsystemW1 + df$immprobs_jobsW1 + df$immprobs_crimeW1)/3
df$imm_rec <- car::recode(df$imm_index, "0:2.33333333333333='0'; else='1'")
df$climate_tax01 <- car::recode(df$climatepolicies_taxesW2, "0:2=1; 4:5=0; else=NA")
df$livcosts01 <- car::recode(df$leftpopattid_govredW2, "0:2=1; 4:5=0; else=NA")
df$euintegr01 <- car::recode(df$euintegrationW1, "0:4=1; 6:10=0; else=NA")
df$climate_renew01 <- car::recode(df$climatepolicies_renewableW2, "0:2=1; 4:5=0; else=NA")

df_policy <- df %>% select(lr, imm_rec, climate_renew01, livcosts01, euintegr01, group)

gath <- gather(df_policy, "Policy", "value", 
               imm_rec, climate_renew01, livcosts01, euintegr01)


gath$Policy <- revalue(gath$Policy, c(
                                  "climate_renew01"="Climate change",
                                  "imm_rec"="Immigration",
                                  "livcosts01"="Living costs",
                                  "euintegr01"="EU integration"))


policy <- ggplot(gath, aes(x=lr, y=value, group=Policy, color=Policy)) +
  geom_hline(yintercept = 0.5, color = "black", linetype="dashed") +
  stat_smooth(method="loess", size=0.8) +
  # facet_wrap(~group) +
  scale_x_continuous(breaks=0:10) + 
  scale_y_continuous(breaks = c(0.00,0.25,0.50,0.75,1.00)) +
  scale_color_manual(values=c("#999999", "#000000", "#600000", "#666666")) +  
  theme_minimal() +
  labs(title="", x="\nIdeology: 0 (Left) to 10 (Right)", y="Share of opposed to ...") +
  theme(axis.text = element_text(size = 8), axis.title = element_text(size=8),
        title=element_text(size=10), legend.text=element_text(size=8))


```


```{r Compiled plot, }

ggarrange(policy_gap, arrangeGrob(mi_issue, policy))

```

# Most important issue based on conjoint experiment

```{r Plot to show that immigration has the largest effects on Pr(Choosing a candidate)}

PRRV <- conjoint[conjoint$group == "PRRV",]
nonPRRV <- conjoint[conjoint$group == "nonPRVV",]

result <- cregg::cj(
    PRRV, 
    selected ~ imm + soc + climate + eu + run,
    id = ~ panelist_id,
    estimate = "mm")

nonprrv <- cregg::cj(
    nonPRRV, 
    selected ~ imm + soc + climate + eu + run,
    id = ~ panelist_id,
    estimate = "mm")

result_df <- data.frame(result)
result_df$Voters <- rep("PRRV")
nonprrv_df <- data.frame(nonprrv)
nonprrv_df$Voters <- rep("nonPRRV")
combined <- rbind(result_df, nonprrv_df)

ggplot(combined, aes(estimate, level, colour=Voters)) +
  geom_point() + 
  geom_errorbarh(data = combined, mapping=aes(y=level, xmax=lower, xmin=upper), 
                 height=0, size=0.5) + 
  geom_text(aes(label = sprintf("%0.2f (%0.2f)", estimate, std.error)), size = 1.5, 
            position = position_nudge(y = 0.4)) +
  scale_x_continuous(limits=c(0.25, 0.75)) +
  facet_wrap(~feature, scales="free_y", ncol=1) +
  geom_vline(xintercept = 0.5, linetype="solid", color = "black", size=0.2) +
  annotate("rect", xmin = 0.4, xmax = 0.6, ymin = -Inf, ymax = Inf, 
           fill = "black", alpha = 0.1, color = NA) +
  ggtitle("") +
  theme_bw() + 
  ylab("") + 
  xlab("Pr(Choosing a candidate)") +
  theme(axis.text=element_text(size=8), axis.title=element_text(size=8),
        title=element_text(size=10)) +
  scale_color_manual(values = c("#999999", "#000000"))


```

## Conjoint Plots by Country

The plots illustrate marginal means for PRVV and nonPRRV voters by country.

```{r MM by country on a single plot, fig.width=15, fig.height=6}

allprrv <- conjoint %>% filter(group == "PRRV")
allnonprrv <- conjoint %>% filter(group == "nonPRVV")

# PRRV
p_allprrv <- plot(cj(allprrv, selected ~ imm + soc + climate + eu + run, id = ~ panelist_id, by = ~ country, estimate = "mm"), group = "BY", vline = 0.5) + ggtitle("PRRV")

# nonPRRV
p_allnonprrv <- plot(cj(allnonprrv, selected ~ imm + soc + climate + eu + run, id = ~ panelist_id, by = ~ country, estimate = "mm"), group = "BY", vline = 0.5) + ggtitle("nonPRRV")

gridExtra::grid.arrange(p_allprrv, p_allnonprrv, ncol=2)

```

# Testing Pre-registered Hypothesis from PAP about The Limist of Issue Frustration

```{r, Subsetting profiles with PRR position on immigration}

conjoint$task <- rep(1:8, each=2) # add task number variable
conjoint$num_imm <- as.numeric(conjoint$imm) # numerical imm
# only tasks with PRR imm position:
dtimm <- conjoint %>% group_by(panelist_id, task) %>% filter(1 %in% num_imm)

# we don't need tasks, where both profiles proposed PRR imm measure, so let's remove it:
dtimm <- dtimm %>% group_by(panelist_id, task) %>% filter(sum(num_imm) > 2)

# drop tasks, where a panelist had to choose between profile with PRR and Left imm position, because Left imm position is as strong trigger too (see plots from the preliminary analysis)
dtimm <- dtimm %>% group_by(panelist_id, task) %>% filter(sum(num_imm) < 4)

# make other attributes numerial for further subsetting
dtimm$num_soc <- as.numeric(dtimm$soc)
dtimm$num_climate <- as.numeric(dtimm$climate)
dtimm$num_eu <- as.numeric(dtimm$eu)
dtimm$num_run <- as.numeric(dtimm$run)
dtimm <- as.data.frame(dtimm) # make sure it's df for further manipulations

```


```{r, Subsetting by number of left porposals in profiles}

#### Left positions: ZERO #### 
dtimm_left0 <- dtimm %>%
  mutate(ind = rowSums(select(., 18:21)==3)==0) %>% 
  group_by(panelist_id, task) %>% 
  filter(if(any(ind)) all(ind[num_imm==1]) else FALSE) %>% 
  ungroup %>% 
  select(-ind)

dtimm_left0 <- dtimm_left0[dtimm_left0$group == "PRRV",] # only PRR voters


####  Left positions: ONE #### 
dtimm_left1 <- dtimm %>%
  mutate(ind = rowSums(select(., 18:21)==3)==1) %>% 
  group_by(panelist_id, task) %>% 
  filter(if(any(ind)) all(ind[num_imm==1]) else FALSE) %>% 
  ungroup %>% 
  select(-ind)

dtimm_left1 <- dtimm_left1[dtimm_left1$group == "PRRV",] # only PRR voters


####  Left positions: TWO #### 
dtimm_left2 <- dtimm %>%
  mutate(ind = rowSums(select(., 18:21)==3)==2) %>% 
  group_by(panelist_id, task) %>% 
  filter(if(any(ind)) all(ind[num_imm==1]) else FALSE) %>% 
  ungroup %>% 
  select(-ind)

dtimm_left2 <- dtimm_left2[dtimm_left2$group == "PRRV",] # only PRR voters


#### Left positions: THREE #### 
dtimm_left3 <- dtimm %>%
  mutate(ind = rowSums(select(., 18:21) == 3) == 3) %>% 
  group_by(panelist_id, task) %>% 
  filter(if(any(ind)) all(ind[num_imm==1]) else FALSE) %>%
  ungroup %>%
  select(-ind)

dtimm_left3 <- dtimm_left3[dtimm_left3$group == "PRRV",] # only PRR voters


#### Left positions: FOUR #### 
# With FOUR left positions we are underpowered
dtimm_left4 <- dtimm %>%
  mutate(ind = rowSums(select(., 18:21) == 3) == 4) %>% 
  group_by(panelist_id, task) %>% 
  filter(if(any(ind)) all(ind[num_imm==1]) else FALSE) %>%
  ungroup %>%
  select(-ind)

dtimm_left4 <- dtimm_left4[dtimm_left4$group == "PRRV",] # only PRR voters

```

## Plotting coefficients of interest

```{r, major plot in the paper}

m <- selected ~ imm + soc + climate + eu + run
m4 <- cj(dtimm_left4, m, id= ~ panelist_id, estimate="mm", h0=0.5)
m3 <- cj(dtimm_left3, m, id= ~ panelist_id, estimate="mm", h0=0.5)
m2 <- cj(dtimm_left2, m, id= ~ panelist_id, estimate="mm", h0=0.5)
m1 <- cj(dtimm_left1, m, id= ~ panelist_id, estimate="mm", h0=0.5)
m0 <- cj(dtimm_left0, m, id= ~ panelist_id, estimate="mm", ho=0.5)


# with four left positions
imm4_coefdt <- data.frame(n_left=c("0", "1", "2", "3", "4"), rbind(m0[1,], m1[1,], m2[1,], m3[1,], m4[1,]))

my_title1 <- expression(paste("Competing candidate ", bold("cannot"), " propose pro-immigrant policy"))
my_title2 <- expression(paste("Competing candidate ", bold("can"), " propose pro-immigrant policy"))

ggplot(imm4_coefdt, aes(x=n_left, y=estimate)) +
  geom_point(size=1.5, shape=21, fill="black") + 
  geom_line(aes(group=FALSE), linetype="dashed") + 
  scale_y_continuous(limits=c(0.48, 1)) +
  geom_errorbar(mapping=aes(ymax=lower, ymin=upper), width=0.1, size=0.3, color="black") +
  theme_bw() +
  geom_hline(yintercept = 0.5, linetype="solid", color = "black", size=0.1) + 
  xlab("Number of left proposals in anti-immigrant candidate profile") + 
  ylab("Pr(Choosing anti-immigrant candidate)") +
  ggtitle(my_title1) +
  theme(axis.text=element_text(size=10), axis.title=element_text(size=10),
        title=element_text(size=10))


```

# Numerical results

```{r, numerical results}

# PRRV
print(xtable::xtable(
  cj(allprrv, 
     selected ~ imm + soc + climate + eu + run,
     id = ~ panelist_id,
     estimate = "mm",
     h0 = 0.5)[c("feature", "level", "estimate", "std.error", "z")],
     digits = 2, align = c("l", "l", "p{3in}", "r", "r", "r")), include.rownames = FALSE,
     comment=FALSE, size = "footnotesize")

# nonPRRV
print(xtable::xtable(
  cj(allnonprrv, 
     selected ~ imm + soc + climate + eu + run,
     id = ~ panelist_id,
     estimate = "mm",
     h0 = 0.5)[c("feature", "level", "estimate", "std.error", "z")],
     digits = 2, align = c("l", "l", "p{3in}", "r", "r", "r")), include.rownames = FALSE,
     comment=FALSE, size = "footnotesize")

```