library(lattice) trellis.par.set(theme=col.whitebg()) options(width=120) source('readdata.R') source('utils.R') # Graphics parameters trellpar <- trellis.par.get() trellpar$axis.line$col <- NA trellpar$superpose.symbol <- list(alpha=rep(1,12), cex=rep(.7,12), col = c('orange','orange', 'violetred2', 'red','red','red', 'brown','brown','brown', 'slategrey','darkgreen','royalblue'), font=rep(1,12), pch=c(1,0, 16, 6,5,2, 6,5,2, 4,3,3)) trellis.par.set(trellpar) #show.settings() partycols = c('Labour'='red','LibDem'='orange','Conservative'='blue','Other'='black') ## Work out winner baxter2001nb <- getwinners(baxter2001nb) baxter2001 <- getwinners(baxter2001) baxter1997 <- getwinners(baxter1997) baxter1992nb <- getwinners(baxter1992nb) bbc2005 <- getwinners(bbc2005) # Some overall poll results natres.2005 <- sapply(parties.int, function(p) sum(bbc2005[,paste('Votes',p,sep='.')], na.rm=TRUE)) natres.2001 <- c('Labour'=10724953,'Conservative'=8357615,'LibDem'=4814321) natres.1997 <- c('Labour'=13517911,'Conservative'=9600940,'LibDem'=5243440) natres.1992 <- c('Labour'=11560484,'Conservative'=14093007,'LibDem'=5999384) natres.2005.tc <- tcoord(natres.2005['Labour'],natres.2005['Conservative'], natres.2005['LibDem']) natres.2001.tc <- tcoord(natres.2001['Labour'],natres.2001['Conservative'],natres.2001['LibDem']) natres.1997.tc <- tcoord(natres.1997['Labour'],natres.1997['Conservative'],natres.1997['LibDem']) natres.1992.tc <- tcoord(natres.1992['Labour'],natres.1992['Conservative'],natres.1992['LibDem']) ######################################################################## ## Graphics routes ## How much does each type of seat move? seattot <- xtabs(~factor(Winner), data=bbc2005) seattot.all <- sum(seattot) dataset <- merge(bbc2005, baxter2001nb, by='Constituency', suffixes=c('.2005','.2001')) for (p in parties.int) { dataset[,paste('d',p,sep='.')] <- dataset[,paste('Votes',p,'2005',sep='.')]/ dataset[,paste('Votes',p,'2001',sep='.')] } dataset$Region <- dataset$Region.2005 row.names(dataset) <- dataset$Constituency dataset <- dataset[!is.na(dataset$Turnout),] tc.d2005 <- tcoord(dataset$d.Labour, dataset$d.Conservative, dataset$d.LibDem) x.d2005 <- tc.d2005[[1]] y.d2005 <- tc.d2005[[2]] natres.d2005 <- natres.2005/natres.2001 natres.d2005.tc <- tcoord(natres.d2005['Labour'], natres.d2005['Conservative'], natres.d2005['LibDem']) partycols.mute <- c('Labour'='#FFB3B3', 'LibDem'='#FFD530', 'Conservative'='#B3B3FF', 'Other'='grey80') xyplot(y.d2005~x.d2005, data=dataset, scales=list(draw=FALSE), groups = Region, cex=.5, key=simpleKey(levels(dataset$Region),columns=5), panel = function(x,y,...) { triangleAxes(eps=.20) lsegments(0,0,x.d2005,y.d2005, col=partycols.mute[dataset$Winner.2001], lwd=.1) panel.superpose(x,y,...) ltext(x,y,paste(dataset$Constituency,'.',sep=''), adj=c(0,.5), cex=.1, col='grey80') panel.xyplot(natres.d2005.tc[[1]],natres.d2005.tc[[2]], col='black', pch=4, cex=2) lsegments(0,0,natres.d2005.tc[[1]],natres.d2005.tc[[2]], col='darkgreen', lwd=3) ltext(bdy.top(eps=.22)[[1]],bdy.top(eps=.22)[[2]],adj=c(.5,.5),cex=1.5,'LibDem') ltext(bdy.botleft(eps=.22)[[1]],bdy.botleft(eps=.22)[[2]],cex=1.5,adj=c(.5,.5),'Cons') ltext(bdy.botright(eps=.22)[[1]],bdy.botright(eps=.22)[[2]],cex=1.5,adj=c(.5,.5),'Lab') }, xlim=c(bdy.botleft(eps=.2)[[1]],bdy.botright(eps=.2)[[1]]), ylim=c(bdy.bot(eps=.2)[[2]],bdy.top(eps=.2)[[2]]), xlab="",ylab="", aspect='iso', sub=list('For each constituency, there is a line indicating the swing from 2001 to 2005. The colour of the line indicates the winning party in 2001. The black cross and green line indicate the national swing. Damon Wischik 2005',font=1), main='Swings from 2001 to 2005, by constituency') ## Plotting routes: 2005 result seattot <- xtabs(~factor(Winner), data=bbc2005) seattot.all <- sum(seattot) dataset <- bbc2005[!is.na(bbc2005$Turnout) & bbc2005$Region != "Northern Ireland",] tc2005 <- tcoord(dataset$Votes.Labour, dataset$Votes.Conservative, dataset$Votes.LibDem) x2005 <- tc2005[[1]] y2005 <- tc2005[[2]] xyplot(y2005~x2005, data=dataset, scales=list(draw=FALSE), groups = Region, cex=.5, key=simpleKey(levels(dataset$Region),columns=5), panel = function(x,y,...) { triangleAxes() panel.superpose(x,y,...) ltext(x,y,paste(dataset$Constituency,'.',sep=''), adj=c(0,.5), cex=.1, col='grey80') ltext(bdy.top[[1]],bdy.top[[2]]-.3,cex=1.5, paste('LibDem: ',seattot['LibDem'],'/',seattot.all,sep='')) ltext(bdy.botleft[[1]]+.2,bdy.botleft[[2]],cex=1.5,adj=c(0,0), paste('Cons: ',seattot['Conservative'],'/',seattot.all,sep='')) ltext(bdy.botright[[1]]-.2,bdy.botright[[2]],cex=1.5,adj=c(1,0), paste('Lab: ',seattot['Labour'],'/',seattot.all,sep='')) }, xlim=c(bdy.botleft[[1]],bdy.botright[[1]]), ylim=c(bdy.bot[[2]],bdy.top[[2]]), xlab="",ylab="", aspect='iso', sub=list('The black cross indicates the 2005 national average. Lines show swings from 2001 to 2005. Damon Wischik 2005',font=1), main='UK 2005 parliament, by region') ## Plotting routes: 2005 result seattot <- xtabs(~factor(Winner), data=bbc2005) seattot.all <- sum(seattot) dataset <- bbc2005[!is.na(bbc2005$Turnout) & bbc2005$Region != "Northern Ireland",] votes2001 <- baxter2001nb[dataset$Constituency,] tc2005 <- tcoord(dataset$Votes.Labour, dataset$Votes.Conservative, dataset$Votes.LibDem) tc2001 <- tcoord(votes2001$Votes.Labour,votes2001$Votes.Conservative,votes2001$Votes.LibDem) x2005 <- tc2005[[1]] y2005 <- tc2005[[2]] x2001 <- tc2001[[1]] y2001 <- tc2001[[2]] xyplot(y2005~x2005, data=dataset, scales=list(draw=FALSE), col = partycols[dataset$Winner], cex=.5, panel = function(x,y,...) { triangleAxes() lsegments(x2001,y2001,x2005,y2005, col=ifelse(votes2001$Winner==dataset$Winner,'grey90', partycols[votes2001$Winner])) panel.xyplot(x,y,...) # ltext(x,y,paste(dataset$Constituency,'.',sep=''), adj=c(0,.5), cex=.1, col='slategrey') panel.xyplot(natres.2005.tc[[1]],natres.2005.tc[[2]], col='black', pch=4, cex=2) lsegments(natres.2001.tc[[1]],natres.2001.tc[[2]], natres.2005.tc[[1]],natres.2005.tc[[2]], col='darkgreen', lwd=3) # ltext(bdy.top[[1]],bdy.top[[2]]-.3,cex=1.5, # paste('LibDem: ',seattot['LibDem'],'/',seattot.all,sep='')) # ltext(bdy.botleft[[1]]+.2,bdy.botleft[[2]],cex=1.5,adj=c(0,0), # paste('Cons: ',seattot['Conservative'],'/',seattot.all,sep='')) # ltext(bdy.botright[[1]]-.2,bdy.botright[[2]],cex=1.5,adj=c(1,0), # paste('Lab: ',seattot['Labour'],'/',seattot.all,sep='')) }, xlim=c(bdy.botleft[[1]],bdy.botright[[1]]), ylim=c(bdy.bot[[2]],bdy.top[[2]]), xlab="",ylab="", aspect='iso', sub=list('The black cross indicates the 2005 national average. Lines show swings from 2001 to 2005. Damon Wischik 2005',font=1), main='UK 2005 general election') ## Plotting routines: for 2001 notional boundary results seattot <- xtabs(~factor(Winner), data=baxter2001nb) seattot.all <- sum(seattot) xyplot(tcoord(Votes.Labour,Votes.Conservative,Votes.LibDem)[[2]]~ tcoord(Votes.Labour,Votes.Conservative,Votes.LibDem)[[1]], data = baxter2001nb, scales=list(draw=FALSE), groups = Region, cex=.4, key=simpleKey(levels(const.int$Region),columns=5), panel = function(x,y,...) { triangleAxes() panel.superpose(x,y,...) ltext(x,y,paste(baxter2001nb$Constituency,'.',sep=''), adj=c(0,.5), cex=.1, col='grey') panel.xyplot(natres.2001.tc[[1]],natres.2001.tc[[2]], col='black', pch=4, cex=2) lsegments(natres.2001.tc[[1]],natres.2001.tc[[2]], natres.2005.tc[[1]],natres.2005.tc[[2]], col='darkgreen', lwd=3) ltext(bdy.top[[1]],bdy.top[[2]]-.3,cex=1.5, paste('LibDem: ',seattot['LibDem'],'/',seattot.all,sep='')) ltext(bdy.botleft[[1]]+.2,bdy.botleft[[2]],cex=1.5,adj=c(0,0), paste('Cons: ',seattot['Conservative'],'/',seattot.all,sep='')) ltext(bdy.botright[[1]]-.2,bdy.botright[[2]],cex=1.5,adj=c(1,0), paste('Lab: ',seattot['Labour'],'/',seattot.all,sep='')) }, xlim=c(bdy.botleft[[1]],bdy.botright[[1]]), ylim=c(bdy.bot[[2]],bdy.top[[2]]), xlab="",ylab="", aspect='iso', sub=list('The black cross indicates the 2001 national average, and the different green lines show how various recent 2005 polls predict this cross will move. If such a move is repeated in each constituency, the dot for every constituency will move by the same amount. Damon Wischik 2005',font=1), main='UK 2001 general election, by constituency, using 2005 boundaries') ## Plotting routines: Shift from 1997 to 2001 seattot <- xtabs(~factor(Winner), data=baxter2001) seattot.all <- sum(seattot) tc2001 <- tcoord(baxter2001$Votes.Labour,baxter2001$Votes.Conservative,baxter2001$Votes.LibDem) tc1997 <- tcoord(baxter1997$Votes.Labour,baxter1997$Votes.Conservative,baxter1997$Votes.LibDem) x2001 <- tc2001[[1]] y2001 <- tc2001[[2]] x1997 <- tc1997[[1]] y1997 <- tc1997[[2]] xyplot(y2001~x2001, data = baxter2001, col = partycols[baxter2001$Winner], panel = function(x,y,...) { triangleAxes() lsegments(x1997,y1997,x2001,y2001, col=ifelse(baxter1997$Winner==baxter2001$Winner,'grey90',partycols[baxter1997$Winner])) panel.xyplot(x,y,...) ltext(x,y,paste(baxter2001$Constituency,'.',sep=''), adj=c(0,.5), cex=.1, col='slategrey') panel.xyplot(natres.2001.tc[[1]],natres.2001.tc[[2]], col='black',pch=4,cex=2) lsegments(natres.1997.tc[[1]],natres.1997.tc[[2]], natres.2001.tc[[1]],natres.2001.tc[[2]], col='darkgreen', lwd=3) ltext(bdy.top[[1]],bdy.top[[2]]-.3,cex=1.5, paste('LibDem: ',seattot['LibDem'],'/',seattot.all,sep='')) ltext(bdy.botleft[[1]]+.2,bdy.botleft[[2]],cex=1.5,adj=c(0,0), paste('Cons: ',seattot['Conservative'],'/',seattot.all,sep='')) ltext(bdy.botright[[1]]-.2,bdy.botright[[2]],cex=1.5,adj=c(1,0), paste('Lab: ',seattot['Labour'],'/',seattot.all,sep='')) }, scales=list(draw=FALSE), xlim=c(bdy.botleft[[1]],bdy.botright[[1]]), ylim=c(bdy.bot[[2]],bdy.top[[2]]), xlab="",ylab="", aspect='iso', main='UK 2001 general election, by constituency, with 1997-2001 swings', sub=list('For each constituency, we plot a dot for the 2001 result and a line for the swing from 1997. The line is coloured yellow to indicate a LibDem loss etc., grey if the seat does not change hands. The black cross indicates the 2001 national average, and the green line indicates the swing from 1997. Damon Wischik 2005',font=1)) ## Plotting routines: Shift from 1992 to 1997 seattot <- xtabs(~factor(Winner), data=baxter1997) seattot.all <- sum(seattot) tc2001 <- tcoord(baxter2001$Votes.Labour,baxter2001$Votes.Conservative,baxter2001$Votes.LibDem) tc1997 <- tcoord(baxter1997$Votes.Labour,baxter1997$Votes.Conservative,baxter1997$Votes.LibDem) tc1992 <- tcoord(baxter1992nb$Votes.Labour,baxter1992nb$Votes.Conservative,baxter1992nb$Votes.LibDem) x2001 <- tc2001[[1]] y2001 <- tc2001[[2]] x1997 <- tc1997[[1]] y1997 <- tc1997[[2]] x1992 <- tc1992[[1]] y1992 <- tc1992[[2]] xyplot(y1997~x1997, data = baxter1997, col = partycols[baxter1997$Winner], panel = function(x,y,...) { triangleAxes() lsegments(x1992,y1992,x1997,y1997, col=ifelse(baxter1992nb$Winner==baxter1997$Winner,'grey90',partycols[baxter1992nb$Winner])) panel.xyplot(x,y,...) ltext(x,y,paste(baxter1997$Constituency,'.',sep=''), adj=c(0,.5), cex=.1, col='slategrey') panel.xyplot(natres.1997.tc[[1]],natres.1997.tc[[2]], col='black',pch=4,cex=2) lsegments(natres.1992.tc[[1]],natres.1992.tc[[2]], natres.1997.tc[[1]],natres.1997.tc[[2]], col='darkgreen', lwd=3) ltext(bdy.top[[1]],bdy.top[[2]]-.3,cex=1.5, paste('LibDem: ',seattot['LibDem'],'/',seattot.all,sep='')) ltext(bdy.botleft[[1]]+.2,bdy.botleft[[2]],cex=1.5,adj=c(0,0), paste('Cons: ',seattot['Conservative'],'/',seattot.all,sep='')) ltext(bdy.botright[[1]]-.2,bdy.botright[[2]],cex=1.5,adj=c(1,0), paste('Lab: ',seattot['Labour'],'/',seattot.all,sep='')) }, scales=list(draw=FALSE), xlim=c(bdy.botleft[[1]],bdy.botright[[1]]), ylim=c(bdy.bot[[2]],bdy.top[[2]]), xlab="",ylab="", aspect='iso', main='UK 1997 general election, by constituency, with 1992-1997 swings', sub=list('For each constituency, we plot a dot for the 1997 result and a line for the swing from 1992. The line is coloured yellow to indicate a LibDem loss etc., grey if the seat does not change hands. The black cross indicates the 1997 national average, and the green line indicates the swing from 1992. Damon Wischik 2005',font=1))