Election 2021 (DEU) · 🇩🇪

Author

Holger Doering

Published

October 27, 2024

Code 
library(conflicted) # create errors for function name conflicts

library(tidyverse)
conflicts_prefer(dplyr::filter, .quiet = TRUE)
library(knitr) # layout // tables in RMarkdown with kable()

ggplot2::theme_set(theme_void())
options(scipen = 999) # suppress scientific notation

library(estimatr) # robust standard errors
library(patchwork) # arrrange plots
library(sf) # plot maps and gespatial tools

crs_deu <- "+proj=lcc +lat_1=48 +lat_2=53 +lat_0=51 +lon_0=10" # LCC Germany parameters

Source — The Federal Returning Officer (“Der Bundeswahlleiter”): Bundestag election 2021

Code 
btw_raw <- read_csv("data/btw21-results-party.csv")

party_level <- c("AfD", "CDU", "CSU", "FDP", "SPD", "GRÜNE", "DIE LINKE")

btw_dt <-
  btw_raw |>
  mutate(party = fct_relevel(party, party_level))

btw_tier1 <- btw_dt |> filter(level == "district", votes_type == "Erststimmen")
btw_tier2 <- btw_dt |> filter(level == "district", votes_type == "Zweitstimmen")

mp_raw <- read_csv("data/btw21-gewaehlte-wahlkreis.csv")

mp <-
  mp_raw |>
  mutate(party = fct_relevel(party, party_level))

wk_shp <-
  read_rds("data/btw21-districts-geometry.rds") |>
  left_join(mp |> distinct(wkr_nr, region))
wk_ctr <- read_rds("data/btw21-districts-centroid.rds")

Votes · 🗳

Results

party vote share federal level

  • candidate tier (first tier) — (“Erststimmen”)
  • party tier (second tier) — (“Zweitstimmen”)
Code 
btw_dt |>
  filter(level == "federal") |>
  mutate(party = if_else(party %in% c("CDU", "CSU"), "CDU/CSU", party)) |>
  group_by(votes_type, party) |>
  summarise(share = sum(share) |> round(1)) |>
  pivot_wider(names_from = votes_type, values_from = share)
party Erststimmen Zweitstimmen
AfD 10.2 10.4
CDU/CSU 28.6 24.1
DIE LINKE 5.0 4.9
FDP 8.7 11.4
GRÜNE 13.9 14.7
SPD 26.4 25.7

Party votes

Code 
pl_dt <-
  wk_shp |>
  select(wkr_nr, geometry) |>
  right_join(btw_tier2) |>
  mutate(party = if_else(party %in% c("CDU", "CSU"), "CDU/CSU", party)) |>
  group_by(party) |>
  mutate(share_diff = share - mean(share))

party tier (“Zweitstimmen”) vote share electoral districts

Code 
pl1 <-
  ggplot() +
  geom_sf(data = pl_dt, aes(fill = share), lwd = 0.05) +
  scale_fill_viridis_c(option = "magma", direction = -1) +
  coord_sf(crs = crs_deu) +
  facet_wrap(vars(party))

pl1 + plot_annotation(caption = "Source: Bundeswahlleiter 2021")

difference (+/-) of vote share party district from national average vote share party

Code 
pl2 <-
  ggplot() +
  geom_sf(data = pl_dt, aes(fill = share_diff), lwd = 0.05) +
  scale_fill_gradient2(name = "+/-") +
  coord_sf(crs = crs_deu) +
  facet_wrap(vars(party))

pl2 + plot_annotation(caption = "Source: Bundeswahlleiter 2021")

Code 
pl_out <- pl1 / pl2 + plot_annotation(caption = "Source: Bundeswahlleiter 2021")

ggsave("z-btw21-vote-share.png", pl_out, width = 5, height = 7)

Candidate votes

candidate tier (“Erststimmen”) vote share by party

  • A — plurality vote winning party
  • B — sum of candidate vote share difference by ideology
    • right — AfD, CDU, CSU, FDP
    • left — DIE LINKE, GRÜNE, SPD
  • I – vote share plurality winner
  • II – vote share difference top 2 results
Code 
party_scale <- c("#A6CEE3", "#1F78B4", "#1b699e", "#E31A1C", "#33A02C", "#FB9A99")

ideo_share <-
  btw_tier1 |>
  group_by(wkr_nr, ideology) |>
  summarise(share = sum(share)) |>
  pivot_wider(names_from = ideology, values_from = share) |>
  mutate(rl_diff = right - left)

pl_dt <-
  wk_shp |>
  select(wkr_nr, geometry) |>
  inner_join(ideo_share) |>
  inner_join(mp |> select(wkr_nr, party))

pl_dt_ctr <- wk_ctr |> left_join(mp)

pl1 <-
  ggplot() +
  geom_sf(data = pl_dt, aes(fill = party), lwd = 0.05, alpha = 0.8) +
  geom_sf(data = pl_dt_ctr, aes(shape = party), alpha = 0.4) +
  coord_sf(crs = crs_deu) +
  scale_fill_manual(values = party_scale)
# print(pl1)

pl2 <-
  ggplot() +
  geom_sf(data = pl_dt, aes(fill = rl_diff), lwd = 0.05) +
  coord_sf(crs = crs_deu) +
  scale_fill_gradient2(name = "right +/-")
# print(pl2)

pl1 + pl2 + plot_annotation(tag_levels = "A") +
  plot_annotation(caption = "Source: Bundeswahlleiter 2021")

Code 
diff_1_2 <-
  btw_tier1 |>
  arrange(wkr_nr, desc(share)) |>
  group_by(wkr_nr) |>
  filter(row_number() %in% c(1, 2)) |>
  summarise(
    top_2_diff = max(share) - min(share),
    share = max(share)
  )

pl_dt <-
  wk_shp |>
  select(wkr_nr, geometry) |>
  inner_join(diff_1_2)

pl1 <-
  ggplot() +
  geom_sf(data = pl_dt, aes(fill = share), lwd = 0.05) +
  coord_sf(crs = crs_deu) +
  scale_fill_viridis_c(option = "cividis", direction = -1)
# print(pl1)

pl2 <-
  ggplot() +
  geom_sf(data = pl_dt, aes(fill = top_2_diff), lwd = 0.05) +
  coord_sf(crs = crs_deu) +
  scale_fill_viridis_c(option = "magma", direction = -1)
# print(pl2)

pl1 + pl2 + plot_annotation(tag_levels = "I") +
  plot_annotation(caption = "Source: Bundeswahlleiter 2021")

MPs (SMD) · 🗺

Maps

plurality winner candidate (first) tier vote by party and sex

Germany

Code 
pl_dt_shp <- wk_shp |> left_join(mp)
pl_dt_ctr <- wk_ctr |> left_join(mp)

pl1 <-
  ggplot() +
  geom_sf(data = pl_dt_shp, aes(fill = party), lwd = 0.1) +
  # scale_fill_brewer(type = "qual", palette = 4) +
  scale_fill_manual(values = party_scale) +
  geom_sf(data = pl_dt_ctr, aes(shape = sex), colour = "grey15", alpha = 0.7) +
  coord_sf(crs = crs_deu)

pl2 <-
  ggplot() +
  geom_sf(data = pl_dt_shp, colour = "lightgrey", fill = "grey95", lwd = 0.1) +
  geom_sf(data = pl_dt_ctr, aes(shape = sex, colour = party)) +
  scale_colour_manual(values = party_scale) +
  guides(colour = "none", fill = "none", shape = "none") +
  coord_sf(crs = crs_deu)

pl1 + pl2 + plot_annotation(caption = "Source: Bundeswahlleiter 2021")

NRW and Berlin

Code 
plot_state <- function(state_select, party_scale_select) {
  pl_dt_shp_re <- pl_dt_shp |> filter(state == state_select)
  pl_dt_ctr_re <- pl_dt_ctr |> filter(state == state_select)

  ggplot() +
    geom_sf(data = pl_dt_shp_re, aes(fill = party), lwd = 0.2) +
    scale_fill_manual(values = party_scale_select) +
    geom_sf(data = pl_dt_ctr_re, aes(shape = sex), colour = "grey30", size = 2) +
    guides(colour = "none", fill = "none", shape = "none")
}

pl1 <- plot_state("NW", party_scale[c(2, 4, 5)])
pl2 <- plot_state("BE", party_scale[c(2, 4, 5, 6)])
# plot_state("HH", party_scale[c(2, 5, 6)])
pl1 + pl2 + plot_layout(widths = c(55, 45)) +
  plot_annotation(caption = "Source: Bundeswahlleiter 2021")

Descriptives

number (n) of districts won by party and sex (f – female, m – male)

Party

Code 
count_party <-
  mp |>
  count(party, sex) |>
  pivot_wider(names_from = sex, values_from = n) |>
  mutate(share_f = round(100 * f / (m + f)))

count_party |> arrange(share_f)
party f m share_f
AfD 2 14 12
CDU 17 81 17
CSU 10 35 22
SPD 39 82 32
DIE LINKE 1 2 33
GRÜNE 9 7 56
Code 
mp |>
  count(party) |>
  mutate(share = round(100 * n / sum(n))) |>
  arrange(desc(share))
party n share
SPD 121 40
CDU 98 33
CSU 45 15
AfD 16 5
GRÜNE 16 5
DIE LINKE 3 1

States

Code 
count_state <-
  mp |>
  left_join(wk_shp |> select(wkr_nr, state_name = land_name)) |>
  count(state_name, sex) |>
  pivot_wider(names_from = sex, values_from = n) |>
  mutate(share_f = round(100 * f / (m + f)))

count_state |> arrange(share_f)
state_name f m share_f
Nordrhein-Westfalen 11 53 17
Sachsen 3 13 19
Sachsen-Anhalt 2 7 22
Hessen 5 17 23
Bayern 11 35 24
Saarland 1 3 25
Rheinland-Pfalz 4 11 27
Schleswig-Holstein 3 8 27
Baden-Württemberg 11 27 29
Berlin 4 8 33
Niedersachsen 10 20 33
Bremen 1 1 50
Hamburg 3 3 50
Mecklenburg-Vorpommern 3 3 50
Brandenburg 6 4 60
Thüringen NA 8 NA

Models · 📈

  • area_km2 — size of district as square length (root of area)
  • coord_y — north/south position (latitude)
  • left_share — share of left parties (SPD, Linke, Grüne)
  • region – western or eastern (former GDR) state
Code 
library(broom)
library(ggeffects)

mo_dt <-
  pl_dt_shp |>
  left_join(ideo_share) |>
  mutate(
    female = if_else(sex == "f", 1, 0),
    left_share = left
  )

Female first-tier winners

Logit model to predict female winners of candidate (first) tier vote

Code 
mo_glm <- glm(female ~ area_km2 + coord_y + left_share, data = mo_dt, family = "binomial")

tidy(mo_glm) |> mutate(across(where(is.numeric), round, 2))
term estimate std.error statistic p.value
(Intercept) -3.98 4.62 -0.86 0.39
area_km2 0.02 0.01 1.96 0.05
coord_y 0.01 0.11 0.12 0.90
left_share 0.03 0.02 1.62 0.11
Code 
pl1 <-
  ggpredict(mo_glm, terms = "area_km2 [all]") |>
  plot(add.data = TRUE, show.title = FALSE)

pl2 <-
  ggpredict(mo_glm, terms = "coord_y [all]") |>
  plot(add.data = TRUE, show.title = FALSE, show.y.title = FALSE)

pl1 + pl2

Left vote-share

Linear model of left parties (SPD, Linke, Grüne) vote share

Code 
mo_lm <- lm_robust(left_share ~ area_km2 * region + coord_y * region, data = mo_dt)

tidy(mo_lm) |>
  mutate(across(where(is.numeric), round, 2)) |>
  select(-conf.low, -conf.high, -df, -outcome)
term estimate std.error statistic p.value
(Intercept) -286.70 59.84 -4.79 0.00
area_km2 -0.27 0.07 -3.77 0.00
regionwest 181.81 60.87 2.99 0.00
coord_y 6.54 1.19 5.50 0.00
area_km2:regionwest -0.13 0.08 -1.73 0.08
regionwest:coord_y -3.34 1.21 -2.76 0.01
Code 
pl1 <-
  ggpredict(mo_lm, c("area_km2", "region")) |>
  plot(add.data = TRUE, show.title = FALSE, show.legend = FALSE)

pl2 <-
  ggpredict(mo_lm, terms = c("coord_y", "region")) |>
  plot(add.data = TRUE, show.title = FALSE, show.y.title = )

pl1 + pl2

Party vote-share

Linear model of party vote share

Code 
mo_dt2 <-
  btw_tier2 |>
  mutate(party = if_else(party %in% c("CDU", "CSU"), "CDU/CSU", party)) |>
  # mutate(party = fct_relevel(party, "CDU")) |>
  left_join(wk_shp)

mo_lm2 <- lm_robust(share ~ party * area_km2 * region, data = mo_dt2)

# tidy(mo_lm2) |> mutate(across(where(is.numeric), round, 2))

ggpredict(mo_lm2, terms = c("area_km2", "region", "party")) |>
  plot(add.data = TRUE, show.title = FALSE)