Das folgende Assignment ist überwiegend praktischer Natur und beschäftigt sich im Wesentlichen mit angewandten Aufgaben rund um einen Datensatz zum Exposure Based Face Memory Test. Lediglich Aufgabe 1 fragt kurz theoretisches, praxisrelevantes Basiswissen zu R ab. Ausserdem wird teilweise innerhalb der Aufgaben ein kurzer inhaltlicher Kommentar gefordert.
Im angewandten Teil soll die Gliederung in einzelne Aufgaben auch eine Richtschnur sein. Allgemeines Ziel ist es, Determinanten der unterschiedlichen Scores bei der Erkennung von Gesichtern zu identifizieren.
Reiche die Ergebnisse als Bericht im .pdf oder .html Format ein. Liefere ausserdem die zu Verwendung des Berichts erstellte .Rmd (R Markdown) file mit.
Hinweis: Führe den Test auf http://personality-testing.info/tests/EBFMT/ selbst durch, um dein Verständnis des Datensatzes zu fördern.
Die Musterlösung versucht ausführlich und transparent darzustellen was verlangt gewesen ist. Die Musterlösung zeigt einen Lösungsweg der mit den im Kurs erlernten Mittel relativ einfach umsetzbar ist. Oft vielen sehr viele verschieden Wege zum Ziel, die ebenfalls akzeptiert werden. Bei den Basics habe ich in Klammern noch Punkte angegeben.
Im Kurs wurde die Rolle verschiedener Datentypen in R besprochen. Erkläre kurz folgende gebräuchliche Datentypen und wie sie in der Praxis zueinander stehen:
Ein Vector ist eine Abfolge von Elementen gleichen Datentyps.(1) Auch Skalare, werden als Vector der Länge 1 abgespeichert.
eine Matrix ist ein 2 dimensionaler (1) Vector . Voraussetzung für eine Matrix ist dass alle Spalten die gleiche Anzahl an Zeilen (1) haben. Ausserdem müssen alle Elemente den gleichen Datentyp (1) aufweisen. Genau wie bei einem Vector wählt R bzgl. des Datentyps im Zweifel den kleinsten gemeinsamen Nenner (.5) (character)
Wie die Matrix hat auch das data.frame 2 Dimensionen und schreibt vor, dass alle Spalten die gleiche Anzahl Zeilen (1) aufweisen. Im Unterschied zur Matrix, darf aber beim data.frame jede Spalte einen anderen Datentyp haben (1. data.frames erlauben auch die Verschachtelung von Zellen. Dies war aber explizit nicht gefragt und nicht Gegenstand des Kurses.
Die liste ist der flexibelste Datentyp, der im Kurs behandelt wurde. Die einzelnen Elemente einer Liste dürfen beliebiger Länge (1) und beliebigen Datentyp (1) sein. Listen können verschachtelt sein. Wichtiger Anwendungsbereich sind Ausgaben von Funktionen, da Funktionen nur einen Objekt zurück geben können. Mit Hilfe von Listen können mehrere Elemente aus einer Funktion zurückgegeben werden, in dem die Funktion als einziges Objekt eine Liste mit mehreren Elementen retourniert. (1 Bonuspunkt)
Lade den Datensatz von http://personality-testing.info/_rawdata/ herunter und lies den Datensatz in ein R object mit dem Namen EBFMT ein. Wähle ein sinnvolles Verzeichnis und beachte auch das gewählte Trennzeichen (hier sep=“\t”).
# inkl. missing values als na.string deklariert.
EBFMT <- read.csv2("../data/EBFMT/data.csv",sep="\t",na.strings = c("-1","0"))
Der Datensatz enthält 1768 Beobachtungen (Zeilen) und 275 Variablen (Spalten) inkl. NAs. Bei dieser relativ hohen Anzahl an Variablen ist ist die Wahrscheinlichkeit von missing Items bei einzelnen Variablen sehr hoch, so dass ein kompletter Ausschluss einer Beobachtung auf Grund eines einzelnen fehlenden Wertes (na.omit(EBFMT) wenig sinnvolle ist da sonst zu viele Beobachtungen verloren gehen. Eine Angabe über die missing values lässt sich dann machen, wenn klar ist welche Variablen in die Analyse einfliessen.
Der Datensatz verwendet 0 und -1 für missing values. Dies ist keine R konforme Codierung. R’s Bezeichnung für fehlende Werte ist NA. Ausserdem werden tatsächlich leere Felder von R beim einlesen erkannt und nachdem Einlesen automatisch als missing values NA codiert.
# ich erspare euch den output :)
head(EBFMT)
summary(EBFMT)
# remove unreasonable age values
EBFMT$gender_bin <- EBFMT$gender
EBFMT[!(EBFMT$gender_bin %in% c(1,2)),"gender_bin"] <- NA
# einige outlier in age
table(EBFMT$age)
##
## 2 3 5 11 12 13 14 15 16 17 18 19 20 21 22
## 1 2 1 3 6 22 64 94 127 125 129 106 90 93 73
## 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37
## 55 49 42 42 43 43 27 41 25 16 14 31 30 16 21
## 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52
## 14 18 15 15 16 17 13 17 11 10 8 9 20 6 5
## 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67
## 11 16 14 10 6 9 8 14 9 6 7 1 4 4 1
## 68 70 71 72 73 75 76 79 136 1996
## 3 3 1 1 1 1 1 1 1 1
EBFMT$age_clean <- EBFMT$age
EBFMT[(EBFMT$age_clean < 12 | EBFMT$age_clean > 100 | is.na(EBFMT$age_clean)),"age_clean"] <- NA
Wie in 2. gesehen enthält der Datensatz eine Vielzahl an Variablen, die sich aber wie folgt Gruppieren lassen: binäre Fragen, Zeiten, allg. Variablen (vorwiegend demografisch) und Items aus dem Persönlichkeitstest. Nutze die Spaltennamen um mit Hilfe von regulären Ausdrücken (regular Expressions), Vektoren zu erstellen, die Spaltennamen enthalten. So kannst du später sehr leicht eine Gruppe Variablen innerhalb des Gesamtdatensatzes ansprechen.
Hinweis: Die Datei codebook.txt, die mit dem Datensatz geliefert wird, enthält weitere Hinweise zu den Variablen.
q <- grep("^Q",names(EBFMT),value=T)
# groups
lap <- grep("LAPSE",names(EBFMT),value=T)
vars <- grep("[a-z]",names(EBFMT),value=T)
p <- grep("^PQ",names(EBFMT),value=T)
Die im Vektor l zusammengefassten LAPSE Variablen messen die Antwortzeit in Millisekunden. Erstelle zunächst eine neue Variable lapse_sum, die die zeilenweise Summe der LAPSE Variablen pro Beobachtung - jeweils ohne die erste LAPSE Variable - enthält und füge diese Variablen dem ursprünglichen data.frame hinzu. Füge eine weitere Variable outlier hinzu, die einen binären Indikator enthält, wenn diese Summe grösser als 200000 Millisekunden ist.
Hinweis: Mittels apply und sum lässt sich die Summe sehr leicht (in einer Zeile) lösen.
# lapse sum without first column!
EBFMT$lapse_sum <- apply(EBFMT[,lap[-1]],1,sum)
# Outlier TRUE / FALSE
EBFMT$outlier <- EBFMT$lapse_sum > 200000
summary(EBFMT$lapse_sum)
## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## 27140 102400 119300 129700 139400 4514000 11
Leider ist in der Beschreibung des Datensatzes nicht vermerkt, welche Bilder auch tatsächlich mehrfach angezeigt wurden. Schaffe Abhilfe und erstelle eine Funktion, die die Fähigkeiten aller Probanden bei der Gesichtserkennung nutzt, um herauszufinden welche Bilder mehrfach gezeigt wurden.
Hinweis: Insgesamt zeigt der Test auf der Webseite allen Probanden 75 Portraitfotos in derselben Reihenfolge an. Wenn du die mit 0 codierten Werte korrekt als NAs eingelesen hast, sollten die Anworten immer 1 oder 2 sein. Zähle die Anworten für jede Variable aus und verwende die Differenz bzw. das Verhältnis als Indikator.
Hinweise: Die folgenden Hinweise sollen helfen – skizzieren aber nur einen der vielen möglichen Wege.
# name der Funktion: identify_seen
# Parameter: d - ein data.frame, v - ein vector von Variablen (i.e. spalten der Funktion)
identify_seen <- function(d,v){
# Funktionsbody start
# Speichere das Ergebnis von table für jede spalte des data.frames in eine
# Liste, berücksichtige dabei nur die spalten die mittels v ausgewählt wurden
li <- lapply(d[,v],table)
# da alle spalten entweder "gesehen" oder "nicht gesehen" repräsentieren
# hat table immer zwei Elemente, also kann nun wieder lapply auf die
# gerade erstellte Liste angewandt werden.
# diesmal geben wir lapply aber keine vordefinierte R Funktion wie table
# mit, sondern eine selber definierte funktion um das Verhältnis zu berechnen.
# da diese funktion sehr einfach ist, definieren wir sie an Ort und Stelle als
# anonymen Funktion (Funktion ohne Namen). Erneut ist das Ergebnis eine Liste,
# weil lapply eine Liste zurück gibt.
li_f <- lapply(li,function(x) (x[1]-x[2])/sum(x))
# wie im Hinweis angegeben verwenden wir nun noch unlist um
# die liste li_f (die in jedem Element nur einen Vektor der Länge 1 enthält)
# in einen vector umzuwandeln
unlist(li_f)
# Funktionsbody Ende
}
Rufe die unter a) erstellte Funktion mit den parametern EBFMT und q auf, und nutze die Ausgabe der Funktion um eine Grafik wie die unten gezeigte zu erstellen. Kommentiere die Grafik kurz.
# das Ergebnis der Funktion, die wir in a) erstellt haben ist
# ein Vektor. diesen können wir ganz einfach plotten:
# plot(identify_seen(EBFMT,q))
# Diese Zeile hätte für die Lösung der Aufgabe genügt.
# Im folgenden wird der Plot noch etwas anschaulicher dargestellt.
# Es wird ein Titel und eine Achsenbeschriftung hinzugefügt.
# Ausserdem wird die Achse weg gelassen um später eine andere Achsen hinzufügen.
plot(identify_seen(EBFMT,q),
type="b",xaxt="n",ylab="y = (new - seen) / total ",
main="Portraits by Index")
# Einfügen einiger Hinweise linien.
abline(h=0,lwd=2,lty="dashed",col="red")
abline(h=.4,lwd=1,lty="dashed",col="red")
abline(h=-.4,lwd=1,lty="dashed",col="red")
axis(1, at = seq(0, 76, by = 2), las=2)
Führe im Folgenden einen vergleichenden Boxplot, einen T-Test durch und schätze ein lineares Modell. Schliesse dabei jeweils mit Hilfe der in Aufgabe 4 erstellten Outlier Variable die Outlier bzgl. der lapse_sum aus.
Hinweis: Bei allen Aufgaben ist der im Kurs besprochene “formula Syntax” hilfreich.
Vergleiche die Scores nach Ethnizitäten mit Hilfe eines Boxplots. Erstelle ausserdem eine Grafik, die geeignet ist um die relativen Häufigkeiten der unterschiedlichen Ethnizitäten darzustellen. Kommentiere die Grafiken kurz.
# race ist datentyp character, die umwandlung in einen factor
# bewirk, dass die variable als categorical verstanden wird, was bei manchen
# anwendungen sehr hilfreich ist, da dies zu einer automatischen Gruppierung
# führt.
EBFMT$race_f <- as.factor(EBFMT$race)
# umkodierung gem. Manual
levels(EBFMT$race_f) <- c("mixed","Asian","Black","Nat. US",
"Nat. AUS","White","Other")
# Mittels Formula syntax im boxplot context
boxplot(score ~ race_f,data = EBFMT[!EBFMT$outlier,],las=2)
Gibt es einen signifikaten Unterschied in den Scores zwischen Männern und Frauen ? Untersuche mit Hilfe eines T-Tests und kommentiere das Ergebnis.
# Mittels Formula syntax funktioniert ein
# t-test analog zum oben gezeigen boxplot so:
t.test(score ~ gender_bin,data = EBFMT[!EBFMT$outlier,])
##
## Welch Two Sample t-test
##
## data: score by gender_bin
## t = -1.0568, df = 889.65, p-value = 0.2909
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -0.7858294 0.2357410
## sample estimates:
## mean in group 1 mean in group 2
## 63.70362 63.97867
Schätze den Score mit Hilfe einer linearen Regression. Konzentriere dich bei der Auswahl der erklärenden Variablen auf die demografischen Variablen wie etwa race, age_clean bzw. auf lapse_sum. Nutze die Pakete knitr bzw. texreg (Funktion: htmlreg) um die Regressionstabellen ansprechend in deinem Report darzustellen. Kommentiere das Ergebnis.
# Bezugslevel auf White setzen. Oft wird die Kategorie als Referenz gewählt,
# die am häufigsten vorhanden ist.
EBFMT$race_f <- relevel(EBFMT$race_f,ref = "White")
EBFMT$fastclicks[is.na(EBFMT$fastclicks)] <- 0
fit1 <- lm(score ~ gender_bin +
I(lapse_sum/1000) +
age_clean +
fastclicks +
factor(religion) +
factor(engnat) +
race_f,
data = EBFMT[!EBFMT$outlier,])
Wie schon zuvor der beim t-test, zeigt sich, dass das Geschlecht auch dann keinen signifikanten Einfluss hat wenn man für verschiedene andere Variablen kontrolliert. Pro Sekunde, die sich ein Teilnehmer mehr Zeit lässt erhöht sich der Score signifikant um 0.03 Punkte. Das Alter hat ebenfalls einen signifikanten Einfluss auf den Score, doch ist dieser negativ. Ebensosignifikant ist der negative Einfluss der Variable fastclicks. Religion scheint keinen, Einfluss zu haben. Dies dürfte auch dadurch begründet seim, dass wir für die Enthnizität der Teilnehmer kontrollieren. Englische Muttersprachler schliessen im Test offenbar signifikant besser ab. Diese könnte durch das leichtere Verständnis der Aufgabenstellung erklärt werden. Asiatische und Afroamerikanische Teilnehmer haben einen signifikant niedrigeren Score im Face Recognition Test. Diese deutet auf eine mögliche Schwäche des Tests hin, da die gezeigten Bilder meistens Protraits von Weissen sind und Gesichter innerhalb der eigenen Ethnizität vermutlich leichter wieder zu erkennen sind. Insgesamt lässt sich sagen, dass die Regression mit einem \(R^2\) von 0.1 relativ geringen Erklärungsgehalt bzgl. der Gesamtvarianz im Datensatz besitzt. Für weiterführende Schlüsse sollte im Blick behalten werden, dass nur knapp 1600 Beobachtungen von 1768 auf Grund von missing items berücksichtig werden konten. In einer wissenschaftlichen Analyse sollte unbedingt geprüft werden welche Variablen für den grössten dropout verantwortlich sind. Bzw. sollte verstanden wie robust die Ergebnisse sind wenn einzelne Variablen in die Spezifikation aufgenommen oder herausgestrichen werden.
library(texreg)
htmlreg(fit1,single.row = T)
| Model 1 | ||
|---|---|---|
| (Intercept) | 63.23 (0.75)*** | |
| gender_bin | -0.13 (0.27) | |
| I(lapse_sum/1000) | 0.03 (0.00)*** | |
| age_clean | -0.08 (0.01)*** | |
| fastclicks | -0.39 (0.07)*** | |
| factor(religion)2 | -0.11 (0.28) | |
| factor(religion)3 | 0.56 (0.67) | |
| factor(religion)4 | 0.04 (0.96) | |
| factor(religion)5 | 0.22 (0.77) | |
| factor(religion)6 | 0.20 (1.04) | |
| factor(religion)7 | -0.61 (0.37) | |
| factor(engnat)2 | -0.75 (0.27)** | |
| race_fmixed | 0.02 (0.44) | |
| race_fAsian | -1.22 (0.43)** | |
| race_fBlack | -1.92 (0.60)** | |
| race_fNat. US | -2.11 (1.41) | |
| race_fNat. AUS | -2.66 (1.89) | |
| race_fOther | 0.26 (0.50) | |
| R2 | 0.10 | |
| Adj. R2 | 0.09 | |
| Num. obs. | 1575 | |
| RMSE | 4.62 | |
| p < 0.001, p < 0.01, p < 0.05 | ||
Philip Leifeld (2013). texreg: Conversion of Statistical Model Output in R to LaTeX and HTML Tables. Journal of Statistical Software, 55(8), 1-24. URL http://www.jstatsoft.org/v55/i08/.