Tactical voting site analysis

tv2019.R

### Load libraries
library(tidyverse)
library(rio)
library(rdrobust)
library(hrbrthemes)

## Data from https://docs.google.com/spreadsheets/d/1uNdRzf5-IqnSwNCPCD8eTxsBKBEEaTmlvq4eP_pt7JI/edit?usp=sharing
dat <- read.csv("data.csv") 
### Graph things
p1 <- ggplot(dat, aes(x = LD17, y = LD,
                      group = (Rec.b4b == "LD"),
                      alpha = (Rec.b4b == "LD"))) +
    scale_x_continuous("Lib Dem share in 2017") +
    scale_y_continuous("Lib Dem share in 2019") +
    geom_point(size = 4,
               aes(shape = (Rec.b4b == "LD"), colour = (Rec.b4b == "LD"))) +
    scale_shape_discrete("Recommended by Best for Britain") +
    scale_alpha_manual(values = c(0.5, 1), guide = "none") + 
    scale_colour_manual("Recommended by Best for Britain",
                        values = c("grey", "goldenrod")) +
    geom_smooth(se = FALSE, aes(colour = (Rec.b4b == "LD")), linetype = "dotted") +
    labs(title = "Lib Dems did better when they received a Best for Britain recommendation",
         subtitle = "This holds controlling for Lib Dem vote share in 2017",
         caption = "@chrishanretty") + 
    theme_ipsum_rc() +
    theme(legend.position = c(0.9, 1.05)) 

p2 <- ggplot(dat, aes(x = LD17, y = LD,
                      group = (Rec.ru == "LD"),
                      alpha = (Rec.ru == "LD"))) +
    scale_x_continuous("Lib Dem share in 2017") +
    scale_y_continuous("Lib Dem share in 2019") +
    geom_point(size = 4,
               aes(shape = (Rec.ru == "LD"), colour = (Rec.ru == "LD"))) +
    scale_shape_discrete("Recommended by Remain Utd") +
    scale_colour_manual("Recommended by Remain Utd",
                        values = c("grey", "goldenrod")) +
    scale_alpha_manual(values = c(0.5, 1), guide = "none") + 
    geom_smooth(se = FALSE, aes(colour = (Rec.ru == "LD")), linetype = "dotted") +
    labs(title = "Lib Dems also did better when they received a Remain United recommendation",
         subtitle = "This holds controlling for Lib Dem vote share in 2017",
         caption = "@chrishanretty") + 
    theme_ipsum_rc() +
    theme(legend.position = c(0.9, 1.05)) 

ggsave(p1, file = "p1.png", width = 9 * 72, height = 5 * 72, dpi = 300)
ggsave(p2, file = "p1.png", width = 9 * 72, height = 5 * 72, dpi = 300)

### Create models for different dep. vars using different sites
f_con_b4b <- Con ~ Con17 + Con15 + Con10 + ld_winner + remainHanretty + b4b_rec_ld+ poly(Con.b4b, 2) + Green_cand + PC_cand
f_lab_b4b <- Lab ~ Lab17 + Lab15 + Lab10 + lab_winner + remainHanretty + b4b_rec_ld+ poly(Lab.b4b, 2) + Green_cand + PC_cand
f_ld_b4b <- LD ~ LD17 + LD15 + LD10 + con_winner + remainHanretty + b4b_rec_ld+ poly(LD.b4b, 2) + Green_cand + PC_cand
f_green_b4b <- Green ~ Green17 + Green15 + Green10 + remainHanretty + b4b_rec_ld+ poly(Green.b4b, 2) + Green_cand + PC_cand

ols_con_b4b <- lm(f_con_b4b,
                  data = dat)
ols_lab_b4b <- lm(f_lab_b4b,
                  data = dat)
ols_ld_b4b <- lm(f_ld_b4b,
                 data = dat)
ols_green_b4b <- lm(f_green_b4b,
                    data = dat)

ols_ld_ru <- lm(LD ~ LD17 + LD15 + LD10 + ld_winner + remainHanretty + ru_rec_ld + poly(LD.ru, 2) + Green_cand + PC_cand,
                 data = dat)
ols_con_ru <- lm(Con ~ Con17 + Con15 + Con10 + con_winner + remainHanretty + ru_rec_ld + poly(Con.ru, 2) + Green_cand + PC_cand,
                 data = dat)

ols_lab_ru <- lm(Lab ~ Lab17 + Lab15 + Lab10 + lab_winner + remainHanretty + ru_rec_ld + poly(Lab.ru, 2) + Green_cand + PC_cand,
                 data = dat)

ols_green_ru <- lm(Green ~ Green17 + Green15 + Green10 + remainHanretty + ru_rec_ld + poly(Green.ru, 2) + Green_cand + PC_cand,
                 data = dat)

### Create RDD models  using rdrobust
### (Not reported)
rdd_ld_b4b_a <- rdrobust(y = dat$chg_ld, x = dat$rv.b4b)

rdd_ld_b4b_b <- rdrobust(y = dat$chg_ld, x = dat$rv.b4b,
                         fuzzy = as.numeric(dat$Rec.b4b == "LD"))

rdd_ld_ru_a <- rdrobust(y = dat$chg_ld, x = dat$rv.ru)

rdd_ld_ru_b <- rdrobust(y = dat$chg_ld, x = dat$rv.ru,
                        fuzzy = as.numeric(dat$Rec.ru == "LD"))

### What would the results have been but for this?
###
alt_parties <- c("Con.alt", "Lab.alt", "LD.alt", "Green.alt", "Plaid.alt", "SNP.alt", "Other.alt")
dat$Con.alt <- dat$Lab.alt <- dat$LD.alt <- dat$Green.alt <- dat$Plaid.alt <- dat$SNP.alt <- dat$Other.alt <- NA
dat[,alt_parties] <-
    dat[,c("Con", "Lab", "LD", "Green", "Plaid", "SNP", "Other")]

changes <- c(tidy(ols_con_b4b) %>% filter(term == "b4b_rec_ld") %>% pull(estimate),
             tidy(ols_lab_b4b) %>% filter(term == "b4b_rec_ld") %>% pull(estimate),
             tidy(ols_ld_b4b) %>% filter(term == "b4b_rec_ld") %>% pull(estimate),
             tidy(ols_green_b4b) %>% filter(term == "b4b_rec_ld") %>% pull(estimate),
             0,
             0,
             0)

for (i in alt_parties) {
    dat[,i] <- ifelse(dat$b4b_rec_ld,
                      dat[,i] - changes[which(alt_parties == i)],
                      dat[,i])
}

winners <- alt_parties[apply(dat[,sub(".alt", "", alt_parties)], 1, which.max)]
table(winners, useNA = "always")

alt_winners <- alt_parties[apply(dat[,alt_parties], 1, which.max)]
table(alt_winners, useNA = "always")

### Seats which would have been lost w/o tactical voting sites
which(winners == "LD.alt" & alt_winners != "LD.alt")