---
title: "Do Women Give Up More Easily? <br> Evidence from the Lab and the Dutch Math Olympiad"
author: "Anna-Lena Glatzel"
date: '2022-01-27'
output:
  html_document: 
      df_print: paged
  pdf_document: default
---

```{r setup, include=FALSE}

# Dieser Befehl sorgt dafür, dass zu jedem Output auch der
# entsprechende RCode angezeigt wird (echo = TRUE)
# sowie dass das Dokument auch geknittet werden kann, wenn
# ein Error im Code auftritt (error = TRUE)
knitr::opts_chunk$set(echo = TRUE, error = TRUE)

# Unerbinden von Warnungen
knitr::opts_chunk$set(warning = FALSE, message = FALSE) 

# Unterbinden stoerender Nachricht bei dplyr summmarise Befehl
options(dplyr.summarise.inform = FALSE)

```


```{r load packages, include=FALSE}

# Laden aller benoetigten Pakete
library(haven) ## stata einlesen
library(dplyr)
library(ggplot2)
library(plotrix) ## std.error
library(broom) ## für tidy Funktion
library(reshape2) ## für melt Funktion
library(estimatr)  # für lm_robust Funktion
library(modelsummary) # regressionsergebnisse vergleichend abbilden
library(rhandsontable) # für schöne Tabellen

```

## 0. Allgemeines

Die Autoren Thomas Buser und Huaiping Yuan widmen sich in ihrem Paper aus dem Jahr 2019 der Fragestellung wie sich Unterschiede im Geschlecht (Frauen vs. Männer) auf die Bereitschaft zum Wettbewerb als Reaktion auf Erfahrung (positive als auch negative) auswirkt.

Damit grenzen sie sich gegenüber vorangegangenen Studien ab, die sich bisher nur auf die einmalige Entscheidung an einem Wettbewerb teilzunehmen konzentrieren. 

Zur Untersuchung des Effekts werden einerseits Felddaten aus der niederländischen Matheolympiade und andererseits Daten aus drei Laborexperimenten verwendet.

Das Hauptergebnis ist, dass Frauen nach einem Rückschlag eher aufhören zu konkurrieren als Männer. In anderen Worten, nach einem "selbstverschuldeten" (als Ergebnis eigener Taten) Scheitern, treten Frauen seltener noch einmal zum gleichen Wettkampf an als Männer.

Mit diesem Ergebnis versuchen die Autoren zudem Rückschlüsse darauf zu ziehen, warum Frauen seltener Spitzenpositionen in Wirtschaft oder akademischen Bereich einnehmen, da gerade im beruflichen Umfeld die Bereitschaft wiederholt an Wettbewerben, z.B. Bewerbung auf eine andere Position, notwendig ist, um karrieretechnisch aufzusteigen.

\ 

## 1. Daten

Der gesamte Datensatz ist auf zwei Datensätze aufgeteilt. 
*`experiments.dta`* enthält die experimentellen Daten aus dem Labor, während in *`matholympiad.dta`* die Daten aus der niederländischen Matheolympiade enthalten sind.

Hier betrachten wir sowohl einen Teil der Laborexperimente, als auch die Daten aus dem Feld.

Daher werden beide Datensätze zunächst geladen und in den Variablen `dat.exp` bzw. `dat.olymp` gespeichert. Zum Einlesen des Dateiformats `.dta` (STATA) wird der Befehl `read_dta()` aus dem Paket `haven` verwendet.


```{r data}
# Definiere working directory und Ablageort der Daten

  DATA.FOLDER = "C:/Users/Admin/Documents/Master/2.Semester/Seminar R/data"
  setwd(DATA.FOLDER)

# Daten aus dem Experiment

  dat.exp = read_dta("experiments.dta")

# Daten der Mathe Olympiade

  dat.olymp = read_dta("matholympiad.dta")

```

Für einen ersten Überblick lassen sich mit `head()` die ersten 6 Zeilen des Datensatzes ausgeben, sowie mit `dim()` die Dimensionen ermitteln.
Da die experimentellen Daten eine Vielzahl an Variablen enthalten, verschaffen wir uns hier zusätzlich mit `colnames()` einen Überblick.

```{r data overview}

  # Labordaten

  # Ausgabe der ersten 6 Zeilen
  head(dat.exp)
  # Ausgabe der Dimensionen 
  dim(dat.exp)
  # Ausgabe der Spaltennamen
  colnames(dat.exp)

  # Felddaten
  
  # Ausgabe der ersten 6 Zeilen
  head(dat.olymp)
  # Ausgabe der Dimensionen
  dim(dat.olymp)

```

Der Datensatz aus dem Labor enthält 560 Datenpunkte, deren Beobachtungen in insgesamt 95 Variablen gespeichert sind und bereits den groben Aufbau der Experimente erahnen lassen (wie das Festhalten von Fehlern, Punkten und Auszahlungen über mehrere Runden). Mehr dazu in Kapitel 2.

Der Felddatensatz dagegen enthält ein deutlich größeres Sample mit 11591 Datensätzen, aber nur 13 Variablen. Auch hier wurde wieder eine erreichte Leistung in Punkten festgehalten. Mehr dazu in Kapitel 3.

Im Folgenden werden - entsprechend der Struktur des Papers - zunächst die Daten aus dem Labor betrachtet und anschließend die Fragestellung anhand der Felddaten aus der Matheolympiade untersucht und validiert. 

\ 

## 2. Laborexperimente

Die Autoren haben insgesamt 3 Experimente im Labor durchgeführt:

1. **Main**
2. **Feedback**
3. **Risk**

Dabei wird in *main* die grundlegende Fragestellung untersucht. *feedback* und *risk* erweitern das Hauptexperiment - wie ihr Name erahnen lässt - um die Komponenten Feedback und Risikoeinstellung.

\ 

### 2.1 Versuchsaufbau
#### 2.1.1 Main

Das Hauptexperiment besteht aus sechs bezahlten Runden. Pro Runde haben die Probanden drei Minuten Zeit, um so viele Additionsprobleme zu lösen wie möglich. Falsche Antworten werden nicht bestraft.
Vor dem Start der sechs Runden, gibt es eine Proberunde, nach der die Probanden Feedback darüber erhalten wie viele Aufgaben sie korrekt gelöst haben. Anschließend werden sie gebeten ihre Leistung für die nächste Runde im Vergleich zu allen anderen Teilnehmern einzuschätzen und sich einen entsprechenden Rang zu vergeben. Bei korrekter Einordnung (+/- 1) erhalten sie 2 Bonuspunkte. Dann starten die bezahlten Runden:

Vor Ausführung der Matheaufgaben müssen die Probanden angeben, wie sie für ihre Leistung entlohnt werden möchten. Sie können wählen zwischen: 

a) **Piece-Rate Pay:** Pro korrekter Aufgabe erhalten sie 1 Punkt im Wert von 0.25€ 
oder

b) **Competition Pay:** Pro korrekt gelöster Aufgabe erhalten sie 2 Punkte, falls sie besser abgeschnitten haben als ein zufällig ausgewählter anderer Teilnehmer oder 0 Punkte, falls sie schlechter sind.

Anschließend starten die 3min Bearbeitungszeit.
Nach Ablauf der Zeit erhalten die Teilnehmer Feedback entsprechend des gewählten Bezahlungsschemas:

Bei a): Information darüber wie viele Aufgaben korrekt gelöst wurden.

Bei b): Information darüber wie viele Aufgaben korrekt gelöst wurden sowie ob man gegen seinen zugelosten "Gegner" gewonnen oder verloren hat.

Dieser Ablauf wiederholt sich für alle 6 Runden, insbesondere müssen die Teilnehmer sich vor jeder Runde neu einschätzen (Ranking) und dürfen das Bezahlungsschema neu festlegen.
Nach der 6. Runde wird von jedem Teilnehmer noch das Geschlecht, Alter, Risikoeinstellung und Einschätzung zur eigenen Wettkampfbereitschaft erfragt.  

\ 

#### 2.1.2 Feedback

Das Feedbackexperiment geht über 4 Runden à 4 Minuten und ist identisch zum Hauptexperiment bis auf eine Änderung:
Alle Teilnehmer erhalten unabhängig des gewählten Bezahlungsschemas Feedback zu ihrer absoluten Performance (Punktanzahl) sowie ihrer relativen Performance (im Vergleich zu der ihnen zufällig zugeteilten Person).

\ 

#### 2.1.3 Risk

Das Risikoexperiment ist ebenfalls fast identisch zum Hauptexperiment. Hier besteht die einzige Abänderung in den möglichen Bezahlungsschemata. Die Teilnehmer wählen vor jeder der 6 Runden zwischen:

a) Piece-Rate Pay: 1 Punkt pro korrekter Aufgabe (identisch zu Main)
oder

b) Random Remuneration: mit einer zufällig zugeteilten Gewinnchance zwischen 30 und 70% erhalten die Teilnehmer 2 Punkte pro korrekt gelöster Aufgabe oder mit entsprechender Gegenwahrscheinlichkeit 0 Punkte. 
Das heißt, Gewinn bzw. Verlust ist rein zufallsbasiert und unabhängig der relativen Leistung zu anderen Teilnehmern. 



Im Datensatz lässt sich die Zugehörigkeit der Datenpunkte zu den Experimenten über die Spalte *"experiment"* erkennen. 
**Im Folgenden soll sich nur auf die Daten aus dem Mainexperiment fokussiert werden.** 

Für eine bessere Handhabung werden die Daten in einem seperaten Dataframe *exp.main* unter Verwendung des Befehls `filter()`aus dem `dplyr`package gespeichert.

```{r Laborexperimente - Datensatz filtern}

  # Neuer Dataframe, mit ausschließlich den Beobachtungen aus dem Hauptexperiment (Main)
  # In der Spalte "experiment" ist mit 1, 2, 3 die Zugehörigkeit des Datenpunkts 
  # zum jeweiligen Experiment codiert.
  # Main ist mit "1" gekennzeichnet.

  exp.main = dat.exp %>% 
                filter(experiment == 1)

```

\ 

### 2.2 Deskriptive Statistik

Für ein besseres Verständnis der Daten und Bedeutung der einzelnen Variablen, werden zunächst einige deskriptive Statistiken zur allgemeinen Performance, Selbstbewusstsein, Wettbewerbsbereitschaft etc. aller Teilnehmer, sowie getrennt nach Männern und Frauen betrachtet. (vgl. Buser & Yuan (2019), S.230)

Dazu werden pro Variable (Score, Belief, ...) die Werte aus allen 6 Runden zusammengefasst und hierfür Mittelwert (`mean()`) und Standardabweichung (`sd()`) berechnet - einerseits für alle Teilnehmer (`rowMeans()`) und andererseits separat für Männer und Frauen (`group_by()`, `summarize()`). Zudem wird der p-value aus t-Tests zwischen den Geschlechtern berechnet (`t.test()`).
Die Zwischenschritte werden in Hilfsvektoren zwischengespeichert und anschließend zu einer gemeinsamen Übersicht zusammengefügt. Da die Zwischenberechnungen selbst nur von geringer Relevanz sind, wird ihr Code im Folgenden nicht angezeigt.

```{r Laborexperiemente: Main - Deskriptive Statistik - Teilnehmer, echo = FALSE}
  
  # Anzahl an Beobachtungen = Anzahl an Teilnehmern
  o1 = nrow(exp.main)

  # Anzahl an Männern und Frauen
  o2 = exp.main %>% group_by(Gender) %>% summarize(Anzahl = n())
  
  # Vektor mit Werten für Übersicht
  o = as.numeric(c(o1, o2[1,2], o2[2,2], c(""))) %>% round(0)
  
```

```{r Laborexperimente: Main - Deskriptive Statistik: Score, echo =FALSE}

  # In einer neuen Hilfsspalte *Scores_all* werden zunächst die durchschnittliche Anzahl an erreichten Punkten
  # pro Individuum und  Session über alle Runden berechnet. Da die erste Runde (Scores1) lediglich die Proberunde
  # ist, wird diese bei der Berechnung ausgelassen.

  # Lege die neue Spalte an, die die durchschnittlich erreichte Punktzahl über alle Runden (2 bis 7) pro Minute berechnet
  exp.main = exp.main %>% mutate(Scores_all = rowMeans(exp.main %>% select(Scores2:Scores7)/3))
  
  # Berechne basierend auf Scores_all den Durchschnitt und die Standardabweichung 

  s1 = mean(exp.main$Scores_all)
  s2 = sd(exp.main$Scores_all)

  # Berechne nun den Durschnitt und die Standardabweichung seperat für Männer und Frauen
  s3 = exp.main %>% group_by(Gender) %>% summarize(Mean = mean(Scores_all), SD = sd(Scores_all))

  # p-value aus t-tests zwischen den Geschlechtern
  s4 = t.test(filter(exp.main, Gender == 1)$Scores_all, filter(exp.main, Gender == 2)$Scores_all)
  
  # Vektor für Übersicht
  s = as.numeric(c(s1, s3[1,2], s3[2,2], s4[3])) %>% round(2)
  s_sd = as.numeric(c(s2, s3[1,3], s3[2,3], c(""))) %>% round(2)
  
```

```{r Laborexperimente: Main - Deskriptive Statistik: Belief, echo =FALSE}

  #(hier Spalten 1-6)

  exp.main = exp.main %>% mutate(Conf_all = rowMeans(exp.main %>% select(c(Confidence1:Confidence5, Confidence6)), na.rm=T ))
  
  b1 = mean(exp.main$Conf_all)
  b2 = sd(exp.main$Conf_all)
  
  b3 = exp.main %>% group_by(Gender) %>% summarize(Mean = mean(Conf_all), SD = sd(Conf_all))
  
  b4 = t.test(filter(exp.main, Gender == 1)$Conf_all, filter(exp.main, Gender == 2)$Conf_all) 
  
  # Vektor für Übersicht
  b = as.numeric(c(b1, b3[1,2], b3[2,2], b4[3]))%>% round(2)
  b_sd = as.numeric(c(b2, b3[1,3], b3[2,3], c(""))) %>% round(2)

```

```{r Laborexperimente: Main - Deskriptive Statistik: Choosing Competition, echo =FALSE}

  # Da die Entscheidung, ob eine Person in einer Runde konkurrieren möchte binär ist, ist es sinnvoll die Spalten so umzukodieren, 
  # dass 0 = nein und 1 = ja bedeutet (aktuell als 1 und 2 kodiert).

  # Umkodieren der Spalten "Choices" in 0 und 1, indem von allen Werten 1 subtrahiert wird

  exp.main = exp.main %>% mutate(across(.cols = starts_with("Choices"), .fns = ~ .x-1))
  
  # Spalte anlegen, die die durchschnittliche Entscheidung pro Individuum über alle Runden enthält
  exp.main = exp.main %>% mutate(Comp_all = rowMeans(exp.main %>% select(c(Choices2:Choices7)), na.rm=T ))
  
  cc1 = mean(exp.main$Comp_all)
  cc2 = sd(exp.main$Comp_all)
  
  cc3 = exp.main %>% group_by(Gender) %>% summarize(Mean = mean(Comp_all), SD = sd(Comp_all))

  cc4 = t.test(filter(exp.main, Gender == 1)$Comp_all, filter(exp.main, Gender == 2)$Comp_all) 

  # Vektor für Übersicht
  cc = as.numeric(c(cc1, cc3[1,2], cc3[2,2], cc4[3]))%>% round(2)
  cc_sd = as.numeric(c(cc2, cc3[1,3], cc3[2,3], c(""))) %>% round(2)
  
```

```{r Laborexperimente: Main - Deskriptive Statistik: Earnings, echo =FALSE}

  exp.main = exp.main %>% mutate(Pay_all = rowMeans(exp.main %>% select(Payments2:Payments7)/3, na.rm=T ))
  
  e1 = mean(exp.main$Pay_all)
  e2 = sd(exp.main$Pay_all)
  
  e3 = exp.main %>% group_by(Gender) %>% summarize(Mean = mean(Pay_all), SD = sd(Pay_all))

  e4 = t.test(filter(exp.main, Gender == 1)$Pay_all, filter(exp.main, Gender == 2)$Pay_all)

  # Vektor für Übersicht
  e = as.numeric(c(e1, e3[1,2], e3[2,2], e4[3]))%>% round(2)
  e_sd = as.numeric(c(e2, e3[1,3], e3[2,3], c(""))) %>% round(2)
  
```

```{r Laborexperimente: Main - Deskriptive Statistik: Risk taking, echo =FALSE}
  
  r1 = mean(exp.main$Risk)
  r2 = sd(exp.main$Risk)
  
  r3= exp.main %>% group_by(Gender) %>% summarize(Mean = mean(Risk), SD = sd(Risk))
  
  r4 = t.test(filter(exp.main, Gender == 1)$Risk, filter(exp.main, Gender == 2)$Risk)
  
  # Vektor für Übersicht
  r = as.numeric(c(r1, r3[1,2], r3[2,2], r4[3]))%>% round(2)
  r_sd = as.numeric(c(r2, r3[1,3], r3[2,3], c(""))) %>% round(2)
```

```{r Laborexperimente: Main - Deskriptive Statistik: Competitiveness, echo =FALSE}

  c1 = mean(exp.main$CompetitionScale)
  c2 = sd(exp.main$CompetitionScale)
  
  c3 = exp.main %>% group_by(Gender) %>% summarize(Mean = mean(CompetitionScale), SD = sd(CompetitionScale))
  
  c4= t.test(filter(exp.main, Gender == 1)$CompetitionScale, filter(exp.main, Gender == 2)$CompetitionScale)

  # Vektor für Übersicht
  c = as.numeric(c(c1, c3[1,2], c3[2,2], c4[3])) %>% round(2)
  c_sd = as.numeric(c(c2, c3[1,3], c3[2,3], c(""))) %>% round(2)
  
```

\ 

#### Übersicht

```{r Laborexperimente: Main - Deskriptive Statistik: Gesamtübersicht }

  # Zusammenfassung der Vektoren aus obigen Berechnungen 
  stat = rbind(s, s_sd, b, b_sd, cc, cc_sd, e, e_sd, r, r_sd, c, c_sd, o)

  # Initialisiere Dataframe stat.main (vgl. Buser & Yuan (2019) S. 230) und
  # füge zusammengefasste Werte aus "stat" ein
  stat.main = data.frame(Scale =c("0-6.5","", "0-1","", "binary","", "0-0.325","", "0-10","", "0-10","",""), 
                         row.names = c("Score per Minute", "(SD) S", "Belief", "(SD) B", "Choosing Competition",
                                       "(SD) CC", "Earnings per Minute","(SD) E", "Risk taking", "(SD) R", "Competitiveness",
                                       "(SD) C", "Observations")) %>% 
                cbind(stat)
              
  # Spaltennamen festlegen
  colnames(stat.main) = c("Scale", "All", "Male", "Female", "p-value")
  
  # Ausgabe Übersicht in Tabellenform mittel 'rhandsontabl()' aus gleichnamigem Paket
   rhandsontable(stat.main) %>% hot_table(stretchH="all", rowHeaderWidth = 180)
   
```

Auf den ersten Blick erkennt man, dass Männer leicht besser abschneiden als Frauen - der Score per Minute der Männer beträgt 2.51, der der Frauen 2.36 - (jedoch nicht statistisch signifikant, p-value: 0.24).
Allerdings glauben Männer häufiger, dass sie besser abschneiden als ihre Konkurrenz (Belief) und haben eine höhere Bereitschaft zu konkurrieren (Choosing Competition), mit Werten von 0.53 (Männer) im Vergleich zu 0.41 (Frauen) und p-value 0.05. Zusätzlich schätzen sich Männer als risikofreudiger (Risk Taking) und kompetitiver (Competitiveness) ein als Frauen.


(Die Tabelle entspricht der Grafik "Deskriptive Statistik" der Präsentation auf Folie 6)

\ 

### 2.3 Willingness To Compete - Plots

Nach dieser ersten allgemeinen Übersicht, soll nun mehr ins Detail gegangen werden - insbesondere in Bezug auf die Bereitschaft zu konkurrieren (Willingness To Compete) im Zeitverlauf, sprich über die sechs Runden hinweg.

Hierfür werden zunächst drei Plots betrachtet, die den Anteil derer zeigen, die pro Runde gewählt haben zu konkurrieren, sprich ihre Leistung mit der eines zufälligen anderen zu vergleichen. (vgl. Buser & Yuan Online Appendix, S.34-36)

Zusätzlich werden pro Plot und Runde die p-values des Chi-Quadrat Tests ausgegeben (vgl. Buser & Yuan). Der Chi-Quadrat Test dient der Überprüfung, ob zwei kategorielle Variablen unabhängig voneinander sind.
Dafür werden die realen Werte mit Werten verglichen, die man erwarten würde, wenn es zwischen den Variablen keinerlei Beziehung gäbe. 

Hier sind die betrachteten Variablen: Geschlecht (männlich, weiblich) und Wahl zu Konkurrieren (ja, nein). Die zu betrachtende Nullhypothese H0 lautet: Geschlecht und Wahl zu Konkurrieren sind unabhängig.

Unterschreitet der p-value das gewählte Signifikanzniveau, wird H0 verworfen, sprich man kann davon ausgehen, dass eine Korrelation zwischen den Variablen besteht.



Für den ersten Plot wird der Code untenstehend angezeigt, da die beiden weiteren nahezu identisch erzeugt werden, wird hier auf den Code verzichtet. 


```{r Plot - Figure1}
  
  # Funktion zur Berechnung der Willingness To Compete, zugehöriger SE, 90% Konfidenzintervallgrenzen pro Runde und Geschlecht
  # Mithilfe der Funktion lassen sich PLot 2 und 3 schneller erzeugen
  # Als Input dient somit der entsprechende (Teil-)Datensatz und die Rundenzahl

  will2C = function(data, Round){
    
     x = data %>%
            select(Gender, .data[[Round]]) %>% 
            group_by(Gender) %>% 
            summarize(
              WillingToCompete = mean(.data[[Round]]),
              Standard_Error = std.error(.data[[Round]]),
              LowerConfInt90 = WillingToCompete - qnorm(1 - (1 - 0.90) / 2) * Standard_Error,
              UpperConfInt90 = WillingToCompete + qnorm(1 - (1 - 0.90) / 2) * Standard_Error)
     x      
  }

  # Anwenden der Funktion auf alle Runden mittels 'lapply()'

  w2c = 2:7 %>% 
    lapply(.,function(x){paste0("Choices",x)}) %>% 
    unlist() %>% 
    lapply(., will2C, data=exp.main)
  
  
  # Erstelle Dataframe aus einzelnen Listenelementen und füge eine Spalte hinzu, die die Runde kennzeichnet
  
  w2c_df = do.call(rbind, w2c) %>% 
            cbind(., Round= rep(x=c(1:6), each = 2))
      
     
  
  # Datentyp konvertieren für hübscheren Plot
  
  w2c_df$Gender = as.factor(w2c_df$Gender)
  w2c_df$Round = as.factor(w2c_df$Round)
  
  # Erzeuge Plot mit Daten aus w2c_df mithilfe der Funktion 'ggplot()' aus dem Paket 'ggplot2'
  
  figure1 = ggplot(w2c_df, aes(x = Round, y = WillingToCompete, color = Gender, linetype = Gender, group = Gender)) +
              geom_line(size = 1.5) +
              ylim(0.25, 0.7)+
              ggtitle("Bereitschaft zu Konkurrieren nach Geschlecht und Runde\n(n=188)", 
                      subtitle = "Hauptexperiment")+ 
              labs(caption = "Quelle: In Anlehnung an Buser & Yuan (2019)") +
              ylab("Konkurrierender Anteil") +
              xlab("Runde")+
              labs(color = "Geschlecht", linetype = "Geschlecht")+
              scale_color_manual(values = c(
                                "1" = "cyan3",
                                "2" = "deeppink2")
                                ) +
              theme(legend.position = "bottom")+
              geom_ribbon(data=w2c_df, aes(ymin=LowerConfInt90, ymax=UpperConfInt90), alpha=0.3)
  

  # Funktion zur Berechnung des Chi-Quadrat Tests pro Runde
  
  chi2test = function(data, Round){
    
    df = cbind(as.factor(data$Gender), as.factor(data[[Round]]))
    
    test = chisq.test(df[,1], df[,2], correct=F)
    
    c(Round, round(test[["p.value"]], 3)   )
  }

  # Erstelle Dataframe mit p-values aus chi2test pro Runde
  c2t = 2:7 %>% 
    lapply(.,function(x){paste0("Choices",x)}) %>% 
    unlist() %>% 
    lapply(., chi2test, data=exp.main) %>% 
    do.call(rbind, .) %>% 
    as.data.frame() %>% 
    rename("Runde" = V1 , "p-value" = V2) %>% 
    mutate(Runde = c(1,2,3,4,5,6))
 
  # Ausgabe des Plots 
  figure1
  
  # Ausgabe der Werte des Chi2Tests
  c2t
  
```

Der erste Plot zeigt die Teilnahmebereitschaft aller Probanden über alle Runden hinweg (die grauen Flächen zeigen das 90% Konfidenzintervall). Allgemein zeigt sich hier, dass Männer (Geschlecht = 1) prinzipiell mehr Bereitschaft zeigen zu konkurrieren als Frauen (Geschlecht = 2). Der Geschlechterunterschied ist dabei über die Runden recht ähnlich und schwankt zwischen 9 und 15 Prozentpunkten. 


(Der Plot entspricht der Grafik in der Präsentation auf Folie 7)

\ 

```{r Plot - Figure2, echo = FALSE }

  # Willingness to compete by gender and round (participants who chose competition in round 1)

  # Filter Datensatz exp.main nach den Personen, die in der ersten Runde "competetion" gewählt haben
  exp.main_comp1 = exp.main %>% 
                      filter(Choices2 == 1)


  # benutze Funktion w2c, zur Berechnung der Willingness to Compete für alle Runden, mit neuem Datensatz

  w2c_comp1 = 2:7 %>% 
    lapply(.,function(x){paste0("Choices",x)}) %>% 
    unlist() %>% 
    lapply(., will2C, data=exp.main_comp1)
  
  
  # erstelle Dataframe  
  w2c_df_comp1 = do.call(rbind, w2c_comp1) %>% 
                  cbind(., Round= rep(x=c(1:6), each = 2)) %>% 
                  mutate(Gender = as.factor(Gender), Round = as.factor(Round))

  
  # Plot
  figure2 = ggplot(w2c_df_comp1 , aes(x = Round, y = WillingToCompete, color = Gender, linetype = Gender, group = Gender)) +
              geom_line(size = 1.5) +
              ylim(0.4, 1.0)+
              ggtitle("Bereitschaft zu Konkurrieren nach Geschlecht und Runde\n(Teilnehmer, die in der ersten Runde 'Compete'\ngewählt haben) (n=92)", 
                      subtitle = "Hauptexperiment")+ 
              labs(caption = "Quelle: In Anlehnung an Buser & Yuan (2019)") +
              ylab("Konkurrierender Anteil") +
              xlab("Runde")+
              labs(color = "Geschlecht", linetype = "Geschlecht")+
              scale_color_manual(values = c(
                                            "1" = "cyan3",
                                            "2" = "deeppink2")
                                            ) +
              theme(legend.position = "bottom")+
              geom_ribbon(aes(ymin=LowerConfInt90, ymax=UpperConfInt90), alpha=0.3)
  
  figure2
  
  # Berechnung der p-values unter Verwendung der chi2test Funktion - starte bei Runde 2, da Runde 1 identisch (alle wählen competition)
  c2t_comp1 = 3:7 %>% 
    lapply(.,function(x){paste0("Choices",x)}) %>% 
    unlist() %>% 
    lapply(., chi2test, data=exp.main_comp1) %>% 
    do.call(rbind, .) %>% 
    as.data.frame() %>% 
    rename("Runde" = V1 , "p-value" = V2) %>% 
    mutate(Runde = c(2,3,4,5,6))
  
  # Ausgabe der Werte
  c2t_comp1
  
```

Plot 2 zeigt die Bereitschaft nur derer, die in der ersten Runde "Competition" gewählt haben (Runde 1: Konkurrierender Anteil = 100% ). Interessant zu beobachten ist, dass selbst hier sich ab Runde 2 eine große Lücke zwischen den Geschlechtern auftut. In Runde 2 sind es noch ca. 87% der Männer, aber nur noch 65% der Frauen (p=0.02) und in Runde 4 sind es 77% vs. 55% (p=0.03).
(Die grauen Flächen markieren wieder das 90% Konfidenzintervall).


(Der Plot entspricht der Grafik in der Präsentation auf Folie 8)

\ 

```{r Plot - Figure3, echo = FALSE}

  # Willingness to compete by gender and round (participants who did NOT choose competition in round 1, but piece rate)

  # Filter Datensatz exp.main nach den Personen, die in der ersten Runde "competetion" gewählt haben
  exp.main_pr1 = exp.main %>% 
                      filter(Choices2 == 0)


  # benutze Funktion w2c, zur Berechnung der Willingness to Compete für alle Runden, mit neuem Datensatz
  w2c_pr1 = 2:7 %>% 
    lapply(.,function(x){paste0("Choices",x)}) %>% 
    unlist() %>% 
    lapply(., will2C, data=exp.main_pr1)
  
  
  # erstelle Dataframe  
  w2c_df_pr1 = do.call(rbind, w2c_pr1) %>% 
                cbind(., Round= rep(x=c(1:6), each = 2)) %>% 
                mutate(Gender = as.factor(Gender), Round = as.factor(Round))

  
  # Plot
  figure3 = ggplot(w2c_df_pr1 , aes(x = Round, y = WillingToCompete, color = Gender, linetype = Gender, group = Gender)) +
              geom_line(size = 1.5) +
              ylim(0, 0.5)+
              ggtitle("Bereitschaft zu Konkurrieren nach Geschlecht und Runde\n(Personen, die in der ersten Runde 'Piece Rate'\ngewählt haben) (n=96)", 
                      subtitle = "Hauptexperiment")+ 
              labs(caption = "Quelle: In Anlehnung an Buser & Yuan (2019)") +
              ylab("Konkurrierender Anteil") +
              xlab("Runde")+
              labs(color = "Geschlecht", linetype = "Geschlecht")+
              scale_color_manual(values = c(
                                          "1" = "cyan3",
                                          "2" = "deeppink2")
                                          ) +
              theme(legend.position = "bottom")+
              geom_ribbon(aes(ymin=LowerConfInt90, ymax=UpperConfInt90), alpha=0.3)
  
  figure3
  
  # Berechnung der p-values unter Verwendung der chi2test Funktion - starte bei Runde 2, da Runde 1 identisch (alle wählen piece rate)
  c2t_pr1 = 3:7 %>% 
    lapply(.,function(x){paste0("Choices",x)}) %>% 
    unlist() %>% 
    lapply(., chi2test, data=exp.main_pr1) %>% 
    do.call(rbind, .) %>% 
    as.data.frame() %>% 
    rename("Runde" = V1 , "p-value" = V2) %>% 
    mutate(Runde = c(2,3,4,5,6))
  
  # Ausgabe der Werte
  c2t_pr1
  
```

Plot 3 zeigt als Gegenstück zu Plot 2 die Bereitschaft derer, die sich in der ersten Runde für "Piece-Rate" und damit gegen "Competition" entschieden haben. Nach der ersten Runde, entscheiden sich ca. gleich viele Männer und Frauen in der 2.Runde um und wechseln zu "Competition" (Männer 29%, Frauen 33% (p=0.72)). In den folgenden Runden lässt die Bereitschaft bei beiden Geschlechtern wieder nach, wobei es bei den Frauen diesmal weniger sind als bei den Männern - jedoch ist der Unterschied nicht signifikant.
(Die grauen Flächen markieren wieder das 90% Konfidenzintervall).

\ 

### 2.4 OLS Regression

Eben jene graphischen Effekte werden nun mittels OLS Regression untersucht und validiert. (vgl. Buser & Yuan, S.231ff.)

\

#### 2.4.1 Geschlechterunterschied im Wettbewerbsantritt pro Runde allgemein (n = 188)

Zunächst wird die reine "Willingness To Compete" (d.h. die Bereitschaft zu Konkurrieren) pro Runde betrachtet.
Hierfür wird das Geschlecht auf einen binären Indikator für die Entscheidung zu Konkurrieren regressiert.

Als Kontrollvariablen dienen die absolute Performance und die Gewinnchance (= Rang, normalisiert mit der Anzahl an Teilnehmern pro Session) aus Runde 1.
Zusätzlich kontrollieren alle Regressionen nach Session Fixed Effects [Beobachtungen wurden über mehrer Sessions gesammelt]; Standardfehler sind robust.

Das Ergebnis wird in der Variablen `ols_reg` gespeichert. 

```{r OLS-Regression}
  
  # Berechnung der OLS Regressionen von Geschlecht auf Willingness To Compete pro Runde
  # Vorab: Aufbereitung der Daten in einem Dataframe im Longformat mittels 'melt' aus dem Paket 'reshape2' 
  # für eine einfachere Berechnung der einzelnen Regressionen

  ols_reg = melt(data.frame(Female =       exp.main$Gender,       # erklärende Variable
                            Performance1 = exp.main$Scores2,      # Kontrollvariable
                            Rank1_norm =   exp.main$Rank2,        # Kontrollvariable
                            sessionId =    exp.main$session_id,   # Fixed Effects
                            Round1 = exp.main$Choices2,           # Willingness To Compete pro Runde
                            Round2 = exp.main$Choices3, 
                            Round3 = exp.main$Choices4, 
                            Round4 = exp.main$Choices5, 
                            Round5 = exp.main$Choices6,
                            Round6 = exp.main$Choices7
                            ),
                            # Angabe der Variablen (eigene Spalte)
                            id.vars = c("Female","Performance1","Rank1_norm","sessionId")) %>% 
  
              # Umbenennung der Spalten in aussagekräftigere Begriffe
              rename("Runde" = variable, "WTC" = value) %>% 
              # Gruppierung nach Runde, da Regression pro Runde berechnet wird
              group_by(Runde) %>%                                                           
              # Berechnung der Regressionen pro Runde
              # 'lm_robust' aus dem Paket 'estimatr' für robuste Standardfehlerberechnung
              # 'tidy' aus dem Paket 'broom' für eine übersichtlichere Ausgabe
              do(tidy(lm_robust(WTC ~ Female + Performance1 + Rank1_norm,
                                data = ., fixed_effects = ~ sessionId, se_type = "stata" ))) %>% 
              # Filtern des Ergebnisses nach der relevanten Variable (Female) für mehr Übersichtlichkeit
              filter(term == "Female")

  # Ausgabe der Regressionsergebnisse
  ols_reg
  
 
```

Die Werte der Spalte "estimate" für den Genderdummy lassen bereits erkennen, dass Männer prinzipiell eine höhere Bereitschaft haben zu konkurrieren als Frauen. Der Effekt bewegt sich über die Runden hinweg zwischen 9 und 15 Prozentpunkten. 

(Die Ergebnisse der Regression entsprechenen denen auf Folie 7 der Präsentation)

```{r OLS-Regression Alternative, include = FALSE}
  
  # alternativ mit felm Befehl: kontrolliert für Performance, Rang, Session und hat robuste SE

  library(lfe)
  fe_reg = melt(data.frame(Female =       exp.main$Gender,
                           Performance1 = exp.main$Scores2,
                           Rank1_norm =   exp.main$Rank2,
                           sessionId =    exp.main$session_id,
                           Round1 = exp.main$Choices2,
                           Round2 = exp.main$Choices3, 
                           Round3 = exp.main$Choices4, 
                           Round4 = exp.main$Choices5, 
                           Round5 = exp.main$Choices6,
                           Round6 = exp.main$Choices7
                           ),
                           id.vars = c("Female","Performance1", "Rank1_norm","sessionId")) %>% 
            rename("Runde" = variable, "WTC" = value) %>% 
            group_by(Runde) %>% 
            do(tidy(felm(WTC ~ Female + Performance1 + Rank1_norm | sessionId | 0 | 0 , data = .), se.type = "robust")) %>% 
            filter(term == "Female")
 

```



```{r OLS Regression Funktion}

  # Funktion für schnellere Berechnung der anderen Regressionen auf Teildaten von exp.main
  # Schritte ähneln vorangegangerer Berechnung von 'ols_reg'
  
  fun.ols_reg = function(data){
      
      melt(data.frame(Female =        data$Gender,
                      Performance1 =  data$Scores2,
                      Rank1_norm =    data$Rank2,
                      Outcome1 =   data$Outcomes2,
                      sessionId =  data$session_id,
                      Round2 = data$Choices3, 
                      Round3 = data$Choices4, 
                      Round4 = data$Choices5, 
                      Round5 = data$Choices6,
                      Round6 = data$Choices7
                    ),
                    id.vars = c("Female", "Performance1", "Rank1_norm", "Outcome1", "sessionId")) %>%  
              rename("Runde" = variable, "WTC"= value) %>% 
              group_by(Runde) %>% 
              do(tidy(lm_robust(WTC ~ Female + Performance1 + Rank1_norm + Outcome1,
                                data = ., fixed_effects = ~ sessionId, se_type = "stata" ))) %>%
              filter(term == "Female")
                      
  }
  
```  

\ 

#### 2.4.2 Geschlechterunterschied im Wettbewerbsantritt pro Runde der Kompetitiven in Runde 1 (n = 92) 

Nun werden nur diejenigen betrachtet, die in der ersten Runde sich kompetitiv verhalten haben, sprich "Compete" gewählt haben.
Das Vorgehen zur vorherigen Regression ist identisch, bis auf, dass die erste Runde wegfällt und der Outcome aus Runde (Gewinn oder Verlust) als Kontrollvariable aufgenommen wird.  

```{r OLS Regression Variante 2}  
  
 # Berechnung der Regression mithilfe oben definierter Funktion 'fun.ols_reg()' auf Teildatensatz exp.main_comp1  
 ols_reg_comp1 = fun.ols_reg(exp.main_comp1)

 ols_reg_comp1

```

Das Ergebnis zeigt, dass selbst bei den Teilnehmern, die in der ersten Runde die Herausforderung gewählt haben, in den Folgerunden sich eine größe Lücke zwischen den Geschlechtern auftut, ob "Competetion" oder "Piece-Rate" gewählt wird:

In Runde 2 ist es ca. 21 Prozentpunkte weniger wahrscheinlich, dass eine Frau nochmals antritt, als ein Mann mit identischen Parametern wie die Frau in Runde 1. Auch in den Folgerunden hält dieser Effekt an.

(Die Ergebnisse der Regression entsprechenen denen auf Folie 8 der Präsentation)

\ 

#### 2.4.3 Geschlechterunterschied im Wettbewerbsantritt pro Runde der Nicht-Kompetitiven in Runde 1 (n = 96)

Als Gegenstück zu den kompetitiven Teilnehmern werden auch für diejenigen, die das sichere Bezahlschema in der ersten Runde gewählt haben Regressionen für die Runden 2-6 berechnet.
Die Berechnung erfolgt identisch zu 2.4.2.

```{r OLS Regression Variante 3}

 # Berechnung der Regression mithilfe oben definierter Funktion 'fun.ols_reg()' auf Teildatensatz exp.main_pr1  
 ols_reg_pr1 = fun.ols_reg(exp.main_pr1) 

 ols_reg_pr1
 
```

Das Ergebnis zeigt, dass bei denen, die bereits in Runde 1 das sichere Bezahlschema wählen, der geschlechterspezifische Unterschied in den Folgerunden "Competition" zu wählen sehr gering bzw. zu vernachlässigen ist. 

\ 

#### 2.4.4 Geschlechterunterschied im Effekt des Verlierens auf die anschließende Bereitschaft zu Konkurrieren

Anknüpfend an das Ergebnis aus 2.3.2, soll nun untersucht werden, ob diese geschlechterspezifische Diskrepanz unter denjenigen, die in der ersten Runde am Wettkampf teilnehmen, möglicherweise auf das Ergebnis dieser ersten Runde zurückzuführen ist. D.h. ob der Erfolg oder Misserfolg in der ersten Runde zu einer geschlechterspezifischen Reaktion führt. 
Insbesondere soll damit die Frage beantwortet werden, ob Frauen im Zuge einer Niederlage eher "aufgeben" als Männer. (vgl. Buser & Yuan, S.233 ff.)



Hierfür soll zunächst wieder graphisch ein Überblick über die verschiedenen Entscheidungen von Männern und Frauen geschaffen werden.

```{r Figure 4, echo = FALSE}

  # Datenaufbereitung für Plot
  fig4_stat = exp.main_comp1 %>% 
                # Zählen wie oft ein Teilnehmer "Competition" gewählt hat -> rowSums über Dummyspalten Choices
                mutate(TimesCompeting = rowSums(exp.main_comp1 %>% select(c(Choices3:Choices7)), na.rm = T)) %>% 
                # Gruppieren nach Geschlecht und Ergebnis der ersten Runde
                group_by(Gender, Outcomes2) %>% 
                # Berechnung des Durchschnittwerts der Anzahl an Wettkampfrunden, sowie zugehöriger Standardfehler und 90%       Konfidenzintervall
                summarize(
                          TimesCompeting_Mean = mean(TimesCompeting), 
                          SE = std.error(TimesCompeting),
                          LowerConfInt95 = TimesCompeting_Mean - qnorm(1 - (1 - 0.90) / 2) * SE,
                          UpperConfInt95 = TimesCompeting_Mean + qnorm(1 - (1 - 0.90) / 2) * SE)

  # Umbennung für lesbareren Plot
  fig4_stat = fig4_stat %>% 
              mutate(Gender = ifelse(Gender == 1, "Männer", "Frauen"),
                     Outcomes2 = ifelse(Outcomes2 == 0, "Verloren", "Gewonnen"))

  # Plotgenerierung
  figure4 = ggplot(fig4_stat, aes(x=as.factor(Outcomes2), y=TimesCompeting_Mean, fill=Gender, width = 0.5) ) +
                geom_bar( stat="identity") +
                geom_errorbar(aes(ymin = fig4_stat$LowerConfInt95, ymax=fig4_stat$UpperConfInt95), size = 0.5, width = 0.2)+
                facet_wrap(as.factor(fig4_stat$Gender))+
                ggtitle("Durchschnittliche Rundenzahl, in denen 'Competition' gewählt\nwurde nach Geschlecht und Ergebnis in der ersten Runde", 
                                  subtitle = "Hauptexperiment (Competition in Runde 1)")+
                ylab("Anzahl Runden, in denen konkurriert wurde (Runde 2-6)") +
                xlab("Ergebnis in Runde 1")+
                labs(caption = "Quelle: In Anlehnung an Buser & Yuan (2019)") +
                theme_gray()+
                theme(legend.position = "bottom")+
                scale_fill_manual(values = c(
                                          "Männer" = "cyan3",
                                          "Frauen" = "deeppink2")
                                          ) 
  
    
  # Ausgabe Plot
  figure4
  
```

\ 

Der Plot zeigt, aufgetrennt nach Geschlecht und nach Ergebnis der ersten Runde (Gewinn oder Niederlage), die durchschnittliche Anzahl an Runden, in denen ein Individuum wieder "Competition" gewählt hat. (Errorbars repräsentieren 90% Konfidenzintervall).

Bei beiden Geschlechtern wählen die, die in der ersten Runde erfolgreich waren, wieder den Wettkampf. 
Bei den Verlierern der ersten Runde zeigt sich jedoch ein großer geschlechterspezifischer Unterschied. Männer, die in der ersten Runde verlieren treten durchschnittlich nochmals in 2.6 von 5 Runden an, während es bei den Frauen nur 1.1 Runden sind. 

(Der Plot entspricht der Grafik auf Folie 9 der Präsentation)

\ 

Zur Bestätigung der statistischen Signifikanz und der Robustheit des geschlechterspezfischen Unterschieds in der Reaktion auf eine Niederlage, soll nun eine weitere OLS Regression geschätzt werden. 

Dazu wird ein binärer Indikator für "Competition" auf einen Geschlechterdummy, einen binären Indikator für Niederlage in der ersten Runde und die Interaktion der beiden sowie die relative Performance aus Runde 1 regressiert. (Jede Entscheidung ist eine eigene Beobachtung und Standardfehler werden auf individueller Ebene geclustert. Außerdem wird für den normalisierten Rang der ersten Runde kontrolliert und Berücksichtigung von Score Fixed Effects.) Das Ergebnis wird in der Variable `ols_reg2` gespeichert.

Zusätzlich wird eine zweite Regression geschätzt (`ols_reg3`) - nun aber ausschließlich für die besten Individuen der ersten Runde (Top 50%). So soll überprüft werden, ob sich auch ein Geschlechterunterschied bei denen zeigt, die eigentlich einen positiven erwarteten Return von der Teilnahme am Wettkampf haben.

```{r Table 3}

  # Erstelle Dataframe mit benötigten Variablen im Longformat wie bei vorherigen Regressionen 
  # Da Standardfehler auf individueller Ebene geclustert werden, wird zusätzlich die Subject_id aufgenommen
  ols_reg2 = melt(data.frame(Female =     exp.main_comp1$Gender,
                             Outcome1 =   exp.main_comp1$Outcomes2,
                             Rank1_norm = exp.main_comp1$Rank2,
                             ScoresFE =   exp.main_comp1$Scores2,
                             Subject =    exp.main_comp1$subject_id,
                             Round2 = exp.main_comp1$Choices3, 
                             Round3 = exp.main_comp1$Choices4, 
                             Round4 = exp.main_comp1$Choices5, 
                             Round5 = exp.main_comp1$Choices6,
                             Round6 = exp.main_comp1$Choices7
                             ),
                             id.vars = c("Subject","Female","Outcome1", "Rank1_norm", "ScoresFE")) %>% 
                # da Female original mit Werten 1 und 2 kodiert ist, wird hier umkodiert,
                # sodass 0 = Mann, 1 = Frau und Outcome2 original mit 0 = Niederlage und 
                # 1 = Gewinn kodiert ist, wird die Variable so umkodiert, dass 1 = Niederlage
                mutate(
                  Female_recoded = Female - 1, 
                  Outcome1_recoded = Outcome1 * (-1) + 1 
                  ) %>% 
                rename("WTC" = value) %>% 
                # robuste OLS Regression eines Geschlechterdummies, Erfolgsdummies (Runde1) und 
                # deren Interaktionseffekt auf die Willingness To Compete in den Folgerunden (aggregiert)
                # Kontrollvariable: Rang, Score Fixed Effects und clustered standard errors auf 
                # individueller Ebene
                lm_robust(WTC ~ Female_recoded + Outcome1_recoded + Female_recoded*Outcome1_recoded + Rank1_norm, 
                          data = ., fixed_effects = ~ ScoresFE, clusters = Subject, se_type = "stata" )
  
```

```{r Regression Top50}

  # Filter der Top 50% - Teilnehmer mit Gewinnchance über 50% basierend auf ihrem relativen Rang 
  # nach der ersten Runde
  top50 = exp.main_comp1 %>% 
    filter(Rank2>=0.50)
  
  # identisches Vorgehen wie für ols_reg2, nur auf Basis der Top 50
  ols_reg3 = melt(data.frame(Female =     top50$Gender,
                             Outcome1 =   top50$Outcomes2,
                             Rank1_norm = top50$Rank2,
                             ScoresFE =   top50$Scores2,
                             Subject =    top50$subject_id,
                             Round2 = top50$Choices3, 
                             Round3 = top50$Choices4, 
                             Round4 = top50$Choices5, 
                             Round5 = top50$Choices6,
                             Round6 = top50$Choices7
                             ),
                             id.vars = c("Subject","Female","Outcome1", "Rank1_norm", "ScoresFE")) %>% 
                mutate(
                  Female_recoded = Female - 1, 
                  Outcome1_recoded = Outcome1 * (-1) + 1 
                  ) %>% 
                rename("WTC" = value) %>% 
                lm_robust(WTC ~ Female_recoded + Outcome1_recoded + Female_recoded*Outcome1_recoded + Rank1_norm, 
                          data = ., fixed_effects = ~ ScoresFE, clusters = Subject, se_type = "stata" )
  
 
  # Gemeinsame Darstellung der Modell mittels modelsummary() aus gleichnamigem Package.
  modelsummary(list("All" = ols_reg2, "Top 50" = ols_reg3))
  
```

Die Ergebnisse der ersten Regression zeigen, dass der Geschlechterunterschied in Reaktion auf eine Niederlage auch robust gegenüber relativer und absoluter Performance ist. Während sich bei männlichen Verlierern die weitere Teilnahe am Konkurrieren um ca. 24 Prozentpunkte reduziert, sind es bei den Frauen mit 59 Prozentpunkten mehr als doppelt so viele.

Unter den Top 50 ist der Effekt sogar noch etwas größer: während Männer sich von der Niederlage kaum irritieren lassen (ca. 15 PP ), nehmen leistungsstarke Frauen, die in der ersten Runde verlieren rund 56 PP weniger wahrscheinlich in den Folgerunden am Wettkampf teil, als leistungsstarke Frauen, die gewonnen haben.

(Die Ergebnisse entsprechen denen auf Folie 9 der Präsentation)

\ 

## 3. Niederländische Matheolympiade

Mithilfe der Daten von der Niederländischen Matheolypmiade soll nun überprüft werden, ob sich die Effekte aus den Laborexperiementen auch im Feld beobachten lassen.

Dazu benutzen die Autoren den Regression Discontinuity Ansatz. Dieser bietet sich an, da Gewinnen oder Verlieren von einem strikten Cutoff abhängt - alle darüber gewinnen, alle darunter verlieren. Der Cutoff selbst wird so gewählt, dass eine gewisse TopN weiterkommt. Nahe an der Grenze ist es also mehr oder weniger willkürlich, ob man zu den Gewinnern oder Verlieren zählt und ermöglicht daher die kausale Schätzung des Effekts von Verlieren auf die Teilnahme im nächsten Jahr. (vgl. Buser & Yuan, S.243 ff.)

Klassisch würde man nach Regression Discontinuity Design also den Effekt von einer Niederlage auf die Wahrscheinlichkeit im nächsten Jahr nochmals anzutreten  schätzen. Die Besonderheit hier ist, dass zudem der Geschlechterunterschied im Effekt von Verlieren auf die Teilnahme im Folgejahr untersucht wird.

Die Autoren stellen folgende Regressionsgleichung auf:

\ 

  $Y_i = alpha + delta_1 · T_i + delta_2 · F_i + delta_3 · T_i · F_i + f(s) + f(s) · F_i + f(s_i) · T_i + f(s_i) · T_i · F_i + eps_i$
  
\ 

  - Y:       binärer Indikator, ob i im nächsten Jahr erneut teilgenommen hat
  - T:       binärer Indikator, ob i oberhalb des Cutoffs lag (d.h. in die zweite Runde gekommen ist)
  - F:       binärer Indikator, ob i weiblich ist
  - f(s):    Polynomfunktion von der Anzahl an erreichten Punkten s (Empfehlung: quadratisch)
  - delta_3: Schätzer, der den Unterschied zwischen Männern und Frauen in ihrer Reaktion auf Verlieren anzeigt
  - f(s)·T:  Interaktionsterm, um unterschiedliche Steigungen vor und hinter dem Cutoff zuzulassen
  - f(s)·F bzw. f(s)·F·T: Interaktionsterm, um unterschiedliche Steigungen pro Geschlecht zuzulassen

\ 


### 3.1 Deskriptive Statistik  

Zunächst soll wieder ein Überblick über die Daten mittels einiger deskriptiver Statistiken geschaffen werden.

Hierfür wird einerseits die Geschlechterverteilung im Datensatz angegeben, die Anteile pro Geschlecht der besten Schüler, die in die nächste Runde gekommen sind, sowie die Anteile nach Geschlecht derer, die im nächsten Jahr erneut an der Olympiade teilgenommen haben.
Für derarte Berechnungen bieten sich die Befehle `group_by()`, `summarise()` und `mutate()`aus dem `dpylr` Paket an. 

```{r Mathe Olympiade - Deskriptive Statistik}
  
  # Geschlechterverteilung
  dat.olymp %>% 
      group_by(gender) %>% 
      summarise(
        Anzahl = round(n(),2), 
        Anteil = round((n()/nrow(dat.olymp)),2)) %>% 
      mutate(gender = ifelse(gender == 0, "männlich", "weiblich"))

 
  
  # getrennte Datensätze für beide Geschlechter 
  olymp.male = dat.olymp %>% filter(gender == 0)
  olymp.female = dat.olymp %>% filter(gender == 1)
 
  # Anteil, die zu den besten gehört haben
  olymp.male %>% 
      group_by(T) %>% 
      summarise(Top1000 = round(n()/nrow(olymp.male),2)) %>%
      mutate(Geschlecht = "männlich") %>% 
      rbind(
        olymp.female %>% 
          group_by(T) %>% 
          summarise(Top1000 = round(n()/nrow(olymp.female),2)) %>% 
          mutate(Geschlecht = "weiblich")
      )

  
  # Anteil, die ein Jahr später wieder antreten
  olymp.male %>%
      group_by(y) %>% 
      summarise(ErneuteTeilnahme = round(n()/nrow(olymp.male),2)) %>% 
      mutate(Geschlecht = "männlich") %>% 
      rbind(
        olymp.female %>% 
          group_by(y) %>% 
          summarise(ErneuteTeilnahme = round(n()/nrow(olymp.female),2)) %>% 
          mutate(Geschlecht = "weiblich")
      )
  
```

Von insgesamt 11591 Teilnehmern sind 63% männlich und 37% weiblich.
14% der männlichen Teilnehmern und 9% der weiblichen erzielen ein Ergebnis überhalb des Thresholds und qualifizieren sich damit für die nächste Runde.
Zudem nehmen im nächsten Jahr 47% der männlichen und 42% der weiblich Teilnehmer unabhängig ihrer Leistung im ersten Jahr erneut teil.

\ 


Folgender Plot zeigt nochmals die Verteilung nach Geschlecht und die zugehörigen Leistungen im ersten Jahr. Der Score ist so normalisiert, dass 0 die Grenze markiert, ab der die Teilnehmer in die nächste Runde gekommen sind (sprich: "gewonnen haben").

\ 

```{r Plot Performance, echo= FALSE}

  # Plot der Performance 
  figure5 =  ggplot(dat.olymp %>% 
                      mutate(Geschlecht = ifelse(gender == 0, "Männlich", "Weiblich")),
                    aes(x=NetScore, color = Geschlecht, fill = Geschlecht)) + 
              geom_histogram(binwidth = 2, center = 1, position = "identity") +
              scale_color_manual(values=c("Männlich" = "grey", "Weiblich" = "grey")) +
              scale_fill_manual(values=c("Männlich" = "cyan3", "Weiblich" = "deeppink2")) +
              geom_vline(aes(xintercept=0), color="black",linetype="dashed")+
              ylab("Anzahl")+
              xlab("Score (normalisiert)")+
              labs(caption = "Quelle: In Anlehnung an Buser & Yuan (2019)") +
              ggtitle("Performance Verteilung nach Geschlecht\nim ersten Jahr")+
              theme(legend.position = "bottom")
              

  figure5
 
```

(Der Plot entspricht der Grafik auf Folie 10 der Präsentation)

\ 

### 3.2 Regression Disconitinuity (bzw. Dif-in-Dif)

Wie bereits oben beschrieben sollen nun Regressionsanalysen durchgeführt werden, um zu überprüfen, ob es einen geschlechterspezifischen Unterschied in der Bereitschaft nochmals anzutreten gibt. 

Hierfür betrachten wir zunächst wieder graphisch wie die Bereitschaft der Teilnahme im nächsten Jahr um den Cutoff ("gewonnen/verloren") für die beiden Geschlechter aussah.



```{r Datensatztransformation, echo=FALSE}

  # Transformiere Datensatz dat.olymp
  # Erstelle Hilfsvariablen zur Berechnung des Anteils je Leistung und Geschlecht derer,
  # die im nächsten Jahr wieder teilgenommen haben (share_again)
  x1 = dat.olymp %>% 
          group_by(NetScore, gender) %>% 
          summarize(all = n())
  x2 = dat.olymp %>% 
          filter(y == 1) %>% 
          group_by(NetScore, gender) %>% 
          summarize(again = n())
  share_again = cbind(x1, x2$again) %>% 
          mutate(share = `...4`/all) %>% 
          select(NetScore, gender, share)
  
  # Erzeuge Dummy T_lost, der angibt, ob ein Individuum besser oder schlechter als der Threshold war
  # Joine berechnete Anteile (share_again) an Originaldatensatz
  dat.olymp = dat.olymp %>% 
          mutate(T_lost = ifelse(T==0, 1, 0)) %>% 
          inner_join(., share_again, by= c("NetScore" = "NetScore", "gender" = "gender"), keep = F)
  

```

#### 3.2.1 Regression Discontinuity Graphen

Panel A zeigt die Schätzung mittels linearem Ansatz und für eine Bandweite von +/-5 um den Cutoff, sprich betrachtet nur die Individuen, die knapp "gewonnen" bzw. "verloren" haben.

Panel B zeigt das ganze mittels quadratischem Ansatz und für eine Bandweite von +/-10 um den Cutoff von 0.

\ 

```{r Plot Regression Discontinuity Graphs }

  # Filter Datensatz nach Bandweite +/- 5
  olymp_5 = dat.olymp %>% 
              filter(NetScore %in% c(-5:4)) %>% 
              mutate(Geschlecht = ifelse(gender == 0, "Männlich", "Weiblich"))
  
  ggplot(olymp_5, aes(x =NetScore, y=share,  color = Geschlecht)) + 
    geom_count(data = filter(olymp_5, gender == 1), alpha=0.2) + 
    geom_count(data = filter(olymp_5, gender == 0), alpha=0.2) +
    ylim(0.2,1) + 
    geom_vline(aes(xintercept = -0.5)) +
    geom_smooth(data = filter(olymp_5, NetScore <0 & gender == 1), method = "lm", formula = y~x)+
    geom_smooth(data = filter(olymp_5, NetScore >=0 & gender == 1), method = "lm", formula = y~x)+
    geom_smooth(data = filter(olymp_5, NetScore <0 & gender == 0), method = "lm", formula = y~x)+
    geom_smooth(data = filter(olymp_5, NetScore >=0 & gender == 0), method = "lm", formula = y~x)+
    ylab("Teilnahme im nächsten Jahr")+
    xlab("Punktzahl in der ersten Runde (normiert)")+
    labs(caption = "Quelle: In Anlehnung an Buser & Yuan (2019)") +
    scale_x_continuous(labels = olymp_5$NetScore, breaks = olymp_5$NetScore)+
    ggtitle(label = "Regression Discontinuity Graph A (Linear)")+
    theme(legend.position="bottom")+
    scale_color_manual(values=c("Männlich" = "cyan3", "Weiblich" = "deeppink2"))

  
  # Filter Datensatz nach Bandweite +/- 10
  olymp_10 = dat.olymp %>% 
              filter(NetScore %in% c(-10:9)) %>% 
              mutate(Geschlecht = ifelse(gender == 0, "Männlich", "Weiblich"))
  
  ggplot(olymp_10, aes(x =NetScore, y=share,  color = Geschlecht)) + 
    geom_count(data = filter(olymp_10, gender == 1), alpha=0.2) + 
    geom_count(data = filter(olymp_10, gender == 0), alpha=0.2) +
    ylim(0.2,1) + 
    geom_vline(aes(xintercept = -0.5)) +
    geom_smooth(data = filter(olymp_10, NetScore <0 & gender == 1), method = "lm", formula = y~poly(x,2))+
    geom_smooth(data = filter(olymp_10, NetScore >=0 & gender == 1), method = "lm", formula = y~poly(x,2))+
    geom_smooth(data = filter(olymp_10, NetScore <0 & gender == 0), method = "lm", formula = y~poly(x,2))+
    geom_smooth(data = filter(olymp_10, NetScore >=0 & gender == 0), method = "lm", formula = y~poly(x,2))+
    ylab("Teilnahme im nächsten Jahr")+
    xlab("Punktzahl in der ersten Runde (normiert)")+
    labs(caption = "Quelle: In Anlehnung an Buser & Yuan (2019)") +
    scale_x_continuous(labels = olymp_10$NetScore, breaks = olymp_10$NetScore)+
    ggtitle(label = "Regression Discontinuity Graph B (Quadratisch)")+
    theme(legend.position="bottom")  +
    scale_color_manual(values=c("Männlich" = "cyan3", "Weiblich" = "deeppink2"))

```

In beiden Grafiken ist gut zu erkennen, dass die Regressionslinien der Mädchen einen deutlich größeren Sprung am Cutoff (0) machen, als die der Jungen, die beinahe nahtlos ineinander übergehen.

\ 

#### 3.2.2 Regression Discontinuity Ergebnisse

Im Folgenden werden vier (leicht vereinfachte) Regressionen geschätzt mit variierender Bandweite von +/- 4, 8, 11 und 20 Punkte vom Cutoff. Die Breiten sind so gewählt, dass darin ca. 25, 50, 75 und 100% der Daten liegen. 

Mittels `filter()` werden zunächst vier Subsets erstellt.

```{r Regression Discontinuity Bandweiten}

  # Individuen +/- 4 Punkte um den Cutoff 
  olymp_4= dat.olymp %>% filter(NetScore %in% c(-4:3))

  # Individuen +/- 8 Punkte um den Cutoff
  olymp_8 =  dat.olymp %>% filter(NetScore %in% c(-8:7))

  # Individuen +/- 11 Punkte um den Cutoff
  olymp_11 = dat.olymp %>% filter(NetScore %in% c(-11:10))
  
  # Individuen +/- 20 Punkte um den Cutoff
  olymp_20 = dat.olymp %>% filter(NetScore %in% c(-20:19))
  
``` 

Anschließend wird für jedes der Subsets eine Regression (mittels `lm_robust()`) eines binären Indikators für die Teilnahme im Folgejahr (y) auf einen Geschlechter Dummy (gender, mit 1 = weiblich), einen Niederlagen Dummy (T_lost, 1 = nicht in die nächste Runde gekommen) und dem Interaktionsterm der beiden geschätzt - Standardfehler sind geclustert nach NetScore. Die Art der Berechnung gleicht einem Difference-In-Difference Ansatz und ist eine etwas vereinfachte Form der weiterführenden linearen und quadratischen Diskontinuitätsanalysen der Autoren - da diese aber bereits durch die Plots widergespiegelt wurden, belassen wir es an dieser Stelle mit den DiD Berechnungen. 

Mittels `modelsummary()` werden die Ergebnisse übersichtlich nebeneinander dargestellt. 

```{r Regressionen}

  # Dif - in - Dif

  DiD_4  = lm_robust(y ~ T_lost + gender + T_lost*gender, data = olymp_4, clusters=NetScore, se_type = "stata")

  DiD_8  = lm_robust(y ~ T_lost + gender + T_lost*gender, data = olymp_8, clusters=NetScore, se_type = "stata")
  
  DiD_11 = lm_robust(y ~ T_lost + gender + T_lost*gender, data = olymp_11, clusters=NetScore, se_type = "stata")
 
  DiD_20 = lm_robust(y ~ T_lost + gender + T_lost*gender, data = olymp_20, clusters=NetScore, se_type = "stata")
  
  
  modelsummary(list("-/+ 4" = DiD_4,"-/+ 8" = DiD_8, "-/+ 11" =DiD_11,"-/+ 20" = DiD_20),
               stars = TRUE, title = "Regression Discontinuity Results - Dif-in-Dif", output = "markdown")

```  

Der Geschlechterunterschied in der Reaktion auf eine Niederlage ist hier im Interaktionsterm der Dummies "gender" und "T_lost" ersichtlich und für alle Bandweiten siginifikant negativ.

(Die Ergebnisse entsprechen der Tabelle auf Folie 12 der Präsentation)

```{r Plot Range für verschiedene Bandweiten, echo = FALSE}  
  
  # Berechnung der Regressionskoeffizienten für weitere Bandweiten 
  # Zusammenfassung in gemeinschaftlichem Dataframe für anschließende Visualisierung
  range = data.frame(
    range_est = c(-0.09824221, -0.10498794,-0.11335462,-0.09014197,-0.06162176,
                  -0.07082799, -0.06640628, -0.06966719, -0.06349966),
    range_se = c( 0.06712271, 0.04322761,  0.03574142 , 0.03440127, 0.03551187,
                  0.03171906, 0.02863691,  0.02665637, 0.02493404)
    ) %>% 
  mutate(
      confint_low = range_est - 1.64* range_se,
      confint_high = range_est +1.64* range_se
    )
  
  figure6 = ggplot(range, aes(y=range_est, x=c(2:10))) + 
                geom_point() + 
                geom_hline(yintercept = 0, color="red")+
                geom_errorbar(aes(ymin = confint_low, ymax = confint_high, width = 0.1), color = "black", alpha = 0.2)+
                ylim(-0.3,0.3) +
                ylab("Geschlechteruntschied im Effekt einer Niederlage")+
                xlab("Bandweiten")+
                labs(caption = "Quelle: In Anlehnung an Buser & Yuan (2019)") +
                ggtitle("Discontinuity Schätzer für variierende Bandweiten (Dif-in-Dif)")+
                theme_bw()
              
  
  figure6
  
```

Der Plot zeigt nochmals übersichtlich die Schätzer (mit 90% Konfidenzintervall) für die Bandbreiten 2 bis 10, die wie man sieht stets unterhalb der 0 liegen.
Das bedeutet, dass Mädchen als Reaktion auf die Niederlage im ersten Jahr, im Folgejahr mit geringer Wahrscheinlichkeit erneut teilnehmen, als Jungen.

(Der Plot entspricht der Grafik (links) auf Folie 13 der Präsentation)

\ 

## 4. Fazit

Die Ergebnisse von der Niederländischen Matheolympiade zeigen, dass die gefundenen Effekte im Labor - dass Männer auch nach einer Niederlage eher nochmals zum Wettkampf antreten als Frauen - sich auch auf das Feld übertragen lassen und dass der Effekt auch über einen längeren Zeitraum anhält (hier: 1 Jahr bis zur Entscheidung, nochmals anzutreten).

Im Zusammenhang mit dem Jobmarkt und Karrierechancen führen die Autoren an, dass dieser Effekt eine möglich Erklärung für die sogenannte "Leaking Pipeline" sein könnte. Die Leaking Pipeline spielt darauf an, dass steigendem Karrieregrad der Anteil an Frauen kontinuierlich abnimmt, z.B. stellen Frauen 59% der Absolventen an europäischen Universitäten, 46% der Doktoranden, und nur 20% der Professoren. Der akademische Bereich ist recht stark umgkämpft - bspw. in Bezug auf Veröffentlichungen in Journals, Finanzierung oder Stellenangebote - und bringt "Teilnehmer" immer wieder in Wettkampfsituationen, aus denen man entweder als Gewinner oder Verlierer hervorgeht und sich für den langfristigen Erfolg immer wieder beweisen und durchsetzen muss - ähnlich sei es auf andere Bereiche zu übertragen. 

Eine mögliche Erklärung für den Geschlechterunterschied, den die Autoren noch anführen, kommt aus der Psychologie, welche besagt, dass Männer Erfolg eher internen Faktoren (wie Talent) zuschreiben und Misserfolg eher externen Umständen (wie wenig Anstrengung) - Frauen dagegen machen genau das Gegenteil. 
Den Einfluss solcher Aspekte, sowie Mechanismen gegen geschlechterspezifische Unterschiede, gilt es in zukünftiger Forschung weiter zu untersuchen. Ebenso geben die Autoren den Anstoß, den Effekt auch in anderen Bereichen - hier: Mathematik - zu untersuchen, die eher stereotypisch "weiblich" sind. 


\ 

