Coronamonitor-Analyse
Politischer Datenjournalismus
Aline Laura Metzler 16-721-227
3. Januar 2021
Pakete
# Benötigte Pakete
library(dplyr)##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(tidyr)
library(reshape2)##
## Attaching package: 'reshape2'## The following object is masked from 'package:tidyr':
##
## smithslibrary(ggplot2)
library(ggridges)
library(forcats) # for fct_reorder
library(purrr)
library(magrittr) # for pipes##
## Attaching package: 'magrittr'## The following object is masked from 'package:purrr':
##
## set_names## The following object is masked from 'package:tidyr':
##
## extractlibrary(lubridate)##
## Attaching package: 'lubridate'## The following objects are masked from 'package:base':
##
## date, intersect, setdiff, unionDaten laden
# Arbeitsverzeichnis definieren
setwd("/Users/alinelaurametzler/Documents/Universität/Master/Vorbereitung zum Forschungsseminar/Daten_DDJ_HS20_Olat")
# Dateipfad definieren
file_path <- "./Corona-Monitor/2-Daten/CoronaMonitorAll.csv"
# read data
coronamonitor <- read.csv(file_path,
sep = ",",
encoding = "UTF-8",
stringsAsFactors = FALSE)Theme
# Theme für Plots
theme_am <- function(base_size = 12,
base_family = "Helvetica",
base_line_size = base_size / 170,
base_rect_size = base_size / 170){
ggplot2::theme_minimal(base_size = base_size,
base_family = base_family,
base_line_size = base_line_size) %+replace%
ggplot2::theme(
plot.title = element_text(color = rgb(22, 38, 46,
maxColorValue = 250),
face = "bold", hjust = 0),
axis.title = element_text(color = rgb(22, 38, 46,
maxColorValue = 250),
size = rel(0.75)),
axis.text = element_text(color = rgb(22, 38, 46,
maxColorValue = 250),
size = rel(0.7)),
panel.grid.minor = element_line(rgb(159, 162, 178,
maxColorValue = 250),
linetype = "dotted", size = rel(4)),
complete = TRUE
)
}Daten säubern und vorbereiten
# NAs in wichtigen Variablen
coronamonitor$homeoffice <- car::recode(coronamonitor$homeoffice, "c('', 'NA' ) = NA")
coronamonitor$massnBewegung <- car::recode(coronamonitor$massnBewegung, "c('', 'NA' ) = NA")
coronamonitor$massnLockdown <- car::recode(coronamonitor$massnLockdown, "c('', 'NA' ) = NA")
coronamonitor$massnWirtsch <- car::recode(coronamonitor$massnWirtsch, "c('', 'NA' ) = NA")
coronamonitor$massnLohn <- car::recode(coronamonitor$massnLohn, "c('', 'NA' ) = NA")
coronamonitor$massnLohn <- car::recode(coronamonitor$massnLohn, "c('', 'NA' ) = NA")
coronamonitor$alltagcontact <- car::recode(coronamonitor$alltagcontact, "c('', 'NA' ) = NA")
coronamonitor$alltagcontactNoSchtz <- car::recode(coronamonitor$alltagcontactNoSchtz, "c('', 'NA' ) = NA")
coronamonitor$circuitBreaker <- car::recode(coronamonitor$circuitBreaker, "c('', 'NA' ) = NA")
coronamonitor$restaurantBegrenz <- car::recode(coronamonitor$restaurantBegrenz, "c('', 'NA' ) = NA")
coronamonitor$veranstaltungenZehn <- car::recode(coronamonitor$veranstaltungenZehn, "c('', 'NA' ) = NA")
coronamonitor <- coronamonitor %>%
filter(!(kanton %in% c("", "Auslandschweizer/in", "- Auslandschweizer/in -"))) %>%
mutate(kürzel = case_when( # Kantonskürzel für Matching mit COVID-Fallzahlen
kanton == "Aargau" ~ "AG",
kanton == "Appenzell Ausserrhoden" ~ "AI",
kanton == "Appenzell Innerrhoden" ~ "AR",
kanton == "Basel-Landschaft" ~ "BL",
kanton == "Basel-Stadt" ~ "BS",
kanton == "Bern" ~ "BE",
kanton == "Freiburg" ~ "FR",
kanton == "Genf" ~ "GE",
kanton == "Glarus" ~ "GL",
kanton == "Graubünden" ~ "GR",
kanton == "Jura" ~ "JU",
kanton == "Luzern" ~ "LU",
kanton == "Neuenburg" ~ "NE",
kanton == "Nidwalden" ~ "NW",
kanton == "Obwalden" ~ "OW",
kanton == "Schaffhausen" ~ "SH",
kanton == "Schwyz" ~ "SZ",
kanton == "Solothurn" ~ "SO",
kanton == "St. Gallen" ~ "SG",
kanton == "Tessin" ~ "TI",
kanton == "Thurgau" ~ "TG",
kanton == "Uri" ~ "UR",
kanton == "Waadt" ~ "VD",
kanton == "Wallis" ~ "VS",
kanton == "Zug" ~ "ZG",
kanton == "Zürich" ~ "ZH")) %>%
mutate(date_time = ymd_hms(datestamp),
date = as_date(date_time)) %>%
mutate(region = case_when(
kürzel %in% c("BE", "FR", "JU", "NE", "SO") ~ "Espace Mittelland",
kürzel %in% c("GE", "VD", "VS") ~ "Genferseeresion",
kürzel %in% c("AG", "BL", "BS") ~ "Nordwestschweiz",
kürzel %in% c("AI", "AR", "GL", "GR", "SH", "SG", "TG") ~ "Ostschweiz",
kürzel %in% "TI" ~ "Tessin",
kürzel %in% c("LU", "NW", "OW", "SZ", "UR", "ZG") ~ "Zentralschweiz",
kürzel %in% "ZH" ~ "Zürich"))Fallzahlen
Indikatoren: https://www.bfs.admin.ch/bfs/de/home/statistiken/regionalstatistik/regionale-portraets-kennzahlen/kantone.html
# Fallzahlen nach Kanton und Tag
library(readxl)
fallzahlen <- readxl::read_xlsx("/Users/alinelaurametzler/Documents/Universität/Master/Vorbereitung zum Forschungsseminar/Blogbeitrag/swiss_covid.xlsx") %>%
filter(pttod_1 == 0) %>%
group_by(fall_dt, ktn) %>%
rename(kürzel = ktn) %>%
summarise(fallzahlen = sum(fallklasse_3)) %>% # Fallzahlen pro Tag und Kanton
mutate(date = as_date(fall_dt)) %>%
filter(kürzel != "FL") %>% # Ohne Lichtenstein
dplyr::select(date, kürzel, fallzahlen) ## `summarise()` regrouping output by 'fall_dt' (override with `.groups` argument)## Warning: Problem with `mutate()` input `date`.
## ℹ All formats failed to parse. No formats found.
## ℹ Input `date` is `as_date(fall_dt)`.
## ℹ The error occurred in group 272: fall_dt = "NA".## Warning: All formats failed to parse. No formats found.## Adding missing grouping variables: `fall_dt`# 7-Tagessumme berechnen
coronamonitor %>%
group_by(Welle) %>%
distinct(date) # Daten der Wellen## # A tibble: 21 x 2
## # Groups: Welle [5]
## Welle date
## <int> <date>
## 1 1 2020-03-21
## 2 1 2020-03-22
## 3 1 2020-03-23
## 4 2 2020-04-03
## 5 2 2020-04-04
## 6 2 2020-04-05
## 7 2 2020-04-06
## 8 3 2020-05-02
## 9 3 2020-05-03
## 10 3 2020-05-04
## # … with 11 more rowsfallzahlen_welle <- fallzahlen %>%
mutate(date = as.character(date)) %>%
mutate(Welle = case_when(
date %in% c("2020-03-21", "2020-03-22", "2020-03-23") ~ 1,
date %in% c("2020-04-03", "2020-04-04", "2020-04-05", "2020-04-06") ~ 2,
date %in% c("2020-05-02", "2020-05-03", "2020-05-04", "2020-05-05") ~ 3,
date %in% c("2020-06-05", "2020-06-06", "2020-06-07", "2020-06-08") ~ 4,
date %in% c("2020-10-23", "2020-10-24", "2020-10-25", "2020-10-26", "2020-10-27", "2020-10-28") ~ 5
)) %>%
mutate(date = as_date(date))
library(RcppRoll)
fallzahlen_welle <- fallzahlen_welle %>%
group_by(kürzel) %>%
mutate(sum_pastsevendays = roll_sum(fallzahlen, 7, align = "right", fill = NA)) %>% # Summe der letzten sieben Tage
filter(!is.na(Welle))
# Indikatoren Kantone
Indikatoren <- readxl::read_xlsx("/Users/alinelaurametzler/Documents/Universität/Master/Vorbereitung zum Forschungsseminar/Blogbeitrag/Indikatoren_Kantone.xlsx", skip = 2)[-c(1:3), ] %>%
rename(Indikator = ...1) %>%
filter(Indikator == "Einwohner in 1000") %>%
gather(key = "kürzel", value = "Einwohner in 1000")## New names:
## * `` -> ...1Indikatoren <- Indikatoren[-c(1:3), ] %>%
mutate(`Einwohner in 1000` = as.numeric(`Einwohner in 1000`)) %>%
mutate(Einwohner = `Einwohner in 1000` * 1000) %>%
dplyr::select(kürzel, Einwohner)
# Inzidenz berechnen
covid_Kantone <- left_join(fallzahlen_welle, Indikatoren, by = "kürzel") %>%
rowwise() %>%
mutate(Inzidenz = (sum_pastsevendays / Einwohner) * 100000) %>%
group_by(kürzel, Welle) %>%
mutate(Inzidenz_mean = mean(Inzidenz)) %>%
ungroup()Fallzahlen Map
Schweiz Map: https://gadm.org/download_country_v3.html
library(viridis)## Loading required package: viridisLitelibrary(sp)
library(raster)##
## Attaching package: 'raster'## The following object is masked from 'package:magrittr':
##
## extract## The following object is masked from 'package:tidyr':
##
## extract## The following object is masked from 'package:dplyr':
##
## selectlibrary(rgdal)## rgdal: version: 1.5-18, (SVN revision 1082)
## Geospatial Data Abstraction Library extensions to R successfully loaded
## Loaded GDAL runtime: GDAL 3.1.4, released 2020/10/20
## Path to GDAL shared files: /Library/Frameworks/R.framework/Versions/4.0/Resources/library/rgdal/gdal
## GDAL binary built with GEOS: TRUE
## Loaded PROJ runtime: Rel. 6.3.1, February 10th, 2020, [PJ_VERSION: 631]
## Path to PROJ shared files: /Library/Frameworks/R.framework/Versions/4.0/Resources/library/rgdal/proj
## Linking to sp version:1.4-4
## To mute warnings of possible GDAL/OSR exportToProj4() degradation,
## use options("rgdal_show_exportToProj4_warnings"="none") before loading rgdal.library(sf) # spacial feature## Linking to GEOS 3.8.1, GDAL 3.1.1, PROJ 6.3.1# switzerland shapefile from GADM
switzerland <- st_read("/Users/alinelaurametzler/Documents/Universität/Master/Vorbereitung zum Forschungsseminar/Blogbeitrag/gadm36_CHE_shp/gadm36_CHE_1.shp", quiet = TRUE) %>%
mutate(kürzel = case_when( # NAME_1 als kürzel für Matching mit COVID-Fallzahlen
NAME_1 == "Aargau" ~ "AG",
NAME_1 == "Appenzell Ausserrhoden" ~ "AI",
NAME_1 == "Appenzell Innerrhoden" ~ "AR",
NAME_1 == "Basel-Landschaft" ~ "BL",
NAME_1 == "Basel-Stadt" ~ "BS",
NAME_1 == "Bern" ~ "BE",
NAME_1 == "Fribourg" ~ "FR",
NAME_1 == "Genève" ~ "GE",
NAME_1 == "Glarus" ~ "GL",
NAME_1 == "Graubünden" ~ "GR",
NAME_1 == "Jura" ~ "JU",
NAME_1 == "Lucerne" ~ "LU",
NAME_1 == "Neuchâtel" ~ "NE",
NAME_1 == "Nidwalden" ~ "NW",
NAME_1 == "Obwalden" ~ "OW",
NAME_1 == "Schaffhausen" ~ "SH",
NAME_1 == "Schwyz" ~ "SZ",
NAME_1 == "Solothurn" ~ "SO",
NAME_1 == "Sankt Gallen" ~ "SG",
NAME_1 == "Ticino" ~ "TI",
NAME_1 == "Thurgau" ~ "TG",
NAME_1 == "Uri" ~ "UR",
NAME_1 == "Vaud" ~ "VD",
NAME_1 == "Valais" ~ "VS",
NAME_1 == "Zug" ~ "ZG",
NAME_1 == "Zürich" ~ "ZH"))
# merge the data
map_plot <- covid_Kantone %>%
filter(Welle == 5) %>%
filter(date == "2020-10-28")
switzerland1 <- switzerland %>%
left_join(map_plot, join = "kürzel") ## Joining, by = "kürzel"# Durchschnittliche Inzidenz nach Kanton
covid_Kantone %>%
filter(Welle == 5) %>%
group_by(kürzel, Inzidenz_mean) %>%
arrange(desc(Inzidenz_mean))## # A tibble: 156 x 9
## # Groups: kürzel, Inzidenz_mean [26]
## fall_dt date kürzel fallzahlen Welle sum_pastsevenda… Einwohner
## <chr> <date> <chr> <dbl> <dbl> <dbl> <dbl>
## 1 2020-1… 2020-10-23 VS 762 5 3718 343955
## 2 2020-1… 2020-10-24 VS 522 5 3956 343955
## 3 2020-1… 2020-10-25 VS 377 5 4135 343955
## 4 2020-1… 2020-10-26 VS 882 5 4450 343955
## 5 2020-1… 2020-10-27 VS 888 5 4779 343955
## 6 2020-1… 2020-10-28 VS 768 5 4878 343955
## 7 2020-1… 2020-10-23 GE 972 5 4153 499480
## 8 2020-1… 2020-10-24 GE 473 5 4396 499480
## 9 2020-1… 2020-10-25 GE 391 5 4619 499480
## 10 2020-1… 2020-10-26 GE 1283 5 5366 499480
## # … with 146 more rows, and 2 more variables: Inzidenz <dbl>,
## # Inzidenz_mean <dbl># gleichmässige Einteilung in 8 Bins für Map
# bins für Inzidenz
switzerland1$bins_Inzidenz <- cut(switzerland1$Inzidenz_mean,
breaks = c(-Inf, 250, 400, 550, 700, 850, 1000, 1150, Inf),
right = TRUE,
labels = c("<250",
"250-400",
"400-550",
"550-700",
"700-850",
"850-1000",
"1000-1150",
">1150"))
# bin Farben
bin_colors <- c(
"<250" = "#A9D6E5",
"250-400" = "#89C2D9",
"400-550" = "#61A5C2",
"550-700" = "#468FAF",
"700-850" = "#286A8F",
"850-1000" = "#01497C",
"1000-1150" = "#01497C",
">1150" = "#013A63"
)
# Plot: Welle 5
map_plot <- switzerland1 %>%
mutate(bins_Inzidenz = fct_relevel(bins_Inzidenz,
c(">1150","1000-1150", "850-1000", "700-850", "550-700", "400-550", "250-400", "<250") ))%>%
ggplot() +
geom_sf(aes(fill = bins_Inzidenz),
color = "#FFFFFF",
size = 0.3) +
annotate(
geom = "curve", x = 6.7, y = 45.9, xend = 7.3, yend = 46.1,
curvature = -.3, arrow = arrow(length = unit(2, "mm"))
) +
annotate(geom = "text", x = 6, y = 45.7,
label = "Wallis hat mit einer \nInzidenz von 1256 die \nmeisten COVID-19 Fälle",
family = "sans",
size = 3,
hjust = "left") +
annotate(
geom = "curve", x = 6.8, y = 47.6, xend = 7.55, yend = 47.45,
curvature = -.2, arrow = arrow(length = unit(2, "mm"))
) +
annotate(geom = "text", x = 5.7, y = 47.6,
label = "Basel-Landschaft \nhat die wenigsten \n COVID-19 Fälle",
family = "sans",
size = 3,
hjust = "left") +
scale_fill_manual(values = bin_colors) +
theme_void() +
labs(title = bquote( ~ bold('«Röstigraben» spaltet Schweiz bezüglich Corona-Fallzahlen')),
subtitle = "7-Tage-Inzidenz der Kantone während der 5. Umfrage-Welle von sotomo (23.-28.10.2020)",
caption = "Daten: BAG und BFS (Stand: November 2020).",
fill = "Inzidenz") +
expand_limits(y = 45.5)
map_plot
ggsave(map_plot, filename = "Plots/map_plot.png", height = 4, width = 7)Zum Vergleich: Welle 2
covid_Kantone %>%
filter(Welle == 2) %>%
group_by(kürzel, Inzidenz_mean) %>%
arrange(desc(Inzidenz_mean))## # A tibble: 104 x 9
## # Groups: kürzel, Inzidenz_mean [26]
## fall_dt date kürzel fallzahlen Welle sum_pastsevenda… Einwohner
## <chr> <date> <chr> <dbl> <dbl> <dbl> <dbl>
## 1 2020-0… 2020-04-03 GE 196 2 1571 499480
## 2 2020-0… 2020-04-04 GE 121 2 1473 499480
## 3 2020-0… 2020-04-05 GE 73 2 1443 499480
## 4 2020-0… 2020-04-06 GE 189 2 1387 499480
## 5 2020-0… 2020-04-03 TI 71 2 518 353343
## 6 2020-0… 2020-04-04 TI 31 2 502 353343
## 7 2020-0… 2020-04-05 TI 21 2 496 353343
## 8 2020-0… 2020-04-06 TI 94 2 458 353343
## 9 2020-0… 2020-04-03 VD 137 2 1022 799145
## 10 2020-0… 2020-04-04 VD 72 2 962 799145
## # … with 94 more rows, and 2 more variables: Inzidenz <dbl>,
## # Inzidenz_mean <dbl>map_plot2 <- covid_Kantone %>%
filter(Welle == 2) %>%
filter(date == "2020-04-06")
switzerland2 <- switzerland %>%
left_join(map_plot2, join = "kürzel")## Joining, by = "kürzel"# Plot
switzerland2 %>%
ggplot() +
geom_sf(aes(fill = Inzidenz),
color = "#FFFFFF",
size = 0.3) +
theme_void() +
labs(title = "7-Tagesinzidenz in der ersten Coronawelle",
subtitle = "",
fill = "Inzidenz")
Kontakt
# Kontakt allgemein
coronamonitor %>%
filter(Welle == 5) %>%
filter(!is.na(alltagcontact)) %>%
mutate(alltagcontact_bin = 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% "11-20" ~ "11-20",
alltagcontact %in% c("21-30", "31-40", "41-50", "51-100", "101+") ~ "21+"
)) %>%
mutate(sprachreg = case_when(
sprachreg == "fr" ~ "Romandie",
sprachreg == "de" ~ "Deutschschweiz",
sprachreg == "it" ~ "Ital. Schweiz"
)) %>%
mutate(sprachreg = fct_relevel(sprachreg,
c("Deutschschweiz",
"Romandie",
"Ital. Schweiz"))) %>%
group_by(sprachreg, alltagcontact_bin) %>%
count(wt = weight) %>%
summarise(is = sum(n)) %>%
mutate(share = is / sum(is)) %>%
mutate(alltagcontact_bin = fct_relevel(alltagcontact_bin,
c("0",
"1-2",
"3-5",
"6-10",
"11-20",
"21+"))
) %>%
ggplot(aes(x = alltagcontact_bin, y = share)) +
geom_bar(stat = "identity", fill = "#3d5a80", color = "white") +
geom_text(
aes(
y = share,
label = scales::percent(share, accuracy = 1L)
),
position = position_stack(vjust = 0.5),
color = "white",
family = "Helvetica",
size = 3
) +
facet_wrap(~ sprachreg) +
labs(title = "",
subtitle = "Nähere Kontakte ausserhalb des eigenen Haushaltes",
caption = "Daten: Forschungsstelle sotomo, 5. Welle (Stand: November 2020).",
x = "Anzahl Kontakte diese Woche",
y = "Anteil in %") +
theme_am() ## `summarise()` regrouping output by 'sprachreg' (override with `.groups` argument)
# Kontakt ohne Schutz
map_contact <- coronamonitor %>%
filter(Welle == 5) %>%
filter(!is.na(alltagcontactNoSchtz)) %>%
# filter(kürzel %in% c("BL", "NW", "BS", "FR", "GE", "VS")) %>%
mutate(alltagcontactNoSchtz_bin = case_when(
alltagcontactNoSchtz %in% "0" ~ "0",
alltagcontactNoSchtz %in% c("1", "2") ~ "1-2",
alltagcontactNoSchtz %in% c("3", "4", "5") ~ "3-5",
alltagcontactNoSchtz %in% c("6", "7", "8", "9", "10") ~ "6-10",
alltagcontactNoSchtz %in% "11-20" ~ "11-20",
alltagcontactNoSchtz %in% c("21-30", "31-40", "41-50", "51-100", "101+") ~ "21+"
)) %>%
mutate(sprachreg = case_when(
sprachreg == "fr" ~ "Romandie",
sprachreg == "de" ~ "Deutschschweiz",
sprachreg == "it" ~ "Ital. Schweiz"
)) %>%
mutate(sprachreg = fct_relevel(sprachreg,
c("Deutschschweiz",
"Romandie",
"Ital. Schweiz"))) %>%
group_by(sprachreg, alltagcontactNoSchtz_bin) %>%
count(wt = weight) %>%
summarise(is = sum(n)) %>%
mutate(share = is / sum(is)) %>%
mutate(alltagcontactNoSchtz_bin = fct_relevel(alltagcontactNoSchtz_bin,
c("0",
"1-2",
"3-5",
"6-10",
"11-20",
"21+"))
) %>%
ggplot(aes(x = alltagcontactNoSchtz_bin, y = share)) +
geom_bar(stat = "identity", fill = "#3d5a80", color = "white") +
geom_text(
aes(
y = share,
label = scales::percent(share, accuracy = 1L)
),
position = position_stack(vjust = 0.5),
color = "white",
family = "Helvetica",
size = 3
) +
scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
facet_wrap(~ sprachreg) +
theme_am() +
labs(title = "Geringe Unterschiede zwischen den Sprachregionen ",
subtitle = "\nAnzahl nähere, ungeschützte Kontakte ausserhalb des eigenen Haushaltes",
caption = "Daten: Forschungsstelle sotomo, 5. Welle (Stand: November 2020).",
x = "Anzahl Kontakte diese Woche",
y = "Anteil")## `summarise()` regrouping output by 'sprachreg' (override with `.groups` argument)map_contact
ggsave(map_contact, filename = "Plots/map_contact.png", height = 4, width = 7)Home Office
plot_homeoffice <- coronamonitor %>%
filter(Welle == 5) %>%
filter(!is.na(homeoffice)) %>%
mutate(sprachreg = case_when(
sprachreg == "fr" ~ "Romandie",
sprachreg == "de" ~ "Deutschschweiz",
sprachreg == "it" ~ "Ital. Schweiz"
)) %>%
mutate(sprachreg = fct_relevel(sprachreg,
c("Ital. Schweiz",
"Romandie",
"Deutschschweiz"))) %>%
group_by(sprachreg, homeoffice) %>%
count(wt = weight) %>%
summarise(is = sum(n)) %>%
mutate(share = is / sum(is)) %>%
ggplot(aes(x = sprachreg, y = share, fill = homeoffice)) +
geom_bar(stat = "identity", position = "fill", color = "white", width = 0.9) +
geom_text(
aes(
y = share,
label = scales::percent(share, accuracy = 1L)
),
position = position_stack(vjust = 0.5),
color = "white",
family = "Helvetica",
size = 3
) +
scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
scale_fill_manual(values = c(
"Ja, ich arbeite nur noch von zuhause" = "#3d5a80",
"Ja, ich arbeite teilweise von zuhause" = "#abd9e9",
"Nein" = "#f4a582"
)) +
theme_am() +
coord_flip() +
theme(legend.position="bottom") +
labs(title = "Rund ein Drittel arbeitet teilweise oder ganz im Home-Office",
subtitle = "\nAnteil Arbeitnehmer im Home-Office aufgrund der Corona-Krise",
caption = "Daten: Forschungsstelle sotomo, 5. Welle (Stand: November 2020).",
x = "",
y = "",
fill = ""
)## `summarise()` regrouping output by 'sprachreg' (override with `.groups` argument)plot_homeoffice
ggsave(plot_homeoffice, filename = "Plots/plot_homeoffice.png", height = 4, width = 7)Infrastruktur
## Verhalten vor Pandemie
benutzPre <- coronamonitor %>%
filter(Welle == 5) %>%
gather(key = "benutzPre", value = "Infrastruktur", starts_with("benutzPre_")) %>%
filter(!is.na(Infrastruktur)) %>%
group_by(sprachreg, benutzPre) %>%
count(Infrastruktur, wt = weight) %>%
mutate(share_before = n / sum(n))
# Vorbereiten der Variable für Plot
SQ001 <- coronamonitor %>%
filter(Welle == 5) %>%
filter(benutzPre_SQ001 == "Fachgeschäfte, Warenhäuser: Selected") %>% # Interessiert nur die, welche bereits vor Corona Angebot häufig benutzt haben
mutate(benutzPostSame_SQ001 = case_when(
benutzPostSame_SQ001 == "Fachgeschäfte, Warenhäuser: Selected" ~ "Fachgeschäfte, Warenhäuser: Selected",
benutzPostSame_SQ001 == "Fachgeschäfte, Warenhäuser: Not selected" ~ "0"
)) %>%
replace(is.na(.), 0) %>%
mutate(benutzPostLess_SQ001 = case_when(
benutzPostLess_SQ001 == "Fachgeschäfte, Warenhäuser: Selected" ~ "Fachgeschäfte, Warenhäuser: Selected",
benutzPostLess_SQ001 == "Fachgeschäfte, Warenhäuser: Not selected" ~ "0"
)) %>%
replace(is.na(.), 0) %>%
group_by(sprachreg, benutzPostSame_SQ001, benutzPostLess_SQ001) %>%
count(wt = weight) %>%
ungroup() %>%
group_by(sprachreg) %>%
mutate(share_now = n / sum(n)) %>%
filter(benutzPostSame_SQ001 == "Fachgeschäfte, Warenhäuser: Selected") %>%
rename(Infrastruktur = benutzPostSame_SQ001) %>%
dplyr::select(sprachreg, Infrastruktur, share_now)
SQ002 <- coronamonitor %>%
filter(Welle == 5) %>%
filter(benutzPre_SQ002 == "Restaurants: Selected") %>%
mutate(benutzPostSame_SQ002 = case_when(
benutzPostSame_SQ002 == "Restaurants: Selected" ~ "Restaurants: Selected",
benutzPostSame_SQ002 == "Restaurants: Not selected" ~ "0"
)) %>%
replace(is.na(.), 0) %>%
mutate(benutzPostLess_SQ002 = case_when(
benutzPostLess_SQ002 == "Restaurants: Selected" ~ "Restaurants: Selected",
benutzPostLess_SQ002 == "Restaurants: Not selected" ~ "0"
)) %>%
replace(is.na(.), 0) %>%
group_by(sprachreg, benutzPostSame_SQ002, benutzPostLess_SQ002) %>%
count(wt = weight) %>%
ungroup() %>%
group_by(sprachreg) %>%
mutate(share_now = n / sum(n)) %>%
filter(benutzPostSame_SQ002 == "Restaurants: Selected") %>%
rename(Infrastruktur = benutzPostSame_SQ002) %>%
dplyr::select(sprachreg, Infrastruktur, share_now)
SQ003 <- coronamonitor %>%
filter(Welle == 5) %>%
filter(benutzPre_SQ003 == "Zug, Tram, Bus: Selected") %>%
mutate(benutzPostSame_SQ003 = case_when(
benutzPostSame_SQ003 == "Zug, Tram, Bus: Selected" ~ "Zug, Tram, Bus: Selected",
benutzPostSame_SQ003 == "Zug, Tram, Bus: Not selected" ~ "0"
)) %>%
replace(is.na(.), 0) %>%
mutate(benutzPostLess_SQ003 = case_when(
benutzPostLess_SQ003 == "Zug, Tram, Bus: Selected" ~ "Zug, Tram, Bus: Selected",
benutzPostLess_SQ003 == "Zug, Tram, Bus: Not selected" ~ "0"
)) %>%
replace(is.na(.), 0) %>%
group_by(sprachreg, benutzPostSame_SQ003, benutzPostLess_SQ003) %>%
count(wt = weight) %>%
ungroup() %>%
group_by(sprachreg) %>%
mutate(share_now = n / sum(n)) %>%
filter(benutzPostSame_SQ003 == "Zug, Tram, Bus: Selected") %>%
rename(Infrastruktur = benutzPostSame_SQ003) %>%
dplyr::select(sprachreg, Infrastruktur, share_now)
SQ004 <- coronamonitor %>%
filter(Welle == 5) %>%
filter(benutzPre_SQ004 == "Museen, Bibliotheken: Selected") %>%
mutate(benutzPostSame_SQ004 = case_when(
benutzPostSame_SQ004 == "Museen, Bibliotheken: Selected" ~ "Museen, Bibliotheken: Selected",
benutzPostSame_SQ004 == "Museen, Bibliotheken: Not selected" ~ "0"
)) %>%
replace(is.na(.), 0) %>%
mutate(benutzPostLess_SQ004 = case_when(
benutzPostLess_SQ004 == "Museen, Bibliotheken: Selected" ~ "Museen, Bibliotheken: Selected",
benutzPostLess_SQ004 == "Museen, Bibliotheken: Not selected" ~ "0"
)) %>%
replace(is.na(.), 0) %>%
group_by(sprachreg, benutzPostSame_SQ004, benutzPostLess_SQ004) %>%
count(wt = weight) %>%
ungroup() %>%
group_by(sprachreg) %>%
mutate(share_now = n / sum(n)) %>%
filter(benutzPostSame_SQ004 == "Museen, Bibliotheken: Selected") %>%
rename(Infrastruktur = benutzPostSame_SQ004) %>%
dplyr::select(sprachreg, Infrastruktur, share_now)
SQ005 <- coronamonitor %>%
filter(Welle == 5) %>%
filter(benutzPre_SQ005 == "Konzerte: Selected") %>%
mutate(benutzPostSame_SQ005 = case_when(
benutzPostSame_SQ005 == "Konzerte: Selected" ~ "Konzerte: Selected",
benutzPostSame_SQ005 == "Konzerte: Not selected" ~ "0"
)) %>%
replace(is.na(.), 0) %>%
mutate(benutzPostLess_SQ005 = case_when(
benutzPostLess_SQ005 == "Konzerte: Selected" ~ "Konzerte: Selected",
benutzPostLess_SQ005 == "Konzerte: Not selected" ~ "0"
)) %>%
replace(is.na(.), 0) %>%
group_by(sprachreg, benutzPostSame_SQ005, benutzPostLess_SQ005) %>%
count(wt = weight) %>%
ungroup() %>%
group_by(sprachreg) %>%
mutate(share_now = n / sum(n)) %>%
filter(benutzPostSame_SQ005 == "Konzerte: Selected") %>%
rename(Infrastruktur = benutzPostSame_SQ005) %>%
dplyr::select(sprachreg, Infrastruktur, share_now)
SQ006 <- coronamonitor %>%
filter(Welle == 5) %>%
filter(benutzPre_SQ006 == "Theater / Kino: Selected") %>%
mutate(benutzPostSame_SQ006 = case_when(
benutzPostSame_SQ006 == "Theater / Kino: Selected" ~ "Theater / Kino: Selected",
benutzPostSame_SQ006 == "Theater / Kino: Not selected" ~ "0"
)) %>%
replace(is.na(.), 0) %>%
mutate(benutzPostLess_SQ006 = case_when(
benutzPostLess_SQ006 == "Theater / Kino: Selected" ~ "Theater / Kino: Selected",
benutzPostLess_SQ006 == "Theater / Kino: Not selected" ~ "0"
)) %>%
replace(is.na(.), 0) %>%
group_by(sprachreg, benutzPostSame_SQ006, benutzPostLess_SQ006) %>%
count(wt = weight) %>%
ungroup() %>%
group_by(sprachreg) %>%
mutate(share_now = n / sum(n)) %>%
filter(benutzPostSame_SQ006 == "Theater / Kino: Selected") %>%
rename(Infrastruktur = benutzPostSame_SQ006) %>%
dplyr::select(sprachreg, Infrastruktur, share_now)
SQ007 <- coronamonitor %>%
filter(Welle == 5) %>%
filter(benutzPre_SQ007 == "Schwimmbad / Wellness: Selected") %>%
mutate(benutzPostSame_SQ007 = case_when(
benutzPostSame_SQ007 == "Schwimmbad / Wellness: Selected" ~ "Schwimmbad / Wellness: Selected",
benutzPostSame_SQ007 == "Schwimmbad / Wellness: Not selected" ~ "0"
)) %>%
replace(is.na(.), 0) %>%
mutate(benutzPostLess_SQ007 = case_when(
benutzPostLess_SQ007 == "Schwimmbad / Wellness: Selected" ~ "Schwimmbad / Wellness: Selected",
benutzPostLess_SQ007 == "Schwimmbad / Wellness: Not selected" ~ "0"
)) %>%
replace(is.na(.), 0) %>%
group_by(sprachreg, benutzPostSame_SQ007, benutzPostLess_SQ007) %>%
count(wt = weight) %>%
ungroup() %>%
group_by(sprachreg) %>%
mutate(share_now = n / sum(n)) %>%
filter(benutzPostSame_SQ007 == "Schwimmbad / Wellness: Selected") %>%
rename(Infrastruktur = benutzPostSame_SQ007) %>%
dplyr::select(sprachreg, Infrastruktur, share_now)
SQ008 <- coronamonitor %>%
filter(benutzPre_SQ008 == "Gottesdienste / religiöse Feiern: Selected") %>%
mutate(benutzPostSame_SQ008 = case_when(
benutzPostSame_SQ008 == "Gottesdienste / religiöse Feiern: Selected" ~ "Gottesdienste / religiöse Feiern: Selected",
benutzPostSame_SQ008 == "Gottesdienste / religiöse Feiern: Not selected" ~ "0"
)) %>%
replace(is.na(.), 0) %>%
mutate(benutzPostLess_SQ008 = case_when(
benutzPostLess_SQ008 == "Gottesdienste / religiöse Feiern: Selected" ~ "Gottesdienste / religiöse Feiern: Selected",
benutzPostLess_SQ008 == "Gottesdienste / religiöse Feiern: Not selected" ~ "0"
)) %>%
replace(is.na(.), 0) %>%
group_by(sprachreg, benutzPostSame_SQ008, benutzPostLess_SQ008) %>%
count(wt = weight) %>%
ungroup() %>%
group_by(sprachreg) %>%
mutate(share_now = n / sum(n)) %>%
filter(benutzPostSame_SQ008 == "Gottesdienste / religiöse Feiern: Selected") %>%
rename(Infrastruktur = benutzPostSame_SQ008) %>%
dplyr::select(sprachreg, Infrastruktur, share_now)
SQ010 <- coronamonitor %>%
filter(benutzPre_SQ010 == "Clubs / Bars: Selected") %>%
mutate(benutzPostSame_SQ010 = case_when(
benutzPostSame_SQ010 == "Clubs / Bars: Selected" ~ "Clubs / Bars: Selected",
benutzPostSame_SQ010 == "Clubs / Bars: Not selected" ~ "0"
)) %>%
replace(is.na(.), "Keine Angabe") %>%
mutate(benutzPostLess_SQ010 = case_when(
benutzPostLess_SQ010 == "Clubs / Bars: Selected" ~ "Clubs / Bars: Selected",
benutzPostLess_SQ010 == "Clubs / Bars: Not selected" ~ "0"
)) %>%
replace(is.na(.), "Keine Angabe") %>%
group_by(sprachreg, benutzPostSame_SQ010, benutzPostLess_SQ010) %>%
count(wt = weight) %>%
ungroup() %>%
group_by(sprachreg) %>%
mutate(share_now = n / sum(n)) %>%
filter(benutzPostSame_SQ010 == "Clubs / Bars: Selected") %>%
rename(Infrastruktur = benutzPostSame_SQ010) %>%
dplyr::select(sprachreg, Infrastruktur, share_now)
# mergen zu einem Datensatz
benutzPost <- bind_rows(SQ001, SQ002, SQ003, SQ004, SQ005, SQ006, SQ007, SQ008, SQ010)
rm(SQ001, SQ002, SQ003, SQ004, SQ005, SQ006, SQ007, SQ008, SQ010)
plot_Infrastruktur <- benutzPost %>%
mutate(sprachreg = case_when(
sprachreg == "fr" ~ "Romandie",
sprachreg == "de" ~ "Deutschschweiz",
sprachreg == "it" ~ "Ital. Schweiz"
)) %>%
mutate(sprachreg = fct_relevel(sprachreg,
c("Ital. Schweiz",
"Romandie",
"Deutschschweiz"))) %>%
mutate(Infrastruktur = case_when(
Infrastruktur == "Fachgeschäfte, Warenhäuser: Selected" ~ "Fachgeschäfte, Warenhäuser",
Infrastruktur == "Restaurants: Selected" ~ "Restaurants",
Infrastruktur == "Zug, Tram, Bus: Selected" ~ "Zug, Tram, Bus",
Infrastruktur == "Museen, Bibliotheken: Selected" ~ "Museen, Bibliotheken",
Infrastruktur == "Konzerte: Selected" ~ "Konzerte",
Infrastruktur == "Theater / Kino: Selected" ~ "Theater / Kino",
Infrastruktur == "Schwimmbad / Wellness: Selected" ~ "Schwimmbad / Wellness",
Infrastruktur == "Gottesdienste / religiöse Feiern: Selected" ~ "Gottesdienste / religiöse Feiern",
Infrastruktur == "Clubs / Bars: Selected" ~ "Clubs / Bars",
)) %>%
group_by(sprachreg) %>%
arrange(share_now) %>%
mutate(Infrastruktur = fct_reorder(Infrastruktur, share_now, first)) %>%
ggplot(aes(x = sprachreg, y = share_now, fill = sprachreg)) +
geom_bar(stat = "identity", color = "white") +
geom_text(
aes(
y = share_now,
label = scales::percent(share_now, accuracy = 1L)
),
position = position_stack(vjust = 0.5),
color = "white",
family = "Helvetica",
size = 3
) +
facet_wrap(~ Infrastruktur, ncol = 3) +
scale_fill_manual(values = c("Ital. Schweiz" = "#3d5a80",
"Romandie" = "#52B788",
"Deutschschweiz" = "#f4a582")) +
scale_x_discrete(labels = NULL) +
scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
coord_flip() +
theme_am() +
theme(legend.position="bottom") +
labs(title = "Romands und Tessiner kehren schneller zu alten Gewohnheiten zurück",
subtitle = "\nAnteil der häufigen Nutzer öffentlicher Angebote, welche diese bereits wieder ähnlich \nnutzen wie vor der Pandmie",
fill = "",
x = "",
y = "Anteil",
caption = "Daten: Forschungsstelle sotomo, 5. Welle (Stand: November 2020).")## Warning: Problem with `mutate()` input `sprachreg`.
## ℹ Unknown levels in `f`: Ital. Schweiz, Romandie
## ℹ Input `sprachreg` is `fct_relevel(sprachreg, c("Ital. Schweiz", "Romandie", "Deutschschweiz"))`.
## ℹ The error occurred in group 1: sprachreg = "Deutschschweiz".## Warning: Unknown levels in `f`: Ital. Schweiz, Romandie## Warning: Problem with `mutate()` input `sprachreg`.
## ℹ Unknown levels in `f`: Romandie, Deutschschweiz
## ℹ Input `sprachreg` is `fct_relevel(sprachreg, c("Ital. Schweiz", "Romandie", "Deutschschweiz"))`.
## ℹ The error occurred in group 2: sprachreg = "Ital. Schweiz".## Warning: Unknown levels in `f`: Romandie, Deutschschweiz## Warning: Problem with `mutate()` input `sprachreg`.
## ℹ Unknown levels in `f`: Ital. Schweiz, Deutschschweiz
## ℹ Input `sprachreg` is `fct_relevel(sprachreg, c("Ital. Schweiz", "Romandie", "Deutschschweiz"))`.
## ℹ The error occurred in group 3: sprachreg = "Romandie".## Warning: Unknown levels in `f`: Ital. Schweiz, Deutschschweizplot_Infrastruktur
ggsave(plot_Infrastruktur, filename = "Plots/plot_Infrastruktur.png", height = 5, width = 7)Verstärkte Massnahmen
plot_circuitBreaker <- coronamonitor %>%
filter(Welle == 5) %>%
mutate(sprachreg = case_when(
sprachreg == "fr" ~ "Romandie",
sprachreg == "de" ~ "Deutschschweiz",
sprachreg == "it" ~ "Ital. Schweiz"
)) %>%
mutate(sprachreg = fct_relevel(sprachreg,
c("Ital. Schweiz",
"Romandie",
"Deutschschweiz"))) %>%
mutate(
circuitBreaker = factor(circuitBreaker, levels = c("Dafür",
"Eher dafür",
"Weiss nicht",
"Eher dagegen",
"Dagegen"))
) %>%
filter(!is.na(circuitBreaker)) %>%
group_by(sprachreg, circuitBreaker) %>%
count(wt = weight) %>%
summarise(is = sum(n)) %>%
mutate(share = is / sum(is)) %>%
ggplot(aes(x = sprachreg, y = share, fill = circuitBreaker)) +
geom_bar(stat = "identity", position = "fill", color = "white") +
geom_text(
aes(
y = share,
label = scales::percent(share, accuracy = 1L)
),
position = position_stack(vjust = 0.5),
color = "white",
family = "Helvetica",
size = 3
) +
scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
scale_fill_manual(values = c(
"Dagegen" = "#d6604d",
"Eher dagegen" = "#f4a582",
"Weiss nicht" = "#C4C4CC",
"Eher dafür" = "#abd9e9",
"Dafür" = "#3d5a80"
)) +
theme_am() +
coord_flip() +
theme(legend.position = "bottom") +
labs(title = "Mehrheit der lateinischen Schweiz befürwortet Kurz-Lockdown",
subtitle = "\nEinstellungen zu «Circuit Breaker», um den Anstieg der Fallzahlen wieder in \nden Griff zu bekommen",
fill = "",
x = "",
y = "",
caption = "Daten: Forschungsstelle sotomo, 5. Welle (Stand: November 2020)."
)## `summarise()` regrouping output by 'sprachreg' (override with `.groups` argument)plot_circuitBreaker
plot_restaurantBegrenz <- coronamonitor %>%
filter(Welle == 5) %>%
mutate(sprachreg = case_when(
sprachreg == "fr" ~ "Romandie",
sprachreg == "de" ~ "Deutschschweiz",
sprachreg == "it" ~ "Ital. Schweiz"
)) %>%
mutate(sprachreg = fct_relevel(sprachreg,
c("Ital. Schweiz",
"Romandie",
"Deutschschweiz"))) %>%
mutate(
restaurantBegrenz = factor(restaurantBegrenz, levels = c("Dafür",
"Eher dafür",
"Weiss nicht",
"Eher dagegen",
"Dagegen"))
) %>%
filter(!is.na(restaurantBegrenz)) %>%
group_by(sprachreg, restaurantBegrenz) %>%
count(wt = weight) %>%
summarise(is = sum(n)) %>%
mutate(share = is / sum(is)) %>%
ggplot(aes(x = sprachreg, y = share, fill = restaurantBegrenz)) +
geom_bar(stat = "identity", position = "fill", color = "white") +
geom_text(
aes(
y = share,
label = scales::percent(share, accuracy = 1L)
),
position = position_stack(vjust = 0.5),
color = "white",
family = "Helvetica",
size = 3
) +
scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
scale_fill_manual(values = c(
"Dagegen" = "#d6604d",
"Eher dagegen" = "#f4a582",
"Weiss nicht" = "#C4C4CC",
"Eher dafür" = "#abd9e9",
"Dafür" = "#3d5a80"
)) +
theme_am() +
coord_flip() +
theme(legend.position = "bottom") +
labs(title = "Deutschschweiz wehrt sich stärker gegen Restaurant-Sperrstunde",
subtitle = "\nEinstellung zu Sperrstunde für Restaurants und Bars um 22:00",
fill = "",
x = "",
y = "",
caption = "Daten: Forschungsstelle sotomo, 5. Welle (Stand: November 2020)."
)## `summarise()` regrouping output by 'sprachreg' (override with `.groups` argument)plot_restaurantBegrenz
plot_veranstaltungenZehn <- coronamonitor %>%
filter(Welle == 5) %>%
mutate(sprachreg = case_when(
sprachreg == "fr" ~ "Romandie",
sprachreg == "de" ~ "Deutschschweiz",
sprachreg == "it" ~ "Ital. Schweiz"
)) %>%
mutate(sprachreg = fct_relevel(sprachreg,
c("Ital. Schweiz",
"Romandie",
"Deutschschweiz"))) %>%
mutate(
veranstaltungenZehn = factor(veranstaltungenZehn, levels = c("Dafür",
"Eher dafür",
"Weiss nicht",
"Eher dagegen",
"Dagegen"))
) %>%
filter(!is.na(veranstaltungenZehn)) %>%
group_by(sprachreg, veranstaltungenZehn) %>%
count(wt = weight) %>%
summarise(is = sum(n)) %>%
mutate(share = is / sum(is)) %>%
ggplot(aes(x = sprachreg, y = share, fill = veranstaltungenZehn)) +
geom_bar(stat = "identity", position = "fill", color = "white") +
geom_text(
aes(
y = share,
label = scales::percent(share, accuracy = 1L)
),
position = position_stack(vjust = 0.5),
color = "white",
family = "Helvetica",
size = 3
) +
scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
scale_fill_manual(values = c(
"Dagegen" = "#d6604d",
"Eher dagegen" = "#f4a582",
"Weiss nicht" = "#C4C4CC",
"Eher dafür" = "#abd9e9",
"Dafür" = "#3d5a80"
)) +
theme_am() +
coord_flip() +
theme(legend.position = "bottom") +
labs(title = "Veranstaltungseinschränkungen weniger beliebt in der Deutschschweiz",
subtitle = "\nEinstellungen zu Beschränken von privaten und öffentlichen Veranstaltungen \nauf maximal 10 Personen",
fill = "",
x = "",
y = "",
caption = "Daten: Forschungsstelle sotomo, 5. Welle (Stand: November 2020)."
)## `summarise()` regrouping output by 'sprachreg' (override with `.groups` argument)plot_veranstaltungenZehn
ggsave(plot_circuitBreaker, filename = "Plots/plot_circuitBreaker.png", height = 4, width = 7)
ggsave(plot_restaurantBegrenz, filename = "Plots/plot_restaurantBegrenz.png", height = 4, width = 7)
ggsave(plot_veranstaltungenZehn, filename = "Plots/plot_veranstaltungenZehn.png", height = 4, width = 7)