inst/doc/polling_districts.R

In tongfen: Make Data Based on Different Geographies Comparable

## ----include = FALSE----------------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)

## ----setup--------------------------------------------------------------------
library(dplyr)
library(ggplot2)
library(tidyr)
library(tongfen)
library(sf)

## -----------------------------------------------------------------------------
data("vancouver_elections_data_2015",package="tongfen")
data("vancouver_elections_data_2019",package="tongfen")
data("vancouver_elections_geos_2015",package="tongfen")
data("vancouver_elections_geos_2019",package="tongfen")

## -----------------------------------------------------------------------------
party_colours <- c(
  "People's Party"="#4a3389",
  Conservative="#0C499C",
  "Bloc Québécois"="#02819E",
  Liberal="#A50B0B",
  NDP="#DA3D00",
  "Green Party"="#2E8724",
  "Independent"="#676767",
  Other="yellow"
)

raw_vote_data <- bind_rows(
  vancouver_elections_geos_2015 %>% 
    left_join(vancouver_elections_data_2015 %>%
                group_by(PD_2015) %>%
                top_n(1,Votes),by="PD_2015") %>%
    mutate(Year="2015"),
  vancouver_elections_geos_2019 %>% 
    left_join(vancouver_elections_data_2019 %>%
                group_by(PD_2019) %>%
                top_n(1,Votes),by="PD_2019") %>%
    mutate(Year="2019")
) %>%
  mutate(Party=case_when(grepl("NDP",Party) ~ "NDP",
                        Party %in% names(party_colours) ~ Party,
                        TRUE ~ "Other"))

ggplot(raw_vote_data) +
  geom_sf(aes(fill=Party),size=0.2,color="black") +
  facet_wrap("Year") +
  scale_fill_manual(values=party_colours) +
  theme(legend.position = "bottom") +
  coord_sf(datum=NA) +
  labs(title="Canada federal election winning candidate party by polling district", 
       caption = "Data: Elections Canada")

## -----------------------------------------------------------------------------
correspondence <- estimate_tongfen_correspondence(
  data = list(vancouver_elections_geos_2015,vancouver_elections_geos_2019),
  geo_identifiers = c("PD_2015","PD_2019"),
  method = "estimate",
  tolerance = 30) 

vote_data <- correspondence %>% 
  left_join(vancouver_elections_data_2019 %>% select(PD_2019,Party,Votes_2019=Votes),by="PD_2019") %>%
  left_join(vancouver_elections_data_2015 %>% select(PD_2015,Party,Votes_2015=Votes),by=c("PD_2015","Party")) %>%
  group_by(TongfenID,Party) %>% 
  summarize_at(vars(starts_with("Votes")),sum,na.rm=TRUE) %>%
  group_by(TongfenID) %>%
  mutate(Total_2019=sum(Votes_2019,na.rm=TRUE),
         Total_2015=sum(Votes_2015,na.rm=TRUE)) %>%
  mutate(Share_2015=Votes_2015/Total_2015,
         Share_2019=Votes_2019/Total_2019) %>%
  ungroup() 

## -----------------------------------------------------------------------------
base_geo <- vancouver_elections_geos_2019 %>% 
  left_join(correspondence,by=c("PD_2019")) %>%
  group_by(TongfenID) %>%
  summarise() 

## ----fig.height=3-------------------------------------------------------------
focus_area <- base_geo[base_geo$TongfenID=="59039_51",]

bbox <- focus_area %>% st_buffer(200) %>% st_bbox() %>% st_as_sfc()

compare_geos <- rbind(vancouver_elections_geos_2015 %>% mutate(type="2015") %>% select(type) ,#%>% st_transform(4326),
      vancouver_elections_geos_2019 %>% mutate(type="2019") %>% select(type) ,#%>% st_transform(4326),
      base_geo %>% mutate(type="TongFen") %>% select(type)) #%>% st_transform(4326)) %>% 

ridings <- vancouver_elections_geos_2019 %>% 
  group_by(FED_NUM) %>%
  summarize(.groups="drop") 


ggplot(compare_geos) +
  facet_wrap("type") +
  geom_sf(size=0.25) +
  geom_sf(data=ridings,size=0.75,fill=NA) +
  geom_sf(data=bbox,color="red",fill=NA,size=1) +
  coord_sf(datum = NA) +
  labs(title="Federal electoral poll district boundaries TongFen",caption="Elections Canada")

## ----fig.height=3-------------------------------------------------------------
bb <- st_bbox(bbox)
ggplot(compare_geos) +
  facet_wrap("type") +
  geom_sf(size=0.25) +
  geom_sf(data=ridings,size=0.75,fill=NA) +
  geom_sf(data=bbox,color="red",fill=NA,size=1) +
  coord_sf(datum = NA, xlim=c(bb$xmin,bb$xmax),ylim=c(bb$ymin,bb$ymax)) +
  labs(title="Federal electoral poll district boundaries TongFen",caption="Elections Canada")

## -----------------------------------------------------------------------------
main_parties <- c("Liberal","Conservative","Green Party","NDP-New Democratic Party")

plot_data <- base_geo %>%
  left_join(vote_data %>% 
              filter(Party %in% main_parties) %>%
              mutate(Party=recode(Party,"NDP-New Democratic Party"="NDP")),
            by="TongfenID") 

plot_data2 <- vancouver_elections_geos_2019 %>% 
  group_by(FED_NUM) %>%
  summarize(.groups="drop") 

plot_data %>% 
  ggplot(aes(fill=Share_2019-Share_2015)) +
  #mountainmathHelpers::geom_water() +
  geom_sf(size=0.01) +
  geom_sf(data=plot_data2,size=0.5,fill=NA) +
  scale_fill_gradient2(labels=function(d)scales::percent(d,suffix="pp")) +
  facet_wrap("Party") +
  coord_sf(datum = NA) +
  labs(title="Percentage point change in share of polling station votes 2015-2019",
       fill="Percentage point\nchange 2015-2019", caption="Elections Canada")

## -----------------------------------------------------------------------------
correspondence2 <- estimate_tongfen_correspondence(
  data = list(vancouver_elections_geos_2015,vancouver_elections_geos_2019),
  geo_identifiers = c("AP_2015","AP_2019"),
  method = "estimate",
  tolerance = 30) 

advance_votes_data <- correspondence2 %>%
  left_join(vancouver_elections_data_2019 %>% select(AP_2019=PD_2019,Party,Votes_2019=Votes),by="AP_2019") %>%
  left_join(vancouver_elections_data_2015 %>% select(AP_2015=PD_2015,Party,Votes_2015=Votes),by=c("AP_2015","Party")) %>%
  group_by(TongfenID,Party) %>% 
  summarize_at(vars(starts_with("Votes")),sum,na.rm=TRUE) %>%
  group_by(TongfenID) %>%
  mutate(Total_2019=sum(Votes_2019,na.rm=TRUE),
         Total_2015=sum(Votes_2015,na.rm=TRUE)) %>%
  mutate(Share_2015=Votes_2015/Total_2015,
         Share_2019=Votes_2019/Total_2019) %>%
  ungroup() 

## -----------------------------------------------------------------------------
advanced_base_geo <- vancouver_elections_geos_2019 %>% 
  left_join(correspondence2,by=c("AP_2019")) %>%
  group_by(TongfenID) %>%
  summarise()

plot_data <- advanced_base_geo %>%
  left_join(advance_votes_data %>% 
              filter(Party %in% main_parties) %>%
              group_by(TongfenID) %>%
              complete(Party=main_parties,fill=list(Share_2015=0,Share_2019=0)) %>%
              mutate(Party=recode(Party,"NDP-New Democratic Party"="NDP")),
            by="TongfenID") 



plot_data %>% 
  ggplot(aes(fill=Share_2019-Share_2015)) +
  geom_sf(size=0.1) +
  geom_sf(data=ridings,size=0.5,fill=NA) +
  scale_fill_gradient2(labels=function(d)scales::percent(d,suffix="pp")) +
  theme(legend.position="bottom", legend.key.width = unit(2.5, "cm")) +
  facet_wrap("Party") +
  coord_sf(datum=NA) +
  labs(title="Percentage point change in share of advance poll votes 2015-2019",
       fill="Percentage point\nchange 2015-2019",
       caption="Elections Canada")