crosshairs.R

gistfile1.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()