hexmaps.Rmd

---
title: "2020 NZ Election"
output: 
  flexdashboard::flex_dashboard:
    theme: spacelab
    self_contained: false
    css: https://fonts.googleapis.com/css?family=Open%20Sans
    lib_dir: lib
    mathjax: null
    navbar:
      - { title: "Intro", icon: "fa-home", href: "index.html", align: left }
      - { title: "Parties", icon: "ion-ios-settings-strong", href: "dumbbells.html", align: left }
      - { title: "Refs", icon: "ion-ios-settings-strong", href: "referenda.html", align: left }
      - { title: "Hexmaps", icon: "ion-cube", align: left }
      - { title: "@dakvid", icon: "fa-twitter", href: "https://twitter.com/dakvid", align: right }
    social: menu
    source_code: https://github.com/dakvid/election2020
editor_options: 
  chunk_output_type: console
---

```{r init, include=FALSE}
knitr::opts_chunk$set(echo = FALSE)
knitr::opts_chunk$set(message = FALSE)
knitr::opts_chunk$set(warning = FALSE)
```

```{r setup, include=FALSE}
library(sf)
library(magrittr)
library(readr)
library(dplyr)
library(purrr)
library(stringr)
library(leaflet)
library(htmltools)
library(htmlwidgets)

begin_label_text <- "<div style='font-size:12px;float:left'>"
begin_label_text_200 <- "<div style='font-size:12px;width:200px;float:left'>"
begin_label_header <- "<span style='font-size:18px;font-weight:bold'>"
end_label_header <- "</span><br>"
end_label_text <- "</div>"

nzhex <- 
  read_sf("data/nzhex.gpkg") %>% 
  st_transform(crs = "+proj=longlat +datum=WGS84")

GE2020 <- readRDS("data/GE2020.rds")
GE2017 <- readRDS("data/GE2017.rds")
electorates <- read_csv("data/electorates.csv")
party_colours <- read_csv("data/party_colours.csv")

GE2017 <- 
  GE2017 %>% 
  inner_join(
    electorates %>% select(id, id_14),
    by = "id_14"
  ) %>% 
  select(-id_14, -electorate_name_14)

party_voters_2017 <-
  GE2017 %>% 
  filter(VotingType == "Party",
         !str_detect(Party, "nformal")) %>% 
  group_by(id) %>% 
  summarise(Voters2017 = sum(Votes)) %>% 
  ungroup()

candidate_voters_2017 <-
  GE2017 %>% 
  filter(VotingType == "Candidate",
         !str_detect(Candidate, "nformal")) %>% 
  group_by(id) %>% 
  summarise(Voters2017 = sum(Votes)) %>% 
  ungroup()

party_voters_2020 <-
  GE2020 %>% 
  filter(VotingType == "Party",
         !str_detect(Party, "nformal")) %>% 
  group_by(id) %>% 
  summarise(Voters = sum(Votes)) %>% 
  ungroup()

candidate_voters_2020 <-
  GE2020 %>% 
  filter(VotingType == "Candidate",
         !str_detect(Candidate, "nformal")) %>% 
  group_by(id) %>% 
  summarise(Voters = sum(Votes)) %>% 
  ungroup()

getLeafletOptions <- function(minZoom, maxZoom, ...) {
  leafletOptions(
    crs = leafletCRS("L.CRS.Simple"),
    minZoom = minZoom, maxZoom = maxZoom,
    dragging = TRUE, zoomControl = FALSE,
    tap = FALSE,
    attributionControl = FALSE , ...)
}

getFactorPal <- function(f) {
  colorFactor(colormap::colormap(
    colormap = colormap::colormaps$hsv,
    nshades = length(f)), f)
}
```

# {.storyboard}

### Hello HexMaps: a hexagonal cartogram of New Zealand electorates in 2020

```{r hex_regions}
leaflet(options = getLeafletOptions(5.8, 5.8)) %>% 
  addPolygons(
    data = nzhex,
    label = ~nzhex %>% 
      transpose() %>% 
      map(~ paste0(begin_label_text,
               begin_label_header, .x$electorate_name, end_label_header,
               "In ", .x$region, ".",
               end_label_text) %>% HTML()),
    weight=2, color='#000000', group = 'Regions',
    fillOpacity = 0.6, opacity = 1, fillColor = ~getFactorPal(region)(region),
    highlightOptions = highlightOptions(weight = 4)
  ) %>% 
  addLabelOnlyMarkers(
    data = nzhex %>% st_centroid(),
    label = ~abbr,
    labelOptions = labelOptions(
      noHide = 'T', textOnly = T,
      direction = "center")
  ) %>% 
  onRender(
    "function(el, t) {
      var myMap = this;
      // get rid of the ugly grey background
      myMap._container.style['background'] = '#ffffff';
      myMap.scrollWheelZoom.disable();
    }"
  )
```

***

This is a [cartogram](https://en.wikipedia.org/wiki/Cartogram) of the current
(2020) New Zealand electorates, with one hexagon for each electorate.
Electorates have roughly equal populations, so this is a reasonable map of
population distribution. The North and South Islands should be obvious; the
Māori electorates make up a second mini NZ in the bottom right.

Why are these maps more useful than a geographic map? In short, because they don't
overrepresent rural areas and underrepresent urban areas.
[Stephen Beban (NZ)](https://thespinoff.co.nz/politics/24-09-2017/a-better-visual-breakdown-of-the-2017-election-results/) and
[Pitch Interactive (USA)](http://pitchinteractive.com/latest/tilegrams-more-human-maps/)
have more to say on the topic.

The colours here indicate the regional groupings, to help orient you to the
distorted geography. Many electorates cross regional boundaries, so these
are just a rough guide. Most notably, the Wellington region is split between
several Māori electorates.

The hexagonal layout is basically the same as I used [in 2017](https://david.frigge.nz/election2017/hexmaps.html),
with the addition of the new south Auckland electorate. The original layout is thanks to
[Joseph Wright](http://mapdruid.blogspot.co.nz/2015/05/hexagonal-tile-map-of-new-zealand.html).

Click through the storyboard and see different data from the election
visualised in hexmaps...


### Electorate Winners: Who won the seats?

```{r hex_candidates}
electorate_winners <-
  GE2020 %>%
  filter(VotingType == "Candidate") %>%
  group_by(id, Party) %>%
  summarise(Votes = sum(Votes)) %>%
  top_n(1, Votes) %>%
  ungroup() %>% 
  inner_join(candidate_voters_2020) %>% 
  mutate(PerCent = round(Votes / Voters * 100, 1)) %>% 
  left_join(party_colours, by = "Party") %>% 
  mutate(opa = 0.1 + 0.85 * ((PerCent - min(PerCent)) / (max(PerCent) - min(PerCent))))
electorate_winners$labeltext <-
  electorate_winners %>% 
  inner_join(nzhex) %>% 
  transpose() %>% 
  map(~ paste0(begin_label_text,
               begin_label_header, .x$electorate_name, end_label_header,
               .x$Party, " won with ", prettyNum(.x$Votes, big.mark=','), " votes.",
               "<br>",
               "<div style='width:95%'>",
               "<span style='color:", .x$party_colour, ";float:left'>", .x$PerCent, "%</span>",
               "<br clear='all' />",
               "<span style='background:", .x$party_colour, ";width:", .x$PerCent, "%;float:left'>&nbsp;</span>",
               "</div>",
               end_label_text) %>% 
        HTML())

leaflet(options = getLeafletOptions(5.8, 5.8)) %>% 
  addPolygons(
    data = inner_join(nzhex, electorate_winners),
    label = ~labeltext,
    weight=2, color='#000000', group = 'Electorate Seats',
    fillOpacity = ~opa, opacity = 1, fillColor = ~party_colour,
    highlightOptions = highlightOptions(weight = 4)
  ) %>% 
  addLabelOnlyMarkers(
    data = nzhex %>% st_centroid(),
    label = ~abbr,
    labelOptions = labelOptions(
      noHide = 'T', textOnly = T,
      direction = "center")
  ) %>% 
  onRender(
    "function(el, t) {
      var myMap = this;
      // get rid of the ugly grey background
      myMap._container.style['background'] = '#ffffff';
    }"
  )
```

***

Each hexagon is coloured for the party of the winning candidate. The strength of colour tracks
the percentage of votes the winner received --- from
`r electorate_winners %>% top_n(-1, PerCent) %$% PerCent`% for the
`r electorate_winners %>% top_n(-1, PerCent) %$% Party` in
`r electorate_winners %>% top_n(-1, PerCent) %>% inner_join(nzhex) %$% electorate_name`
to
`r electorate_winners %>% top_n(1, PerCent) %$% PerCent`% for the
`r electorate_winners %>% top_n(1, PerCent) %$% Party` in
`r electorate_winners %>% top_n(1, PerCent) %>% inner_join(nzhex) %$% electorate_name`.
Mouse over to see the numbers.



### Party Votes: How are each party's voters distributed? Do they have broad or localised support?

```{r hex_parties}
party_votes <-
  GE2020 %>% 
  filter(VotingType == "Party") %>% 
  group_by(id, Party) %>% 
  summarise(Votes = sum(Votes)) %>% 
  ungroup() %>% 
  inner_join(party_voters_2020) %>% 
  mutate(PerCent = round(Votes / Voters * 100, 1)) %>% 
  left_join(party_colours, by = "Party") %>% 
  group_by(Party) %>% 
  mutate(mean_votes = mean(Votes),
         opa = case_when(
           Votes < 0.8 * mean_votes ~ 0.15,
           Votes < 0.95 * mean_votes ~ 0.3,
           Votes <= 1.05 * mean_votes ~ 0.5,
           Votes <= 1.2 * mean_votes ~ 0.7,
           Votes > 1.2 * mean_votes ~ 0.85
         ),
         MaxPC = ceiling(max(PerCent))
  ) %>% 
  ungroup()

party_votes_2017 <-
  GE2017 %>% 
  filter(VotingType == "Party") %>% 
  group_by(id, Party) %>% 
  summarise(Votes2017 = sum(Votes)) %>% 
  ungroup() %>% 
  inner_join(party_voters_2017) %>% 
  mutate(PerCent2017 = round(Votes2017 / Voters2017 * 100, 1)) %>% 
  group_by(Party) %>% 
  mutate(MaxPC2017 = ceiling(max(PerCent2017))) %>% 
  ungroup()

party_votes$labeltext <-
  party_votes %>% 
  left_join(party_votes_2017) %>% 
  group_by(Party) %>% 
  mutate(MaxPC = max(MaxPC, MaxPC2017, na.rm = TRUE)) %>% 
  ungroup() %>% 
  inner_join(electorates) %>% 
  transpose() %>% 
  map(~ paste0(begin_label_text_200,
               begin_label_header, .x$electorate_name, end_label_header,
               prettyNum(.x$Votes, big.mark=','), " votes.",
               "<br>",
               "<div style='width:95%'>",
               "<span style='float:left'>2020: ", .x$PerCent, "%</span>",
               "<br clear='all' />",
               "<span style='background:", .x$party_colour, ";width:", round(.x$PerCent / .x$MaxPC * 100), "%;float:left'>&nbsp;</span>",
               if (is.na(.x$MaxPC2017)) {""} else {
                 paste0(
                   "<br clear='all' />",
                   "<span style='float:left'>2017: ", .x$PerCent2017, "%",
                   ifelse(.x$boundary_change, " (<i>boundary change</i>)", ""),
                   "</span>",
                   "<br clear='all' />",
                   "<span style='background:", .x$party_colour, ";width:", round(.x$PerCent2017 / .x$MaxPC * 100), "%;float:left'>&nbsp;</span>"
                 )
               },
               "</div>",
               end_label_text) %>% 
        HTML())

leaflet(options = getLeafletOptions(5.8, 5.8)) %>% 
  addPolygons(
    data = nzhex %>% 
      inner_join(party_votes %>% filter(Party == "Labour Party")),
    label = ~labeltext,
    weight=2, color='#000000', group = 'Labour 50.0%',
    fillOpacity = ~opa, opacity = 1, fillColor = ~party_colour,
    highlightOptions = highlightOptions(weight = 4)
  ) %>% 
  addPolygons(
    data = nzhex %>% 
      inner_join(party_votes %>% filter(Party == "National Party")),
    label = ~labeltext,
    weight=2, color='#000000', group = 'National 25.6%',
    fillOpacity = ~opa, opacity = 1, fillColor = ~party_colour,
    highlightOptions = highlightOptions(weight = 4)
  ) %>% 
  addPolygons(
    data = nzhex %>% 
      inner_join(party_votes %>% filter(Party == "Green Party")),
    label = ~labeltext,
    weight=2, color='#000000', group = 'Green 7.9%',
    fillOpacity = ~opa, opacity = 1, fillColor = ~party_colour,
    highlightOptions = highlightOptions(weight = 4)
  ) %>% 
  addPolygons(
    data = nzhex %>% 
      inner_join(party_votes %>% filter(Party == "ACT New Zealand")),
    label = ~labeltext,
    weight=2, color='#000000', group = 'ACT 7.6%',
    fillOpacity = ~opa, opacity = 1, fillColor = ~party_colour,
    highlightOptions = highlightOptions(weight = 4)
  ) %>% 
  addPolygons(
    data = nzhex %>% 
      inner_join(party_votes %>% filter(Party == "New Zealand First Party")),
    label = ~labeltext,
    weight=2, color='#000000', group = 'NZ First 2.6%',
    fillOpacity = ~opa, opacity = 1, fillColor = ~party_colour,
    highlightOptions = highlightOptions(weight = 4)
  ) %>% 
  addPolygons(
    data = nzhex %>% 
      inner_join(party_votes %>% filter(Party == "Māori Party")),
    label = ~labeltext,
    weight=2, color='#000000', group = 'Māori 1.2%',
    fillOpacity = ~opa, opacity = 1, fillColor = ~party_colour,
    highlightOptions = highlightOptions(weight = 4)
  ) %>% 
  addLabelOnlyMarkers(
    data = nzhex %>% st_centroid(),
    label = ~abbr,
    labelOptions = labelOptions(
      noHide = 'T', textOnly = T,
      direction = "center")
  ) %>% 
  addLayersControl(
    baseGroups = c("Labour 50.0%", "National 25.6%", "Green 7.9%", "ACT 7.6%",
                   "NZ First 2.6%", "Māori 1.2%"),
    options = layersControlOptions(collapsed = FALSE)
  ) %>% 
  onRender(
    "function(el, t) {
      var myMap = this;
      // get rid of the ugly grey background
      myMap._container.style['background'] = '#ffffff';
    }"
  )
```

***

Choose a party and see the tiles shaded relative to the number of voters. There are
five shades: within 5% of the average, between 5-20% over (or under) average, and more than 20% over (or under) the average.
The mouseover compares the 2020 and 2017 percentages.

Note that because it's based on absolute numbers rather than percentages, the Māori
electorates may be unexpectedly lighter because of their lower turnouts.

Despite the big shifts,
National and Labour still have fairly complementary patterns.




<script>
  (function(i,s,o,g,r,a,m){i['GoogleAnalyticsObject']=r;i[r]=i[r]||function(){
  (i[r].q=i[r].q||[]).push(arguments)},i[r].l=1*new Date();a=s.createElement(o),
  m=s.getElementsByTagName(o)[0];a.async=1;a.src=g;m.parentNode.insertBefore(a,m)
  })(window,document,'script','https://www.google-analytics.com/analytics.js','ga');

  ga('create', 'UA-30013353-2', 'auto');
  ga('send', 'pageview');

</script>