public
Created

crosshairs.R

  • Download Gist
gistfile1.r
R
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131
## 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()

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.