Aufgabe 1: Gebräuchliche Datentypen in R

Vector

Ein Vector enthält Daten mit demselben Datentyp. Das können zum Beispiel Worte, bzw. Buchstaben (“characters”) oder Zahlen sein. Ein Vector kann beliebig viele Dateneinheiten umfassen. Um einen Vector x zu definieren, schreibt man x mit dem Pfeil “<-” alle Daten zu, die x umfassen soll.

Beispiel:

a <- 1 #wir schreiben dem Vector "a", die Zahl 1 zu

b <- c(1,2,3,4) #so schreiben wir dem Vector "b", die Zahlen 1-4 zu
b <- c(1:4) #eine kürzere Schreibweise 

b #dann kann man "a" oder "b" abrufen und erhält im Output, alles was den Vectoren zugeschrieben wurde. 
## [1] 1 2 3 4

Matrix

Matrizen funktionieren wie einfache Tabellen. Zwei Bedingungen müssen erfüllt sein, damit eine Matrix erstellt werden kann:

  1. Alle Spalten müssen die gleiche Länge haben
  2. Eine Matrix kann entweder Buchstaben (“characters”) oder Zahlen (“scalars”) enthalten.

Um eine Matrix zu erstellen, verwendet man die matrix()-Funktion.

Beispiel: Lasst uns eine Matrix mit 2 Spalten und 2 Zeilen erstellen. Wir nennen diese Matrix “m”.

m <- matrix(data = 1:4, nrow = 2, ncol = 2) 
m
##      [,1] [,2]
## [1,]    1    3
## [2,]    2    4
#data = Inhalt der Matrix
#nrow = Anzahl der Zeilen
#ncol = Anzahl der Spalten
#Der Matrizeninhalt (Zahlen von 1-4) wird also auf 2 Zeilen und 2 Spalten verteilt.

Data.frame

Data.frames sind den Matrizen sehr ähnlich. Allerdings muss bei data.frames nur die erste Bedingung erfüllt sein. Das bedeutet, dass alle Spalten die gleiche Länge haben müssen, aber ein data.frame kann jedes beliebige Datenformat enthalten (characters / Zahlen /…)

Um ein data.frame zu erstellen, verwendet man die data.frame()-Funktion.

Beispiel:

Lasst uns ein data.frame mit 2 Spalten und 2 Zeilen erstellen:

df <- data.frame(column1 = c(1,2),
                 column2 = c("a","b")
                 )
df
##   column1 column2
## 1       1       a
## 2       2       b
#stringsAsFactors = F 
# factors --> kategoriale Variablen
# per default auf True gesetzt. Standardverhalten von R. 

str(df)
## 'data.frame':    2 obs. of  2 variables:
##  $ column1: num  1 2
##  $ column2: Factor w/ 2 levels "a","b": 1 2

List

Eine Liste kann alles mögliche enthalten und es gibt keinerlei Bedingungen, die erfüllt sein müssen.

Beispiel: Lasst uns eine Liste kreieren, die alles enthält, was wir bisher gemacht haben.

l <- list(a,m,df)
l
## [[1]]
## [1] 1
## 
## [[2]]
##      [,1] [,2]
## [1,]    1    3
## [2,]    2    4
## 
## [[3]]
##   column1 column2
## 1       1       a
## 2       2       b

Aufgabe 2: Einlesen des Datensatzes Exposure Based Face Memory Test

  1. Einlesen des Datensatzes Exposure Based Face Memory Test
EBFMT <- read.csv("~/Documents/Psychologie/7. Semester/R/Blockseminar R/FinalAssignment/Data/EBFMT/data.csv", sep="\t", header=TRUE) 
#summary(EBFMT)
#head(EBFMT) um zu überprüfen ob es geklappt hat und sich einen ersten Überblick über die Daten zu verschaffen

2b) Deskriptive Informationen zum Datensatz

nrow(EBFMT)
## [1] 1768

Der Datensatz EBFMT enthält 1768 Zeilen (inklusive NAs), was 1768 Beobachtungen entspricht.

ncol(EBFMT)
## [1] 275

Der Datensatz EBFMT enthält 275 Spalten (inklusive NAs), was 275 Variablen entspricht.

EBFMT <- read.table("~/Documents/Psychologie/7. Semester/R/Blockseminar R/FinalAssignment/Data/EBFMT/data.csv", sep="\t", header=TRUE, na.strings =c(0,-1)) 
#head(EBFMT)
  1. manuelle Bereinigung offensichtlich unplausibler Werte
EBFMT$gender_bin <- EBFMT$gender 
EBFMT$gender_bin[EBFMT$gender_bin == 3] <- NA
#table(EBFMT$gender_bin)

Wenn man sich die Variable “age” anschaut scheinen bei ihr jedoch noch einige unplausible Werte vorhanden zu sein.

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

Um die Variable analysierbar zu machen, werde ich alle Werte <12 und >100 als Missing Values codieren:

EBFMT$age_clean <- EBFMT$age 
EBFMT$age_clean[EBFMT$age_clean < 12] <- NA 
EBFMT$age_clean[EBFMT$age_clean > 100] <- NA 
summary(EBFMT$age_clean)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max.    NA's 
##   12.00   17.25   22.00   26.90   32.75   79.00      18

Wie im im Summary zu sehen ist, ist der minimale Wert der Variable “age_clean” 12 und der maximale Wert 79.

Aufgabe 3

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önlichkeit- stest. 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.

lap <- grep("LAPSE", names(EBFMT), value=T)
#table(lap)
#head(lap)
#str(lap)
vars <- grep("[:lower:]", names(EBFMT), value=T)
#table(vars)
#head(vars)
p <- grep("^P", names(EBFMT), value=T)
#table(p)
#head(p)
q <- grep("^Q", names(EBFMT), value=T)
#table(q)
#head(q)

Aufgabe 4: Identifikation von Outliern

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.

lap1 <- lap[2:75]
lap_sum <- apply(EBFMT[,lap1], 1, sum)
#table(lap_sum)
summary(lap_sum)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max.    NA's 
##   27140  102400  119300  129700  139400 4514000      11
EBFMT$lap_sum <- lap_sum #add a the lapsum column to the EBFMT-dataframe

EBFMT$outlier[EBFMT$lap_sum > 200000] <- 1 #alle outlier werden mit einer 1 codiert
EBFMT$outlier[EBFMT$lap_sum <= 200000] <- 0 #alle "nicht-outlier" werden mit 0 codiert

#table(EBFMT$outlier)
#head(EBFMT) 
#die beiden neuen Spalten für die Variablen "lap_sum" und "outlier" wurden nun also hinzugefügt. 

Aufgabe 5: Eine eigene R Funktion

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.

  1. Definiere eine Funktion mit Namen, Parametern und Funktionsbody Hinweise: Die folgenden Hinweise sollen helfen – skizzieren aber nur einen der vielen möglichen Wege.

1=new 2=seen

identify_seen <- function(d,vn){
  w <- (lapply(d[vn], table))
  index <- (lapply(w, function(x) 
   diff(-x)/sum(x)
    ))
print = index
}

seen <- identify_seen(EBFMT,q)
unlist(seen)
##       Q1.2       Q2.2       Q3.2       Q4.2       Q5.2       Q6.2 
##  0.9681637  0.9591373  0.9330306 -0.8366421  0.9739081 -0.8593307 
##       Q7.2       Q8.2       Q9.2      Q10.2      Q11.2      Q12.2 
##  0.9875213 -0.9263039 -0.8752834  0.9750567  0.9818594  0.9807256 
##      Q13.2      Q14.2      Q15.2      Q16.2      Q17.2      Q18.2 
## -0.2721088  0.9818800  0.6987542 -0.9388448 -0.6095076 -0.9173741 
##      Q19.2      Q20.2      Q21.2      Q22.2      Q23.2      Q24.2 
##  0.9343520 -0.7306169  0.9739672 -0.2642898  0.9807583  0.8664403 
##      Q25.2      Q26.2      Q27.2      Q28.2      Q29.2      Q30.2 
##  0.8132428 -0.2948500  0.8336163 -0.5551783  0.8189021  0.8891403 
##      Q31.2      Q32.2      Q33.2      Q34.2      Q35.2      Q36.2 
## -0.2375566  0.9128959 -0.6018100  0.8065611 -0.9253394  0.8947964 
##      Q37.2      Q38.2      Q39.2      Q40.2      Q41.2      Q42.2 
##  0.9208145  0.3959276 -0.6414027 -0.3122172  0.9309955 -0.6968326 
##      Q43.2      Q44.2      Q45.2      Q46.2      Q47.2      Q48.2 
##  0.6549774 -0.1527149 -0.1787330  0.7217195 -0.9705882 -0.9015837 
##      Q49.2      Q50.2      Q51.2      Q52.2      Q53.2      Q54.2 
## -0.9389140  0.6334842  0.8733032 -0.5803167 -0.9219457  0.9049774 
##      Q55.2      Q56.2      Q57.2      Q58.2      Q59.2      Q60.2 
##  0.5542986 -0.4332579  0.8823529 -0.2579186 -0.6889140 -0.9242081 
##      Q61.2      Q62.2      Q63.2      Q64.2      Q65.2      Q66.2 
##  0.7500000  0.8291855  0.7296380 -0.2251131 -0.8461538  0.6708145 
##      Q67.2      Q68.2      Q69.2      Q70.2      Q71.2      Q72.2 
##  0.9140271  0.7115385  0.7545249  0.2443439 -0.7975113  0.7296380 
##      Q73.2      Q74.2      Q75.2 
## -0.8563348  0.8823529 -0.8755656
  1. Aufruf und Erstellung einer Übersichtsgrafik 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.
#install.packages("reshape") #dieses package enthält die unten verwendeten Funktionen
#library(reshape)
#d <- data.frame(EBFMT[,q]) 
#p <- lapply (d, identify_seen)
#p
 
#datm <- melt(d, id.var=c())
#seen <- cast(datm,~variable, identify_seen) #Liste des Index über alle Q-Variablen 
#x <- unlist(seen) 
#z <- data.frame(x) #verwandle es in einen Dataframe 
#o <- lapply(z,function (x) diff(-x)/sum(x)) #Berechne die jeweiligen Indizes 
#k <- unlist(o) 
#z <- data.frame(k, row.names = NULL) #auch das verwandeln wir in ein Dataframe, damit es von ggplot verwendet werden kann. 
#y <- cbind(z,index = 1:75) #Dataframe, das jeweils die Zahl der Q-Variable (x-Achse und die Werte des Index des jeweiligen Bildes enthält)
 
 
#library(ggplot2)
 
#p <- ggplot(data=y, aes(x=index, y=k)) +
#  geom_hline(yintercept = 0,colour="red",linetype = "dashed", #size=1)+ #so fügen wir die roten Linien hinzu 
#  geom_hline(yintercept = 0.4,colour="red",linetype = "dashed", size =0.5)+
#  geom_hline(yintercept = -0.4,colour="red",linetype = "dashed", size =0.5)+
#  geom_point(shape = 1, size = 3) +
# geom_line()+
#  labs(x="\nindex", y="Y = (new-seen)/total\n") + #Bezeichnung der X- und Y-Achse
#  ggtitle ("Portraits by Index")+ #Füge Titel hinzu 
#  scale_x_continuous(breaks=seq(from=0,to=76, by=2))+ #Zahlen auf der X-Achse
#  scale_y_continuous(breaks=seq(from=-1.0,to=1.0, by=0.5)) #Skala auf der Y-Achse +
#  theme_bw()  +
#  theme(axis.text.x=element_text(angle=90, hjust=0.5),axis.text.y=element_text(angle=90, hjust=0.5),plot.title = element_text+(lineheight=10, face="bold")) #sonstige Verschönerungen

#print(p) #Plot aufrufen 

Aufgabe 6: Schliessende Statistik

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.

Boxplot

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.

#Zunächst erstellen wir ein Dataframe "EBFMTno", dass die keine Outlier gemäß Aufgabe 4 enthält.


EBFMTno <- data.frame(subset(EBFMT, outlier == "0")) #erstelle ein Dataframe, das nur die Daten enthält, die nach lap_sum, keine Outlier sind (Aufgabe 4)
#head(EBFMTno)
  • Vergleichender Boxplot der verschiedenen Ethnizitäten
library(ggplot2) #das Paket ggplot 2 aufrufen 
ga <- ggplot(EBFMTno, aes(factor(race), score)) #eine Leinwand für das Plot erstellen und dann mit den entsprechenden Angaben und aesthetics "füllen"
ga + geom_boxplot(notch = F, outlier.colour = "gray", outlier.size = 3) + 
  aes(fill = race) +
  theme_bw()

Gemäß dem Codebook stehen die Zahlen für folgende Ethnizitäten: * 1=Mixed race * 2=Asian * 3=Black * 4=Native American * 5=Native Australian * 6=White * 7=Other

Im vergleichenden Boxplot wird deutlich, dass es keine großen Unterschiede zwischen den Ethnizitäten gibt. Die Probanden mit gemischten Ethnizitäten und “anderen” Ethnizitäten scheinen die höchsten Scores zu erzielen.

  • Häufigkeiten der Ethnizitäten in einem einfachen Histogramm:
gb <- ggplot(EBFMTno, aes(x=race), binwidth = 1)
gb + geom_histogram(aes(x= race), #erstelle das Histogramm
                    binwidth = 1, 
                    fill = "gray",
                    color = "black")

Der größte Anteil der Probanden ist weiß.

T-Test

Gibt es einen signifikaten Unterschied in den Scores zwischen Männern und Frauen? Untersuche mit Hilfe eines T-Tests und kommentiere das Ergebnis.

t.test(score~gender_bin, data = EBFMTno)
## 
##  Welch Two Sample t-test
## 
## data:  score by gender_bin
## t = -1.0568, df = 889.645, 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
#Es gibt keinen signifikanten Unterschied zwischen Männern und Frauen. Das Konfidenzintervall schließt die 0 mit ein. 

OLS Modell

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.

fit1 <- lm(score ~ race + age_clean + lap_sum + race + gender_bin, data = EBFMTno) 

fit1
## 
## Call:
## lm(formula = score ~ race + age_clean + lap_sum + race + gender_bin, 
##     data = EBFMTno)
## 
## Coefficients:
## (Intercept)         race    age_clean      lap_sum   gender_bin  
##   6.112e+01    2.175e-01   -7.995e-02    3.325e-05   -1.034e-01
summary(fit1)
## 
## Call:
## lm(formula = score ~ race + age_clean + lap_sum + race + gender_bin, 
##     data = EBFMTno)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -29.3740  -2.4500   0.4005   3.2965  11.4235 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  6.112e+01  7.819e-01  78.166  < 2e-16 ***
## race         2.175e-01  6.284e-02   3.462  0.00055 ***
## age_clean   -7.995e-02  9.644e-03  -8.290 2.36e-16 ***
## lap_sum      3.325e-05  4.757e-06   6.989 4.04e-12 ***
## gender_bin  -1.034e-01  2.617e-01  -0.395  0.69288    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 4.693 on 1610 degrees of freedom
##   (76 observations deleted due to missingness)
## Multiple R-squared:  0.05788,    Adjusted R-squared:  0.05554 
## F-statistic: 24.73 on 4 and 1610 DF,  p-value: < 2.2e-16
  • Darstellung der Ergebnisse in einer schönen Tabelle
Statistical models
Model 1
(Intercept) 61.12***
(0.78)
race 0.22***
(0.06)
age_clean -0.08***
(0.01)
lap_sum 0.00***
(0.00)
gender_bin -0.10
(0.26)
R2 0.06
Adj. R2 0.06
Num. obs. 1615
RMSE 4.69
p < 0.001, p < 0.01, p < 0.05

KOMMENTAR:

  • Die Variablen “lap_sum” und “gender_bin”, also die Geschwindigkeit mit der die Probanden den Test bearbeitet haben und das Geschlecht der Probanden haben statistisch gesehen keinen signifikanten Einfluss.

  • Das Alter hingegen und auch die Ethnizität haben einen signifikanten Einfluss auf den Score.

  • Aus dem oben erstellten Boxplot können wir erschließen, dass gemischte Ethnizitäten, “andere” Ethnizitäten und Asiaten besonders gut abschneiden.

The End.