An exercise in transparency: unedited ugly scripts used in making electoral hexmaps.

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))

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(hv.ob@hexVp.off)

   
    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)
}