Skip to content

Instantly share code, notes, and snippets.

@tslumley

tslumley/hexmap.R

Created March 11, 2015 21:29
Show Gist options
  • Save tslumley/efc7102f07a39758850b to your computer and use it in GitHub Desktop.
Save tslumley/efc7102f07a39758850b to your computer and use it in GitHub Desktop.
Download ZIP
An exercise in transparency: unedited ugly scripts used in making electoral hexmaps.
Raw
hexmap.R
fogmap=
" '..','..','..','..','..','..','..','..','..','..','..','..','..',
'..','69','..','..','..','..','..','35','63','..','..','..','..',
'..','..','67','..','..','..','..','..','45','..','..','..','..',
'..','..','65','71','..','..','..','15','11','33','..','..','..',
'..','..','68','66','..','..','..','..','55','34','..','..','..',
'..','70','..','..','..','..','..','53','01','49','..','..','..',
'..','..','..','..','..','..','..','21','27','12','26','38','..',
'..','..','..','..','..','..','..','31','28','24','03','..','..',
'..','..','..','..','..','..','..','..','..','23','25','..','..',
'..','..','..','..','..','..','..','..','..','40','16','..','..',
'..','..','..','..','..','..','..','..','..','..','56','07','..',
'..','..','..','..','..','..','..','..','..','14','13','02','52',
'..','..','..','..','..','..','..','..','..','..','50','51','..',
'..','..','..','..','..','..','..','..','..','32','62','47','10',
'..','..','..','..','..','..','..','..','..','..','43','29','..',
'..','..','..','..','..','..','..','..','..','39','54','..','..',
'..','..','..','..','..','..','..','..','..','37','58','..','..',
'..','..','..','..','..','..','..','..','22','44','..','..','..',
'..','..','..','..','..','..','..','..','36','17','..','..','..',
'..','..','..','..','30','20','..','60','46','..','..','..','..',
'..','..','..','..','..','57','..','..','..','..','..','..','..',
'..','..','..','61','48','05','..','..','..','..','..','..','..',
'..','..','..','..','18','04','..','..','..','..','..','..','..',
'..','..','..','64','41','..','..','..','..','..','..','..','..',
'..','..','..','42','..','..','..','..','..','..','..','..','..',
'..','..','59','..','..','..','..','..','..','..','..','..','..',
'..','..','09','08','..','..','..','..','..','..','..','..','..',
'..','06','..','..','..','..','..','..','..','..','..','..','..',
'..','19','..','..','..','..','..','..','..','..','..','..','..'
"
fogmap1<-sapply(strsplit(fogmap,"\n"),strsplit,",")
fogrows<- t(sapply(fogmap1, function(row) as.numeric(gsub("[^0-9]+([0-9]+)[^0-9]+","\\1",row))))
#xfog<-col(fogrows)[!is.na(fogrows)]
#yfog<-NROW(fogrows)+1-row(fogrows)[!is.na(fogrows)]
xfog<-col(fogrows)[!is.na(fogrows)]
yfog<-NROW(fogrows)+1-row(fogrows)[!is.na(fogrows)]
idfog<-fogrows[!is.na(fogrows)]
hex_id<-(col(fogrows) + NCOL(fogrows)*(NROW(fogrows)-row(fogrows)))[!is.na(fogrows)]
i<-order(yfog,xfog)
xfog<-xfog[i]
yfog<-yfog[i]
idfog<-idfog[i]
hex_id<-hex_id[i]
library(jsonlite)
electorate_layout<-fromJSON("~/Desktop/electorate_hex.json")
money<-read.csv("~/Downloads/electoral_donations_2014.csv",stringsAsFactors=FALSE)
library(hexbin)
electorate_loc<-data.frame(name=sapply(electorate_layout,"[[","electoral_district"), id=as.numeric(names(electorate_layout)))
electorate_loc$hex_id<-hex_id[match(electorate_loc$id,idfog)]
totals<-aggregate(Amount_Donated~Electorate,sum,data=money)
totaldosh<-totals$Amount_Donated
names(totaldosh)<-totals$Electorate
not_there<-setdiff(electorate_loc$name, names(totaldosh))
zeroes<-rep(1,length(not_there))
names(zeroes)<-not_there
totaldosh<-c(totaldosh,zeroes)
totaldosh<-totaldosh[order(names(totaldosh))]
makehex<-function(data,total=sum(data)){
data_order<-order(electorate_loc$hex_id[match(names(data),electorate_loc$name)])
nz<-new("hexbin", cell=as.integer(hex_id),count=round(data[data_order]),xcm=xfog-0.5, ycm=(yfog-0.5), xbins=NCOL(fogrows), shape=2, xbnds=c(0,NCOL(fogrows)+3), ybnds=c(0,NROW(fogrows)+1),dimen=dim(fogrows), n=as.integer(ceiling(sum(data))), ncells=length(xfog), call=sys.call(),xlab="",ylab="",cID=NULL,cAtt=integer(0))
}
a<-makehex(totaldosh)
#pdf("cashmaps.pdf",height=14,width=7)
hexplot(a,pen="darkgrey",border="black")
party<-function(partyname, partycolor){
p_totals<-aggregate(Amount_Donated~Electorate,sum,data=subset(money, Party %in% partyname))
p_dosh<-p_totals$Amount_Donated
names(p_dosh)<-p_totals$Electorate
p_there<-setdiff(electorate_loc$name, names(p_dosh))
zeroes<-rep(1,length(p_there))
names(zeroes)<-p_there
p_dosh<-c(p_dosh,zeroes)[order(c(names(p_dosh),p_there))]
p<-makehex(p_dosh)
# gr<-hexplot(p,pen=partycolor,border="black",minarea=0.002,maxarea=0.8*max(p_dosh)/totaldosh[which.max(p_dosh)])
gr<-hexplot(p,pen=partycolor,border="black",minarea=0.002,maxarea=0.8*max(p_dosh)/max(totaldosh))
grid.rect(x=0,y=29,width=6,height=8,default.units="native",just=c("left","top"))
gr
}
pdf("~/CASHMAPS/parties.pdf",height=12,width=6)
party("National Party","#1E4680")
party("Labour Party","#D92A19")
party("United Future","purple")
party(c("MANA Movement","Internet Party"),"purple")
party("Green Party","#99CF1C")
party("ACT New Zealand","#FFD700")
party("Conservative","#00ADF2")
party("New Zealand First Party","black")
dev.off()
svg_party<-function(partyname,partycolor,filename){
grobs<-party(partyname,partycolor)
names_sorted<-electorate_loc$name[idfog]
grobnames<-sapply(grobs,"[[","name")
names(names_sorted)<-grobnames
addTooltipsElect(filename,names_sorted)
}
svg_party("National Party","#1E4680","~/CASHMAPS/national.svg")
svg_party("Labour Party","#D92A19","~/CASHMAPS/labour.svg")
svg_party("United Future","purple","~/CASHMAPS/unitedfuture.svg")
svg_party(c("MANA Movement","Internet Party"),"purple","~/CASHMAPS/imp.svg")
svg_party("Green Party","#99CF1C","~/CASHMAPS/greens.svg")
svg_party("ACT New Zealand","#FFD700","~/CASHMAPS/act.svg")
svg_party("Conservative","#00ADF2","~/CASHMAPS/conservative.svg")
svg_party("New Zealand First Party","black","~/CASHMAPS/nzfirst.svg")
svg_party(unique(money$Party),"grey","~/CASHMAPS/allparties.svg")
results<-read.table("~/Downloads/election14margins.txt",header=TRUE,fileEncoding="UCS-2LE",sep="\t")
results$margin<-as.numeric(gsub(",","",as.character(results$Margin)))
results$margingp<-cut(results$margin/1000,c(0,2,4, 8,Inf))
results<-results[order(as.character(results$Electorate)),]
n1<-n2<-n3<-n4<-totaldosh
n1[as.numeric(results$margingp)!=1]<-0
n2[as.numeric(results$margingp)!=2]<-0
n3[as.numeric(results$margingp)!=3]<-0
n4[as.numeric(results$margingp)!=4]<-0
# plot(makehex(n1), mincnt=1,style="lattice",xaxt="n",yaxt="n",pen=rgb(160,32,160,max=255),legend=FALSE)
# plot(makehex(n2), mincnt=1,style="lattice",xaxt="n",yaxt="n",pen=rgb((160+256)/3,(32+256)/3,(160+256)/3,max=255),legend=FALSE,newpage=FALSE)
# plot(makehex(n3), mincnt=1,style="lattice",xaxt="n",yaxt="n",pen=rgb(0.5,0.5,0.5),legend=FALSE,newpage=FALSE)
# plot(makehex(n4), mincnt=1,style="lattice",xaxt="n",yaxt="n",pen="darkgreen",legend=FALSE,newpage=FALSE)
#dev.off()
cols<-c(rgb(160,32,160,max=255), rgb((160+256)/3,(32+256)/3,(160+256)/3,max=255), rgb(0.5,0.5,0.5), "darkgreen")
marg<-hexplot(a,border="black",pen=cols[as.numeric(results$margingp)[order(electorate_loc$hex_id[match(as.character(results$Electorate),electorate_loc$name)])]])
names_sorted<-electorate_loc$name[idfog]
grobnames<-sapply(marg,"[[","name")
names(names_sorted)<-grobnames
addTooltipsElect("~/CASHMAPS/marginmap.svg",names_sorted)
pushViewport(viewport(x=unit(0,"npc"),y=unit(2/3,"npc"),width=unit(1/4,"npc"),height=unit(1/4,"npc"),just="left"))
grid.legend(c("<2000","2000-4000","4000-8000",">8000"),pch=19,gp=gpar(col=cols))
addTooltipsElect("~/CASHMAPS/marginmap1.svg",names_sorted)
plot(results$margin,totaldosh/1000,xlab="Margin of victory",ylab="Total donations (k$)")
identify(results$margin,totaldosh/1000,labels=names(totaldosh))
Raw
hexplot.R
hexplot<-function (dat, style = "lattice", minarea = 0.001, maxarea = 0.8, check.erosion = TRUE,
mincnt = 1, maxcnt = max(dat@count), density = NULL, border = NULL, pen = NULL,
def.unit = "native", verbose = getOption("verbose"),newpage=TRUE)
{
if (!is(dat, "hexbin"))
stop("first argument must be a hexbin object")
if (minarea <= 0)
stop("hexagons cannot have a zero area, change minarea")
if (maxarea > 1)
warning("maxarea > 1, hexagons may overplot")
cnt <- dat@count
xbins <- dat@xbins
shape <- dat@shape
tmp <- hcell2xy(dat, check.erosion = check.erosion)
good <- mincnt <= cnt & cnt <= maxcnt
xnew <- tmp$x[good]
ynew <- tmp$y[good]
cnt <- cnt[good]
sx <- xbins/diff(dat@xbnds)
sy <- (xbins * shape)/diff(dat@ybnds)
if (min(cnt, na.rm = TRUE) < 0) {
pcnt <- cnt + min(cnt)
rcnt <- {
if (maxcnt == mincnt) rep.int(1, length(cnt)) else (pcnt -
mincnt)/(maxcnt - mincnt)
}
} else rcnt <- {
if (maxcnt == mincnt) rep.int(1, length(cnt)) else (cnt -
mincnt)/(maxcnt - mincnt)
}
area <- minarea + rcnt * (maxarea - minarea)
area <- pmin(area, maxarea)
radius <- sqrt(area)
if (length(pen) != length(cnt)) {
if (is.null(pen)) pen <- rep.int(1, length(cnt)) else if (length(pen) ==
1) pen <- rep.int(pen, length(cnt)) else stop("'pen' has wrong length")
}
if (length(border) != length(cnt)) {
if (is.null(border)) border <- rep.int(1, length(border)) else if (length(border) ==
1) border <- rep.int(border, length(cnt)) else stop("'border' has wrong length")
}
inner <- 0.5
outer <- (2 * inner)/sqrt(3)
dx <- inner/sx
dy <- outer/(2 * sy)
rad <- sqrt(dx^2 + dy^2)
hexC <- hexcoords(dx, dy, sep = NULL)
n <- length(radius)
if (verbose)
cat("length = ", length(pen), "\n", "pen = ", pen + 1,
"\n")
n6 <- rep.int(6:6, n)
pltx <- rep.int(hexC$x, n) * rep.int(radius, n6) + rep.int(xnew,
n6)
plty <- rep.int(hexC$y, n) * rep.int(radius, n6) + rep.int(ynew,
n6)
if (newpage)
grid.newpage()
hv.ob <- hexViewport(dat)
pushViewport([email protected])
idx<-rep(1:n,each=6)
lapply(1:n, function(i)
grid.polygon(pltx[idx==i], plty[idx==i], default.units = def.unit, id.lengths=6,
gp = gpar(fill = pen[i], col = border[i]))
)
}
garnishAllGrobsElect <- function(elt,texts) {
if (inherits(elt, "grob")) {
garnishGrob(elt,
onmousemove = paste("showTooltip(evt, '",
gsub("\n", " ", texts[elt$name]), "')",
sep = ""),
onmouseout = "hideTooltip()")
} else {
elt
}
}
addTooltipsElect <- function(filename = "Rplots.svg", names) {
grid.DLapply(garnishAllGrobsElect,texts=names)
grid.script(filename = "tooltip.js")
grid.export(filename)
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment