Brexit Poll Analysis

Overview

In June 2016, the United Kingdom (UK) held a referendum to determine whether the country would “Remain” in the European Union (EU) or “Leave” the EU. This referendum is commonly known as Brexit. Although the media and others interpreted poll results as forecasting “Remain” ( 𝑝>0.5) , the actual proportion that voted “Remain” was only 48.1% (𝑝=0.481) and the UK thus voted to leave the EU. Pollsters in the UK were criticized for overestimating support for “Remain”.

# suggested libraries and options
library(tidyverse)

package ‘tidyverse’ was built under R version 4.0.1Registered S3 methods overwritten by 'dbplyr':
  method         from
  print.tbl_lazy     
  print.tbl_sql      
── Attaching packages ──────── tidyverse 1.3.0 ──
✓ ggplot2 3.3.2     ✓ purrr   0.3.4
✓ tibble  3.0.1     ✓ dplyr   1.0.0
✓ tidyr   1.1.0     ✓ stringr 1.4.0
✓ readr   1.3.1     ✓ forcats 0.5.0
package ‘ggplot2’ was built under R version 4.0.2package ‘readr’ was built under R version 4.0.2── Conflicts ─────────── tidyverse_conflicts() ──
x dplyr::filter() masks stats::filter()
x dplyr::lag()    masks stats::lag()

options(digits = 3)

# load brexit_polls object
library(dslabs)

package ‘dslabs’ was built under R version 4.0.2

data(brexit_polls)

Define 𝑝=0.481 as the actual percent voting “Remain” on the Brexit referendum and 𝑑=2𝑝−1=−0.038 as the actual spread of the Brexit referendum with “Remain” defined as the positive outcome:

p <- 0.481    # official proportion voting "Remain"
d <- 2*p-1    # official spread

Question 1: Expected value and standard error of a poll

The final proportion of voters choosing “Remain” was 𝑝=0.481 . Consider a poll with a sample of 𝑁=1500 voters.

What is the expected total number of voters in the sample choosing “Remain”?

N <- 1500
expected <- N*p
expected

[1] 722

What is the standard error of the total number of voters in the sample choosing “Remain”?

se_remain <- sqrt(N * p * (1 - p))
se_remain

[1] 19.4

What is the expected value of 𝑋̂ , the proportion of “Remain” voters?

x_hat <- p
x_hat

[1] 0.481

What is the standard error of 𝑋̂ , the proportion of “Remain” voters?

standard_error_x_hat <- sqrt(x_hat * (1-x_hat)/N)
standard_error_x_hat

[1] 0.0129

What is the expected value of 𝑑 , the spread between the proportion of “Remain” voters and “Leave” voters?

d <- 2*p -1
d

[1] -0.038

What is the standard error of 𝑑 , the spread between the proportion of “Remain” voters and “Leave” voters?

se_d <- 2 * standard_error_x_hat
se_d

[1] 0.0258

Question 2: Actual Brexit poll estimates

Load and inspect the brexit_polls dataset from dslabs, which contains actual polling data for the 6 months before the Brexit vote. Raw proportions of voters preferring “Remain”, “Leave”, and “Undecided” are available (remain, leave, undecided) The spread is also available (spread), which is the difference in the raw proportion of voters choosing “Remain” and the raw proportion choosing “Leave”.

Calculate x_hat for each poll, the estimate of the proportion of voters choosing “Remain” on the referendum day ( 𝑝=0.481 ), given the observed spread and the relationship 𝑑̂ =2𝑋̂ −1 . Use mutate() to add a variable x_hat to the brexit_polls object by filling in the skeleton code below:

What is the average of the observed spreads (spread)?

brexit_polls <- brexit_polls %>% 
                  mutate(x_hat = (spread + 1) /2)
mean(brexit_polls$spread)

[1] 0.0201

What is the standard deviation of the observed spreads?

sd(brexit_polls$spread)

[1] 0.0588

What is the average of x_hat, the estimates of the parameter

mean(brexit_polls$x_hat)

[1] 0.51

What is the standard deviation of x_hat?

sd(brexit_polls$x_hat)

[1] 0.0294

Question 3: Confidence interval of a Brexit poll

Consider the first poll in brexit_polls, a YouGov poll run on the same day as the Brexit referendum:

you_gov <- brexit_polls[1,]

Use qnorm() to compute the 95% confidence interval for 𝑋̂ .

What is the lower bound of the 95% confidence interval?

x_hat <- 0.52
N <- 4722
se <- sqrt(x_hat * (1-x_hat) / N)
ci <- c(x_hat - qnorm(0.975) * se, x_hat + qnorm(0.975) * se)
ci

[1] 0.506 0.534

Question 4: Confidence intervals for polls in June

Create the data frame june_polls containing only Brexit polls ending in June 2016 (enddate of “2016-06-01” and later). We will calculate confidence intervals for all polls and determine how many cover the true value of 𝑑.

First, use mutate() to calculate a plug-in estimate se_x_hat for the standard error of the estimate SE¹ for each poll given its sample size and value of 𝑋̂ (x_hat). Second, use mutate() to calculate an estimate for the standard error of the spread for each poll given the value of se_x_hat. Then, use mutate() to calculate upper and lower bounds for 95% confidence intervals of the spread. Last, add a column hit that indicates whether the confidence interval for each poll covers the correct spread 𝑑=−0.038.

How many polls are in june_polls?

june_polls <- brexit_polls %>% filter(enddate >= '2016-06-1')
nrow(june_polls)

[1] 32

What proportion of polls have a confidence interval that covers the value 0?

d <- -0.38
june_polls <- june_polls %>%
  mutate(se_x_hat = sqrt(x_hat * (1-x_hat)/ samplesize), se_spread = 2*se_x_hat,
         lower = spread - qnorm(0.975) * se_spread,
         upper = spread + qnorm(0.975) * se_spread,
         hit = (lower < 2*p-1 & upper > 2*p-1))
mean(june_polls$lower < 0 & june_polls$upper > 0)

[1] 0.625

mean(june_polls$lower > 0 & june_polls$upper > 0)

[1] 0.125

What proportion of polls have a confidence interval covering the true value of 𝑑 ?

head(june_polls)

mean(june_polls$hit)

[1] 0.562

Question 5: Hit rate by pollster

Group and summarize the june_polls object by pollster to find the proportion of hits for each pollster and the number of polls per pollster. Use arrange() to sort by hit rate.

june_polls_grouped <- june_polls %>% group_by(pollster) %>% summarize(hits = n())

`summarise()` ungrouping output (override with `.groups` argument)

head(june_polls_grouped)

Question 6: Boxplot of Brexit polls by poll type

ggplot(data = june_polls, aes(poll_type, spread)) + geom_boxplot()

Question 7: Combined spread across poll type

Calculate the confidence intervals of the spread combined across all polls in june_polls, grouping by poll type. Recall that to determine the standard error of the spread, you will need to double the standard error of the estimate.

Use this code (which determines the total sample size per poll type, gives each spread estimate a weight based on the poll’s sample size, and adds an estimate of p from the combined spread) to begin your analysis:

combined_by_type <- june_polls %>%
        group_by(poll_type) %>%
        summarize(N = sum(samplesize),
                  spread = sum(spread*samplesize)/N,
                  p_hat = (spread + 1)/2,
                  se_spread = 2 * sqrt(p_hat*(1-p_hat)/N),
                  lower = spread - qnorm(0.975) * se_spread,
                  upper = spread + qnorm(0.975) * se_spread)

`summarise()` ungrouping output (override with `.groups` argument)

combined_by_type

Question 8: Interpreting combined spread estimates across poll type

Question 9: Chi-squared p-value

Define brexit_hit, with the following code, which computes the confidence intervals for all Brexit polls in 2016 and then calculates whether the confidence interval covers the actual value of the spread 𝑑=−0.038 :

brexit_hit <- brexit_polls %>%
  mutate(p_hat = (spread + 1)/2,
         se_spread = 2*sqrt(p_hat*(1-p_hat)/samplesize),
         spread_lower = spread - qnorm(.975)*se_spread,
         spread_upper = spread + qnorm(.975)*se_spread,
         hit = spread_lower < -0.038 & spread_upper > -0.038) %>%
  select(poll_type, hit)

Use brexit_hit to make a two-by-two table of poll type and hit status. Then use the chisq.test() function to perform a chi-squared test to determine whether the difference in hit rate is significant.

What is the p-value of the chi-squared test comparing the hit rate of online and telephone polls?

head(brexit_hit)

totals <- brexit_hit %>% summarize(online_yes = sum(hit == 'TRUE' & poll_type == 'Online'), online_no = sum(hit == 'FALSE' & poll_type == 'Online'),
                                   telephone_yes = sum(hit == 'TRUE' & poll_type == 'Telephone'),
                                   telephone_no = sum(hit == 'FALSE' & poll_type == 'Telephone'))
totals

two_by_two <- tibble(hit = c('yes','no'),
                     online = c(totals$online_yes, totals$online_no),
                     telephone = c(totals$telephone_yes, totals$telephone_no))
two_by_two

chisq_test <- two_by_two %>% select(-hit) %>% chisq.test()
chisq_test

    Pearson's Chi-squared test with Yates'
    continuity correction

data:  .
X-squared = 11, df = 1, p-value = 0.001

10 Question 10: Odds ratio of online and telephone poll hit rate

two_by_two$online[1]

[1] 48

two_by_two$online[2]

[1] 37

two_by_two$telephone[1]

[1] 10

two_by_two$telephone[2]

[1] 32

online_yes_odds <- (two_by_two$online[1] / sum(two_by_two$online)) / (two_by_two$online[2] / sum(two_by_two$online))
online_yes_odds

[1] 1.3

Calculate the odds that a telephone poll generates a confidence interval that covers the actual value of the spread.

telephone_yes_odds <- (two_by_two$telephone[1] / sum(two_by_two$telephone)) / (two_by_two$telephone[2] / sum(two_by_two$telephone))
telephone_yes_odds

[1] 0.312

Calculate the odds ratio to determine how many times larger the odds are for online polls to hit versus telephone polls.

online_yes_odds / telephone_yes_odds

[1] 4.15

Question 11: Plotting spread over time

Use brexit_polls to make a plot of the spread (spread) over time (enddate) colored by poll type (poll_type). Use geom_smooth() with method = “loess” to plot smooth curves with a span of 0.4. Include the individual data points colored by poll type. Add a horizontal line indicating the final value of 𝑑=−.038 .

ggplot(data = brexit_polls, aes(enddate, spread, color = poll_type)) + geom_smooth(method = "loess", span = 0.4) + geom_point() + geom_hline(yintercept =  -0.038)

Question 12: Plotting raw percentages over time

Use the following code to create the object brexit_long, which has a column vote containing the three possible votes on a Brexit poll (“remain”, “leave”, “undecided”) and a column proportion containing the raw proportion choosing that vote option on the given poll:

brexit_long <- brexit_polls %>%
    gather(vote, proportion, "remain":"undecided") %>%
    mutate(vote = factor(vote))
head(brexit_long)

Make a graph of proportion over time colored by vote. Add a smooth trendline with geom_smooth() and method = “loess” with a span of 0.3.

ggplot(data = brexit_long, aes(enddate, proportion, color = vote)) + geom_smooth(method = "loess", span = 0.3) + geom_point()

---

1. 𝑋↩