Skript zu diesem Blogpost

Zusatzpakete:

library(tidyverse)

Daten zu Sterbefallzahlen (Daten hier)

# Daten einlesen (extrahiert aus Excel-Tabelle https://www.destatis.de/DE/Themen/Gesellschaft-Umwelt/Bevoelkerung/Sterbefaelle-Lebenserwartung/Tabellen/sonderauswertung-sterbefaelle.html?nn=209016)
sterbefaelle <- read_csv("sterbefaelle_nach_bundesland.csv", col_types = c("n", "n", "c", "c", rep("n", 42)))

# Spaltennamen anpassen
colnames(sterbefaelle)[5:46] <- paste0("KW", colnames(sterbefaelle)[5:46])

# Gesamtzahl der Sterbefälle
sf <- filter(sterbefaelle, Alter == "Insgesamt")

# in langes Format überführen
sf <- pivot_longer(sf, cols = 5:length(sf))

# KW als numerisch
sf$name <- as.numeric(gsub("KW", "", sf$name))

# Spalte umbenennen
sf <- rename(sf, "KW" = "name")

# value-Spalte als numerisch
sf$value <- as.numeric(gsub(" ", "", sf$value))

# nur KW 36 bis 40
sf36bis40 <- filter(sf, KW %in% c(36:40))

Daten zur Impfquote - leider geben die Autoren nicht an, auf welchem Stand die Zahlen sind, mit denen sie gearbeitet haben - da ihre Studie auf den 16.11. datiert ist, arbeiten wir im Folgenden mit den Daten von diesem Tag (Daten hier):

# Daten einlesen
impf <- read_csv("2021-11-16_Deutschland_Impfquoten_COVID-19.csv")
## Rows: 18 Columns: 22
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr   (2): Bundesland, BundeslandId_Impfort
## dbl  (19): Impfungen_gesamt, Impfungen_gesamt_min1, Impfungen_gesamt_voll, I...
## date  (1): Datum
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

Zudem nehmen die Autoren eine Gewichtung nach Einwohnerzahl des jeweiligen Bundeslands vor, ohne genauer zu erläutern, wie diese Gewichtung genau erfolgt und nur mit dem generellen Hinweis, dass die Daten auch beim Statistischen Bundesamt verfügbar seien (ohne Link). Deshalb ignorieren wir sie hier, lesen die Daten aber trotzdem ein (um weiter unten die Quatsch-Korrelation zwischen Einwohnerzahl und Weltkulturerbestätten, WKE in der Tabelle, herstellen zu können). Einwohnerdaten aus https://www.destatis.de/DE/Themen/Gesellschaft-Umwelt/Bevoelkerung/Bevoelkerungsstand/Tabellen/bevoelkerung-nichtdeutsch-laender.html, Welterbedaten von https://www.welterbetour.de/.

einw <- read_csv("einwohnerzahl.csv")
## Rows: 16 Columns: 3
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (1): Land
## dbl (2): insgesamt, WKE
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

Data wrangling - Übersterblichkeit:

# Mittelwert der Sterblichkeitszahlen 2016-2020

sf20162020kws <- sf36bis40 %>% filter(Jahr %in% 2016:2020) %>% group_by(Bundesland, Jahr) %>% summarise(
  deaths = sum(value)
) %>% group_by(Bundesland) %>% summarise(
  mean = mean(deaths),
  sd = sd(deaths)
)
## `summarise()` has grouped output by 'Bundesland'. You can override using the `.groups` argument.
# Sterblichkeitszahlen 2021
sf2021kws <- sf36bis40 %>% filter(Jahr==2021) %>% group_by(Bundesland) %>%
  summarise(
    deaths2021 = sum(value)
  )


# Tabellen verbinden
uebersterblichkeit <- left_join(sf20162020kws, sf2021kws)
## Joining, by = "Bundesland"
# Übersterblichkeits-Koeffizient hinzufügen
uebersterblichkeit <- mutate(uebersterblichkeit, ues = (deaths2021 / mean)*100)

# Impfquote hinzufügen
uebersterblichkeit <- left_join(uebersterblichkeit, select(impf, !Datum))
## Joining, by = "Bundesland"
# Korrelationskoeffizient

# Pearson-Koeffizient
cor.test(uebersterblichkeit$ues, uebersterblichkeit$Impfquote_gesamt_voll)
## 
##  Pearson's product-moment correlation
## 
## data:  uebersterblichkeit$ues and uebersterblichkeit$Impfquote_gesamt_voll
## t = -0.097854, df = 14, p-value = 0.9234
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  -0.5151726  0.4757268
## sample estimates:
##         cor 
## -0.02614371
# Weltkulturerbedaten hinzufügen
uebersterblichkeit <- left_join(uebersterblichkeit, einw, by = c("Bundesland" = "Land"))

Quatsch-Korrelation: Weltkulturerbe & Impfquote

# Weltkulturerbe-Korrelation
cor.test(uebersterblichkeit$Impfquote_gesamt_voll, uebersterblichkeit$WKE)
## 
##  Pearson's product-moment correlation
## 
## data:  uebersterblichkeit$Impfquote_gesamt_voll and uebersterblichkeit$WKE
## t = -1.2543, df = 14, p-value = 0.2303
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  -0.7028205  0.2111167
## sample estimates:
##        cor 
## -0.3178524
# Tabelle: Übersterblichkeit X Impfquote
uebersterblichkeit %>% select(Bundesland, ues, Impfquote_gesamt_voll) %>% arrange(desc(Impfquote_gesamt_voll))
## # A tibble: 16 × 3
##    Bundesland               ues Impfquote_gesamt_voll
##    <chr>                  <dbl>                 <dbl>
##  1 Bremen                  105.                  79.3
##  2 Saarland                106.                  74.1
##  3 Hamburg                 110.                  73.1
##  4 Schleswig-Holstein      107.                  72.1
##  5 Nordrhein-Westfalen     110.                  71  
##  6 Niedersachsen           110.                  69.5
##  7 Berlin                  104.                  68.2
##  8 Rheinland-Pfalz         111.                  67.4
##  9 Hessen                  107.                  66.7
## 10 Mecklenburg-Vorpommern  116.                  65.9
## 11 Baden-Württemberg       109.                  65.7
## 12 Bayern                  111.                  65.6
## 13 Sachsen-Anhalt          108.                  64  
## 14 Thüringen               104.                  61.5
## 15 Brandenburg             113.                  61.3
## 16 Sachsen                 102.                  57.5

Fiktive Korrelationen Einkommen/Abiturnote:

cor.test(c(500,2000,5000,10000,25000,50000,100000),
         c(640,600,780,800,570,650,700))
## 
##  Pearson's product-moment correlation
## 
## data:  c(500, 2000, 5000, 10000, 25000, 50000, 1e+05) and c(640, 600, 780, 800, 570, 650, 700)
## t = -0.021093, df = 5, p-value = 0.984
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  -0.7571128  0.7489454
## sample estimates:
##          cor 
## -0.009432801
cor.test(c(500,2000,5000,10000,25000,50000,100000),
         c(500,570,600,650,720,780,800))
## 
##  Pearson's product-moment correlation
## 
## data:  c(500, 2000, 5000, 10000, 25000, 50000, 1e+05) and c(500, 570, 600, 650, 720, 780, 800)
## t = 3.653, df = 5, p-value = 0.0147
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  0.2791008 0.9778809
## sample estimates:
##       cor 
## 0.8528976