Analysis on popular votes

Predicting on polls

d ~ N($\mu$, $\tau$) describes our best guess had we not seen any polling data
$\overline{X}$ | d ~ N(d, $\sigma$) describes randomness due to sampling and the pollster effect

Fundamentals: current economy, historical factors

Bayes rule in election forecast of USA, data from the last poll of each pollster, up to one week before election
Considerations: $\mu$ = 0, $\tau$ = 0.035 (average spread)
Analysis based on spread of Clinton and Trump votes of 2016.

library(tidyverse)
library(dslabs)
options(repr.plot.width=15, repr.plot.height=10)

── Attaching packages ─────────────────────────────────────── tidyverse 1.3.1 ──

✔ ggplot2 3.3.5     ✔ purrr   0.3.4
✔ tibble  3.1.3     ✔ dplyr   1.0.7
✔ tidyr   1.1.3     ✔ stringr 1.4.0
✔ readr   2.0.0     ✔ forcats 0.5.1

── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter() masks stats::filter()
✖ dplyr::lag()    masks stats::lag()

polls <- polls_us_election_2016 %>%
  filter(state == "U.S." & enddate >= "2016-10-31" &
           (grade %in% c("A+", "A", "A-", "B+") | is.na(grade))) %>%
  mutate(spread = rawpoll_clinton/100 - rawpoll_trump/100)

one_poll_per_pollster <- polls %>% group_by(pollster) %>%
  filter(enddate == max(enddate)) %>%
  ungroup()

results <- one_poll_per_pollster %>%
  summarize(avg = mean(spread), se = sd(spread)/sqrt(length(spread))) %>%
  mutate(start = avg - qnorm(0.975)*se, end = avg + qnorm(0.975)*se)

Calculating expected valor and standard error for Xbar | d ~ N(d, $\sigma$):
General bias present in every election (historically noticeable) with standard deviations between 2% and 3%

$E(p|y) = B*y + (1-B)*Y$
$SE(p|y)^{2} = 1/(1/\sigma^{2} + 1/\tau^{2})$

Sample of election: $Xi,j = d + b + hi + \varepsilon i,j$
    $i$: pollster
    $j$: poll
    $d$: actual spread
    $b$: general bias of all pollster
    $hi$: house effect of ith pollster
    $\varepsilon i,j$: ramdom error of i,jth poll
Sample average: $\overline{X} = d + b + \sum_{i=1}^{N} Xi$
Standard error: $SE(\overline{X}) = \sqrt{\sigma^{2}/N + \sigma_{b}^{2}}$

mu <- 0
tau <- 0.035
sigma <- sqrt(results$se^2 + .025^2)
Y <- results$avg
B <- sigma^2 / (sigma^2 + tau^2)
posterior_mean <- B*mu + (1-B)*Y
posterior_se <- sqrt(1 / (1/sigma^2 + 1/tau^2))

posterior_mean
posterior_se

0.0187930549631464

0.0207510862380801

Calculating a 95% credible interval:

posterior_mean + c(-qnorm(0.975), qnorm(0.975))*posterior_se

1. -0.0218783267035753
2. 0.0594644366298681

Probability of d > 0, according to popular vote: (Clinton winning the elections)

1 - pnorm(0, posterior_mean, posterior_se)

0.817437311042768