Predicting presidential election winners by polling data and logistic regression.

polling.R

library('mice')

polling <- read.csv('PollingData.csv')

table(polling$Year)

# Note missing values in Rasmussen and SurveyUSA.
summary(polling)

simple <- polling[c('Rasmussen', 'SurveyUSA', 'PropR', 'DiffCount')]

set.seed(144)

# Fill in missing values by simulating similar values.
imputed <- complete(mice(simple))

polling$Rasmussen <- imputed$Rasmussen
polling$SurveyUSA <- imputed$SurveyUSA

train <- subset(polling, Year == 2004 | Year == 2008)
test <- subset(polling, Year == 2012)

#  0 1
# 47 53
# Shows results for 53 republication wins. A baseline prediction can assume a republication always wins or 53%.
table(train$Republican)

# Baseline accuracy: 0.53
53 / (47 + 53)

# Smart baseline will pick winner as higher Rasmussen variable. If repub higher, pick repub.
table(sign(train$Rasmussen))

# -1  0  1 
# 42  3 55 
# So this shows the smart baseline predicts in 55 cases the republican would win, 42 the democrat, and 3 cases inconclusive.

# See how smart baseline compares against actual result of win.
table(train$Republican, sign(train$Rasmussen))

#    -1  0  1
#  0 42  2  3
#  1  0  1 52
# So this shows 42 observations where Rasmussen predicts a democrat would win and the democrat actually did win.
# There were 52 observations where Rasmussen predicts a republication would win and the republication actually did win.
# There were 3 times where the smart baseline predicted a republican would win, but a democrat won.

# Smart baseline accuracy: 0.94
(52 + 42) / (52 + 42 + 3 + 3)

# Check correlations to find most highly correlated feature with Republican.
# Looking at the Republican row, we see PropR is highly correlated at 0.948, so it should do a good job at predicting Republican.
cor(train[c('Rasmussen', 'SurveyUSA', 'PropR', 'DiffCount', 'Republican')])

mod1 <- glm(Republican ~ PropR, data=train, family=binomial)

pred1 <- predict(mod1, type='response')
table(train$Republican, pred1 >= 0.5)

#     FALSE TRUE
# 0    45    2
# 1     2   51
# We see 45 true negatives and 51 true positives.
# Accuracy: 0.96
(45 + 51) / (45 + 2 + 2 + 51)

# Next, find least correlated variables and try those if they help predict winner.
# Note model is missing statistical significance, only a '.' on DiffCount.
mod2 <- glm(Republican ~ SurveyUSA + DiffCount, data=train, family=binomial)

pred2 <- predict(mod2, type='response')
table(train$Republican, pred2 >= 0.5)

#     FALSE TRUE
# 0    45    2
# 1     1   52
# We see 45 true negatives and 51 true positives.
# Accuracy: 0.97
(45 + 52) / (45 + 1 + 2 + 52)

# Try smart baseline on the test set (ie. just predict winner by Rasmussen value).
table(test$Republican, sign(test$Rasmussen))

#   -1  0  1
# 0 18  2  4
# 1  0  0 21

# Accuracy: 0.867
(18 + 21) / (18 + 2 + 4 + 21)

testpred <- predict(mod2, newdata=test, type='response')
table(test$Republican, testpred >= 0.5)

#      FALSE TRUE
# 0    23    1
# 1     0   21

# Accuracy: 0.978
(23 + 21) / (23 + 1 + 21)

# Find record where our 1 case failed.
subset(test, testpred >= 0.5 & Republican == 0)

#    State   Year Rasmussen SurveyUSA DiffCount     PropR Republican
# 24 Florida 2012         2         0         6 0.6666667          0

# Rasmussen predicted republican.
# SurveyUSA called a tie.
# DiffCount said 6 more for republican.
# Two thirds (0.66) predicted a republican would win.
# But a republican did not win (Republican = 0).
# Thus, reasonable for mistake on Florida record.

PollingData.csv