Bremen Wahlbefragung Mai 2023

Veröffentlichungsdatum

6. Mai 2023

Code

library(tidyverse)
library(knitr)

set.seed(123)

Buten und Binnen

Beitrag 4. Mai 2023 – Das sind die Bremer Gewinner und Verlierer der neuen Wahlumfrage

Moderator im Beitrag bei 0:50 beim Vergleich der Umfragen 4. Mai und 20. April

“Verglichen mit der Umfrage die Infratest dimap vor zwei Wochen im Auftrag von Radio Bremen und der Nordsee Zeitung durchgeführt hat, kommt es zu diesen Veränderungen:

die CDU verliert leicht einen Prozentpunkt // - 1%

die SPD ebenfalls leichter Verlust minus ein Punkt // - 1%

die Grünen mit deutlichen Verlusten minus vier Prozentpunkte // - 4%

die Linke gewinnt drei Prozentpunkte // + 3%

die FDP unverändert // 0%

und die Bürger in Wut nochmal mit deutlichen Gewinnen plus drei Prozentpunkte // + 3%

die sonstigen Parteien unverändert. Also einige haben Rückenwind im Endspurt des Wahlkampfes und anderen bläst der Wind mittlerweile ganz schön ins Gesicht Felix”

Umfragen-Genauigkeit

Parteien Ergebnisse

Berechnung der Genauigkeit für eine Umfrage mit 1000 Befragten

Code

sample_size <- 1000

# create data with poll results for Bremen
bremen <-
  tribble(
    ~party, ~share, ~change,
    "CDU",      27, -1,
    "SPD",      30, -1,
    "Gruene",   13, -4,
    "Linke",    10,  3,
    "FDP",       6,  0,
    "BiW",       9,  3,
)

# create function to calculate standard error Central Limit Theorem
calculate_se <- \(share) sqrt( (share*(1-share)) / sample_size)

# calculate the critical value for an 80% confidence interval
cv <- qt(0.9, df = sample_size - 1)

# add standard error, confidence interval (CI), lower and upper bounds of 80% CI
bremen <-
  bremen |>
  mutate(
    party = fct_inorder(party),
    se_share = (100 * calculate_se(share/100)),
    ci_80 = se_share * cv,
    ci_lower_80 = share + ci_80,
    ci_upper_80 = share - ci_80,
    share_20_4 = share - change,
  )

Code

party_colors <- c("black", "red", "darkgreen", "purple", "yellow", "blue")

pl <-
  ggplot(bremen, aes(x = party, y = share)) +
    geom_bar(stat = "identity", fill = party_colors) +
    geom_errorbar(aes(ymin = ci_lower_80, ymax = ci_upper_80), color = "darkgrey", width = 0.2) +
    geom_point(aes(y = share_20_4), color = "darkorange", shape = 8, size = 3, show.legend = FALSE) +
    labs(caption = "Konfidenz-Invervalle 80%",
         x = "Parteien",
         y = "Stimmenanteile") +
    theme_minimal()

ggsave("wahlbefragung.png", pl, width = 8, height = 6)
pl

Abbildung 2: Umfrage-Ergebnisse mit Konfidenz-Invervallen (80%)

Hinweise Abbildung 2

Umfrage-Ergebnisse 4. Mai // Balken-Diagramm
Umfrage-Ergebnisse 20. April // Punkte (orange)
Konfidenz-Intervalle (grau)

Code

bremen |>
  select(-se_share) |>
  kable(digits = 1)

party	share	change	ci_80	ci_lower_80	ci_upper_80	share_20_4
CDU	27	-1	1.8	28.8	25.2	28
SPD	30	-1	1.9	31.9	28.1	31
Gruene	13	-4	1.4	14.4	11.6	17
Linke	10	3	1.2	11.2	8.8	7
FDP	6	0	1.0	7.0	5.0	6
BiW	9	3	1.2	10.2	7.8	6

OpenIntro · Lehrbuch

Überblick zur Berechnung der Genauigkeit von Schätzungen durch Stichproben

openintro.org/book/os/ — OpenIntro Statistics 2019

Kapitel 5.1, Seite 170 ff. — Punktschätzer und Stichproben-Variabilität

Code

## Source OpenIntro Stats (2019, p. 171) -- some modifications

# set parameters
pop_size <- 500000
pop_share <- 0.2
sample_size <- 1000

# 1. Create a set of entries, where a share of them are "support"
# and 12% are "not".
possible_entries <- c(rep("support", pop_share * pop_size), rep("not", (1-pop_share) * pop_size))

# 2. Sample 1000 entries without replacement.
sampled_entries <- sample(possible_entries, size = sample_size)

# 3. Compute p-hat: count the number that are "support", then divide by # the sample size.
sum(sampled_entries == "support") / sample_size

Simulation Grüne (13%)

Code

n_simulations <- 10000

df_simulations <- tibble(share = map_dbl(1:n_simulations, \(.x) get_sample(share_greens)))

Eine Simulation der Umfrage-Ergebnisse für die Grünen

Code

df_simulations |>
  mutate(share = 100 * share) |>
  ggplot(aes(share)) +
  geom_vline(aes(xintercept = 11.6), color = "darkgrey", linetype = "longdash", size = 0.5) +
  geom_vline(aes(xintercept = 14.4), color = "darkgrey", linetype = "longdash", size = 0.5) +
  geom_histogram(bins = 20, fill = "darkgreen", color = "white") +
  geom_vline(aes(xintercept = 13), color = "black", linetype = "longdash", size = 0.75) +
  geom_vline(aes(xintercept = 17), color = "darkorange", linetype = "longdash", size = 0.75) +
  labs(x = "Stimmen-Anteil", y = "Anzahl")

Abbildung 3: Simulation Umfrage-Ergebnis Grüne (10000 Simulationen).

500000 Bremer Wahlberechtigte // wahlen-in-deutschland.de
1000 Befragte
10000 Simulationen Befragungen

Code

df_simulations |>
  mutate(vote_share = round(100 * share)) |>
  count(vote_share) |>
  mutate(n_share = 100 * n/sum(n)) |>
  kable(digits = 0)

vote_share	n	n_share
9	3	0
10	88	1
11	623	6
12	2654	27
13	3322	33
14	2579	26
15	618	6
16	110	1
17	3	0

Konfidenz-Intervall 80%

4 von 5 Umfragen liegen in einem Konfidenz-Interval von 80% – so die Wahrscheinlichkeit.

Die Wahl des 80% Konfidenz-Intervals ist angelehnt an das Blog zweitstimme.org der Universität Mannheim.

Die Bänder für jede Partei geben an in welchem Bereich wir den tatsächlichen Wert mit 83% Wahrscheinlichkeit vermuten. Das heißt, dass das tatsächliche Wahlergebnis nicht in diesem Bereich liegt, ist so wahrscheinlich wie eine 6 zu würfeln - nicht sehr wahrscheinlich, aber doch möglich.