Note

Diese Datei enthält den gesamten R-Code, welcher für die Erstellung des Blogbeitrags “Nicht jeder kann es sich leisten, sich einzuschränken”, benutzt wurde.

Setup Markdown

Load required Libraries
# Load required libraries
library(dplyr)
library(tidyr)
library(reshape2)
library(ggplot2)
library(ggridges)
library(ggalt)
library(forcats)
library(data.table)
library(tidyverse)
library(viridis)
library(plotly)

Load Data set

corona <- fread(file = "Corona-Monitor/2-Daten/CoronaMonitorAll.csv", encoding = "UTF-8") %>%
  as_tibble()

Prepare Data

# Select variables,recode them, and calculate grouped means for homeoffice,
# without gender distinctions
corona_gender_1 <- corona %>%
  filter(sex %in% c("Mann", "Frau"), !(kanton %in% "Auslandschweizer/in")) %>%
  select(Welle, HHeinkommen, homeoffice, sex, weight) %>%
  mutate(homeoffice_ja = case_when(
    homeoffice %in% c("Nein, das ist in meinem Beruf nicht möglich.",
                      "Nein, die Vorgesetzten erlauben es nicht",
                      "Nein, das ist nicht möglich",
                      "Nein, das möchte ich nicht",
                      "Nein") ~ 0,
    homeoffice %in% c("Ja, ich arbeite nur noch im Home Office",
                      "Ja, ich arbeite jetzt zum Teil im Home Office ",
                      "Ich habe zuvor schon regelmässig im Home Office gearbeitet.",
                      "Ja, ich arbeite zurzeit nur im Home Office ",
                      "Ja, ich arbeite zurzeit teilweise im Home Office ",
                      "Ja, ich arbeite teilweise von zuhause",
                      "Ja, ich arbeite nur noch von zuhause") ~ 1)) %>%
  mutate(HHeinkommen = case_when(HHeinkommen == "4'000 bis 6‘000" ~ "4'000 bis 6'000 ",
                                 TRUE ~ HHeinkommen)) %>%
  mutate(HHeinkommen = na_if(HHeinkommen, y = ""),
         HHeinkommen = na_if(HHeinkommen, y = "Weiss nicht / keine Angabe"),
         HHeinkommen = factor(HHeinkommen, levels = c("Weniger als 4'000 ",
                                                          "4'000 bis 6'000 ",
                                                          "6'001 bis 10'000 ",
                                                          "10'001 bis 16'000 ",
                                                          "Über 16'000 "))) %>%
  drop_na() %>%
  group_by(Welle, HHeinkommen) %>%
  mutate(HHeinkommen = factor(HHeinkommen)) %>%
  summarize(sex = "Alle",
            pcent_homeoffice = 100*weighted.mean(homeoffice_ja, weight, na.rm = T), n = n())

# Select variables,recode them, and calculate grouped means for homeoffice,
# with gender distinctions
corona_gender_2 <- corona %>%
  filter(sex %in% c("Mann", "Frau"), !(kanton %in% "Auslandschweizer/in")) %>%
  select(Welle, HHeinkommen, homeoffice, sex, weight) %>%
  mutate(homeoffice_ja = case_when(
    homeoffice %in% c("Nein, das ist in meinem Beruf nicht möglich.",
                      "Nein, die Vorgesetzten erlauben es nicht",
                      "Nein, das ist nicht möglich",
                      "Nein, das möchte ich nicht",
                      "Nein") ~ 0,
    homeoffice %in% c("Ja, ich arbeite nur noch im Home Office",
                      "Ja, ich arbeite jetzt zum Teil im Home Office ",
                      "Ich habe zuvor schon regelmässig im Home Office gearbeitet.",
                      "Ja, ich arbeite zurzeit nur im Home Office ",
                      "Ja, ich arbeite zurzeit teilweise im Home Office ",
                      "Ja, ich arbeite teilweise von zuhause",
                      "Ja, ich arbeite nur noch von zuhause") ~ 1)) %>%
  mutate(HHeinkommen = case_when(HHeinkommen == "4'000 bis 6‘000" ~ "4'000 bis 6'000 ",
                                 TRUE ~ HHeinkommen)) %>%
  mutate(HHeinkommen = na_if(HHeinkommen, y = ""),
         HHeinkommen = na_if(HHeinkommen, y = "Weiss nicht / keine Angabe"),
         HHeinkommen = factor(HHeinkommen, levels = c("Weniger als 4'000 ",
                                                          "4'000 bis 6'000 ",
                                                          "6'001 bis 10'000 ",
                                                          "10'001 bis 16'000 ",
                                                          "Über 16'000 "))) %>%
  drop_na() %>%
  group_by(Welle, HHeinkommen, sex) %>%
  mutate(HHeinkommen = factor(HHeinkommen)) %>%
  summarize(pcent_homeoffice = 100*weighted.mean(homeoffice_ja, weight, na.rm = T),
            n = n(), .groups = "keep")

# Combine the two newly generated data sets and group them by survey wave,
# income, and gender
corona_gender <- bind_rows(corona_gender_1, corona_gender_2) %>%
  select(pcent_homeoffice, Welle, HHeinkommen, sex) %>%
  spread(key = sex, value = pcent_homeoffice) %>%
  mutate(pcent_homeoffice_m = Mann, pcent_homeoffice_f = Frau) %>%
  gather(key = sex, value = pcent_homeoffice, -HHeinkommen,-Welle,
         -pcent_homeoffice_m, -pcent_homeoffice_f) %>%
  mutate(Haushaltseinkommen = (factor(HHeinkommen)),
         sex = factor(sex, levels = c("Frau", "Alle", "Mann"))) %>%
  arrange(Welle,Haushaltseinkommen, sex)

corona_gap <- corona_gender %>%
  filter(sex %in% c("Mann", "Frau","Alle")) %>%
  select(pcent_homeoffice, Welle, Haushaltseinkommen, sex) %>%
  spread(key = sex, value = pcent_homeoffice) %>%
  mutate(gap_m_f = Mann - Frau) %>%
  mutate(Welle = factor(Welle,levels = c(1,2,3,4,5),
                       labels = c("März","April","Mai","Juni","Oktober")))

Generate visualizations 1-4

# Small multiple for Activities outside, by income and gender
corona_df1 <- corona %>%
  filter(!Welle %in% 5, sex %in% c("Mann", "Frau"), !(kanton %in% "Auslandschweizer/in")) %>%
  select(HHeinkommen, ausserHaus_SQ001, ausserHaus_SQ002,ausserHaus_SQ003,
         ausserHaus_SQ004,ausserHaus_SQ005,ausserHaus_SQ006,ausserHaus_SQ007,
         ausserHaus_SQ008,ausserHaus_SQ009,ausserHaus_SQ010,ausserHaus_SQ011,
         ausserHaus_XX, sex, weight) %>%
  mutate(HHeinkommen = case_when(HHeinkommen == "4'000 bis 6‘000" ~ "4'000 bis 6'000 ",
                                 TRUE ~ HHeinkommen)) %>%
  mutate(HHeinkommen = na_if(HHeinkommen, y = ""),
         HHeinkommen = na_if(HHeinkommen, y = "Weiss nicht / keine Angabe"),
         HHeinkommen = factor(HHeinkommen, levels = c("Weniger als 4'000 ",
                                                          "4'000 bis 6'000 ",
                                                          "6'001 bis 10'000 ",
                                                          "10'001 bis 16'000 ",
                                                          "Über 16'000 "))) %>%
  mutate(Einkaufen = case_when(
    ausserHaus_SQ001 %in% "Einkaufen: Selected" ~ 1,
    ausserHaus_SQ001 %in% "Einkaufen: Not selected" ~ 0)) %>%
  mutate(Arbeit = case_when(
    ausserHaus_SQ002 %in% "Arbeit: Selected" ~ 1,
    ausserHaus_SQ002 %in% "Arbeit: Not selected" ~ 0)) %>%
  mutate(Arzt = case_when(
    ausserHaus_SQ003 %in% "Arztbesuch oder ähnliches: Selected" ~ 1,
    ausserHaus_SQ003 %in% "Arztbesuch oder ähnliches: Not selected" ~ 0)) %>%
  mutate(Freizeit = case_when(
    ausserHaus_SQ004 %in% "Sport: Selected" ~ 1,
    ausserHaus_SQ005 %in% "Wanderungen: Selected" ~ 1,
    ausserHaus_SQ006 %in% "Spaziergänge: Selected" ~ 1,
    ausserHaus_SQ007 %in% "Kinderspielplatz: Selected" ~ 1,
    ausserHaus_SQ008 %in% "Freunde/Bekannte in anderen Wohnungen treffen: Selected" ~ 1,
    ausserHaus_SQ009 %in% "Freunde/Bekannte draussen treffen: Selected" ~ 1,
    ausserHaus_SQ010 %in% "Ausflüge an andere Orte: Selected" ~ 1,
    ausserHaus_SQ004 %in% "Sport: Not selected" ~ 0,
    ausserHaus_SQ005 %in% "Wanderungen: Not selected" ~ 0,
    ausserHaus_SQ006 %in% "Spaziergänge: Not selected" ~ 0,
    ausserHaus_SQ007 %in% "Kinderspielplatz: Not selected" ~ 0,
    ausserHaus_SQ008 %in% "Freunde/Bekannte in anderen Wohnungen treffen: Not selected" ~ 0,
    ausserHaus_SQ009 %in% "Freunde/Bekannte draussen treffen: Not selected" ~ 0,
    ausserHaus_SQ010 %in% "Ausflüge an andere Orte: Not selected" ~ 0)) %>%
    mutate(Zuhause = case_when(
    ausserHaus_SQ011 %in% "Ich bleibe zuhause: Selected" ~ 1,
    ausserHaus_XX %in% "Ich bleibe zuhause: Selected" ~ 1,
    ausserHaus_SQ011 %in% "Ich bleibe zuhause: Not selected" ~ 0,
    ausserHaus_XX %in% "Ich bleibe zuhause: Not selected" ~ 0)) %>%
  group_by(HHeinkommen, sex) %>%
  mutate(HHeinkommen = factor(HHeinkommen))

corona_Einkaufen1 <- corona_df1 %>%
  summarize(Einkaufen = 100*weighted.mean(Einkaufen, weight, na.rm = T),
            n = n(), .groups = "keep")
corona_Arbeit1 <- corona_df1 %>%
  summarize(Arbeit = 100*weighted.mean(Arbeit, weight, na.rm = T),
            n = n(), .groups = "keep")
corona_Zuhause1 <- merge(corona_Einkaufen1,corona_Arbeit1)
corona_Arzt1 <- corona_df1 %>%
  summarize(Arzt = 100*weighted.mean(Arzt, weight, na.rm = T),
            n = n(), .groups = "keep")
corona_Zuhause1 <- merge(corona_Zuhause1,corona_Arzt1)
corona_Freizeit1 <- corona_df1 %>%
  summarize(Freizeit = 100*weighted.mean(Freizeit, weight, na.rm = T),
            n = n(), .groups = "keep")
corona_Zuhause1 <- merge(corona_Zuhause1,corona_Freizeit1)
corona_Daheim1 <- corona_df1 %>%
  summarize(Nie = 100*weighted.mean(Zuhause, weight, na.rm = T),
            n = n(), .groups = "keep")
corona_Zuhause1 <- merge(corona_Zuhause1,corona_Daheim1) %>%
  drop_na()

corona_AusserH1 <- corona_Zuhause1 %>%
  select(HHeinkommen, sex, Einkaufen, Arbeit,Arzt,Freizeit,
         Nie) %>%
  gather(key = ausserHaus, value = Value, 3:7) %>%
  mutate(Haushaltseinkommen = (factor(HHeinkommen)),
         sex = factor(sex, levels = c("Mann", "Frau"))) %>%
  arrange(Haushaltseinkommen, sex) %>%
  mutate(ausserHaus = factor(ausserHaus, levels = c("Arbeit","Arzt","Nie","Freizeit","Einkaufen")))


corona_AusserH1$Value[corona_AusserH1$sex == "Mann"] <- -corona_AusserH1$Value[corona_AusserH1$sex == "Mann"]

breaks_values <-  pretty(corona_AusserH1$Value)

q = ggplot(data = corona_AusserH1) +
  aes(x = Haushaltseinkommen, y = Value, fill = sex) +
  geom_bar(stat = "identity") + 
  ggpol::facet_share(~sex, dir = "h", scales = "free", reverse_num = TRUE) +
  coord_flip() +
  scale_fill_viridis_d(aesthetics = "fill", option='plasma',begin = 0.02, end = 0.4) +
  labs(title = "Ärmere blieben eher zuhause als Reiche",
       subtitle = '"Wofür haben Sie in den letzten sieben Tagen Ihre Wohnung / Ihr Haus verlassen?"',
       caption = "Daten: Forschungsstelle sotomo (Corona-Monitor, 4 Wellen),
                    N = 111'771 Befragte, repräsentativ gewichtet",
       y = "Anteil Befragte (%)", x = "Haushaltseinkommen", fill = "Geschlecht") +
  scale_y_continuous(breaks = breaks_values,
                     labels = abs(breaks_values))
  
  
sm_income <- q + facet_grid(~ ausserHaus)
sm_income