Blogbeitrag Sophie Schaefer

Packages laden und Datensatz einlesen

library(tidyverse)
library(foreign)
library(data.table)
library(bit64)
library(reshape2)
library(ggridges)
library(ggalt)
library(scales)
library(sf)
library(ggrepel) 
library(RColorBrewer)
library(viridis)

file <- "CoronaMonitorAll.csv"

corona<- as.data.frame(fread(file,
                  sep = ",",
                  encoding = "UTF-8",
                  stringsAsFactors = FALSE))

corona_df <- as.data.frame(corona, stringsAsFactors = FALSE)

1. Angst in verschiedenen Kantonen messen

1.2 Plot generieren

1.2.1 5.Welle auswählen

corona_w5 <- corona_df %>% filter(Welle == 5)

# Kantone AI & AR zusammennehmen
corona_w5$kanton[corona_w5$kanton %in% c("Appenzell Innerrhoden", "Appenzell Ausserrhoden")] <- "Appenzell"

corona_w5 <- corona_w5 %>%
  mutate(cangst = case_when(furchtPersMax_SQ003 == "COVID-19-Erkrankung (Coronavirus): Not selected" ~ 0,
                            furchtPersMax_SQ003 == "COVID-19-Erkrankung (Coronavirus): Selected" ~ 1)) %>%
  group_by(kanton, cangst) %>%
  mutate(cangst = weighted.mean(cangst, na.rm=T, weight = weight)) %>%
  summarise(Prozent=n()) %>% 
  na.omit() %>%
  group_by(kanton) %>% 
  mutate(Prozent=Prozent/sum(Prozent)*100) %>%
  filter(cangst == 1) %>%
  subset(kanton != "- Auslandschweizer/in -") %>% 
  select(kanton, Prozent) %>%
  distinct()

# Für den Merge wird aus Appenzell wieder zwei Kantone gemacht
corona_w5 <- cbind.data.frame(kanton = c("Appenzell Innerrhoden", "Appenzell Ausserrhoden"),
                            Prozent = rep(corona_w5$Prozent[corona_w5$kanton == "Appenzell"],2)) %>%
  rbind.data.frame(corona_w5)

# Nummerierung der Kantone
ktnr <-read.csv("kantonnr.csv",
                       sep=";",
                       encoding="UTF-8",
                       stringsAsFactors = F)

corona_w5 <- corona_w5 %>% 
  left_join(
    ktnr,
    by = c("kanton" = "Kanton")
    )
# shapefile laden
cantons_geo <- read_sf("ag-b-00.03-875-gg20 (1)/ggg_2020-LV95/shp/g2k20.shp")

# Daten vorbereiten
unique(corona$furchtPersMax_SQ003)

## [1] "COVID-19-Erkrankung (Coronavirus): Not selected"
## [2] "COVID-19-Erkrankung (Coronavirus): Selected"    
## [3] NA

corona_w5 <- left_join(cantons_geo, corona_w5,
                       by = c("KTNR" = "X.U.FEFF.ktnr"))

# Schweiz ohne  AR; AI
plot_angst_corona <- ggplot(corona_w5) +
  geom_sf(
    data = filter(corona_w5, !(corona_w5$KTNR %in% c(15,16))),
    aes(fill = Prozent),
    color = "white",
    size = 0.1
    ) +
  # AR; AI hinzufügen, dabei Linienfarbe gemäss Wert Percentage
  geom_sf(
    data = filter(corona_w5, corona_w5$KTNR %in% c(15,16)),
    aes(fill=Prozent, color=Prozent),
    color = "white",
    size = 0.1)

plot_angst <- plot_angst_corona + 
  scale_fill_gradientn(colours = c("#c5e0fa","#07213b"),
  limits = c(35, 55), 
  oob = squish) +
  theme_void() +
  theme(
    panel.grid.major = element_line("transparent")
  ) +
  labs(title = "Ostschweizer Kantone fürchten sich tendenziell am wenigsten",
       subtitle = "Angst vor einer COVID-19 Erkrankung in Prozent",
       caption = "Daten: Forschungsstelle sotomo (Corona-Monitor, 5. Welle, November 2020).")
plot_angst

ggsave(plot_angst, file = "angst_corona.jpg", width = 8, height = 4)

2.Vertrauen in die Kantonsregierung

2.1 5.Welle auswählen

corona_w5 <- corona_df %>% filter(Welle == 5)

2.2 Gewichtete Mittelwerte generieren

# Kantone AI & AR zusammennehmen
corona_w5$kanton[corona_w5$kanton %in% c("Appenzell Innerrhoden", "Appenzell Ausserrhoden")] <- "Appenzell"

corona_w5 <- corona_w5 %>% mutate(vertrauenKRNum = as.numeric(stringr::str_extract(vertrauenKR, "[0-9]+")))
corona_w5 <- corona_w5 %>%
  group_by(kanton) %>%
  mutate(vertrauenKR_w = weighted.mean(vertrauenKRNum, na.rm=T, weight = weight)) %>% 
  subset(kanton != "- Auslandschweizer/in -") %>% 
  select(kanton, vertrauenKR_w) %>%
  distinct() # Nur eindeutige Zeilen auswählen

corona_w5 <- cbind.data.frame(kanton = c("Appenzell Innerrhoden", "Appenzell Ausserrhoden"),
                            vertrauenKR_w = rep(corona_w5$vertrauenKR_w[corona_w5$kanton == "Appenzell"],2)) %>%
  rbind.data.frame(corona_w5)

2.3 Daten zu den Kantonen strukturieren

# Nummerierung der Kantone
ktnr <-read.csv("kantonnr.csv",
                       sep=";",
                       encoding="UTF-8",
                       stringsAsFactors = F)

corona_w5 <- corona_w5 %>% 
  left_join(
    ktnr,
    by = c("kanton" = "Kanton")
    )

# shapefile laden
kantone_geo <- read_sf("ag-b-00.03-875-gg20 (1)/ggg_2020-LV95/shp/g2k20.shp")


# Shapefile und Datensatz mergen
corona_geo <- left_join(kantone_geo, corona_w5,
                       by = c("KTNR" = "X.U.FEFF.ktnr"))

2.4 Plot generieren

plot_vertrauenKR <- ggplot() + 
  # Schweiz ohne  AR; AI
  geom_sf(
    data = filter(corona_geo, !(corona_geo$KTNR %in% c(15,16))),
    aes(fill = vertrauenKR_w),
    color = "white",
    size = 0.1
    ) +
  # AR; AI hinzufügen, dabei Linienfarbe gemäss Wert vertrauenKR_w
  geom_sf(
    data = filter(corona_geo, corona_geo$KTNR %in% c(15,16)),
    aes(fill=vertrauenKR_w, color=vertrauenKR_w),
    color = "white",
    size = 0.1
  ) +
  scale_fill_gradientn(colours = c("#c5e0fa","#07213b"),
                       na.value = "grey50",
                       limits = c(min(corona_geo$vertrauenKR_w), max(corona_geo$vertrauenKR_w)),
                       oob = squish, # Daten ausserhalb limits in die Grenzen drücken
                       # Legende neu beschriften
                       breaks = c(2.25, 2.5, 2.75, 3.0),
                       labels = c("2.25: eher geringes Vertrauen","2.5", "2.75", "3.0: eher grosses Vertrauen")) + 
  scale_color_gradientn(colours = c("#c5e0fa", "#07213b"),
                        na.value = "grey50",
                        limits = c(min(corona_geo$vertrauenKR_w), max(corona_geo$vertrauenKR_w)),
                       guide = FALSE) +
  theme_void() +
  theme(
    panel.grid.major = element_line("transparent")
  ) +
  labs(title = "Vertrauen in die Kantonsregierung in der Zentral- und Ostschweiz verhältnismässig gering",
       subtitle = "Grösse des Vertrauens in die Kantonsregierung in Bezug auf die Bewältigung der Corona-Krise.",
       caption = "Daten: Forschungsstelle sotomo (Corona-Monitor, 5. Welle, November 2020).",
       fill = "Stärke des Vertrauens");plot_vertrauenKR

ggsave(plot_vertrauenKR, file = "Karte_VertrauenKR.jpg", width = 8, height = 4)

3. Anzahl Kontakte im Alltag I

3.1 5.Welle auswählen

corona_w5 <- corona_df %>% filter(Welle == 5)

3.2 Mittelwerte berechnen

corona_w5$alltagcontact <- factor(corona_w5$alltagcontact, levels = c("0", "1", "2", "3", "4", "5", "6",
                                                          "7", "8", "9", "10", "11-20", "21-30",
                                                          "31-40", "41-50", "51-100", "101+"))

corona_w5$var.num <- ifelse(grepl("[-]", corona_w5$alltagcontact), as.numeric(gsub("-.*", "",corona_w5$alltagcontact)) + (as.numeric(gsub(".*-", "",corona_w5$alltagcontact)) - as.numeric(gsub("-.*", "",corona_w5$alltagcontact)))/2, 
                    ifelse(grepl("[+]", corona_w5$alltagcontact), 110, 
                             as.numeric(corona_w5$alltagcontact)))

## Warning in ifelse(grepl("[-]", corona_w5$alltagcontact),
## as.numeric(gsub("-.*", : NAs durch Umwandlung erzeugt

## Warning in ifelse(grepl("[-]", corona_w5$alltagcontact),
## as.numeric(gsub("-.*", : NAs durch Umwandlung erzeugt

## Warning in ifelse(grepl("[-]", corona_w5$alltagcontact),
## as.numeric(gsub("-.*", : NAs durch Umwandlung erzeugt

3.3 Gewichtete Mittelwerte pro Kanton

corona_w5$kanton[corona_w5$kanton %in% c("Appenzell Innerrhoden", "Appenzell Ausserrhoden")] <- "Appenzell"

kanton <- corona_w5 %>%
  group_by(kanton) %>%
  mutate(contact_num = weighted.mean(var.num, na.rm=T, weight = weight)) %>% 
  subset(kanton != "- Auslandschweizer/in -") %>%
  select(kanton, contact_num) %>%
  distinct()

corona_w5 <- cbind.data.frame(kanton = c("Appenzell Innerrhoden", "Appenzell Ausserrhoden"),
                            contact_num = rep(kanton$contact_num[kanton$kanton == "Appenzell"],2)) %>%
  rbind.data.frame(kanton)

3.4 Plot generieren

plot_angst_kanton <- ggplot(kanton) +
  aes(y = fct_reorder(kanton, contact_num), x =
  contact_num) +
  geom_bar(stat='identity', color="white", fill="#1b538c", alpha=1) +
  geom_text(aes(label = round(contact_num, digits = 1)), 
            color = "white", size = 4, vjust = 0.5, hjust = 1) +
  labs(title = bquote( ~ bold("Schweizweit hohe durchschnittliche Anzahl Kontakte")),
    subtitle = "Durchschnittliche Anzahl Personen ausser Haus, mit denen man in den letzten 7 Tagen näheren Kontakt hatte 
(länger als 15 Minuten, näher als 1,5 Meter).", 
  caption = "Daten: Forschungsstelle sotomo (Corona-Monitor, 5. Welle, November 2020).", y = "", x = "Anzahl Kontakte") +
  theme_minimal();plot_angst_kanton

ggsave(plot_angst_kanton, file = "Anzahl_Kontakte_barplot.jpg", width = 9, height = 5)

4. Anzahl Kontakte im Alltag II

4.1 5.Welle auswählen

corona_w5 <- corona_df %>% filter(Welle == 5)

4.2 Variable Kontakt umcodieren

corona_w5 <- corona_w5 %>% 
  mutate(contact = case_when(
    alltagcontact %in% "0" ~ "0",
    alltagcontact %in% c("1", "2") ~ "1-2",
    alltagcontact %in% c("3", "4", "5") ~ "3-5",
    alltagcontact %in% c("6", "7", "8", "9", "10")  ~ "6-10",
    alltagcontact %in% c("11-20") ~ "11-20",
    alltagcontact %in% c("21-30", "31-40", "41-50", "51-100", "100+") ~ "21+"))

4.3 Kantone neu ordnen

# Kantone werden nach höchster durchschnittlicher Anzahl Kontakte im Alltag geordnet (ausgehend von Plot 3.)
corona_w5$kanton <- factor(corona_w5$kanton, levels = (c("Appenzell Innerrhoden","Neuenburg","Glarus","Luzern",
                                                             "St. Gallen","Wallis","Zug", "Basel-Landschaft", "Genf", "Solothurn", "Schwyz", "Basel-Stadt", "Bern","Aargau", "Nidwalden", "Freiburg", "Waadt", "Thurgau", "Uri", "Zürich", "Tessin", "Graubünden", "Schaffhausen", "Jura", "Obwalden", "Appenzell Ausserrhoden")))

4.4 Small Multiples generieren

corona_kontakt <- corona_w5 %>% 
  # relevante Variablen selektieren
  select(id, kanton, sprachreg, contact, weight) %>%
  na.exclude %>%
    group_by(kanton, contact) %>%
  summarise(Nweighted = sum(weight),.groups = 'drop') %>% 
  group_by(kanton) %>%
  mutate(Percentage=Nweighted/sum(Nweighted)*100) %>%
  subset(kanton != "- Auslandschweizer/in -") %>%
    ungroup() %>%
  # Kontakte recodieren
  mutate(contact = na_if(contact, y = ""),
         contact = factor(contact, levels = rev(c("0", "1-2", "3-5", "6-10", "11-20", "21+")))) %>%
  # Grossregionen festlegen
  mutate(region = case_when(
    kanton %in% c("Aargau", "Basel-Stadt", "Basel-Landschaft") ~ "Nordwestschweiz",
    kanton %in% c("Appenzell Ausserrhoden", "Appenzell Innerrhoden", "Glarus", "Graubünden", "Schaffhausen", 
                  "St. Gallen",  "Thurgau") ~ "Ostschweiz",
    kanton %in% c("Bern", "Freiburg", "Jura", "Neuenburg", "Solothurn") ~ "Mittelland",
    kanton %in% c("Genf", "Waadt", "Wallis")  ~ "Genferseeregion",
    kanton %in% c("Luzern", "Nidwalden", "Obwalden", "Schwyz", "Uri", "Zug") ~ "Zentralschweiz",
    kanton %in% "Tessin" ~ "Tessin",
    kanton %in% "Zürich" ~ "Zürich"))

konakt_plot <-ggplot(data = corona_kontakt) +
    aes(y = contact, x = Percentage, color = region) +
    geom_point(size = 3) + 
  scale_x_continuous(name = NULL,labels = function(x){paste0(x,"%")}) +
  facet_wrap(~ kanton) +
    geom_hline(yintercept = 100, linetype = "dashed") +
    coord_flip() +
    labs(title = bquote( ~ bold("Unterschiede in der Anzahl Kontakte auch innerhalb der Regionen")),
         subtitle = "Anzahl Personen ausser Haus mit denen man in den letzten sieben Tagen näheren Kontakt hatte 
(länger als 15 Minuten, näher als 1,5 Meter).", 
         caption = "Daten: Forschungsstelle sotomo (Corona-Monitor, 5. Welle, November 2020).", 
         y = "", x = "") +
    guides(size = guide_legend(title = "Anteil Befragten", title.position = "left")) +
    guides(color = guide_legend(title = "Grossregion", title.position = "right", nrow = 3)) +
    theme_light() +
    theme(legend.position = c(0.65, 0.06), legend.box = "vertical", legend.direction = "horizontal",
          legend.title = element_text(size = 10), legend.spacing.y = unit(-0.2, "cm"), 
          strip.background = element_blank(), 
          strip.text = element_text(color = "black", face = "italic"),  axis.text.x = element_text(angle = 45, hjust = 1))  

konakt_plot

ggsave(konakt_plot, file = "Anzahl_Kontakte_multiples.jpg", width = 9, height = 7)