In this vignette we demonstrate the basic workflow using the most recent Emnid survey.
This package calculates coalition probabilities in multi-party systems. To this end we provide some convenience functions, the most important of which are listed below:
scrape_wahlrecht: A wrapper function that download
the most current survey results from https://www.wahlrecht.de/
collapse_parties: Transforms information on
percentages received by individual parties in long format and stores
them inside a nested tibble (see tidyr::nest)
draw_from_posterior: Draws nsim samples
from the posterior distribution (i.e. nsim simulated
election results based on provided survey)
get_seats: Obtain seat distributions for each
simulation (see also ?sls)
have_majority: Given a list of coalitions of
interest, calculates if the respective coalition would have enough seats
for a majority
calculate_probs: Given majority tables obtained from
have_majority, calculates the probabilities for the
respective coalitions to have enough seats for a majority
# one line per survey (party information in wide format)
emnid <- scrape_wahlrecht() %>% slice(1:6)
emnid %>% select(-start, -end)## # A tibble: 6 × 10
## date cdu spd greens fdp left afd bsw others respondents
## <date> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 2013-09-29 43 26 7 3 9 6 NA 6 1382
## 2 2013-10-06 42 25 8 4 9 6 NA 6 1849
## 3 2013-10-13 42 25 9 3 10 6 NA 5 1833
## 4 2013-10-20 42 25 9 3 10 5 NA 6 2334
## 5 2013-10-27 41 26 10 3 9 5 NA 6 3219
## 6 2013-11-03 42 25 9 3 9 5 NA 7 2768After applying collapse_parties we still have one row
per survey, but information on parties and percentage of votes they
received is stored in a long format in a separate column (see
?tidyr::nest):
elong <- collapse_parties(emnid)
head(elong)## # A tibble: 6 × 5
## date start end respondents survey
## <date> <date> <date> <dbl> <list>
## 1 2013-11-03 2013-10-24 2013-10-30 2768 <tibble [7 × 3]>
## 2 2013-10-27 2013-10-17 2013-10-23 3219 <tibble [7 × 3]>
## 3 2013-10-20 2013-10-10 2013-10-16 2334 <tibble [7 × 3]>
## 4 2013-10-13 2013-10-04 2013-10-09 1833 <tibble [7 × 3]>
## 5 2013-10-06 2013-09-26 2013-10-01 1849 <tibble [7 × 3]>
## 6 2013-09-29 2013-09-24 2013-09-26 1382 <tibble [7 × 3]>## # A tibble: 7 × 3
## party percent votes
## <chr> <dbl> <dbl>
## 1 cdu 42 1163.
## 2 spd 25 692
## 3 greens 9 249.
## 4 fdp 3 83.0
## 5 left 9 249.
## 6 afd 5 138.
## 7 others 7 194.Based on each survey we can now simulate nsim elections
by drawing from the Dirichlet distribution
set.seed(1) # for reproducibility
elong <- elong %>%
mutate(draws = map(survey, draw_from_posterior, nsim=10, correction=0.005))
elong %>% select(date, survey, draws)## # A tibble: 6 × 3
## date survey draws
## <date> <list> <list>
## 1 2013-11-03 <tibble [7 × 3]> <tibble [10 × 7]>
## 2 2013-10-27 <tibble [7 × 3]> <tibble [10 × 7]>
## 3 2013-10-20 <tibble [7 × 3]> <tibble [10 × 7]>
## 4 2013-10-13 <tibble [7 × 3]> <tibble [10 × 7]>
## 5 2013-10-06 <tibble [7 × 3]> <tibble [10 × 7]>
## 6 2013-09-29 <tibble [7 × 3]> <tibble [10 × 7]>## # A tibble: 10 × 7
## cdu spd greens fdp left afd others
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 0.436 0.252 0.0854 0.0257 0.0935 0.0407 0.0671
## 2 0.409 0.264 0.0975 0.0288 0.0891 0.0441 0.0671
## 3 0.416 0.250 0.0909 0.0379 0.0830 0.0530 0.0687
## 4 0.426 0.249 0.0759 0.0328 0.0919 0.0592 0.0647
## 5 0.431 0.255 0.0767 0.0309 0.0924 0.0517 0.0621
## 6 0.429 0.253 0.0767 0.0267 0.0938 0.0556 0.0657
## 7 0.425 0.256 0.0909 0.0272 0.0765 0.0472 0.0774
## 8 0.411 0.258 0.0951 0.0367 0.0860 0.0499 0.0639
## 9 0.429 0.256 0.0794 0.0289 0.0942 0.0467 0.0658
## 10 0.417 0.253 0.0872 0.0328 0.0948 0.0462 0.0694Given the simulated elections, we can calculate the number of seats
each party obtained. To do so we need to have a function that knows how
to redistribute seats for the particular election. In Germany for
example, seats are distributed according to the system of
Sainte-Lague-Scheppers, which is implemented in
?sls.
This makes this package easily extensible to other multi-party
systems, as you only need to provide a function that redistributes seats
based on percentages obtained by the various parties and provide that
function to the distrib.fun argument of the
get_seats function:
elong <- elong %>%
mutate(seats = map2(draws, survey, get_seats, distrib.fun=sls))
elong %>% select(date, survey, draws, seats)## # A tibble: 6 × 4
## date survey draws seats
## <date> <list> <list> <list>
## 1 2013-11-03 <tibble [7 × 3]> <tibble [10 × 7]> <tibble [44 × 3]>
## 2 2013-10-27 <tibble [7 × 3]> <tibble [10 × 7]> <tibble [44 × 3]>
## 3 2013-10-20 <tibble [7 × 3]> <tibble [10 × 7]> <tibble [44 × 3]>
## 4 2013-10-13 <tibble [7 × 3]> <tibble [10 × 7]> <tibble [49 × 3]>
## 5 2013-10-06 <tibble [7 × 3]> <tibble [10 × 7]> <tibble [49 × 3]>
## 6 2013-09-29 <tibble [7 × 3]> <tibble [10 × 7]> <tibble [49 × 3]>
## sim column indicates simulated elections (rows in draws column)
elong %>% slice(1) %>% select(seats) %>% unnest("seats")## # A tibble: 44 × 3
## sim party seats
## <int> <chr> <int>
## 1 1 cdu 301
## 2 1 spd 59
## 3 1 greens 64
## 4 1 left 174
## 5 2 cdu 285
## 6 2 spd 68
## 7 2 greens 62
## 8 2 left 183
## 9 3 cdu 35
## 10 3 spd 278
## # ℹ 34 more rowsIn the above example, given the latest survey, CDU/CSU would have 301 seats in the first simulation, 285 seats in the second simulation, etc.
The next step is to define coalitions of interest, then calculate in what percentage of the simulations the coalition would obtain enough seats for a majority.
Below, each list element defines one coalition of interest (one party could potentially obtain absolute majority on their own):
coalitions <- list(
c("cdu"),
c("cdu", "fdp"),
c("cdu", "greens"),
c("cdu", "fdp", "greens"),
c("spd"),
c("spd", "left"),
c("spd", "greens"),
c("spd", "left", "greens"),
c("cdu", "spd"))
elong <- elong %>%
mutate(majorities = map(seats, have_majority, coalitions = coalitions))
elong %>% select(date, draws, seats, majorities)## # A tibble: 6 × 4
## date draws seats majorities
## <date> <list> <list> <list>
## 1 2013-11-03 <tibble [10 × 7]> <tibble [44 × 3]> <tibble [10 × 9]>
## 2 2013-10-27 <tibble [10 × 7]> <tibble [44 × 3]> <tibble [10 × 9]>
## 3 2013-10-20 <tibble [10 × 7]> <tibble [44 × 3]> <tibble [10 × 9]>
## 4 2013-10-13 <tibble [10 × 7]> <tibble [49 × 3]> <tibble [10 × 9]>
## 5 2013-10-06 <tibble [10 × 7]> <tibble [49 × 3]> <tibble [10 × 9]>
## 6 2013-09-29 <tibble [10 × 7]> <tibble [49 × 3]> <tibble [10 × 9]>
# The majorities table for each date will have 1 row per simulation
# and one column per coalition
elong %>% slice(1) %>% select(majorities) %>% unnest("majorities")## # A tibble: 10 × 9
## cdu cdu_fdp cdu_greens cdu_fdp_greens spd left_spd greens_spd
## <lgl> <lgl> <lgl> <lgl> <lgl> <lgl> <lgl>
## 1 TRUE TRUE TRUE TRUE FALSE FALSE FALSE
## 2 FALSE FALSE TRUE TRUE FALSE FALSE FALSE
## 3 FALSE FALSE FALSE FALSE FALSE TRUE TRUE
## 4 FALSE FALSE FALSE FALSE FALSE TRUE TRUE
## 5 FALSE FALSE FALSE FALSE FALSE TRUE TRUE
## 6 FALSE FALSE FALSE FALSE FALSE TRUE TRUE
## 7 FALSE FALSE TRUE TRUE FALSE FALSE FALSE
## 8 FALSE FALSE TRUE TRUE FALSE FALSE FALSE
## 9 FALSE FALSE TRUE TRUE FALSE FALSE FALSE
## 10 FALSE FALSE TRUE TRUE FALSE FALSE FALSE
## # ℹ 2 more variables: greens_left_spd <lgl>, cdu_spd <lgl>The last step is to calculate the coalition probabilities (note that
by default we exclude “superior” coalitions, i.e. if “cdu/csu” have a
majority on their own, this simulation will not be counted to the
simulation with majority for “cdu/csu” and “fdp”, see example in
?calculate_probs):
elong <- elong %>%
mutate(
probabilities = map(majorities, calculate_probs, coalitions=coalitions))
elong %>% select(date, majorities, probabilities)## # A tibble: 6 × 3
## date majorities probabilities
## <date> <list> <list>
## 1 2013-11-03 <tibble [10 × 9]> <tibble [9 × 2]>
## 2 2013-10-27 <tibble [10 × 9]> <tibble [9 × 2]>
## 3 2013-10-20 <tibble [10 × 9]> <tibble [9 × 2]>
## 4 2013-10-13 <tibble [10 × 9]> <tibble [9 × 2]>
## 5 2013-10-06 <tibble [10 × 9]> <tibble [9 × 2]>
## 6 2013-09-29 <tibble [10 × 9]> <tibble [9 × 2]>## # A tibble: 9 × 2
## coalition probability
## <chr> <dbl>
## 1 cdu 10
## 2 cdu_fdp 0
## 3 cdu_greens 50
## 4 cdu_fdp_greens 0
## 5 spd 0
## 6 left_spd 40
## 7 greens_spd 40
## 8 greens_left_spd 30
## 9 cdu_spd 90There is a wrapper function that directly returns probabilities:
elong <- collapse_parties(emnid)
elong %>% get_probabilities(., nsim=10) %>% unnest("probabilities")## # A tibble: 36 × 3
## date coalition probability
## <date> <chr> <dbl>
## 1 2013-11-03 cdu 40
## 2 2013-11-03 cdu_fdp 0
## 3 2013-11-03 cdu_fdp_greens 20
## 4 2013-11-03 spd 0
## 5 2013-11-03 left_spd 40
## 6 2013-11-03 greens_left_spd 20
## 7 2013-10-27 cdu 0
## 8 2013-10-27 cdu_fdp 0
## 9 2013-10-27 cdu_fdp_greens 30
## 10 2013-10-27 spd 0
## # ℹ 26 more rows