Glyph maps for NZ District Health Boards

cars.R

d<-strsplit("Northland		
No Motor Vehicle	3792	4077
One Motor Vehicle	20229	22161
Two Motor Vehicles	19578	20652
Three or More Motor Vehicles	7398	7407
Waitemata		
No Motor Vehicle	8871	8658
One Motor Vehicle	54753	57492
Two Motor Vehicles	66411	72768
Three or More Motor Vehicles	29757	33219
Auckland		
No Motor Vehicle	14046	16752
One Motor Vehicle	51909	54840
Two Motor Vehicles	49377	52113
Three or More Motor Vehicles	19203	20340
Counties Manukau		
No Motor Vehicle	7839	8214
One Motor Vehicle	38973	40344
Two Motor Vehicles	49824	53991
Three or More Motor Vehicles	25332	29022
Waikato		
No Motor Vehicle	8421	9168
One Motor Vehicle	44409	48396
Two Motor Vehicles	45333	49401
Three or More Motor Vehicles	19245	20016
Lakes		
No Motor Vehicle	2427	2820
One Motor Vehicle	12837	13647
Two Motor Vehicles	12936	13020
Three or More Motor Vehicles	5220	4968
Bay of Plenty		
No Motor Vehicle	4737	4848
One Motor Vehicle	27024	29505
Two Motor Vehicles	27648	30201
Three or More Motor Vehicles	10434	10731		
Tairawhiti		
No Motor Vehicle	1503	1524
One Motor Vehicle	6174	6291
Two Motor Vehicles	5151	5268
Three or More Motor Vehicles	1884	1839
Taranaki		
No Motor Vehicle	3057	3042
One Motor Vehicle	15303	16020
Two Motor Vehicles	14574	16011
Three or More Motor Vehicles	5529	6090
Hawke's Bay		
No Motor Vehicle	4155	4527
One Motor Vehicle	20295	21663
Two Motor Vehicles	20187	21039
Three or More Motor Vehicles	8103	7800
Whanganui		
No Motor Vehicle	2322	2334
One Motor Vehicle	9888	10107
Two Motor Vehicles	7974	7968
Three or More Motor Vehicles	2889	2811
Midcentral		
No Motor Vehicle	4857	5142
One Motor Vehicle	23190	24570
Two Motor Vehicles	21207	21789
Three or More Motor Vehicles	8679	8436		
Hutt		
No Motor Vehicle	5289	4926
One Motor Vehicle	20058	20406
Two Motor Vehicles	16851	17133
Three or More Motor Vehicles	6036	6174		
Capital and Coast		
No Motor Vehicle	12123	13185
One Motor Vehicle	42903	45669
Two Motor Vehicles	30675	31884
Three or More Motor Vehicles	9531	9708		
Wairarapa		
No Motor Vehicle	1257	1314
One Motor Vehicle	5832	6378
Two Motor Vehicles	5472	6066
Three or More Motor Vehicles	2238	2379
Nelson Marlborough		
No Motor Vehicle	3090	3084
One Motor Vehicle	18180	20010
Two Motor Vehicles	19185	21078
Three or More Motor Vehicles	8094	8328		
West Coast		
No Motor Vehicle	993	900
One Motor Vehicle	5130	5052
Two Motor Vehicles	4320	4701
Three or More Motor Vehicles	1500	1788		
Canterbury		
No Motor Vehicle	13077	11298
One Motor Vehicle	63123	59949
Two Motor Vehicles	66921	69204
Three or More Motor Vehicles	29559	33429
South Canterbury		
No Motor Vehicle	1632	1545
One Motor Vehicle	8019	8253
Two Motor Vehicles	8217	8550
Three or More Motor Vehicles	3555	3984
Southern		
No Motor Vehicle	9249	9006
One Motor Vehicle	39534	41970
Two Motor Vehicles	39741	42213
Three or More Motor Vehicles	18015	18999
","\n")[[1]]

d1<-matrix(d,byrow=TRUE,ncol=5)
d1[,1]<-gsub("\t","",d1[,1])
d1[,2:5]<-gsub("[A-z ]","",d1[,2:5])

f<-function(s){
	as.numeric(gsub("\t[0-9]+\t","",s))
}

cars<-data.frame(dhb=d1[,1],none=f(d1[,2]),one=f(d1[,3]),two=f(d1[,4]),more=f(d1[,5]))
tris<-tri_alloc(cars[,-1],c("green","gold","orange","goldenrod"),names=cars$dhb )

dhtri(tri_colours=tris,legend=list(fill=c("green","gold","orange","goldenrod"),border=NA, legend=c("0","1","2","3+"),title="Cars/Household"))


households<-rowSums(cars[,-1])
names(households)<-cars$dhb
dhbin(radii=sqrt(households))
title(main="Number of households in private dwellings")

z<-rnorm(20)
z1<- (z+3)/6
col_z<-rgb(colorRamp(c("blue", "white","red"))(z1),max=255)
dhbin(hex_colours=col_z,border="grey",
	legend_opts=list(fill=c("red","white","blue"),
					legend=c("High","Medium","Low"),
					title="Imaginary Index")
	)
	
	
par(mfrow=c(2,3),mar=c(1,1,1,1))
for(i in 1:6){
	z<-(rnorm(20)+z)/sqrt(2)
	z1<- (z+3)/6
	col_z<-rgb(colorRamp(c("blue", "white","red"))(z1),max=255)
	dhbin(hex_colours=col_z,border="grey",
		legend_opts=list(fill=c("red","white","blue"),
					legend=c("High","Medium","Low"),
					title=paste("Thing",i))
	)
	
}	

dhbins.R

tri_point<-c(0, 1, 0.5, NA, 0, 0.5, -0.5, NA, 0, -0.5, -1, NA, 0, -1, -0.5, 
NA, 0, -0.5, 0.5, NA, 0, 0.5, 1, NA)

tri_flat<-c(0, 0, 0.866025403784439, NA, 0, 0.866025403784439, 0.866025403784439, 
NA, 0, 0.866025403784439, 0, NA, 0, 0, -0.866025403784439, NA, 
0, -0.866025403784439, -0.866025403784439, NA, 0, -0.866025403784439, 
0, NA)

hex_point<-c(1,.5,-0.5,-1,-0.5,0.5,1,NA)
hex_flat<-c(0, 0.866025403784439,0.866025403784439,0,-0.866025403784439,-0.866025403784439,0,NA)



triangles<-function (center_x, center_y, radii, cols, border = FALSE, asp = 1, flat=FALSE) 
{
	if (flat) {
		tri_x<-tri_point
		tri_y<-tri_flat
	} else{
		tri_y<-tri_point
		tri_x<-tri_flat
	}	
    x <- as.vector(t(outer(radii, tri_x) + center_x))
    y <- as.vector(t(outer(radii * asp, tri_y) + center_y))
    polygon(x, y, col = as.vector(t(cols)), border = if (border) 
        NA
    else as.vector(t(cols)))
    invisible(list(x = x, y = y, col = as.vector(t(cols))))
}

hexes<-function (center_x, center_y, radii, cols, border = NULL, asp = 1, flat=FALSE) 
{
	if (flat) {
		hex_x<-hex_point
		hex_y<-hex_flat
	} else{
		hex_y<-hex_point
		hex_x<-hex_flat
	}	

    x <- as.vector(t(outer(radii, hex_x) + center_x))
    y <- as.vector(t(outer(radii * asp, hex_y) + center_y))
    polygon(x, y, col = cols, border = if (is.null(border))
        NA
    else border)
    invisible(list(x = x, y = y, col = cols))
}
	    
tri_alloc<-function(countmatrix,colours,names=rownames(countmatrix)){
	m<-matrix(colours[apply(countmatrix,1,sl)],
		byrow=TRUE,ncol=6)
	if(!is.null(names)) rownames(m)<-names
	m	
} 

sl<-function (counts) 
{
    nparties <- length(counts)
    nseats<-6
    denominators = 2 * (1:nseats) - 1
    quotients = outer(counts, denominators, "/")
    last = sort(quotients, decreasing = TRUE)[nseats]
    clear <- rowSums(quotients > last)
    borderline <- rowSums(quotients == last)
    borderline[sample(which(borderline > 0), sum(borderline) - 
        (nseats - sum(clear)))] <- 0
    total <- clear + borderline
    error <- counts - sum(counts) * total/6
    rval <- rep(1:nparties, clear + borderline)
    attr(rval, "error") <- error
    rval
}



dhbs<-data.frame(
printname=c("Northland","Waitemata","Counties \nManukau","Taranaki","Auckland","Waikato","Whanganui","Capital\n and Coast", "Bay of\nPlenty","Lakes","Midcentral","Hutt\nValley","Tairawhiti","Hawke's \nBay","Wairarapa",
"Nelson \nMarlborough","West Coast","Canterbury","South \nCanterbury","Southern"),
keyname=c("Northland","Waitemata","Counties Manukau","Taranaki","Auckland","Waikato","Whanganui","Capital and Coast", "Bay of Plenty","Lakes","Midcentral","Hutt","Tairawhiti","Hawke's Bay","Wairarapa",
"Nelson Marlborough","West Coast","Canterbury","South Canterbury","Southern"),
x=c(1,1,1,1,2,2,2,2,3,3,3,3,4,4,4,2,1,2,1,0)*(1.5),
y=c(18,16,14,12,15,13,11,9,14,12,10,8,13,11,9,5,4,3,2,1)*sqrt(3)/2
)


dhbin<-function(radii=NULL,hex_colours="lightskyblue",text_colour="black",legend_opts=NULL,border=NULL){
	if(is.null(radii)){
		radii<-rep(0.95,nrow(dhbs))
	}
	if( max(radii)>1) radii<-0.95*radii/max(radii)
	if (!is.null(names(hex_colours))){
		idx<-match(names(hex_colours),dhbs$keyname)
		if(any(is.na(idx))) 
			warning(paste("could not match",paste(names(hex_colours)[is.na(idx)],collapse=",")))
		hex_colours<-hex_colours[idx]
	}
	with(dhbs,plot(x,y,asp=TRUE,type="n",xlim=c(-2,8),ylim=c(0,16),axes=FALSE,xlab="",ylab=""))
	with(dhbs,hexes(x,y,radii,cols=hex_colours,flat=TRUE,border=border))
	with(dhbs, text(x,y,printname,cex=0.8,col=text_colour))
	if(!is.null(legend_opts)) {
		do.call(legend, c(list(x=-1.8,y=9,bty="n"),legend_opts))
	}
}

dhtri<-function(radii=NULL,tri_colours,text_colour="black",legend_opts=NULLL){
	if(is.null(radii)){
		radii<-rep(0.95,nrow(dhbs))
	}
	if( max(radii)>1) radii<-0.95*radii/max(radii)
	if (!is.null(rownames(tri_colours))){
		idx<-match(rownames(tri_colours),dhbs$keyname)
		if(any(is.na(idx))) 
			warning(paste("could not match",paste(rownames(tri_colours)[is.na(idx)],collapse=",")))
		tri_colours<-tri_colours[idx,]
	}
	with(dhbs,plot(x,y,asp=TRUE,type="n",xlim=c(-2,8),ylim=c(0,16),axes=FALSE,xlab="",ylab=""))
	with(dhbs,triangles(x,y,radii,cols=tri_colours,flat=TRUE))
	with(dhbs, text(x,y,printname,cex=0.8,col=text_colour))
	if(!is.null(legend_opts)) {
		do.call(legend, c(list(x=-1.8,y=9,bty="n"),legend_opts))
	}
}