Skip to content

Embed URL

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
crosshairs.R
## harald, 2012-11-08
# make crosshairs plot for pollster precision
# this version prepared for the blogpost
# on http://adistantobserver.blogspot.de/2012/11/pebos-post-election-burn-out-syndrome.html
# first a helper function for downloading the necessary data
getTablesFromURL <- function (URI, index = integer(), header = FALSE) {
require(RCurl)
require(XML)
result <- getURLContent(URI, useragent = "RCurl")
result <- gsub("\\&nbsp;","",result)
webpage <- readLines(tc <- textConnection(result))
close(tc)
pagetree <- htmlTreeParse(webpage
, error=function(...){}
, useInternalNodes = TRUE
)
tables <- readHTMLTable(pagetree
, stringsAsFactors = FALSE
, which = index
, header = header
)
return(tables)
}
# get the current count of the popular vote from wikipedia
pvURL <- "http://en.wikipedia.org/wiki/United_States_presidential_election,_2012"
pvTables <- getTablesFromURL(pvURL)
# the data are in the tenth table
# actually they were in the tenth, but are now in the eleventh...
# as of 2012-11-09 - they seem to move around things a bit
PV <- pvTables[[11]]
# some cleaning...
PV <- PV[c(-1, -10),-1]
PV$candidate <- gsub("\\(.+$", "", PV[,1])
PV <- PV[,c(6,4,5)]
names(PV) <- c("candidate", "votes", "pct")
PV$votes <- as.integer(gsub(",", "", PV$votes))
PV$pct <- as.numeric(gsub("%", "", PV$pct))
# percentage of the two party vote
# actually we won't need this for the blog, but I'll leave it here anyway
O.2P <- round(PV[1,2]/(PV[1,2] + PV[2,2])*100, 1)
R.2P <- round(PV[2,2]/(PV[1,2] + PV[2,2])*100, 1)
# get the predictions from Tanenbaum's site
predURL <- "http://www.electoral-vote.com/evp2012/Pres/Maps/Nov06.html#item-2"
predictions.pollsters <- getTablesFromURL(predURL, index = 3, header = TRUE)
predictions.pollsters$Obama <- as.numeric(gsub("%","",predictions.pollsters$Obama))
predictions.pollsters$Romney <- as.numeric(gsub("%","",predictions.pollsters$Romney))
predictions.pollsters <- predictions.pollsters[,-4]
# again we won't need the two party vote, but...
predictions.pollsters <- transform(predictions.pollsters,
O.2P = round(100*Obama/(Obama + Romney), 1),
R.2P = round(100*Romney/(Obama + Romney), 1)
)
# the function that does the plotting
# it should have some error handling -
# but i'm suffering from PEBOS
crosshairs <- function(centre, pts, no.rings, title, x.ann, y.ann) {
# calculate some parameters for the crosshairs
span <- max(sqrt(apply((centre - pts)^2, 1, sum)))
ring.distance <- ceiling(span/no.rings)
span <- ring.distance * no.rings
# create the canvas and the centre
plot(
centre[1],
centre[2],
axes = FALSE,
xlim = c(centre[1] - span, centre[1] + span),
ylim = c(centre[2] - span, centre[2] + span),
bty = 'n',
main = title,
xlab = x.ann,
ylab = y.ann,
asp = 1
)
# invisible axes: just the ticks, ma'am ;)
axis(1, NULL, pos = centre[2],
cex.axis = 0.8, labels = TRUE, padj=25,
col="transparent"
)
axis(2, NULL, pos = centre[1],
cex.axis = 0.8, labels = TRUE, padj=-30,
col="transparent"
)
# the crossing hairs in the crosshairs
segments(centre[1] - span, centre[2], centre[1] + span, centre[2])
segments(centre[1], centre[2] - span, centre[1], centre[2] + span)
# the circles around the target
symbols(
rep(centre[1], no.rings),
rep(centre[2], no.rings),
circles = (1:no.rings)*ring.distance,
fg = rainbow(no.rings, s = 1, v = 1, start = 0,
end = max(1,no.rings - 1)/no.rings, alpha = 1),
add = TRUE,
inches = FALSE,
lwd = 5)
# the points to be seen "running around in circles... gettin' nowhere"
points(pts[, 1],
pts[, 2],
col = "black",
pch = 19)
}
# now let's plot the thingy
centre <- c( PV[1, 3], PV[2, 3])
pts <- cbind(predictions.pollsters$Obama, predictions.pollsters$Romney)
png('crosshairs.png')
crosshairs(centre = centre, # the actual popular vote
pts = pts, # the predictions
no.rings = 4, # four rings seem about right here ("4 more years")
title = "Pollsters on target?",
x.ann = "Obama popular vote (%)", # annotation for x axis
y.ann = "Romney popularvote (%)" # annotation for y axis
)
dev.off()
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Something went wrong with that request. Please try again.