Created
March 18, 2014 23:08
-
-
Save blmoore/9631779 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
library("ggplot2") | |
library("scales") | |
## Data: http://www.theguardian.com/news/datablog/2009/oct/21/icm-poll-data-labour-conservatives#data (State of the parties spreadsheet) | |
# ICM poll resultsof ~1000 people taken every month or so | |
# (more often before an election) as well as election | |
# results dating from June 1984. | |
sop <- read.csv("StateOfTheParties.csv", stringsAsFactors=F) | |
## Data cleanup | |
sop[,2:5] <- apply(sop[,2:5], 2, function(x) as.numeric(gsub("%", "", x))) | |
sop[,1] <- as.Date(sop[,1], format="%d-%m-%Y") | |
colnames(sop)[1] <- "Date" | |
# correct for some rounding errors leading to 101/99 % | |
sop$rsum <- apply(sop[,2:5], 1, sum) | |
table(sop$rsum) | |
sop[,2:5] <- sop[,2:5] / sop$rsum | |
# Melt for ggplot | |
melt.fun <- function(x) | |
melt(x, measure.vars=c("CON", "LAB", "LIB.DEM", "OTHER"), id.vars="Date") | |
props <- melt.fun(sop) | |
# Grab election data for additional layer | |
elections <- sop[which(grepl("ELECTION", sop$Sample)),] | |
elections <- melt.fun(elections) | |
# Party colours (ish) | |
cols <- brewer.pal(8, "Pastel1")[c(2,1,6,4)] | |
# Area plot overview of public support for main parties over 30 years | |
ggplot(props, aes(x=Date, y=value, fill=variable, group=variable)) + | |
geom_area() + scale_fill_manual(values=cols) + | |
geom_bar(data=elections, stat="identity", position=position_stack(.1), | |
width=I(100), col="grey40") + | |
scale_y_continuous(expand=c(0,0), labels=percent_format()) + | |
scale_x_date(expand=c(0,0)) + | |
labs(list(y="Public support", fill="Party", x="")) #+ | |
ggtitle("UK general elections 1984-2014") | |
## Look at the time between elections | |
e.dates <- c(unique(elections$Date), as.Date("2015-05-07")) | |
results <- c(rep("CON",2), rep("LAB", 3), "CON.LIB", "?") | |
sop.rows <- which(grepl("ELECTION", sop$Sample)) | |
e.years <- c(sub(".*(\\d{4})$", "\\1", sop[sop.rows, "Sample"], perl=T), "2015") | |
sop$runup <- rep(c(1:7), c(sop.rows[1], diff(c(sop.rows, nrow(sop))))) | |
sop$win <- rep(results, c(sop.rows[1], diff(c(sop.rows, nrow(sop))))) | |
e <- sop | |
e <- melt(e, measure.vars=c("CON", "LAB", "LIB.DEM", "OTHER"), | |
id.vars=c("runup", "Date", "win")) | |
e$prior <- with(e, as.numeric(Date - e.dates[runup])) | |
e$header <- with(e, paste0(e.years[e$runup], " (", win, ")")) | |
# Fn to make colours legible on white bg | |
darken <- function(hex.col, amount=.15) | |
return(rgb(t(col2rgb(hex.col)*(1-amount)), max=255)) | |
darken <- Vectorize(darken) | |
dcols <- unname(darken(cols)) | |
# Previous 6 election support history | |
ggplot(subset(e, header != "2015 (?)"), | |
aes(x=prior, y=value, col=variable, fill=variable)) + | |
facet_wrap(~header, scales="free_x") + | |
scale_color_manual(values=dcols) + | |
scale_fill_manual(values=dcols) + | |
geom_smooth(method="loess") + | |
geom_line() + geom_point() + theme_bw() + | |
scale_y_continuous(labels=percent_format()) + | |
labs(list(y="Public support", x="Days relative to election", | |
col="Party", fill="Party")) | |
# boxlots of election runups | |
ggplot(e, aes(x=header, y=value, fill=variable)) + | |
theme_bw() + geom_boxplot(position=position_dodge(.8)) + | |
scale_fill_manual(values=cols) + | |
labs(list(y="Public support", x="Days relative to election", | |
col="Party", fill="Party")) + | |
ggtitle("UK general elections 1984-2014") + | |
theme(legend.position=c(.9,.85), legend.background=element_blank()) | |
## Which prior results are most predictive of end result | |
ggplot(subset(e, variable %in% c("LAB", "CON")), | |
aes(x=prior, y=value, col=variable, fill=variable)) + | |
facet_grid(header~., scales="free_y") + | |
scale_color_manual(values=dcols) + | |
scale_fill_manual(values=dcols) + | |
geom_smooth(method="loess") + | |
scale_x_continuous(expand=c(0.01,0.01)) + | |
theme_bw() + scale_y_continuous(labels=percent_format()) + | |
labs(list(y="Public support", x="Days relative to election", | |
col="Party", fill="Party")) | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment