Last update: 2 May 2023
library(tidyverse)
library(janitor)
library(sf)
library(patchwork)
library(reactable)
library(reactablefmtr)
library(ggpubr)
library(ggh4x)
library(biscale)
library(ggtext)
library(patchwork)
library(gghalves)
library(extrafont)
loadfonts(device = "win", quiet = T)
library(hrbrthemes)
library(ggiraph)
library(gt)Note: On mobile devices best seen in landscape mode. For complete and high resolution images, please see graphs in the blogpost.
This post is a “quick” look at the most recent state-level elections in Austria, namely in Lower Austria, Carinthia, and Salzburg. More precisely, it’s a replication and extension of a graph tweeted by University of Vienna PolSci Prof Laurenz Ennser-Jedensastik in which he highlighted the rather remarkable relation between municipalities’ rates of COVID vaccinations and the performance of the extreme-right Freedom Party (FPÖ) in Lower Austria.
With this as the background, the post is an exercise in demonstrating
a) how to extract electoral data from the rather intricate formats they were published in by the electoral authorities (Section 3).
b) how to replicate the original graph highlighting the bivariate relationship between parties’s vote share win/loss and COVID vaccination ratios on the municipal level (Section 5). The results will be more comprehensive in the sense that they cover (almost) all parties and state elections. Upfront, to state the obvious, the results are not meant to imply any direct causality between vaccination rates and vote results, but are only highlighting mere correlations.
c) how to visualize bivariate relationships on a map with the {biscale} package (Section 6). Biscale maps are a neat tool to visualize the interaction of two variables on a geographical unit by blending two distinct color scales. Electoral results and Covid vaccination ratios on the municipal level seem like a fitting use-case; and
d) a few smaller side kicks along the way, including an alternative form of visualization with a combination of dot- and box-plots (similar to a rainplot)(Section 7), or how to create a large number of tabsets without coding each individually.
Obtaining electoral data is not a big thing, as it should be. Getting them in a format, which is amenable to further analysis, e.g. in R, is another story. While there certainly has been some progress regarding Open Data, nevertheless, quite frequently, a considerable amount of data wrangling is necessary.
With the earlier elections in Lower Austria, the results came inter alia as a standard xlsx file, however, with these column headers:
Below the necessary steps to eventually obtain a tidy dataframe. The `janitor` package once again turns out to be a very helpful tool.
res_noe <- readxl::read_xls(path=here::here("posts","2023-03-17-state-elections-and-covid","data", "noe_lw23.xls"))
#get party names
vec_parties_noe <- res_noe %>%
slice(2) %>%
unlist(use.names=F) %>%
na.omit() %>% as.character()
#take body table
df_res_noe_clean <- res_noe %>%
janitor::find_header()
#make row number 3 auxiliary column names
df_res_noe_clean <- res_noe %>%
janitor::row_to_names(., row_number=3, remove_rows_above = T) %>%
clean_names() %>%
pivot_longer(.,cols=matches("stimmen|ant_|diff_"))
#Assign party names to columns
df_res_noe_clean <- df_res_noe_clean %>%
mutate(party=case_when(
str_detect(name, regex("^Stimmen$")) ~ vec_parties_noe[[1]],
str_detect(name, regex("^ant_percent$")) ~ vec_parties_noe[[1]],
str_detect(name, regex("^diff_percent$")) ~ vec_parties_noe[[1]],
str_detect(name, regex("_2$")) ~ vec_parties_noe[[2]],
str_detect(name, regex("_3$")) ~ vec_parties_noe[[3]],
str_detect(name, regex("_4$")) ~ vec_parties_noe[[4]],
str_detect(name, regex("_5$")) ~ vec_parties_noe[[5]],
str_detect(name, regex("_6$")) ~ vec_parties_noe[[6]],
str_detect(name, regex("_7$")) ~ vec_parties_noe[[7]],
str_detect(name, regex("_8$")) ~ vec_parties_noe[[8]],
.default = NA
))
#Keep only municipalities
df_res_noe_municip <- df_res_noe_clean %>%
filter(str_detect(kenn_nr, regex("\\d{5}"))) %>%
select(kenn_nr, bezeichnung, name, value, party) %>%
filter(str_detect(name, regex("^diff_percent"))) %>%
mutate(diff_percent=as.numeric(value)) %>%
select(-name, -value)
#remove municipalities where a party did not run
df_res_noe_municip <- df_res_noe_municip %>%
filter(!is.na(diff_percent))And with this we obtained a cleaned version of the election results for Lower Austria.
df_res_noe_municip %>%
reactable(
compact = TRUE,
filterable=T,
defaultPageSize = 5,
theme = fivethirtyeight()
) %>%
add_title(title = "Election Results Lower Austria 2023", font_size = 15) %>%
add_subtitle(subtitle = "Only municipal level, mail votes not included.", font_size=12)Carinthia’s election results are published on a dedicated website by the state authorities. As you can see, the main page comprises a left-hand panel with links to each of the municipal results (and other categories). In turn, each of these municipal sub-pages contains a table with election results, the data in which I am actually interested in.
To collect these data, let’s take the following steps:
1) From the left-hand panel on the overview page, extract all links leading to municipal subpages. The pertaining css-selector targets html elements with the id ‘gemeinde’. Since this selector also captures aggregate categories for wider electoral districts which we do not want, they have to be removed. Conveniently, they are all spelled in capital letters, what makes it easy to match them via a regular expression and filter them out.
link_overview <- "https://www.ktn.gv.at/wahlen/ltwahl2023"
main <- rvest::session(link_overview)
#get links
res_links <- main %>% xml2::read_html() %>%
rvest::html_elements("#gemeinde a") %>%
rvest::html_attr("href")
#get names
res_names <- main %>% xml2::read_html() %>%
rvest::html_elements("#gemeinde a") %>%
rvest::html_text()
#combine links and names to a tibble
df_res <- tibble(links=res_links, names=res_names)
df_mun <- df_res %>%
#remove aggregate categories which are spelled with capital letters
filter(!str_detect(links, regex("[A-Z]"))) %>%
#complete links to get entire address
mutate(link_complete=glue::glue("https://www.ktn.gv.at/wahlen/ltwahl2023/{links}"))Here the first few rows of the obtained dataframe with all sub-page links.
# A tibble: 132 × 3
links names link_complete
<chr> <chr> <glue>
1 lt2023_20101.html Klagenfurt am Ws. https://www.ktn.gv.at/wahlen/ltwahl2023…
2 lt2023_20402.html Ebenthal https://www.ktn.gv.at/wahlen/ltwahl2023…
3 lt2023_20403.html Feistritz i. R. https://www.ktn.gv.at/wahlen/ltwahl2023…
4 lt2023_20405.html Ferlach https://www.ktn.gv.at/wahlen/ltwahl2023…
5 lt2023_20409.html Grafenstein https://www.ktn.gv.at/wahlen/ltwahl2023…
6 lt2023_20412.html Keutschach am See https://www.ktn.gv.at/wahlen/ltwahl2023…
7 lt2023_20414.html Köttmannsdorf https://www.ktn.gv.at/wahlen/ltwahl2023…
8 lt2023_20415.html Krumpendorf am Ws. https://www.ktn.gv.at/wahlen/ltwahl2023…
9 lt2023_20416.html Ludmannsdorf https://www.ktn.gv.at/wahlen/ltwahl2023…
10 lt2023_20442.html Magdalensberg https://www.ktn.gv.at/wahlen/ltwahl2023…
# ℹ 122 more rows2) With the links to all municipal pages now available, the next step is about extracting the table with the actual electoral data. To so, I define a function which is subsequently mapped to each subpage link. The css selector allowing us to capture the table is on each page class ‘.bausteinausw3_bo’.
#define function
fn_get_res_municip <- function(link_municip) {
# link_municip <- "https://www.ktn.gv.at/wahlen/ltwahl2023/lt2023_20402.html"
#Extract table
df_res_municip <- link_municip %>%
xml2::read_html() %>%
rvest::html_elements(".bausteinausw3_bo") %>%
rvest::html_table() %>%
.[[1]]
#Filter the results
df_res_municip %>%
janitor::clean_names() %>%
filter(!str_detect(partei, regex("^Partei$|Gesamt|Ungültig|Gültig"))) %>%
mutate(partei=str_remove(partei, regex("^.+?(?=[A-Z])"))) %>%
rename_with(., .fn=\(x) str_replace(x, "_2", "_perc"), .cols=ends_with("_2")) %>%
mutate(across(.cols=-partei, .fns=\(x) parse_number(x, locale=locale(decimal_mark=",")))) %>%
mutate(link_municip=link_municip) %>%
mutate(municip_id=str_extract(link_municip, regex("\\d+(?=\\.html$)")))
}
#Map links to function
df_res_ktn_municip<- df_mun %>%
pull(link_complete) %>%
map(., .f=\(x) fn_get_res_municip(link_municip = x), .progress=T) %>%
purrr::list_rbind()
#Remove parties which did not run in 2023
df_res_ktn_municip <- df_res_ktn_municip %>%
filter(!is.na(lt2023))
#Correct for NA in difference field
df_res_ktn_municip <- df_res_ktn_municip %>%
mutate(differenz_perc=case_when(
is.na(differenz_perc) & !is.na(lt2023_perc) ~ lt2023_perc,
.default = differenz_perc
))Below the obtained election results for Carinthia.
df_res_ktn_municip %>%
select(municip_id, everything()) %>%
reactable(.,
columns = list(
partei=colDef(width=70),
differenz_perc=colDef(width=120),
link_municip=colDef(
html=T,
cell=function(value) {
htmltools::tags$a(href=value, targe="_blank", as.character("link"))
},
align = "center"
)
),
compact = TRUE,
filterable=T,
defaultPageSize = 5,
theme = fivethirtyeight()
) %>%
add_title(title = "Election Results Carinthia 2023", font_size = 15) %>%
add_subtitle(subtitle = "Only municipal level.", font_size=12) Data for Salzburg are available at the State’s official website. Again, with somewhat inconvenient headers. Additionally, to get the changes between the 2023 and preceding 2018 elections, results for both years have to be downloaded (xlsx files) and the differences calculated.
df_res_sbg_18 <- readxl::read_xlsx(path=here::here("posts", "2023-03-17-state-elections-and-covid", "data", "sbg_TW-2018.xlsx"),
sheet="Stimmen",
skip=3, col_types = "text")
vec_col_names <- c(
"code", "region",
"eligible_total", "eligible_male",
"eligible_female",
"votes_total_abs", "votes_total_rel",
"votes_invalid_abs", "votes_invalid_rel",
"votes_valid_abs",
# "votes_valid_rel" ,
"oevp_abs", "oevp_rel",
"spoe_abs", "spoe_rel",
"greens_abs", "greens_rel",
"fpoe_abs", "fpoe_rel",
"fps_abs", "fps_rel",
"neos_abs", "neos_rel",
"kpoe_abs", "kpoe_rel",
"mayr_abs", "mayr_rel",
"cpoe_abs", "cpoe_rel")
names(df_res_sbg_18) <- vec_col_names
#keep only municipalities; id should not end on 00 or 99
df_res_sbg_18_wide <- df_res_sbg_18 %>%
filter(!str_detect(code, regex("(99)|(00)$"))) %>%
filter(str_detect(code, regex("\\d{5}")))
df_res_sbg_18_long <- df_res_sbg_18_wide %>%
pivot_longer(
cols=oevp_abs:last_col(),
names_to="type",
values_to="value_18"
) %>%
mutate(across(.cols=-c(code, region, type), .fns=as.numeric)) %>%
mutate(year=2018)df_res_sbg_23 <- readxl::read_xlsx(path=here::here("posts", "2023-03-17-state-elections-and-covid", "data", "sbg-LTW-2023.xlsx"),
sheet="Stimmen",
skip=3, col_types = "text") %>%
select(1:`...24`)
#ncol(df_res_sbg_23)
vec_col_names <- c(
"code", "region",
"eligible_total",
"votes_total_abs", "votes_total_rel",
"votes_invalid_abs", "votes_invalid_rel",
"votes_valid_abs",
# "votes_valid_rel" ,
"oevp_abs", "oevp_rel",
"spoe_abs", "spoe_rel",
"fpoe_abs", "fpoe_rel",
"greens_abs", "greens_rel",
"neos_abs", "neos_rel",
"kpoe_abs", "kpoe_rel",
"wirs_abs", "wirs_rel",
"mfg_abs", "mfg_rel")
names(df_res_sbg_23) <- vec_col_names
#keep only municipalities; id should not end on 00 or 99
df_res_sbg_23_wide <- df_res_sbg_23 %>%
filter(!str_detect(code, regex("(99)|(00)$"))) %>%
filter(str_detect(code, regex("\\d{5}")))
df_res_sbg_23_long <- df_res_sbg_23_wide %>%
pivot_longer(
cols=oevp_abs:last_col(),
names_to="type",
values_to="value_23"
) %>%
mutate(across(.cols=-c(code, region, type), .fns=as.numeric)) %>%
mutate(year=2023)Calculate the changes between 2023 and 2018.
df_res_sbg_municip_23 <- df_res_sbg_23_long %>%
left_join(., df_res_sbg_18_long %>%
select(code, type, value_18),
by=c("code", "type")) %>%
mutate(value_18=replace_na(value_18, 0)) %>% # otherwise: number - NA = NA !!
mutate(value_diff=(value_23-value_18)*100) %>%
tidyr::separate_wider_delim(
cols=type,
delim="_",
names=c("party", "value_type")
) %>%
mutate(state="sbg", .before=1)
df_res_sbg_municip_23 <- df_res_sbg_municip_23 %>%
filter(value_type=="rel") df_res_sbg_municip_23 %>%
select(-state, -year, -value_18, -value_type, -votes_invalid_abs) %>%
reactable(.,
columns=list(
region=colDef(name="Municipality"),
eligible_total=colDef(name="eligible voters", format=colFormat(separators = T)),
votes_total_abs=colDef(name="votes casted", format=colFormat(separators = T)),
votes_total_rel=colDef(name="turnout",
format=colFormat(percent=T, digits = 2)),
votes_invalid_rel=colDef(name="% invalid votes", format=colFormat(percent=T, digits=2)),
votes_valid_abs=colDef(name="valid votes", format=colFormat(separators = T)),
value_23=colDef(name="vote share 23",
format=colFormat(percent=T, digits=2)),
value_diff=colDef(name="diff % points", format=colFormat(digits=2))
),
compact = TRUE,
filterable=T,
defaultPageSize = 5,
theme = fivethirtyeight()
) %>%
add_title(title = "Election Results Salzburg 2023", font_size = 15) %>%
add_subtitle(subtitle = "Only municipal level.", font_size=12) Finally, let’s combine the results from Lower Austria, Carinthia, and Salzburg into one single dataframe, and keep only the columns of interest. Note that I also standardize and order party names.
df_res_municip <- bind_rows(
noe=df_res_noe_municip %>%
select(
municip_id=kenn_nr,
municip_name=bezeichnung,
party,
change_perc=diff_percent),
ktn=df_res_ktn_municip %>%
select(municip_id,
party=partei,
change_perc=differenz_perc),
sbg=df_res_sbg_municip_23 %>%
select(municip_id=code,
party,
change_perc=value_diff),
.id = "state")
#Standardize party name
df_res_municip <- df_res_municip %>%
mutate(party=case_when(
str_detect(party, regex("^VP$|vpnö|^oev", ignore_case=T)) ~ "ÖVP",
str_detect(party, regex("^spoe")) ~ "SPÖ",
str_detect(party, regex("^greens")) ~ "GRÜNE",
str_detect(party, regex("^fpoe")) ~ "FPÖ",
str_detect(party, regex("^neos")) ~ "NEOS",
str_detect(party, regex("^kpoe")) ~ "KPÖ",
str_detect(party, regex("mfg")) ~ "MFG",
.default = party
))vec_parties_filter <- c(
"ÖVP", "SPÖ", "FPÖ","GRÜNE", "NEOS",
"MFG",
#"ZIEL",
# "KÖFER",
#"STARK",
"BFK",
#"VÖ",
"KPÖ"#,
# "WIRS"
)
df_res_municip <- df_res_municip %>%
filter(party %in% vec_parties_filter) %>%
mutate(party=fct_drop(party))
#put large parties up front
lvls_party <- c("ÖVP", "SPÖ", "FPÖ", "GRÜNE", "NEOS")
# levels(df_res_municip$party)
df_res_municip <- df_res_municip %>%
mutate(party=forcats::fct_relevel(party, lvls_party)) With the electoral results now ready, let’s add the data on Covid vaccination rates on the municipal level. Here one qualification: The vaccination status for all states are dated with early May. Ideally, I should use the vaccination ratios for each election date. However, since there have been basically no meaningful development, particularly when it comes to the ratio pertaining to “at least 1 vaccination”, I take this imprecision as negligible.
#import covid vaccination data
df_covid <- readr::read_csv2(file="https://opendata.sozialversicherung.at/eimpfpass/COVID19_vaccination_municipalities_v202210.csv")
df_covid_2 <- df_covid %>%
mutate(across(.cols=contains("vaccination"), .fns=list(share=\(x) x/municipality_population))) %>%
mutate(municipality_id=as.character(municipality_id))
#add to municip data
df_res_municip_covid<- df_res_municip %>%
left_join(.,
df_covid_2 %>% select((municipality_id), municipality_name, contains("share")),
by=c("municip_id"="municipality_id"))With the required data now available and in the proper format, we can start looking into it in earnest. Below the correlation of parties’ electoral gains/loss and vaccination ratios on the municipal level. The graph is inspired by Ennser-Jedenastik’s tweet, but goes beyond it in terms of elections and parties. Note the graphs pertaining to the ÖVP and FPÖ.
## coloring strip text
df_res_municip_covid <- df_res_municip_covid %>%
mutate(facet_txt_style=case_when(
str_detect(party, regex("FPÖ|ÖVP")) ~ "**",
.default = ""
)) %>%
# mutate(facet_txt=glue::glue("<span style='font-weight:{facet_txt_style}'>{party}</span>"))
mutate(facet_txt=glue::glue("{facet_txt_style}{party}{facet_txt_style}")) %>%
mutate(facet_txt=as_factor(facet_txt))
#levels(df_res_municip_covid$facet_txt)
## coloring strip background
library(ggh4x)
vec_party_levels <- levels(df_res_municip_covid$party)
strip_color <- ifelse(str_detect(vec_party_levels, regex("ÖVP|FPÖ")), "lightgrey", "white")
strip_color_scale <- setNames(strip_color, vec_party_levels)
# strip_color_scale
strip_background <- strip_themed(
text_x = elem_list_text(face = 'bold'),
background_x = elem_list_rect(fill = strip_color_scale, color="white")
)
#df function
fn_reg_plot <- function(df, title) {
{{df}} %>%
ggplot(., aes(y=change_perc,
x=vaccination_1_share))+
labs(
y="change vote share",
x="vaccination rate in municipality (1st shot)",
title={{title}}
)+
geom_point(size=.5)+
geom_smooth(method = "lm", color="orange",
linewidth=.5)+
stat_cor(aes(label = paste(after_stat(rr.label), after_stat(p.label), sep = "~`,`~")), # adds R^2 and p-value
r.accuracy = 0.01,
p.accuracy = 0.001,
color="black",
# fill="grey",
label.x = 0.45,
label.y = -30,
size = 2) +
stat_regline_equation(aes(label =after_stat(eq.label)), # adds equation to linear regression
color="black",
label.x = 0.45,
label.y = -35,
size = 2)+
scale_x_continuous(label=scales::label_percent(scale=100),
breaks=seq(.40,1,.20),
position = "bottom")+
scale_y_continuous(label=scales::label_percent(scale=1),
expand=expansion(mult=c(0.08,0.05)),
position="left")+
facet_wrap2(
facets="party",
strip=strip_background,
nrow=1,
drop=F
)+
theme_ipsum_rc()+
theme(
axis.title.y.left = element_text(size=rel(.7/9*11.5)),
axis.title.x.bottom = element_text(size=rel(.7/9*11.5)),
panel.grid.minor.x = element_blank(),
panel.grid.minor.y=element_blank(),
legend.position="none",
strip.placement = "outside",
axis.text.x.bottom = element_text(size=rel(.5),
margin=ggplot2::margin(t=0, unit="cm")),
axis.text.y.left = element_text(size=rel(.5)),
plot.title=element_text(size=rel(0.9), margin=ggplot2::margin(b=0, unit="cm")),
plot.title.position = "plot",
panel.spacing.x = unit(0.25, "cm"),
plot.margin=ggplot2::margin(t=0.3, b=0.1, unit="cm"),
# strip.text.x.top=element_markdown(size=rel(0.7), hjust=.5, margin=ggplot2::margin(b=0, unit="cm"))
strip.text.x.top=element_text(size=rel(0.7), hjust=.5, face="bold",
margin=ggplot2::margin(b=0, unit="cm")),
strip.background=element_rect(color="white")
)+
coord_cartesian(ylim=c(-35,30), xlim=c(.40,1))
}
#nest municips & apply fn
df_plots_reg <- df_res_municip_covid %>%
filter(!is.na(change_perc)) %>%
tidyr::nest(., .by="state") %>%
mutate(state=case_when(
state=="noe" ~ "Lower Austria",
state=="ktn" ~ "Carinthia",
state=="sbg" ~ "Salzburg"
)) %>%
mutate(plots=map2(.x=data, .y=state, .f=\(x, y) fn_reg_plot(df=x, title=y)))
txt_subtitle="Each dot represents one municipality."
li_plots <- df_plots_reg %>%
pull(plots)
#adjust axis titles
li_plots[[1]] <- li_plots[[1]]+theme(
axis.title.x.bottom = element_text(hjust=0))
li_plots[[2]] <- li_plots[[2]]+theme(axis.title.y.left=element_blank(),
axis.title.x.bottom = element_blank())
li_plots[[3]] <- li_plots[[3]]+theme(axis.title.y.left=element_blank(),
axis.title.x.bottom = element_blank())
#comb plots
li_plots %>%
wrap_plots(., nrow=3)+ #3 rows = 3 states
plot_annotation(
title="Electoral performance and COVID vaccination ratios",
subtitle = txt_subtitle,
caption=txt_caption,
theme=theme(
plot.title=element_text(family="Roboto Condensed", face="bold", size=rel(1.2)),
plot.caption = element_markdown(family="Roboto Condensed", size=rel(.6)),
plot.subtitle = element_markdown(family="Roboto Condensed Light",
size=rel(.9),
lineheight = 1.2)
)
)
If you want to dig a bit deeper into the Salzburg results, hover over the dots in plot below to get details on each municipality.
pl_sbg_f <- df_res_municip_covid %>%
filter(party=="FPÖ") %>%
filter(state=="sbg") %>%
ggplot(., aes(y=change_perc,
x=vaccination_1_share))+
labs(
y="change vote share (% points)",
x="vaccination rate in municipality (1st shot)",
title="State Elections Salzburg 2023 - FPÖ:\nChanges in electoral share and vaccination status per municipality",
subtitle="Hover over dots to get details.",
caption="Data:
https://www.salzburg.gv.at/pol/wahl/land/ltw23; https://info.gesundheitsministerium.gv.at/data/<br>Analysis & Graph: Roland Schmidt | @zoowalk | <span style='font-weight:400'>https://werk.statt.codes</span>",
)+
geom_point_interactive(
aes(tooltip=glue::glue("{municipality_name}
change: {scales::percent(change_perc/100, accuracy=.1)},
min. 1 Covid-shot: {scales::percent(vaccination_1_share,accuracy=.1)}")),
size=.5)+
geom_smooth(method = "lm", color="orange",
linewidth=.5)+
stat_cor(aes(label = paste(after_stat(rr.label), after_stat(p.label), sep = "~`,`~")), # adds R^2 and p-value
r.accuracy = 0.01,
p.accuracy = 0.001,
color="black",
label.x = 0.45,
label.y = -30,
size = 2) +
stat_regline_equation(aes(label =after_stat(eq.label)), # adds equation to linear regression
color="black",
label.x = 0.45,
label.y = -35,
size = 2)+
scale_x_continuous(label=scales::label_percent(scale=100),
breaks=seq(.50,.8,.10),
position = "bottom")+
scale_y_continuous(label=scales::label_percent(scale=1),
expand=expansion(mult=c(0.08,0.05)),
position="left")+
theme_ipsum_rc()+
theme(
axis.title.y.left = element_text(size=rel(.7/9*11.5)),
axis.title.x.bottom = element_text(size=rel(.7/9*11.5)),
panel.grid.minor.x = element_blank(),
panel.grid.minor.y=element_blank(),
legend.position="none",
axis.text.x.bottom = element_text(size=rel(.5),
margin=ggplot2::margin(t=0, unit="cm")),
axis.text.y.left = element_text(size=rel(.5)),
plot.title=element_text(size=rel(1)),
plot.subtitle=element_text(size=rel(0.8)),
plot.title.position = "plot",
plot.margin=ggplot2::margin(l=0, b=0.1, t=0.1, unit="cm"),
plot.caption=element_markdown(size=rel(.5), hjust=0)
)+
coord_cartesian(ylim=c(-10,30), xlim=c(.5,.85))
giraph_options=list(opts_hover(css =
"fill:#FFA500;
color:#FFA500"),
opts_tooltip(css =
"background-color:black;
color: white;
font-size: 80%;
font-family: Roboto Condensed;",
offx = 30,
offy = -30,
delay_mouseout = 1000)
)
giraph_height=3
girafe(ggobj=pl_sbg_f,
options=giraph_options,
height_svg=giraph_height)
Now let’s try an alternative type of visualization. A while ago, I came across Chris Prener’s biscale package which allows you to put the interaction of two variables onto a map. So far I didn’t run into any analysis where I could have made use of it, but the present case - the interaction of vaccination rates and vote share change per municipality - seems to be a good fit to test drive the package.
Before doing so, however, we still need to combine our dataframe containing electoral and vaccination data with spatial data, allowing us to eventually plot the pertaining maps. The code chunk below does this. The source of the shapefiles for all three states is Statistics Austria, the federal statistical office.
When joining the two dataframes, there’s one thing to bear in mind: Some political parties did not compete in all municipalities of a state. The intended map, however, should not only display those municipalities where the parties actually competed, but the maps for the entire state. To achieve this, a function is needed. Below its code.
#import map
map_municips_all <- read_sf(here::here("posts","2023-03-17-state-elections-and-covid","data","OGDEXT_GEM_1_STATISTIK_AUSTRIA_20230101","STATISTIK_AUSTRIA_GEM_20230101.shp"))
#keep only municipalities in Carintia, Lower Austria, and Salzburg
map_municips <- map_municips_all %>% filter(str_detect(g_id, regex("^2(0|1)|^3|^5"))) %>%
mutate(state=case_when(
str_detect(g_id, regex("^2(0|1)")) ~ "ktn",
str_detect(g_id, regex("^3")) ~ "noe",
str_detect(g_id, regex("^5")) ~ "sbg",
.default="other")) %>%
ungroup()
#left-join with results for each party; ensures complete map/also where party didn't compete
vec_parties <- df_res_municip_covid %>%
filter(!is.na(change_perc)) %>%
distinct(party) %>%
pull()
fn_match_map_res <- function(party) {
df_res_municip_covid_party <- df_res_municip_covid %>% filter(party=={{party}})
left_join(map_municips,
df_res_municip_covid_party,
by=c("g_id"="municip_id", "state"="state"),
na_matches="never") %>%
mutate(party={{party}})
}
df_map_res <- vec_parties %>% map(., fn_match_map_res, .progress=T) %>%
purrr::list_rbind() %>%
ungroup()In order to project the interaction of two variables onto a map, biscale::bi_class_breaks splits continuous variables into a maximum of four categories (dims attribute).
For each variable, I decided that each category should span the same width (style=equal). 1 As for the vaccination ratio this is rather straight forward: Take the difference between the highest and the lowest ratio, and divide this distance into four equally spaced intervals.
1 Other style options are “quantile” (default), “fisher”, and “jenks”.
When it comes to parties’ changes of vote share (gain/loss in percentage points), there’s one thing to consider: Rather than taking the difference between the maximum gain and maximum loss across all parties, I decided to take on an ‘intra-party view’, i.e. use the differences only between each party’s maximum and minimum value. The rational behind it is my interest in seeing how each party’s strong and weak electoral performance ties with municipalities vaccination ratios. If I would calculate the interval across all parties, it’s likely that the electoral results of a party with e.g. comparatively little variation in its electoral performance would end up all i.e. in one lump category. What this means in concrete terms will become clearer when showing the results. I just flag it already at this point, since its important when it comes to interpreting the eventual results.
To calculate the ‘intra-party’ categories, I define again a function which is applied to each party separately (per state; rather than across the entire dataset at once).
#define number of categories and color palette
my_dims=4
my_style="equal"
my_pallette="BlueYl"
fn_bi_class <- function(party, state) {
#take only the election results of one party in one state
df_map_res_party_state <- df_map_res %>%
filter(party=={{party}}) %>%
filter(state=={{state}}) %>%
mutate(vaccination_1_share=vaccination_1_share*100)
# calculate breaks to split election results and vaccination rates into 4 categories
bi_break_vals <- bi_class_breaks(df_map_res_party_state,
x=change_perc,
y=vaccination_1_share,
style = my_style,
dim=my_dims,
dig_lab = 2,
split = FALSE)
#class(bi_break_vals)
# assign each municipality to one election result-vaccination ratio category
bi_class(df_map_res_party_state,
x=change_perc,
y=vaccination_1_share,
style = my_style,
dim=my_dims) %>%
mutate(bi_break_vals_vec=list(bi_break_vals))
}
# get unique combinations of state and party
df_state_party <- df_map_res %>%
filter(!is.na(change_perc)) %>% #removes parties which did not run in state
distinct(party, state) %>%
filter(!is.na(party))
# apply function to all state - party combinations
df_map_res_bi_intra <- map2(df_state_party %>% pluck("party"),
df_state_party %>% pluck("state"),
purrr::possibly(.f=\(x,y) fn_bi_class(party=x, state=y),
otherwise = NULL)) %>%
purrr::list_rbind()Finally, with the data now sliced and diced, let’s plot it. For each state - party combination, the code below produces three items: 1) a map with municipalities’ color depending on their vaccination ratio and electoral results; 2) a legend providing the corresponding data for each color shade, plus the share of municipalities in each cell; and 3) a table detailing the relative distribution of municipalities across electoral results within each vaccination category/interval. Below the function.
The three sub-elements of the plot are combined via patchwork. Unfortunately, patchwork doesn’t allow yet the combination of gt plots. To make this happen nevertheless, I first exported them as a png, reimported them as a ‘native’ png and wrapped it via patchwork’s wrap_elements. While there is some loss in the image’s quality, it does the trick. Credit goes to Euge’s pertaining blog entry.
#convert dataframe to sf object
sf_map <- st_as_sf(df_map_res_bi_intra)
#define function to plot each map
fn_plot <- function(party, state) {
sf_plot_map<- sf_map %>%
#filter(!is.na(change_perc)) %>%
filter(state=={{state}}) %>%
filter(party=={{party}})
#create map
plot_map <- sf_plot_map %>%
ggplot() +
ggplot2::geom_sf(mapping = aes(fill = bi_class),
color = "black",
size = 0.1,
show.legend = F) +
bi_scale_fill(pal = my_pallette,
dim = my_dims,
na.value="grey70") +
labs(
title = glue::glue("{state %>% str_to_upper}: {party}")
) +
theme_ipsum_rc()+
bi_theme()+
theme(plot.title=element_text(size=9, hjust=0.5),
plot.margin = ggplot2::margin(0,0,0,0, unit="cm"),
plot.title.position = "plot")
bi_break_vals_vec <- unique(sf_plot_map$bi_break_vals_vec)
#create legend
plot_legend <- bi_legend(
pal = my_pallette,
dim=my_dims,
xlab="change of vote share (% points)",
ylab="vaccination\nratio (%)",
size=8,
breaks=flatten(bi_break_vals_vec),
arrows=F)
df_legend_data <- sf_plot_map %>%
as_tibble() %>%
ungroup() %>%
count(bi_class) %>%
mutate(n_rel=n/sum(n)) %>%
tidyr::separate_wider_delim(cols=c(bi_class), delim = "-", names=c("x", "y")) %>%
mutate(across(.cols=c(x, y), as.numeric))
fn_labels_xy <- function (x) {
str_split(x, regex("(?<=\\d)-(?=\\d)")) %>% map(., .f = function(y) paste0(y, "%")) %>% map_chr(., .f = function(z) paste0(z, collapse = "-"))}
interval_y <- bi_break_vals_vec[[1]]$bi_y
labels_y <- fn_labels_xy(interval_y)
interval_x <- bi_break_vals_vec[[1]]$bi_x
labels_x <- fn_labels_xy(interval_x)
plot_legend_2 <- plot_legend +
labs(title="% of municipalities per category",
y="vaccination\nratio (%)")+
geom_text(data=df_legend_data,
aes(x=x,
y=y,
label=n_rel %>% scales::percent(., accuracy=.1)),
size=2.5)+
scale_y_continuous(
labels=c(NA, labels_y),
expand=expansion(mult=0)
)+
scale_x_continuous(
position="top",
labels=c(NA, labels_x),
expand=expansion(mult=0))+
theme_ipsum_rc()+
theme(
axis.title.y.left = element_text(
angle=0,
hjust=1,
size=6),
axis.text.y.left=element_text(
size=6
),
axis.ticks.x.top = element_blank(),
axis.ticks.y.left = element_blank(),
axis.title.x.top=element_text(
hjust=0,
size=6,
),
axis.text.x.top=element_text(
size=6
),
plot.subtitle=element_blank(),
plot.title=element_text(size=9, hjust=0),
plot.title.position="panel",
plot.margin=ggplot2::margin(0,0,0,0, unit="cm")
)
#create table for marginals
df_marginal <- sf_plot_map %>%
as_tibble() %>%
ungroup() %>%
select(-geometry) %>%
mutate(cat_vac=cut(vaccination_1_share, 4)) %>%
mutate(cat_vote=cut(change_perc, 4)) %>%
count(cat_vac, cat_vote, .drop=F) %>% #drop=F to keep intervals where without observation
mutate(cat_vac_int=as.numeric(cat_vac)) %>%
mutate(cat_vote_int=as.numeric(cat_vote)) %>%
arrange(desc(cat_vac_int)) %>%
arrange(cat_vote_int) %>%
pivot_wider(
id_cols=c(cat_vac_int, cat_vac),
names_from=cat_vote,
values_from=n,
values_fill = 0
) %>%
rowwise() %>%
mutate(sum_n=sum(c_across(3:6), na.rm=T)) %>%
mutate(across(contains("("), .fns=\(x) x/sum_n))
#create table 3
tb_marginal <- df_marginal %>%
relocate(sum_n, .after="cat_vac") %>%
rowwise() %>%
mutate(sum_rel=sum(c_across(contains("(")))) %>%
ungroup() %>%
select(-cat_vac_int) %>%
gt() %>%
fmt_percent(columns=c(contains("("), sum_rel),
decimals=1) %>%
cols_label(
sum_rel="% Total per vaccin. category",
sum_n="Num Municip.",
cat_vac="Vacc. Ratio (%)",
) %>%
tab_spanner(
label="Change vote share (% points)",
columns=contains("(")
) %>%
cols_width(
sum_rel ~ px(75),
sum_n ~ px(50)
) %>%
gtExtras::gt_theme_538() %>%
tab_options(
heading.title.font.size=px(15),
heading.title.font.weight="bold",
table.margin.left = px(0)
) %>%
tab_header(
title=md("**Distribution within vaccination interval**"),
subtitle=md("The table shows how electoral results *within* a specific vaccination interval are distributed (row-wise).")
) %>%
data_color(
columns=3:(last_col()-1),
direction="row",
palette=c("white", "orange"),
method="numeric",
domain=c(0,1)
)
tb_marginal
#export table
gt::gtsave(data = tb_marginal, filename = "tb_marginal.png",
path=here::here("posts","2023-03-17-state-elections-and-covid","data"))
#re-import table
table_png <- png::readPNG(source=here::here("posts","2023-03-17-state-elections-and-covid","data", "tb_marginal.png"), native = TRUE) # read tmp png file
#combine plots
pl_1 <- ((plot_map+(plot_legend_2/plot_spacer()+plot_layout(ncol=1, nrow=2, heights=c(2,1)))+plot_layout(ncol=2, widths=c(2,2)))/((wrap_elements(table_png)+plot_spacer()+plot_layout(widths=c(3,1)))))+plot_layout(nrow=2, heights=c(4,2))+plot_annotation(
title="Covid vaccination ratio and electoral performance on the municipal level",
subtitle="For <span style='font-weight:bold;'>each party and state</span>, vaccination ratios and electoral results (% point changes) were each split into four <br>evenly spaced intervals resulting in a 4 x 4 matrix with 16 cells. Subsequently, each municipality (for each party)<br>was assigned to its corresponding cell.<br><br>Note that intervals of election results were calculated for each party separately and not across all parites. The coloring <br>along the x-axis hence indicates whether a party performed in a municipality relatively well, i.e. in relation to the party's <br>results in other municipalities, and not compared to other parties.",
caption=txt_caption,
theme=theme_ipsum_rc() +
theme(
plot.caption=element_markdown(
size=rel(.5),
hjust=0),
plot.subtitle=element_markdown(size=rel(.8)),
plot.title=element_markdown(size=rel(1.1)),
plot.margin=ggplot2::margin(0, unit="cm"))
)
pl_1# li_res <- list(pl_comb, tb_marginal)
# return(li_res)
}Now, let’s apply the function. As a result, I obtain two vectors for each state: One with the names of the state and the party; and one with the pertaining plots.
#apply function
li_plots <- map2(df_state_party %>% pluck("party"),
df_state_party %>% pluck("state"),
.f=\(x, y) fn_plot(party=x, state=y),
.progress=T)
df_plots <- li_plots %>% enframe(value="plot", name=NULL) %>%
dplyr::bind_cols(., df_state_party)
vec_party_noe <- df_plots %>% filter(state=="noe") %>% pull("party")
vec_party_ktn <- df_plots %>% filter(state=="ktn") %>% pull("party")
vec_party_sbg <- df_plots %>% filter(state=="sbg") %>% pull("party")
vec_plot_noe <- df_plots %>% filter(state=="noe") %>% pull("plot")
vec_plot_ktn <- df_plots %>% filter(state=="ktn") %>% pull("plot")
vec_plot_sbg <- df_plots %>% filter(state=="sbg") %>% pull("plot")For each state, these two vectors are now ‘printed’ into tab-sets. I also show the otherwise not visible code with the asis chunk option, which allows us to create multiple tabsets on the fly, rather than typing them out manually.2 In other words, the code example below produces ‘automatically’ a tab including a map for every party in e.g. Lower Austria.3.
2 Credit goes to Shafee with his related answer on stackoverflow.
3 To display such code chunks, including the opening and closing colons, wrap the code starting with ‘```` markdown’ and closing with another four backticks (````)
:::: {.column-body-outset-right}
::: {.panel-tabset}
```{.r}
#| results: asis
#| eval: true
#| out-width: 100%
#| fig-height: 7
walk2(.x=vec_party_noe, .y=vec_plot_noe, ~ {
cat('## ', .x, '\n\n')
print(.y)
cat('\n\n')
})
:::
:::: Below the maps for all three states and the parties.
Click e.g. the “FPÖ” tab to get the pertaining results. The map reveals some regional differences. There are quite some ‘blue-ish’ municipalities around Vienna. These are municipalities in which vaccination ratios are comparably high and where the FPÖ, compared to its results in other muncipalties, performed relatively weak (but still with impressive 1.3 % to 9 % vote share increase). On the other hand, in the west/south-west, yellow and some light green is the prevalent color. Here, vaccination ratios are rather low, but the FPÖ securred some its best results. The table on the bottom makes this ‘dynamic’ clearer: Of the 27 municipalities in the lowest vaccination interval, 70.4 % feature top election results for the FPÖ. In contrast, only 0.6 % of the 174 municipalities with high vaccination ratios exhibit such strong results. The top-left to bottom-right diagonal shaded in orange reflects the wider dynamic. To contrast, the pertaining diagonal for the ÖVP runs (somewhat) from bottom-left to top-right. Maybe with the exception of MFG, other parties don’t feature such distributions at all, or at least not in such clarity.
I think the maps/graphs speak largely for themselves, and reveal some interesting aspects.
Finally, as an alterantive, another visualisation version, this time using a combination of dot and box-whisker plots (something resembling a rainplot). Let’s divide municipalities into a category with ‘low’ and ‘other’ vaccination ratios and contrast the electoral performance of parties’ between these groups. The ‘low’ category covers the lowest quarter of the vaccination ratios, i.e. take the difference between the maximum and mimum vaccination ratios, and divide it into four evenly spaced intervals. The bottom quarter is taken as the ‘low’ categor. (To be clear, I am not using quartiles here).
df_res_municip_covid_cut <- df_res_municip_covid %>%
group_by(state) %>%
mutate(cat_vac_interval=cut(vaccination_1_share,
breaks=4, include.lowest=T)) %>%
ungroup() %>%
group_split(state) %>%
map(., .f=\(x) x %>% group_by(cat_vac_interval) %>% arrange(vaccination_1_share, .by_group=T) %>%
mutate(cat_vac=cur_group_id())) %>%
purrr::list_rbind() %>%
mutate(cat_vac_low=case_when(
cat_vac>1 ~ "other",
.default = "low"
))col_low <- "black"
col_other <- "grey"
# define function
fn_rain_plot <- function(df, title) {
{{df}} %>%
ggplot(.,
aes(x=cat_vac_low,
y=change_perc,
# fill=cat_vac_low,
color=cat_vac_low))+
labs(
title={{title}},
y="change vote share (% points)"
)+
geom_half_boxplot(
side="r",
nudge=0.2,
errorbar.draw = T,
fill="transparent",
outlier.color=NA)+
geom_half_point(
side="l",
aes(alpha=0.1)
)+
scale_y_continuous(
breaks=seq(-30,30,15),
position="left",
label=scales::label_percent(scale=1, accuracy=1))+
scale_x_discrete(position="top")+
scale_color_manual(values=c(low=col_low, other=col_other))+
scale_fill_manual(values=c(low=col_low, other=col_other))+
theme(
legend.position="none"
)+
#ggthemes::theme_fivethirtyeight()+
theme_ipsum_rc()+
theme(
# axis.title.y.left = element_text(size=rel(.7/9*11.5)),
axis.title.y.left = element_blank(),
axis.title.x.top = element_blank(),
panel.grid.major.x = element_blank(),
panel.grid.minor.y=element_blank(),
legend.position="none",
strip.placement = "outside",
# strip.text.y.left=element_text(face="bold", angle=0,
# hjust=1,
# vjust=1),
#plot.caption = element_markdown(),
#plot.subtitle = element_markdown(),
axis.text.x.top = element_text(size=rel(.7),
margin=ggplot2::margin(t=0, unit="cm")),
axis.text.y.left = element_text(size=rel(.7)),
plot.title=element_text(size=rel(0.9), margin=ggplot2::margin(b=.1, unit="cm")),
plot.title.position = "plot",
panel.spacing.x = unit(0.1, "cm"),
plot.margin=ggplot2::margin(t=0.2, b=0, unit="cm"),
strip.text.x.top=element_text(size=rel(0.7), hjust=.5,
margin=ggplot2::margin(b=0, unit="cm"))
)+
facet_wrap(vars(party),
nrow=1,
#ncol=9,
drop=F)+
coord_cartesian(ylim=c(-35,30))
}
#nest by state and apply function
df_plots <- df_res_municip_covid_cut %>%
filter(party %in% vec_parties_filter) %>%
mutate(party=fct_drop(party)) %>%
ungroup() %>%
tidyr::nest(., .by="state") %>%
mutate(state=case_when(
state=="noe" ~ "Lower Austria",
state=="ktn" ~ "Carinthia",
state=="sbg" ~ "Salzburg"
)) %>%
mutate(plots=map2(.x=data, .y=state, .f=\(x, y) fn_rain_plot(df=x, title=y)))
txt_subtitle="The plot contrasts parties' electoral performance with high and low vaccination ratios in municipalities. Each dot represents the <br>electoral performance (change of vote share in % points) of a party in a specific municipality. Municipalities are grouped according<br>to the COVID vaccination ratio (first shot) of their population: Municipalities within *the lowest 25 % of COVID vaccination ratios are<br>in the category 'low'*, all others are assigned to the group 'other'. Boxplot-halves were added as summary indicators. <br>Generally, the FPÖ performed stronger in municipalities with low vaccination ratios than in other municipalities."
df_plots %>%
pull(plots) %>%
wrap_plots(., ncol=1)+
plot_annotation(
title="2023 State Elections: Electoral performance and COVID vaccination ratios on municipal level",
subtitle = txt_subtitle,
caption=txt_caption,
theme=theme(
plot.title=element_text(family="Roboto Condensed", face="bold", size=rel(1.2)),
plot.caption = element_markdown(family="Roboto Condensed", size=rel(.6)),
plot.subtitle = element_markdown(family="Roboto Condensed Light",
size=rel(.9),
lineheight = 1.2)
)
)
So that’s it. As always, if you spot any error, have a question etc, don’t hesitate to contact me (best via dm on Twitter or Mastadon).
@online{schmidt2023,
author = {Schmidt, Roland},
title = {State {Elections} 2023: {Municipal} Electoral Performance and
{COVID} Vaccination Rates},
date = {2023-04-24},
url = {https://werk.statt.codes/posts/2023-03-17-state-elections-and-covid},
langid = {en}
}