R-Code Blogbeitrag

Setup

rm(list = ls(all.names = TRUE))
require(pacman)
p_load(tidyverse, readxl)
df_geger <- read.csv("geschlechtergerechter_data.csv", na.strings = "")
df_codebook <- read_xlsx("geschlechtergerechter_codebook.xlsx")

Recoding

# Dummy-Variable für sexuelle Orientierung (heterosexuell - nicht-heterosexuell)

df_geger <- df_geger %>%
  mutate(sexOrientation = 
           ifelse(sexOrientation == "A6", NA, sexOrientation)) %>%
  mutate(sexorientqueer = 
           case_when(sexOrientation %in% c("A1", "A3", "A4", "A5") ~ 1,
                     sexOrientation == "A2" ~ 0))
  
table(df_geger$sexorientqueer)[2]/(sum(table(df_geger$sexorientqueer)))
# Anteil nicht-heterosexuell ca. 10.6%

# Variable für Zugehörigkeit zu einer der 4 Gruppen

df_geger <- df_geger %>% 
  mutate(group = as.factor(case_when(
    gender == "M" & sexorientqueer == 0 ~ "Männer, heterosexuell",
    gender == "M" & sexorientqueer == 1 ~ "Männer, nicht-heterosexuell",
    gender == "W" & sexorientqueer == 0 ~ "Frauen, heterosexuell",
    gender == "W" & sexorientqueer == 1 ~ "Frauen, nicht-heterosexuell")))

# "partei", "linksrechts": 1 links, 4 mitte, 7 rechts, "edu"

df_geger <- df_geger %>%
  mutate(partei = ifelse(partei %in% c("svp", "sp", "fdp", "mitte", 
                                       "gps", "glp", "evp", NA), partei, "-oth-"),
         linksrechts = ifelse(linksrechts %in% c("lire1", "lire2", "lire3",
                                                 "lire4", "lire5", "lire6",
                                                 "lire7"), linksrechts, NA),
         edu = recode_factor(edu, 
        "A1" = "kein Bildungsabschluss, obligatorische Schule",
        "A2" = "Berufliche Grundausbildung (Berufslehre/Berufsschule/Handelsschule)",
        "A3" = "Gymnasium, Berufsmatura, FMS, DMS",
        "A4" = "Höhere Fach- und Berufsausbildung (HF, HFP, HTL usw.)",
        "A5" = "ETH, Universität, PH, Fachhochschule")) %>% 
  mutate(
    linksrechts = recode(linksrechts,
                            "lire1" = 1, "lire2" = 2, "lire3" = 3,
                            "lire4" = 4, "lire5" = 5, "lire6" = 6, "lire7" = 7),
    partei = recode_factor(partei,
                           "svp" = "SVP", "sp" = "SP", "fdp" = "FDP",
                           "mitte" = "Mitte", "gps" = "GPS", "glp" = "GLP",
                           "evp" = "EVP", "-oth-" = "Other")
         )

# "kanton"

df_geger <- df_codebook %>% 
  filter(Fragecode == "kanton") %>%
  select(c(Antwortcode, Antwortlabel)) %>% 
  mutate(kanton = as.integer(Antwortcode)) %>% 
  right_join(df_geger, by = "kanton", multiple = "all") %>% 
  select(-c(Antwortcode, kanton)) %>% 
  rename(kanton = Antwortlabel)

# Variable für Altersgruppe => "age_group"

df_geger <- df_geger %>%
  mutate(age_group = case_when(
    age %in% seq(18,29) ~ "18-29", age %in% seq(30,49) ~ "30-49",
    age %in% seq(50,64) ~ "50-64", age %in% seq(65,max(df_geger$age)) ~ "65+"))

# "engagementForMale", "engagementForFemale", "feminist", "dienstpflicht",
# "quoten", "register", "childcareSalary", "careSalary", "elternurlaub"

df_geger <- df_geger %>%
  mutate(across(c(engagementForMale, engagementForFemale, feminist, dienstpflicht,
                  quoten, register, childcareSalary, careSalary, elternurlaub), 
                recode_factor, "A1" = "Ja", "A2" = "Eher ja", 
                "A3" = "Eher nein", "A4" = "Nein"))

# "gendergap"

df_geger <- df_geger %>% 
  mutate(gendergap = recode_factor(gendergap,
                                   "A1" = "Ja", "A2" = "Eher ja", 
                                   "A3" = "Eher nein", "A4" = "Nein",
                                   "A5" = "Es gibt keine Lohnlücke"))

Plot 1

c <- "Daten: Forschungsstelle Sotomo (geschlechtergerechter, Oktober 2021)"
group_levels <- c("Männer, nicht-heterosexuell", "Männer, heterosexuell",
                  "Frauen, nicht-heterosexuell")
# Data frame für plot

df_lire <- df_geger %>% 
  filter(!is.na(group)) %>% 
  group_by(gender, sexorientqueer) %>% 
  summarize(Dlire = weighted.mean(linksrechts, weight, na.rm = TRUE)) %>% 
  mutate(sexorientqueer = recode_factor(sexorientqueer, "0" = "heterosexuell",
                                        "1" = "nicht-heterosexuell"),
         gender = recode(gender, "M" = "Männer", "W" = "Frauen"))

# Plot

plot1 <- ggplot(df_lire , aes(x = gender, y = Dlire)) +
  geom_col(aes(fill = sexorientqueer), width = .3, position = "dodge") +
  coord_flip(ylim = c(1,7)) +
  scale_fill_manual(
    "sexorientqueer", 
    values = c("nicht-heterosexuell" = "pink", "heterosexuell" = "darkblue"),
    breaks = c("nicht-heterosexuell", "heterosexuell")) +
  scale_y_continuous(breaks = seq(1,7,1.5)) +
  theme_light() +
  theme(axis.text.x = element_text(size = 10), axis.text.y = element_text(size = 11),
        strip.text.x = element_text(size = 11),
        plot.caption = element_text(size = 10, face = "italic")) +
  labs(title = "Queers schätzen sich im Durchschnitt linker ein als Heterosexuelle",
       subtitle = 
         "Durchschnittliche Selbsteinstufung auf einer Skala von 1 (links) bis 7 (rechts)",
       caption = c, x = "", y = "") +
  guides(fill = guide_legend(title = "sexuelle Orientierung"))

plot1

ggsave("plot1.1.png", plot1)

# Verteilung von "age group" für nicht-heterosexuelle

table(df_geger[which(df_geger$group == "Frauen, nicht-heterosexuell"),371])

## age_group
## 18-29 30-49 50-64   65+ 
##    34    55    24    11

# etwas wenige Beobachtungen für 65+ (n = 11)

table(df_geger[which(df_geger$group == "Männer, nicht-heterosexuell"),371])

## age_group
## 18-29 30-49 50-64   65+ 
##    18    52    38    37

# etwas wenige Beobachtungen für 18-29 (n = 18)

# Durchschnittliche links-rechts Selbsteinschätzung über alle Altersgruppen

df_geger %>% 
  filter(!is.na(group)) %>% 
  group_by(group) %>% 
  summarize(Dlire = weighted.mean(linksrechts, weight, na.rm = TRUE)) %>% 
  mutate(DelDlire = Dlire - lead(Dlire))

## # A tibble: 4 × 3
##   group                       Dlire DelDlire
##   <fct>                       <dbl>    <dbl>
## 1 Frauen, heterosexuell        3.69    0.422
## 2 Frauen, nicht-heterosexuell  3.27   -0.825
## 3 Männer, heterosexuell        4.10    0.237
## 4 Männer, nicht-heterosexuell  3.86   NA

Plot 2

# Data frame für Plot

df_partei <- df_geger %>%
  filter(!is.na(partei), !is.na(group)) %>%
  group_by(partei, group) %>%
  count(wt = weight) %>%
  group_by(group) %>%
  mutate(Anteil = n / sum(n)) %>%
  filter(partei %in% c("SVP","FDP","Mitte","GLP","SP","GPS")) %>% 
  mutate(partei = fct_relevel(partei, c("GPS","SP","GLP","Mitte","FDP","SVP"))) %>% 
  group_by(partei) %>% 
  mutate(DelAnt = Anteil - lag(Anteil), 
         Delgroup = c(rep("Frauen", 2), rep("Männer", 2)),
         sign = ifelse(DelAnt > 0, TRUE, FALSE)) %>% 
  filter(row_number() %% 2 != 1) %>%
  select(-c(group, n, Anteil))
# Plot  

plot2 <- ggplot(df_partei, aes(x = partei, y = DelAnt)) +
  geom_point(aes(color = sign), size = 3) +
  geom_segment(
    aes(x = partei, xend = partei, y = 0, yend = DelAnt, color = sign)) +
  geom_text(aes(label = sprintf("%.0f%%", 100*DelAnt), vjust = .5, 
            hjust = ifelse(DelAnt > 0, -1, 2)),
            size = 3, color = "black") +
  scale_color_manual(name = "sign", values = c("FALSE" = "red", "TRUE" = "blue")) +
  coord_flip(ylim = c(-.15,.15)) +
  facet_wrap(~Delgroup) +
  scale_y_continuous(labels = scales::percent) +
  theme_light() +
  theme(legend.position = "none", axis.text.x = element_text(size = 10),
        axis.text.y = element_text(size = 11), strip.text = element_text(size = 11),
        plot.caption = element_text(size = 10, face = "italic")) +
  labs(title = "Keine Sympathieverluste für die SVP bei queeren Frauen",
       subtitle = "Parteisympathie von Queers im Vergleich zu Heterosexuellen",
       caption = c, x = "", y = "")

plot2

ggsave("plot2.1.png", plot2)

Plot 3

# Parteien

p <- c("SVP","FDP","Mitte","GLP","SP","GPS")

# Frauenquoten

Fr_quoten <- 
unique(df_codebook[which(df_codebook$Fragecode == "quoten"),2])$Frage
df_quoten <- df_geger %>%
  filter(!is.na(quoten), !is.na(sexorientqueer),
         gender != "-oth", partei %in% p) %>%
  group_by(quoten, gender, sexorientqueer) %>%
  count(wt = weight) %>%
  group_by(gender, sexorientqueer) %>%
  mutate(Anteil = n / sum(n),
         Dquoten = ifelse(quoten %in% c("Ja", "Eher ja"), "JA", "NEIN")) %>%
  group_by(gender, sexorientqueer, Dquoten) %>%
  mutate(DAnteil = sum(Anteil)) %>% 
  filter(quoten == "Ja") %>% 
  select(-quoten) %>% 
  mutate(opinion = "Frauenquoten")

# Registereintrag weiteres Geschlecht

Fr_register <- 
unique(df_codebook[which(df_codebook$Fragecode == "register"),2])$Frage
df_register <- df_geger %>%
  filter(!is.na(register), !is.na(sexorientqueer),
         gender != "-oth-", partei %in% p) %>%
  group_by(register, gender, sexorientqueer) %>%
  count(wt = weight) %>%
  group_by(gender, sexorientqueer) %>%
  mutate(Anteil = n / sum(n), 
         Dregister = ifelse(register %in% c("Ja", "Eher ja"), "JA", "NEIN")) %>%
  group_by(gender, sexorientqueer, Dregister) %>%
  mutate(DAnteil = sum(Anteil)) %>% 
  filter(register == "Ja") %>% 
  select(-register) %>% 
  mutate(opinion = "Zusätzlicher Eintrag")

# Kinderbetreuung

Fr_childcare <- 
unique(df_codebook[which(df_codebook$Fragecode == "childcareSalary"),2])$Frage
df_childcare <- df_geger %>% 
  filter(!is.na(childcareSalary), !is.na(sexorientqueer),
         gender != "-oth-", partei %in% p) %>% 
  group_by(childcareSalary, gender, sexorientqueer) %>% 
  count(wt = weight) %>% 
  group_by(gender, sexorientqueer) %>% 
  mutate(Anteil = n / sum(n),
         Dchildcare = ifelse(childcareSalary %in% c("Ja", "Eher ja"), "JA", "NEIN")) %>%
  group_by(gender, sexorientqueer, Dchildcare) %>% 
  mutate(DAnteil = sum(Anteil)) %>% 
  filter(childcareSalary == "Ja") %>% 
  select(-childcareSalary) %>% 
  mutate(opinion = "Finanzierung Kinderbetreuung")

# Gendergap

Fr_gendergap <- 
unique(df_codebook[which(df_codebook$Fragecode == "gendergap"),2])$Frage
df_gendergap <- df_geger %>%
  filter(!is.na(gendergap), !is.na(group), 
         gender != "-oth-", partei %in% p) %>%
  group_by(gendergap, gender, sexorientqueer) %>%
  count(wt = weight) %>%
  group_by(gender, sexorientqueer) %>%
  mutate(Anteil = n / sum(n),
         Dgendergap = ifelse(gendergap %in% c("Ja", "Eher ja"), "JA", "NEIN")) %>% 
  group_by(gender, sexorientqueer, Dgendergap) %>% 
  mutate(DAnteil = sum(Anteil)) %>% 
  filter(gendergap == "Ja") %>% 
  select(-gendergap) %>% 
  mutate(opinion = "Lohnlücke schliessen")

# Data frame für alle Meinungen

df_opinion <- rbind(df_quoten, df_register, df_childcare, df_gendergap)
df_opinion <- df_opinion[,-c(4,8:10)]
df_opinion$opinion <- as.factor(df_opinion$opinion)
df_opinion <- df_opinion %>% 
  mutate(opinion = fct_relevel(
          opinion, c("Frauenquoten", "Lohnlücke schliessen",
               "Finanzierung Kinderbetreuung", "Zusätzlicher Eintrag")),
         sexorientqueer = recode_factor(sexorientqueer, "0" = "heterosexuell",
                                        "1" = "nicht-heterosexuell"),
         gender = recode(gender, "M" = "Männer", "W" = "Frauen"))

# Plot

plot3 <- ggplot(df_opinion, aes(x = gender, y = DAnteil)) +
  geom_col(aes(fill = sexorientqueer), width = .3, position = "dodge") +
    coord_flip() +
  scale_fill_manual(
    "sexorientqueer", values = c("heterosexuell" = "darkblue", "nicht-heterosexuell" = "pink"),
    breaks = c("nicht-heterosexuell", "heterosexuell")) +
  facet_wrap(~opinion) +
  scale_y_continuous(labels = scales::percent) +
  theme_light() +
  theme(strip.text = element_text(size = 11), legend.title = element_text(size = 12),
        plot.caption = element_text(size = 10, face = "italic"),
        axis.text.x = element_text(size = 8), axis.text.y = element_text(size = 10),
        legend.text = element_text(size = 11)) +
  labs(title = "Kaum Unterstützung für Frauenquoten bei queeren Männern",
       subtitle = "Anteil der Personen, die folgende Politikmassnahmen unterstützen",
       caption = c, x = "", y = "") +
   guides(fill = guide_legend(title = "sexuelle Orientierung"))

plot3

ggsave("plot3.1.png", plot3)

Informationen zur Session

sessionInfo()

## R version 4.2.1 (2022-06-23)
## Platform: aarch64-apple-darwin20 (64-bit)
## Running under: macOS Ventura 13.1
## 
## Matrix products: default
## BLAS:   /Library/Frameworks/R.framework/Versions/4.2-arm64/Resources/lib/libRblas.0.dylib
## LAPACK: /Library/Frameworks/R.framework/Versions/4.2-arm64/Resources/lib/libRlapack.dylib
## 
## locale:
## [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
## 
## attached base packages:
## [1] stats     graphics  grDevices utils     datasets  methods   base     
## 
## other attached packages:
##  [1] readxl_1.4.1    forcats_1.0.0   stringr_1.5.0   dplyr_1.1.0    
##  [5] purrr_1.0.1     readr_2.1.3     tidyr_1.3.0     tibble_3.1.8   
##  [9] ggplot2_3.4.0   tidyverse_1.3.2 pacman_0.5.1   
## 
## loaded via a namespace (and not attached):
##  [1] lubridate_1.9.1     assertthat_0.2.1    digest_0.6.31      
##  [4] utf8_1.2.2          R6_2.5.1            cellranger_1.1.0   
##  [7] backports_1.4.1     reprex_2.0.2        evaluate_0.20      
## [10] highr_0.10          httr_1.4.4          pillar_1.8.1       
## [13] rlang_1.0.6         googlesheets4_1.0.1 rstudioapi_0.14    
## [16] jquerylib_0.1.4     rmarkdown_2.20      labeling_0.4.2     
## [19] textshaping_0.3.6   googledrive_2.0.0   munsell_0.5.0      
## [22] broom_1.0.3         compiler_4.2.1      modelr_0.1.10      
## [25] xfun_0.36           pkgconfig_2.0.3     systemfonts_1.0.4  
## [28] htmltools_0.5.4     tidyselect_1.2.0    fansi_1.0.4        
## [31] crayon_1.5.2        tzdb_0.3.0          dbplyr_2.3.0       
## [34] withr_2.5.0         grid_4.2.1          jsonlite_1.8.4     
## [37] gtable_0.3.1        lifecycle_1.0.3     DBI_1.1.3          
## [40] magrittr_2.0.3      scales_1.2.1        cli_3.6.0          
## [43] stringi_1.7.12      cachem_1.0.6        farver_2.1.1       
## [46] fs_1.6.0            xml2_1.3.3          bslib_0.4.2        
## [49] ellipsis_0.3.2      ragg_1.2.5          generics_0.1.3     
## [52] vctrs_0.5.2         tools_4.2.1         glue_1.6.2         
## [55] hms_1.1.2           fastmap_1.1.0       yaml_2.3.7         
## [58] timechange_0.2.0    colorspace_2.1-0    gargle_1.2.1       
## [61] rvest_1.0.3         knitr_1.42          haven_2.5.1        
## [64] sass_0.4.5

R-Code Blogbeitrag

Schweizer Queers wählen linker — aber nicht unbedingt auf Kosten der SVP

Lionel Saxer

08.01.2023

Setup

Recoding

Plot 1

Plot 2

Plot 3

Informationen zur Session