QLD 2017 election results

Download the data

ECQ provides the data in XML, wrapped in a zip file. This is trivial to download and injest into R. We print the time stamp on the file.

theURL <- "https://results.ecq.qld.gov.au/elections/state/state2017/results/public.zip"

library(curl)
tmpfile <- curl_download(theURL,destfile = tempfile(fileext = ".zip"))

library(rvest)
library(xml2)
doc <- read_xml(tmpfile)

parseDateTime <- function(str){
  as.POSIXct(as.POSIXlt(str,
                        tz="Australia/Brisbane",
                        format="%Y-%m-%dT%H:%M:%OS"))
}

getGenTime <- function(doc){
  require(xml2)
  string <- xml_text(xml_node(doc,xpath="//generationDateTime"))
  return(parseDateTime(string))
}

genTime <- getGenTime(doc)
print(genTime)

## [1] "2017-11-28 11:38:32 AEST"

State totals

## enrolment and total votes
getTotVote <- function(doc){
  e <- xml_node(doc,xpath = "/election")
  out <- as.data.frame(xml_attrs(e))
  names(out) <- "value"
  out$var <- rownames(out)
  
  out <- rbind(out,
               data.frame(var="votes",
                          value=xml_integer(xml_node(doc,xpath = "/election/totalVotes"))),
               data.frame(var="formal",
                          value=xml_integer(xml_node(doc,xpath = "/election/totalFormalVotes"))),
               data.frame(var="informal",
                          value=xml_integer(xml_node(doc,xpath = "/election/totalInformalVotes"))))
  return(out)
}

stotal <- getTotVote(doc)

## formatting
ok <- !is.na(as.numeric(stotal$value))
stotal$value[ok] <- format(as.numeric(stotal$value[ok]),
                           big.mark = ",",
                           drop0trailing = TRUE)

kable(stotal[,c("var","value")],
      row.names=FALSE,
      format.args = list(big.mark=","))

Party totals

getPartyTotals <- function(doc){
  party <- xml_attr(xml_nodes(doc,xpath = "//party"),attr = "code")
  formal <- xml_integer(xml_nodes(doc,xpath = "//party/formalVotes/count"))
  out <- data.frame(party,formal)
  out$per <- out$formal/sum(out$formal)*100
  out$timeStamp <- getGenTime(doc)
  return(out)
}

kable(getPartyTotals(doc),format.args = list(big.mark=","),digits=2)

District level data, as a flat file

getDistrictTotals <- function(doc){
  out <- xml_attrs(xml_nodes(doc,xpath="//districts/district"))
  out <- lapply(out,
                  function(x){as.data.frame(as.list(x),stringsAsFactors=FALSE)})
  out <- dplyr::bind_rows(out)
  out$lastUpdated <- parseDateTime(out$lastUpdated)
  out$number <- NULL
  
  out$informalVotes <- xml_integer(xml_find_all(doc,xpath="//districts/district/informalVotes/count"))
  out$totalVotes <- xml_integer(xml_find_all(doc,xpath="//districts/district/totalVotes"))
  out$informalPer <- out$informalVotes/out$totalVotes * 100
  out$enrolment <- as.integer(out$enrolment)
  
  return(out)
}

ddata <- getDistrictTotals(doc)
kable(ddata %>% 
        arrange(desc(lastUpdated)),
      digits=2,
      format.args = list(big.mark=","))

Candidate level data

candidateProcess <- function(doc){
  cnodes <- xml_nodes(doc,xpath="//candidates/candidate")
  cdata <- xml_attrs(cnodes)
  
  d <- lapply(cnodes,xml_find_first,xpath="ancestor::district")
  d <- unlist(lapply(d,xml_attr,attr="name"))
  
  cdata <- lapply(cdata,function(x){as.data.frame(as.list(x),stringsAsFactors=FALSE)})
  cdata <- dplyr::bind_rows(cdata)
  cdata$district <- d
  return(cdata)
}

candidateShares <- function(doc){
  cnodes <- xml_find_all(doc,xpath = "//district/candidates/candidate/primaryVotes")
  votes <- xml_integer(xml_find_all(cnodes,xpath="count"))
  
  cinfo <- xml_attrs(xml_parent(cnodes))
  cinfo <- lapply(cinfo,
                  function(obj){
                    as.data.frame(as.list(obj),stringsAsFactors=FALSE)
                  })
  cinfo <- dplyr::bind_rows(cinfo)
  
  d <- lapply(cnodes,xml_find_first,xpath="ancestor::district")
  d <- unlist(lapply(d,xml_attr,attr="name"))
  
  cinfo$votes <- votes
  cinfo$district <- d
  
  return(cinfo)
}

cdata <- candidateShares(doc)

## add percentages
cdata <- cdata %>% 
  group_by(district) %>% 
  mutate(per=votes/sum(votes)*100)

We also rank order the candidates within districts.

cdata <- cdata %>% 
  group_by(district) %>%
  mutate(r = n() + 1 - rank(votes))

Seats won without preferences

kout <- inner_join(cdata,
                   cdata %>% 
                     filter(r==1 & per>50)) %>% 
  select(district,ballotName,party,per) %>%
  arrange(desc(per))

kable(kout)

Plurality winners

foo <- filter(cdata,r==1) %>% select(party,district)
tab <- as.data.frame(xtabs(~party,data=foo))
kable(tab)

Smallest pluralities, most entropy in vote shares

tmp <- full_join(cdata %>% group_by(district) %>%
                   summarise(StdDev=sd(per)) %>%
                   arrange(StdDev),
                 cdata %>% group_by(district) %>%
                   summarise(maxVoteShare=max(per)) %>%
                   arrange(maxVoteShare)) %>%
                   filter(between(row_number(),1,10))

kable(tmp,digits=2)

Major party vote share

plotData <- bind_rows(cdata %>% 
                        group_by(district) %>%
                        summarise(x=per[party=="ALP"] + per[party=="LNP"],
                                  alp=per[party=="ALP"],
                                  lnp=per[party=="LNP"]) %>%
                        ungroup(),
                      cdata %>% 
                        ungroup() %>% 
                        summarise(alp0=sum(votes[party=="ALP"]),
                                  lnp0=sum(votes[party=="LNP"]),
                                  x=(alp0+lnp0)/sum(votes)*100,
                                  alp=alp0/sum(votes)*100,
                                  lnp=lnp0/sum(votes)*100,
                                  district="Statewide")) %>%
  arrange(x)

plotData$district <- ordered(plotData$district,levels=plotData$district)
plotData$Statewide <- factor(plotData$district=="Statewide")

library(reshape2)
plotData <- melt(plotData,id.vars = "district",measure.vars = c("alp","lnp","x"))

library(ggplot2)
ggplot(plotData,aes(y=district,x=value,color=variable)) + 
  geom_point() + 
  scale_color_manual(values=c("alp"="red","lnp"="blue","x"="black")) + 
  scale_x_continuous("Major party vote share") + 
  scale_y_discrete("") +
  theme(panel.border = element_blank(),
        legend.position = "none")

Two-candidate preferred

processTPP <- function(doc){
  require(xml2)
  nodes <- xml_find_all(doc,"//district/candidates/candidate/n2cpVotes")
 
  tpp <- data.frame(percentage=xml_double(
    xml_find_all(doc,"//district/candidates/candidate/n2cpVotes/percentage")),
    count=xml_integer(
      xml_find_all(doc,"//district/candidates/candidate/n2cpVotes/count"))
  )
  
  tpp$party <- unlist(lapply(nodes,
                             function(x){
                               xml_attr(xml_find_first(x,
                                                       "ancestor::candidate"),
                                        "party")
                             }))
  tpp$district <- unlist(lapply(nodes,
                                function(x){
                                  xml_attr(xml_find_first(x,
                                                          "ancestor::district"),
                                           "name")
                                }))
  return(tpp)
}

tpp <- processTPP(doc)

setdiff(ddata$name,tpp$district)

##  [1] "Burnett"        "Callide"        "Gladstone"      "Hervey Bay"    
##  [5] "Hinchinbrook"   "Jordan"         "Keppel"         "Logan"         
##  [9] "Morayfield"     "Mulgrave"       "Rockhampton"    "Scenic Rim"    
## [13] "Southern Downs" "Traeger"        "Warrego"        "Waterford"

Difference between TCP and 1st preferences

plotData <- inner_join(cdata,tpp,by=c("party","district"))
ggplot(subset(plotData,party %in% c("ALP","LNP","ONP")),
       aes(x=per,y=percentage)) +
  geom_abline(slope=1,intercept = 0) +
  geom_smooth(method = "lm",se=FALSE,col="blue") +
  geom_point() +
  scale_x_continuous("1st preferences") +
  scale_y_continuous("TCP") +
  facet_wrap(~party)

tcp_type <- tpp %>% 
  group_by(district) %>% 
  arrange(desc(percentage)) %>% 
  summarise(p1=party[1],p2=party[2]) %>% 
  arrange(p1,p2)

kable(tcp_type)

tab <- xtabs(~p1+p2,data=tcp_type)
kable(tab,caption="1st TCP party tabbed against 2nd TCP party")

ONP performance limited to where they ran

theDistricts <- filter(cdata, party=="ONP") %>%
  select(district)
onp_perf <- inner_join(cdata,theDistricts) %>% 
  group_by(party) %>% 
  summarise(total=sum(votes)) %>%
  mutate(per = total/sum(total)*100) %>%
  ungroup()

kable(onp_perf,digits=2,format.args = list(big.mark=",")) 

Seats where ONP is 1st or 2nd (and no ties!)

theDistricts <- filter(cdata, r<2.5 & party=="ONP") %>% select(district)
print(theDistricts)

## # A tibble: 21 x 1
## # Groups:   district [21]
##        district
##           <chr>
##  1      Buderim
##  2      Burnett
##  3      Callide
##  4    Condamine
##  5         Cook
##  6    Gladstone
##  7      Gregory
##  8       Gympie
##  9 Hinchinbrook
## 10      Ipswich
## # ... with 11 more rows

foo <- inner_join(cdata,theDistricts) %>% 
  group_by(district) %>%
  summarise(p1=party[r==1],p2=party[r==2],p3=party[r==3],
            per1=per[r==1],per2=per[r==2],per3=per[r==3],
            onp=per[party=="ONP"]) %>%
  mutate(delta=per1-onp) %>%
  arrange(delta) %>%
  select(-onp)

kable(foo,digits=2)

Seats where ONP is 3rd

theDistricts<- filter(cdata, r==3 & party=="ONP") %>% select(district)

foo <- inner_join(cdata,theDistricts) %>% 
  summarise(p1=party[r==1],p2=party[r==2],
            per1=per[r==1],per2=per[r==2],
            onp=per[party=="ONP"]) %>%
  arrange(desc(onp))

kable(foo,digits=2,format.args = list(big.mark=","))

table(foo$p1,foo$p2)

##      
##       ALP LNP ZZZ
##   ALP   0  18   1
##   LNP  15   0   0

Seats where GRN is 1st or 2nd

theDistricts <- filter(cdata, r<3 & party=="GRN") %>% select(district)

foo <- inner_join(cdata,theDistricts) %>% 
  summarise(p1=party[r==1],p2=party[r==2],p3=party[r==3],
            per1=per[r==1],per2=per[r==2],per3=per[r==3],
            grn=per[party=="GRN"]) %>%
  mutate(delta=per1-grn) %>%
  arrange(delta) %>%
  select(-grn)

kable(foo,
      digits=2,
      format.args = list(big.mark=","))

foo <- inner_join(cdata,theDistricts) %>% 
  filter(r==1) %>% 
  select(party,district)

Seats where GRN has finished 3rd

theDistricts<- filter(cdata, r==3 & party=="GRN") %>% select(district)

foo <- inner_join(cdata,theDistricts) %>% 
  summarise(p1=party[r==1],p2=party[r==2],
            per1=per[r==1],per2=per[r==2],
            grn=per[party=="GRN"]) %>%
  arrange(desc(grn))

kable(foo,digits=2,format.args = list(big.mark=","))

table(foo$p1,foo$p2)

##      
##       ALP LNP
##   ALP   0  13
##   LNP  13   0

One Nation dotplot

plotData <- inner_join(cdata,
                       filter(cdata,party=="ONP") %>%
                         select(district)) %>%
  filter(party %in% c("ALP","LNP","ONP","GRN","KAP"))

levs <- filter(plotData,party=="ONP") %>% arrange(desc(per)) %>% select(district)
plotData$district <- ordered(plotData$district,levels=rev(levs$district))

library(ggplot2)
ggplot(plotData,aes(y=district,x=per,color=party,shape=party)) + 
  geom_point() +
  scale_x_continuous("1st preference vote share") + 
  scale_y_discrete("") + 
  scale_color_manual(values=c("ALP"="red","LNP"="blue","ONP"="black","GRN"="green","KAP"="orange")) +
  scale_shape_manual(values=c("ALP"=1,"LNP"=1,"ONP"=15,"GRN"=1,"KAP"=1)) +
  theme(panel.border = element_blank(),
        legend.position = "top")

Green dotplot

plotData <- inner_join(cdata,
                       filter(cdata,party=="GRN") %>%
                         select(district)) %>%
  filter(party %in% c("ALP","LNP","ONP","GRN","KAP"))

levs <- filter(plotData,party=="GRN") %>% arrange(desc(per)) %>% select(district)
plotData$district <- ordered(plotData$district,levels=rev(levs$district))

library(ggplot2)
ggplot(plotData,aes(y=district,x=per,color=party,shape=party)) + 
  geom_point() +
  scale_x_continuous("1st preference vote share") + 
  scale_y_discrete("") + 
  scale_color_manual(values=c("ALP"="red","LNP"="blue","ONP"="black","GRN"="green","KAP"="orange")) +
  scale_shape_manual(values=c("ALP"=1,"LNP"=1,"ONP"=1,"GRN"=15,"KAP"=1)) +
  theme(panel.border = element_blank(),
        legend.position = "top")

Informality dotplot

plotData <- ddata
plotData$district <- plotData$name
levs <- plotData %>% arrange(desc(informalPer)) %>% select(district)
plotData$district <- ordered(plotData$district,levels=rev(levs$district))

library(ggplot2)
ggplot(plotData,aes(y=district,x=informalPer)) + 
  geom_point() +
  scale_x_continuous("Informality rate") + 
  scale_y_discrete("") + 
  theme(panel.border = element_blank())

Interesting seats

theOnes <- c("Hinchinbrook","Maiwar","Mirani","Mundingburra",
             "Maryborough","Callide","Jordan","Noosa")
tabFunc <- function(theDistrict){
  cat(paste("###",theDistrict))
  kout <- kable(cdata %>% 
                  filter(district==theDistrict) %>% 
                  ungroup() %>%
                  arrange(r) %>%
                  select(-ballotOrderNumber,-sitting) %>%
                  select(-district),
                digits=2,
                format="markdown",
                format.args = list(big.mark=","))
  return(kout)
}

for(theDistrict in sort(theOnes)){
  print(tabFunc(theDistrict))
}