We don’t yet have the final results for the 2024 BC provincial election, we are still waiting on the count of the vote-by-mail ballots that have not arrived yet. Some ridings are still in limbo, as is the overall outcome and who will form government.
As opposed to last time, we can now render the animation live within this blog, thanks quarto’s direct support for observable js. All it takes is a little bit of data prep, where we grab the electoral district boundaries, cut out water features and simplify the polygons. And then scrape the election results from Elections BC. (It’s 2024 and they probably have an actual data feed, but they sure make it hard to find.) Then we assemble a list of ridings that have not been called by hand, we will update that as more results come in.
<code>
library(tidyverse)library(mountainmathHelpers)library(sf)district_boundaries <-simpleCache({ bc_geo <- cancensus::get_statcan_geographies("2021","PR") |>filter(PRUID=="59") |> rmapshaper::ms_simplify() |>st_make_valid()read_sf("~/Downloads/BCGW_7113060B_1729362546577_9396/EBC_ELECTORAL_DISTS_BS11_SVW/EBC_ED_23_polygon.shp") |>select(ED_ID,ED_ABBREV,ED_NAME,geometry) %>% rmapshaper::ms_simplify() %>%st_intersection(st_transform(bc_geo,st_crs(.))) %>% rmapshaper::ms_simplify() %>%st_make_valid() %>%st_cast("MULTIPOLYGON") |>mutate(x=st_coordinates(st_centroid(geometry))[,1],y=st_coordinates(st_centroid(geometry))[,2]) %>%arrange(-y) |>mutate(rank =row_number()) |>st_cast("POLYGON") |>mutate(area=st_area(geometry) |>as.numeric()) %>%mutate(mainShape=area==max(area),.by=ED_ID)},"bc_election_polygons.rds")upload_result <- district_boundaries |>select(ED_ID,ED_NAME,x,y,rank,mainShape,geometry) |>sf_to_s3_gzip("mountainmath","bc_2024_elections/district_boundaries.geojson")results_raw <- rvest::read_html("https://electionsbcenr.blob.core.windows.net/electionsbcenr/Results_7097_GE-2024-10-19_Candidate.html") |> rvest::html_nodes("table#tblReport") |> rvest::html_table() |>first() |>select(ED_NAME=`Electoral District`,Candidate=`Candidate's Ballot Name`,Party=Affiliation,Votes=`Total Valid Votes`,Share=`% of Votes`) |>mutate(ED_NAME =na_if(ED_NAME,"")) |>fill(ED_NAME,.direction ="down") %>%mutate(across(c(Candidate,Party), \(x)if_else(.$Candidate==""& .$Party=="","Total",x))) |>mutate(Party=if_else(Party=="","Unaffiliated",Party)) |>mutate(Votes=gsub(",","",Votes) |>as.numeric(),Share=as.numeric(gsub("\\%","",Share))/100) close_races <-c("Coquitlam-Burke Mountain","Courtenay-Comox","Juan de Fuca-Malahat","Kelowna Centre","Maple Ridge East","Richmond-Steveston","Surrey City Centre","Surrey-Guildford","Surrey-Panorama","Vancouver-Langara","Vernon-Lumby")open_races <-c(#"Coquitlam-Burke Mountain",# "Courtenay-Comox",# "Juan de Fuca-Malahat",# "Kelowna Centre",#"Maple Ridge East",#"Richmond-Steveston",#"Surrey City Centre",# "Surrey-Guildford"#"Surrey-Panorama",#"Vancouver-Langara",#"Vernon-Lumby")results <- results_raw |>filter(!grepl("Advance voting ballot boxes|Final Voting Day ballot boxes|Out-of-district ballots|Status | In Progress| Complete",ED_NAME)) |>left_join(district_boundaries |>st_drop_geometry() |>select(ED_NAME,ED_ID) |>unique(),by=c("ED_NAME"="ED_NAME")) |>mutate(close=ED_NAME %in% close_races,called=!(ED_NAME %in% open_races))tmp <-tempfile(fileext =".csv")cleaned_results <- results |>filter(Party!="Total") |>mutate(Party=recode(Party,"BC NDP"="NDP","BC Green Party"="GRN","Conservative Party"="CON","Independent"="IND","Freedom Party of BC"="FP","Libertarian"="LTN","Christian Heritage Party of B.C."="CHP","Communist Party of BC"="COM" ))cleaned_results |>select(ED_ID,Candidate,Party,Votes,called) |>write_csv( tmp)upload_result <-file_to_s3_gzip(tmp,"mountainmath","bc_2024_elections/results.csv")
With the data in hand1 we can on observable to draw our map. Regions that have not yet been called are coloured in a lighter shade of the party that is currently in the lead. The tooltip on hover shows the full riding results.
The animation interpolates between the geographies of the ridings, and bubbles for each riding of size proportional to the total vote count. This visualizes the degree to which the map view over-emphasizes rural areas, which predominantly went to the Conservatives, whereas electoral districts with high population density and consequently lower area were predominantly won by the NDP.
Some ridings had a clear winner with a large lead, others are still quite tight. Figure 2 we give an overview over the vote share lead in each riding, the tightest race right now is Surrey-Guildford, where the NDP currently holds a 22 vote (0.1 percentage point) lead.
<code>
party_colours <-c(CON="#115DA8",NDP="#F58220",IND="#676767",GRN="#3D9B35")party_colours2 <-c(CON="#83ACF5",NDP="#FFB38D",IND="#FFCBB8",GRN="#84DA80")party_colours_combined <-c(party_colours,setNames(as.character(party_colours2),paste0(names(party_colours2)," (lead)")))lead_results |>mutate(Party_call=paste0(Party, ifelse(called,""," (lead)"))) |>ggplot(aes(x=lead_share,y=reorder(ED_NAME,lead_share),fill=Party_call)) +geom_bar(stat="identity") +scale_fill_manual(values=party_colours_combined,breaks=names(party_colours)) +scale_x_continuous(labels=\(d)scales::percent(d,suffix="pp")) +labs(title="Party lead in each riding",x="Percentage point lead",y=NULL,fill="Party",caption="Data: Elections BC")
Update (Oct 23, 2024)
Elections BC is still regularly updating vote counts, for convenience we added a graph with just the 11 races that CBC has not yet called. We will updated this regularly as updated voting results come in. Fore reference we kept some of the older version in the tabs.
simpleCache(lead_results,"bc_elections_2024_results-2024-11-08.rds") |>filter(close) |>mutate(Party_call=paste0(Party, ifelse(called,""," (lead)"))) |>ggplot(aes(x=lead_share,y=reorder(ED_NAME,lead_share),fill=Party_call)) +geom_bar(stat="identity") +geom_text(aes(label=scales::comma(lead,suffix=" vote lead"),hjust=ifelse(lead_share>0.01,1.1,-0.1))) +scale_fill_manual(values=party_colours_combined,breaks=names(party_colours)) +scale_x_continuous(labels=\(d)scales::percent(d,suffix="pp")) +labs(title="Party lead in races CBC has not called yet",x="Percentage point vote lead",y=NULL,fill="Party",caption="Data: Elections BC")
<code>
simpleCache({},"bc_elections_2024_results-2024-10-28-6:50pm.rds") |>filter(close) |>mutate(Party_call=paste0(Party, ifelse(called,""," (lead)"))) |>ggplot(aes(x=lead_share,y=reorder(ED_NAME,lead_share),fill=Party_call)) +geom_bar(stat="identity") +geom_text(aes(label=scales::comma(lead,suffix=" vote lead"),hjust=ifelse(lead_share>0.01,1.1,-0.1))) +scale_fill_manual(values=party_colours_combined,breaks=names(party_colours)) +scale_x_continuous(labels=\(d)scales::percent(d,suffix="pp")) +labs(title="Party lead in races CBC has not called yet",x="Percentage point vote lead",y=NULL,fill="Party",caption="Data: Elections BC")
<code>
simpleCache({},"bc_elections_2024_results-2024-10-28-5pm.rds") |>filter(close) |>mutate(Party_call=paste0(Party, ifelse(called,""," (lead)"))) |>ggplot(aes(x=lead_share,y=reorder(ED_NAME,lead_share),fill=Party_call)) +geom_bar(stat="identity") +geom_text(aes(label=scales::comma(lead,suffix=" vote lead"),hjust=ifelse(lead_share>0.01,1.1,-0.1))) +scale_fill_manual(values=party_colours_combined,breaks=names(party_colours)) +scale_x_continuous(labels=\(d)scales::percent(d,suffix="pp")) +labs(title="Party lead in races CBC has not called yet",x="Percentage point vote lead",y=NULL,fill="Party",caption="Data: Elections BC")
<code>
simpleCache({},"bc_elections_2024_results-2024-10-28-4pm.rds") |>filter(close) |>mutate(Party_call=paste0(Party, ifelse(called,""," (lead)"))) |>ggplot(aes(x=lead_share,y=reorder(ED_NAME,lead_share),fill=Party_call)) +geom_bar(stat="identity") +geom_text(aes(label=scales::comma(lead,suffix=" vote lead"),hjust=ifelse(lead_share>0.01,1.1,-0.1))) +scale_fill_manual(values=party_colours_combined,breaks=names(party_colours)) +scale_x_continuous(labels=\(d)scales::percent(d,suffix="pp")) +labs(title="Party lead in races CBC has not called yet",x="Percentage point vote lead",y=NULL,fill="Party",caption="Data: Elections BC")
<code>
simpleCache({},"bc_elections_2024_results-2024-10-28-3pm.rds") |>filter(close) |>mutate(Party_call=paste0(Party, ifelse(called,""," (lead)"))) |>ggplot(aes(x=lead_share,y=reorder(ED_NAME,lead_share),fill=Party_call)) +geom_bar(stat="identity") +geom_text(aes(label=scales::comma(lead,suffix=" vote lead"),hjust=ifelse(lead_share>0.01,1.1,-0.1))) +scale_fill_manual(values=party_colours_combined,breaks=names(party_colours)) +scale_x_continuous(labels=\(d)scales::percent(d,suffix="pp")) +labs(title="Party lead in races CBC has not called yet",x="Percentage point vote lead",y=NULL,fill="Party",caption="Data: Elections BC")
<code>
simpleCache({},"bc_elections_2024_results-2024-10-28-2pm.rds") |>filter(close) |>mutate(Party_call=paste0(Party, ifelse(called,""," (lead)"))) |>ggplot(aes(x=lead_share,y=reorder(ED_NAME,lead_share),fill=Party_call)) +geom_bar(stat="identity") +geom_text(aes(label=scales::comma(lead,suffix=" vote lead"),hjust=ifelse(lead_share>0.01,1.1,-0.1))) +scale_fill_manual(values=party_colours_combined,breaks=names(party_colours)) +scale_x_continuous(labels=\(d)scales::percent(d,suffix="pp")) +labs(title="Party lead in races CBC has not called yet",x="Percentage point vote lead",y=NULL,fill="Party",caption="Data: Elections BC")
<code>
simpleCache({},"bc_elections_2024_results-2024-10-28-1pm.rds") |>filter(close) |>mutate(Party_call=paste0(Party, ifelse(called,""," (lead)"))) |>ggplot(aes(x=lead_share,y=reorder(ED_NAME,lead_share),fill=Party_call)) +geom_bar(stat="identity") +geom_text(aes(label=scales::comma(lead,suffix=" vote lead"),hjust=ifelse(lead_share>0.01,1.1,-0.1))) +scale_fill_manual(values=party_colours_combined,breaks=names(party_colours)) +scale_x_continuous(labels=\(d)scales::percent(d,suffix="pp")) +labs(title="Party lead in races CBC has not called yet",x="Percentage point vote lead",y=NULL,fill="Party",caption="Data: Elections BC")
<code>
simpleCache({},"bc_elections_2024_results-2024-10-28-12pm.rds") |>filter(close) |>mutate(Party_call=paste0(Party, ifelse(called,""," (lead)"))) |>ggplot(aes(x=lead_share,y=reorder(ED_NAME,lead_share),fill=Party_call)) +geom_bar(stat="identity") +geom_text(aes(label=scales::comma(lead,suffix=" vote lead"),hjust=ifelse(lead_share>0.01,1.1,-0.1))) +scale_fill_manual(values=party_colours_combined,breaks=names(party_colours)) +scale_x_continuous(labels=\(d)scales::percent(d,suffix="pp")) +labs(title="Party lead in races CBC has not called yet",x="Percentage point vote lead",y=NULL,fill="Party",caption="Data: Elections BC")
<code>
simpleCache({},"bc_elections_2024_results-2024-10-28-11am.rds") |>filter(close) |>mutate(Party_call=paste0(Party, ifelse(called,""," (lead)"))) |>ggplot(aes(x=lead_share,y=reorder(ED_NAME,lead_share),fill=Party_call)) +geom_bar(stat="identity") +geom_text(aes(label=scales::comma(lead,suffix=" vote lead"),hjust=ifelse(lead_share>0.01,1.1,-0.1))) +scale_fill_manual(values=party_colours_combined,breaks=names(party_colours)) +scale_x_continuous(labels=\(d)scales::percent(d,suffix="pp")) +labs(title="Party lead in races CBC has not called yet",x="Percentage point vote lead",y=NULL,fill="Party",caption="Data: Elections BC")
<code>
simpleCache({},"bc_elections_2024_results-2024-10-28-10am.rds") |>filter(close) |>mutate(Party_call=paste0(Party, ifelse(called,""," (lead)"))) |>ggplot(aes(x=lead_share,y=reorder(ED_NAME,lead_share),fill=Party_call)) +geom_bar(stat="identity") +geom_text(aes(label=scales::comma(lead,suffix=" vote lead"),hjust=ifelse(lead_share>0.01,1.1,-0.1))) +scale_fill_manual(values=party_colours_combined,breaks=names(party_colours)) +scale_x_continuous(labels=\(d)scales::percent(d,suffix="pp")) +labs(title="Party lead in races CBC has not called yet",x="Percentage point vote lead",y=NULL,fill="Party",caption="Data: Elections BC")
<code>
simpleCache({},"bc_elections_2024_results-2024-10-27-8pm.rds") |>filter(close) |>mutate(Party_call=paste0(Party, ifelse(called,""," (lead)"))) |>ggplot(aes(x=lead_share,y=reorder(ED_NAME,lead_share),fill=Party_call)) +geom_bar(stat="identity") +geom_text(aes(label=scales::comma(lead,suffix=" vote lead"),hjust=ifelse(lead_share>0.01,1.1,-0.1))) +scale_fill_manual(values=party_colours_combined,breaks=names(party_colours)) +scale_x_continuous(labels=\(d)scales::percent(d,suffix="pp")) +labs(title="Party lead in races CBC has not called yet",x="Percentage point vote lead",y=NULL,fill="Party",caption="Data: Elections BC")
<code>
simpleCache({},"bc_elections_2024_results-2024-10-27-5pm.rds") |>filter(close) |>mutate(Party_call=paste0(Party, ifelse(called,""," (lead)"))) |>ggplot(aes(x=lead_share,y=reorder(ED_NAME,lead_share),fill=Party_call)) +geom_bar(stat="identity") +geom_text(aes(label=scales::comma(lead,suffix=" vote lead"),hjust=ifelse(lead_share>0.01,1.1,-0.1))) +scale_fill_manual(values=party_colours_combined,breaks=names(party_colours)) +scale_x_continuous(labels=\(d)scales::percent(d,suffix="pp")) +labs(title="Party lead in races CBC has not called yet",x="Percentage point vote lead",y=NULL,fill="Party",caption="Data: Elections BC")
<code>
simpleCache({},"bc_elections_2024_results-2024-10-27-1pm.rds") |>filter(close) |>mutate(Party_call=paste0(Party, ifelse(called,""," (lead)"))) |>ggplot(aes(x=lead_share,y=reorder(ED_NAME,lead_share),fill=Party_call)) +geom_bar(stat="identity") +geom_text(aes(label=scales::comma(lead,suffix=" vote lead"),hjust=ifelse(lead_share>0.01,1.1,-0.1))) +scale_fill_manual(values=party_colours_combined,breaks=names(party_colours)) +scale_x_continuous(labels=\(d)scales::percent(d,suffix="pp")) +labs(title="Party lead in races CBC has not called yet",x="Percentage point vote lead",y=NULL,fill="Party",caption="Data: Elections BC")
<code>
simpleCache({},"bc_elections_2024_results-2024-10-26-4pm.rds") |>filter(close) |>mutate(Party_call=paste0(Party, ifelse(called,""," (lead)"))) |>ggplot(aes(x=lead_share,y=reorder(ED_NAME,lead_share),fill=Party_call)) +geom_bar(stat="identity") +geom_text(aes(label=scales::comma(lead,suffix=" vote lead"),hjust=ifelse(lead_share>0.01,1.1,-0.1))) +scale_fill_manual(values=party_colours_combined,breaks=names(party_colours)) +scale_x_continuous(labels=\(d)scales::percent(d,suffix="pp")) +labs(title="Party lead in races CBC has not called yet",x="Percentage point vote lead",y=NULL,fill="Party",caption="Data: Elections BC")
<code>
simpleCache({},"bc_elections_2024_results-2024-10-26-1pm.rds") |>filter(close) |>ggplot(aes(x=lead_share,y=reorder(ED_NAME,lead_share),fill=Party)) +geom_bar(stat="identity") +geom_text(aes(label=scales::comma(lead,suffix=" vote lead"),hjust=ifelse(lead_share>0.01,1.1,-0.1))) +scale_fill_manual(values=party_colours2) +scale_x_continuous(labels=\(d)scales::percent(d,suffix="pp")) +guides(fill=guide_legend(override.aes=list(fill=party_colours[c("CON","NDP")]))) +labs(title="Party lead in races CBC has not called yet",x="Percentage point vote lead",y=NULL, fill="Party",caption="Data: Elections BC")
<code>
simpleCache({},"bc_elections_2024_results-2024-10-25.rds") |>mutate(close=!called) |>filter(close) |>ggplot(aes(x=lead_share,y=reorder(ED_NAME,lead_share),fill=Party)) +geom_bar(stat="identity") +geom_text(aes(label=scales::comma(lead,suffix=" vote lead"),hjust=ifelse(lead_share>0.01,1.1,-0.1))) +scale_fill_manual(values=party_colours2) +scale_x_continuous(labels=\(d)scales::percent(d,suffix="pp")) +guides(fill=guide_legend(override.aes=list(fill=party_colours[c("CON","NDP")]))) +labs(title="Party lead in races CBC has not called yet",x="Percentage point vote lead",y=NULL, fill="Party",caption="Data: Elections BC")
As usual, the code for this post is available on GitHub for anyone to reproduce or adapt for their own purposes.
Reproducibility receipt
<code>
## datetimeSys.time()
[1] "2024-11-08 14:43:48 PST"
<code>
## repositorygit2r::repository()
Local: main /Users/jens/R/mountain_doodles
Remote: main @ origin (https://github.com/mountainMath/mountain_doodles.git)
Head: [4bf0a38] 2024-10-30: freeze for final count of bc election results (not yet accounting for manual recounts).