Zusatz - Lösungen

An dieser Stelle zunächst eine generelle Anmerkung: Für einige der nachfolgenden Aufgaben wird es - wie eigentlich fast immer in R - mehrere Lösungswege geben. Die hier gezeigten Wege sind also exemplarische Vorlagen.

class(geschlecht)

## [1] "numeric"

class(alter)

## [1] "numeric"

class(stadt)

## [1] "numeric"

dim(lz_items)

## [1] 10  5

Die einzelnen Vektoren gehören alle zur Klasse numeric, da sie nur Zahlen beinhalten. Die Dimensionen des Datensatzes zu den lz_items betragen 10 Zeilen und 5 Spalten (in dem Fall die Anzahl der Lebenszufriedenheites-Items).

data <- data.frame(geschlecht, alter, stadt, lz_items)
dim(data)

## [1] 10  8

In dim wäre die Anzahl der Proband:innen, also die Anzahl der Zeilen, der erste Wert. Es liegen also 10 Proband:innen vor. Der zweite Wert beschreibt die Anzahl der Variablen. Hier haben wir demnach um 8 Variablen.

data$geschlecht <- factor(data$geschlecht, levels = 1:3, labels = c("weiblich", "männlich", "divers"))
str(data$geschlecht)

##  Factor w/ 3 levels "weiblich","männlich",..: 1 2 2 1 1 1 3 2 1 2

data$stadt <- factor(data$stadt, levels = 1:5, labels = c("Berlin", "Hamburg", "München", "Frankfurt", "Dresden"))
str(data$stadt)

##  Factor w/ 5 levels "Berlin","Hamburg",..: 2 1 1 4 3 2 5 4 1 3

data[4, "stadt"]

## [1] Frankfurt
## Levels: Berlin Hamburg München Frankfurt Dresden

data[c(7, 8), "geschlecht"]

## [1] divers   männlich
## Levels: weiblich männlich divers

data[c(2, 3), c(4:8)]

##   lz1 lz2 lz3 lz4 lz5
## 2   4   2   3   1   4
## 3   4   3   4   3   3

• Wir sehen, dass Person 4 die Stadt Frankfurt angegeben hat.
• Person 7 hat das Geschlecht divers angegeben und Person 8 männlich.
• In der ausgegebenen Tabelle werden die Lebenszufriedenheits-Werte von Person 2 und 3 auf allen Items ausgegeben.

data[3, "lz2"] <- 2
data[3, "lz4"] <- 1

data[6, "alter"]

## [1] 23

Das Alter der Person 6, das im Datensatz steht, beträgt 23. Hier muss also das richtige Alter (24 Jahre) zugeordnet werden.

data[6, "alter"] <- 24

data$lz2 <- -1 * (data$lz2 - 6)
data$lz4 <- -1 * (data$lz4 - 6)

data[1, c("alter", "geschlecht")] == data[5, c("alter", "geschlecht")]

##   alter geschlecht
## 1  TRUE       TRUE

data[2, c("geschlecht", "stadt")] == data[10, c("geschlecht", "stadt")]

##   geschlecht stadt
## 2       TRUE FALSE

Natürlich könnte man die Vergleiche auch jeweils einzeln durchführen, doch mit diesem Code geht es etwas schneller. Wenn man das und als verbindendes Element verstehen will (beide Werte müssen gleich sein), müsste man es folgendermaßen lösen.

data[1, "alter"] == data[5,"alter"] & data[1, "geschlecht"] == data[5, "geschlecht"]

## [1] TRUE

data[2, "geschlecht"] == data[10, "geschlecht"] & data[2,  "stadt"] == data[10, "stadt"]

## [1] FALSE

Dabei wird nur TRUE als Resultat ausgegeben, wenn beide durch & verbundene Aussagen als TRUE gewertet werden. Da, wie wir bereits gesehen haben, die Angabe in stadt nicht gleich ist beim zweiten Vergleich, erhalten wir hier ein FALSE.

data$farbe <- farbe
data$farbe <- factor(data$farbe, levels = 1:4, labels = c("blau", "rot", "grün", "schwarz"))
str(data$farbe)

##  Factor w/ 4 levels "blau","rot","grün",..: 1 2 1 1 3 4 2 2 1 4

data[11, ] <- c("weiblich", 21, "Frankfurt", 4, 4, 3, 4, 4, "blau")
data[12, ] <- c("männlich", 19, "Dresden", 2, 5, 2, 4, 3, "schwarz")
data[13, ] <- c("weiblich", 20, "Berlin", 1, 5, 1, 5, 1, "blau")

Hier sollte es am einfachsten sein, die neuen Personen manuell an den Datensatz anzufügen. Dabei starten wir natürlich mit der nächsten Zeile nach der vorherigen Anzahl. In diesem Fall hatten wir schon 10 Personen erhoben, starten also mit 11.

str(data)

## 'data.frame':	13 obs. of  9 variables:
##  $ geschlecht: Factor w/ 3 levels "weiblich","männlich",..: 1 2 2 1 1 1 3 2 1 2 ...
##  $ alter     : chr  "20" "21" "19" "19" ...
##  $ stadt     : Factor w/ 5 levels "Berlin","Hamburg",..: 2 1 1 4 3 2 5 4 1 3 ...
##  $ lz1       : chr  "3" "4" "4" "2" ...
##  $ lz2       : chr  "4" "4" "4" "4" ...
##  $ lz3       : chr  "5" "3" "4" "4" ...
##  $ lz4       : chr  "4" "5" "5" "4" ...
##  $ lz5       : chr  "4" "4" "3" "3" ...
##  $ farbe     : Factor w/ 4 levels "blau","rot","grün",..: 1 2 1 1 3 4 2 2 1 4 ...

Es fällt auf, dass unsere numeric Variablen jetzt als chr angezeigt werden. Sie sollten also zurücktransformiert werden.

data$alter <- as.numeric(data$alter)
data$lz1 <- as.numeric(data$lz1)
data$lz2 <- as.numeric(data$lz2)
data$lz3 <- as.numeric(data$lz3)
data$lz4 <- as.numeric(data$lz4)
data$lz5 <- as.numeric(data$lz5)

data$lz_ges <- rowMeans(data[, 4:8])
data$lz_ges   

##  [1] 4.0 4.0 4.0 3.4 2.2 4.2 3.2 3.6 4.0 3.8 3.8 3.2 2.6

getwd()
setwd("...")
save(data, file = "Data_lz.rda")

table(data$farbe)            # Häufigkeiten

## 
##    blau     rot    grün schwarz 
##       6       3       1       3

which.max(table(data$farbe)) # Modus

## blau 
##    1

max(table(data$farbe))       # Ausprägung

## [1] 6

• 3 Proband:innen haben die Farbe “schwarz” als Lieblingsfarbe ausgewählt.
• Der Modus der Variable farbe ist blau und kommt 6 mal vor.

pie(table(data$geschlecht))

prop.table(table(data$geschlecht))

## 
##   weiblich   männlich     divers 
## 0.53846154 0.38461538 0.07692308

Der relative Anteil der Versuchspersonen, die “männlich” angegeben haben, beträgt 0.385.

bruch <- -(1/log(5))
hj <- prop.table(table(data$stadt))
summe <- sum(hj * log(hj))
bruch * summe

## [1] 0.9723626

median(data$lz3)

## [1] 3

quantile(data$lz3, c(.25, .75))

## 25% 75% 
##   3   4

boxplot(data$lz3)

quantile(data$lz3, .75) - quantile(data$lz3, .25)

## 75% 
##   1

• Der Median für lz3 beträgt 3.
• Der Interquartilsbereich erstreckt sich vom Wert 3 bis zum Wert 4.
• Der Interquartilsabstand beträgt 1.

mean(data$lz_ges)

## [1] 3.538462

#Varianz (beide Wege)
var(data$lz_ges) * (12 / 13)

## [1] 0.3346746

sum((data$lz_ges - mean(data$lz_ges))^2) / 13

## [1] 0.3346746

• Das arithmetische Mittel beträgt 3.538.
• Die Varianz beträgt 0.335.

fb22$lerntyp <- factor(fb22$lerntyp, levels = 1:3, labels = c("alleine", "Gruppe", "Mischtyp"))

str(fb22$lerntyp)

##  Factor w/ 3 levels "alleine","Gruppe",..: 1 1 1 1 1 NA 3 2 3 1 ...

colours <- c("#CFB1B3", "#BC7B7D", "#DAB457")  #HEX-Werte (Paletten auf Pinterest)
colours2 <- c("#B7C5D5", "#D6EDEC", "#E7E8ED")

table_lerntyp <- table(fb22$lerntyp)

barplot(table_lerntyp, main = "Lerntypen Jahrgang 2022", ylab = "Anzahl Studierende", col = colours)

barplot(table_lerntyp, main = "Lerntypen Jahrgang 2022", ylab = "Anzahl Studierende", col = colours2)

sum(is.na(fb22$prok4))

## [1] 2

sum(is.na(fb22$prok10))

## [1] 0

• Die Variable prok4 enthält 2 fehlende Werte.
• Die Variable prok10 enthält 0 fehlende Werte.

Da wir gefunden haben, dass in prok10 keine fehlenden Werte vorliegen, können wir die Befehle ohne die Ergänzung na.rm = T durchführen.

median(fb22$prok4, na.rm = T)

## [1] 3

median(fb22$prok10)

## [1] 3

quantile(fb22$prok4, c(.25, .75), na.rm = T)

## 25% 75% 
##   2   3

quantile(fb22$prok10, c(.25, .75))

## 25% 75% 
##   2   4

• Der Median von prok4 liegt bei 3, bei prok10 liegt er bei 3.
• Die mittleren 50% der Angaben in Variable prok4 reicht vom Wert 2 bis zum Wert 3, bei der Variable prok10 reicht er von 2 bis 4.

boxplot(fb22$prok4)

boxplot(fb22$prok10)

range(fb22$gewis)

## [1] 2 5

mean(fb22$gewis)

## [1] 3.883648

• Der niedrigste Gewissenhaftigskeitswert liegt bei 2, der höchste bei 5.
• Die mittlere Ausprägung der Gewissenhaftigkeit liegt bei 3.884.

Zunächst sollten wir überprüfen, ob es fehlende Werte auf den Skalen gibt.

sum(is.na(fb22$gewis))

## [1] 0

sum(is.na(fb22$extra))

## [1] 0

Das ist offensichtlich nicht der Fall. Daher können wir die Befehle auch ohne den ergänzenden Teil durchführen.

mean(fb22$gewis)

## [1] 3.883648

mean(fb22$extra)

## [1] 3.378931

var(fb22$gewis) * (158/159)

## [1] 0.4361477

var(fb22$extra) * (158/159)

## [1] 0.4951693

Der Mittelwert von gewis liegt bei 3.884, der von extra bei 3.379. Unter den getroffenen Annahmen ist Ihre Gruppe gewissenhafter. Auch die Streuung ist deskriptiv auf der Extraversion größer. Hier liegt sie bei 0.495, während sie bei der Gewissenheit bei 0.436 liegt.

hist(fb22$vertr)

Dieses Histogramm soll erstmal zum Vergleich dienen. Wir sehen die ursprünglichen Skalenwerte.

fb22$vertr_z <- scale(fb22$vertr, scale = F)
hist(fb22$vertr_z)

Durch die Zentrierung verändert sich die Form erstmal nicht. Der Mittelwert der Werte wird auf 0 gesetzt. Optisch äußert sich das dadurch, dass die Werte auf der x-Achse nun andere sind.

fb22$vertr_st <- scale(fb22$vertr, scale = T)
hist(fb22$vertr_st)

Die Standardisierung setzt die Standardabweichung auf 1. Aufgrund der neuen Wertestruktur wird natürlich auch die Kategorienanzahl geändert.

Da wir zwei Analysen durchführen wollen, wäre es eine gute Möglichkeit, die Personen in reduzierten Datensätzen abzulegen. Dies kann mittels der Funktion subset gelöst werden.

fb22_alleine <- subset(fb22, subset = lerntyp == "alleine")
fb22_gruppe <- subset(fb22, subset = lerntyp == "Gruppe")

Über das Argument subset geben wir an, in welcher Variable (lerntyp) die Auswahl stattfindet und anschließend legen wir die Auswahl der einzelnen Gruppen über das bereits bekannte == fest.

Eine andere Möglichkeit wäre die Verwendung der logischen Auswahl anhand eckiger Klammern.

fb22_alleine <- fb22[fb22$lerntyp == "alleine",]
fb22_gruppe <- fb22[fb22$lerntyp == "Gruppe",]

Nun können Mittelwerte für die beiden Gruppen bestimmt werden. Beachten Sie, dass die Ergänzung von na.rm nur auf dem zweiten demonstrierten Weg wichtig ist. Dort können Personen mit einem Eintrag nicht richtig zugeordnet werden und sind daher in den beiden Datensätzen erhalten - allerdings nicht mit ihren richtigen Werten sondern mit überall NA. Die Funktion subset nimmt diese Fälle hingegen nicht mit auf.

mean(fb22_alleine$extra, na.rm = T)

## [1] 3.085821

mean(fb22_gruppe$extra, na.rm = T)

## [1] 4.125

mean(fb22_alleine$nerd, na.rm = T)

## [1] 3.226368

mean(fb22_gruppe$nerd, na.rm = T)

## [1] 2.75

dbinom(9, 15, 0.75)

## [1] 0.09174777

1- pbinom(10, 15, 0.75)

## [1] 0.6864859

#Alternativ:
pbinom(10, 15, 0.75, lower.tail = F)

## [1] 0.6864859

X <- 0:15
wk <- pbinom(X, 15, 0.75)
plot(x = X, y = wk, typ = "h", xlab = "Anzahl Frauen", ylab = "kummulierte Wahrscheinlichkeit")

Hypothesen

\(H_0\): Die durchschnittliche Gewissenhaftigkeit der Frauen, die Psychologie studieren, ist gleich oder geringer als die der Frauen in der Allgemeinbevölkerung.

\(H_0\): \(\mu_0\) \(\geq\) \(\mu_1\)

\(H_1\): Die durchschnittliche Gewissenhaftigkeit der Frauen, die Psychologie studieren, ist höher als die der Frauen in der Allgemeinbevölkerung.

\(H_1\): \(\mu_0\) \(<\) \(\mu_1\)

Wir testen zuerst ob unsere Variable Geschlecht bereits als Faktor vorliegt. Wenn nicht wandeln wir sie in einen Faktor um.

load(url('https://pandar.netlify.app/post/fb22.rda'))
is.factor(fb22$geschl)

## [1] FALSE

fb22$geschl <- factor(fb22$geschl,
                      levels = 1:3, 
                      labels = c("weiblich", "männlich", "anderes"))

Nun erstellen wir ein subset, indem nur die weiblichen Teilnehmenden des fb22 Datensatzes enthalten sind.

fb22_frauen <- subset(fb22, geschl == "weiblich")

t-Test

Da wir einen Stichprobenmittelwert mit einem Populationsmittelwert vergleichen wollen und die Varianz in der Population nicht vorliegt, führen wir einen Einstichproben-t-Test durch.

t.test(fb22_frauen$gewis, mu = 3.73, alternative = "greater", conf.level = .99)

## 
## 	One Sample t-test
## 
## data:  fb22_frauen$gewis
## t = 4.7902, df = 124, p-value = 2.333e-06
## alternative hypothesis: true mean is greater than 3.73
## 99 percent confidence interval:
##  3.858015      Inf
## sample estimates:
## mean of x 
##     3.982

Mit einer Irrtumswahrscheinlichkeit von 5% kann die \(H_0\) verworfen und die \(H_1\) angenommen werden. Die weiblichen Psychologie-Studierenden haben verglichen mit der Gesamtbevölkerung der Frauen höhere Gewissenhaftswerte. Das 99%-ige Konfidenzintervall liegt zwischen 3.86 und \(\infty\) (außerhalb des definierten Wertebereichs). Das bedeutet, dass in 99% der Fälle in einer wiederholten Ziehung aus der Grundgesamtheit die mittleren Verträglichkeitswerte zwischen 3.86 und \(\infty\) (außerhalb des definierten Wertebereichs) liegen.

Effektgröße

Für das Effektgrößemaß berechnen wir Cohen’s d.

mean_gewis_frauen <- mean(fb22_frauen$gewis, na.rm = T)
sd_gewis_frauen <- sd(fb22_frauen$gewis, na.rm = T)
mean_gewis_population <- 3.73
d <- abs((mean_gewis_frauen - mean_gewis_population)/sd_gewis_frauen)

Die Effektgröße ist mit 0.43 als groß einzustufen.

Zuerst schauen wir uns an ob die Variable Lerntyp bereits als Faktor vorliegt und wandeln sie gegebenenfalls um.

is.factor(fb22$lerntyp)

## [1] FALSE

fb22$lerntyp <- factor(fb22$lerntyp, 
                       levels = 1:3, 
                       labels = c("alleine", "Gruppe", "Mischtyp"))

Nun wollen wir eine neue Variable erstellen, in der die Personen, die gerne in der Gruppe lernen oder ein Mischtyp sind, zusammengefasst werden.

fb22$lerntyp_neu <- fb22$lerntyp == "alleine"
fb22$lerntyp_neu <- as.numeric(fb22$lerntyp_neu) #Umwandlung in Numeric, da der Variablen Typ nun Logical ist
fb22$lerntyp_neu <- factor(fb22$lerntyp_neu, 
                           levels = 0:1, 
                           labels = c("Gruppe oder Mischtyp", "alleine"))

Jetzt können wir uns die Extraversion der Gruppen deskriptiv in einem Boxplot darstellen lassen.

boxplot(fb22$extra ~ fb22$lerntyp_neu, xlab = "Lerntyp", ylab = "Extraversion") 

Deskriptiv lässt sich ein Mittelwertsunterschied feststellen. Diesen wollen wir aber nun noch inferenzstatistisch überprüfen. Dafür überprüfen wir die Voraussetzungen eines t-Tests für unabhängige Stichproben. Wir können annehmen, dass die abhängige Variable intervallskaliert ist und dass die einzelnen Messwerte voneinander unabhängig sind. Wir müssen nun noch die Normalverteilung der Extraversion in den Gruppen und die Homoskedastizität überprüfen.

Prüfung der Normalverteilung

Wir nutzen dafür die qqPlot Funktion aus dem car Paket.

library(car)

## Lade nötiges Paket: carData

qqPlot(fb22$extra[fb22$lerntyp_neu == "alleine"])

## [1]  7 38

qqPlot(fb22$extra[fb22$lerntyp_neu == "Gruppe oder Mischtyp"])

## [1] 12 32

Die Abweichungen sind nicht zu weit. Trotzdem führen wir zur weiteren Absicherung noch den Shapiro-Test durch.

shapiro.test(fb22$extra[fb22$lerntyp_neu == "alleine"])

## 
## 	Shapiro-Wilk normality test
## 
## data:  fb22$extra[fb22$lerntyp_neu == "alleine"]
## W = 0.98369, p-value = 0.5273

shapiro.test(fb22$extra[fb22$lerntyp_neu == "Gruppe oder Mischtyp"])

## 
## 	Shapiro-Wilk normality test
## 
## data:  fb22$extra[fb22$lerntyp_neu == "Gruppe oder Mischtyp"]
## W = 0.98029, p-value = 0.2395

Keiner der Tests ist signifikant, sodass wir die Normalverteilungsannahme beibehalten.

Homoskedastizität

Diese überprüfen wir mittels Levene-Test.

leveneTest(fb22$extra ~ fb22$lerntyp_neu)

## Levene's Test for Homogeneity of Variance (center = median)
##        Df F value Pr(>F)
## group   1  0.0049 0.9445
##       147

Das Ergebnis ist nicht signifikant, sodass wir die \(H_0\) nicht ablehnen und die Homoskedastizität der Varianzen annehmen können. Damit sind alle Voraussetzungen eines t-Tests erfüllt.

t.test(fb22$extra ~ fb22$lerntyp_neu, var.equal = T)

## 
## 	Two Sample t-test
## 
## data:  fb22$extra by fb22$lerntyp_neu
## t = 4.6444, df = 147, p-value = 7.506e-06
## alternative hypothesis: true difference in means between group Gruppe oder Mischtyp and group alleine is not equal to 0
## 95 percent confidence interval:
##  0.2922374 0.7251452
## sample estimates:
## mean in group Gruppe oder Mischtyp              mean in group alleine 
##                           3.594512                           3.085821

Der deskriptive Unterschied der Mittelwerte lässt sich somit auch inferenzstatistisch feststellen, denn mit einer Irrtumswahrscheinlichkeit von 5% kann die \(H_0\) verworfen und die \(H_1\) angenommen werden. Die Teilnehmenden, die lieber alleine lernen, unterscheiden sich von den Teilnehmenden, die lieber in der Gruppe lernen oder ein Mischtyp sind, in ihrer Extraversion (t(df = 147, zweis.) = 4.64, p = <.001).

Als erstes müssen wir den Datensatz aufbereiten.

is.factor(fb22$wohnen)

## [1] FALSE

is.factor(fb22$job)

## [1] FALSE

fb22$wohnen <- factor(fb22$wohnen, levels = 1:4, labels = c("WG", "bei Eltern", "alleine", "sonstiges"))
fb22$job <- factor(fb22$job, levels = 1:2, labels = c("nein", "ja"))

fb22$wohnen_bei_Eltern <- fb22$wohnen == "bei Eltern" #wir erstellen eine Variable, die angibt, ob eine Personen bei den Eltern wohnt oder nicht

Die Voraussetzungen, dass die einzelnen Beobachtungen voneinander unabhängig sind und jede Person eindeutig einer Merkmalskombination zuordbar ist, ist durch das Studiendesign erfüllt. Wir müssen aber noch prüfen, ob jede Zelle mit mehr als fünf Personen gefüllt ist.

tab <- table(fb22$wohnen_bei_Eltern, fb22$job)
tab

##        
##         nein ja
##   FALSE   62 30
##   TRUE    35 21

Die Voraussetzungen für einen Chi-Quadrat-Test sind erfüllt.

Für die Erwarteten Häufigkeiten brauchen wir die Randsummen. Diese erhalten wir mit dem Befehl addmargins.

tab_mar <- addmargins(tab)
tab_mar

##        
##         nein  ja Sum
##   FALSE   62  30  92
##   TRUE    35  21  56
##   Sum     97  51 148

Die erwarteten Häufigkeiten der Zellen erhalten wir wie folgt:

n <- tab_mar[3,3]

erwartet_11 <- (tab_mar[1,3]*tab_mar[3,1])/n
erwartet_12 <- (tab_mar[1,3]*tab_mar[3,2])/n
erwartet_21 <- (tab_mar[2,3]*tab_mar[3,1])/n
erwartet_22 <- (tab_mar[2,3]*tab_mar[3,2])/n

erwartet <- data.frame(nein = c(erwartet_11, erwartet_21), ja = c(erwartet_12, erwartet_22))
erwartet

##      nein      ja
## 1 60.2973 31.7027
## 2 36.7027 19.2973

Für die Signifikanzentscheidung berechnen wir den empirischen Chi-Quadrat-Wert und den zugehörigen p-Wert.

chi_quadrat_Wert <- (tab[1,1]-erwartet[1,1])^2/erwartet[1,1]+
  (tab[1,2]-erwartet[1,2])^2/erwartet[1,2]+
  (tab[2,1]-erwartet[2,1])^2/erwartet[2,1]+
  (tab[2,2]-erwartet[2,2])^2/erwartet[2,2]

chi_quadrat_Wert

## [1] 0.368761

pchisq(chi_quadrat_Wert, 1, lower.tail = F) #Freiheitsgrad beträgt 1

## [1] 0.5436804

Somit ist der Test nicht signifikant und es lässt sich feststellen, dass das Wohnen bei den Eltern nicht damit zusammen hängt, ob ein Nebenjob ausgeübt wird.

Wir können unser Ergebnis auch noch mit dem Befehl chisq.test() überprüfen und sehen, dass dieser das gleiche Ergebnis liefert.

chisq.test(tab, correct = F)

## 
## 	Pearson's Chi-squared test
## 
## data:  tab
## X-squared = 0.36876, df = 1, p-value = 0.5437

Wir beginnen die Voraussetzungen des t-Tests für unabhängige Stichproben zu überprüfen. Die Voraussetzungen der Intervallskaliertheit der unabhängigen Variable und die Unabhängigkeit der einzelnen Messwerte ist per Untersuchungsdesign erfüllt. Wir wollen nun also die Normalverteilung des Merkmals in der Grundgesamtheit der Gruppen überprüfen.

#Wir überprüfen erst wieder, ob die Variable Nebenjob als Faktor vorliegt
is.factor(fb22$job)

## [1] TRUE

library(car)
qqPlot(fb22$intel[fb22$job == "nein"])

## [1] 30 79

qqPlot(fb22$intel[fb22$job == "ja"])

## [1] 49 46

shapiro.test(fb22$intel[fb22$job == "nein"])

## 
## 	Shapiro-Wilk normality test
## 
## data:  fb22$intel[fb22$job == "nein"]
## W = 0.96409, p-value = 0.009372

shapiro.test(fb22$intel[fb22$job == "ja"])

## 
## 	Shapiro-Wilk normality test
## 
## data:  fb22$intel[fb22$job == "ja"]
## W = 0.93146, p-value = 0.005113

Die Normalverteilungsannahme ist nicht erfüllt. Wir können also keinen t-Test durchführen. Wir überprüfen nun die Voraussetzungen des Wilcoxon-Tests. Wir überprüfen optisch, ob die Messwerte der beiden Gruppen ungefähr der selben Verteilung folgen.

hist(fb22$intel[fb22$job == "ja"])

hist(fb22$intel[fb22$job == "nein"])

Dies kann angenommen werden. Zuletzt überprüfen wir noch die Gleichheit der Streuung in beiden Gruppen mittels Levene-Test.

leveneTest(fb22$intel ~ fb22$job)

## Levene's Test for Homogeneity of Variance (center = median)
##        Df F value Pr(>F)
## group   1  0.0088 0.9254
##       147

Wir können von Varianzhomogenität ausgehen und somit einen Wilcoxon-Test durchführen.

wilcox.test(fb22$lz ~ fb22$ort)

## 
## 	Wilcoxon rank sum test with continuity correction
## 
## data:  fb22$lz by fb22$ort
## W = 2775, p-value = 0.3029
## alternative hypothesis: true location shift is not equal to 0

Das Ergebnis des zweiseitigen Wilcoxon-Tests ist nicht signifikant (W = 2775, p = 0.303 ). Die Nullhypothese konnte nicht verworfen werden und wird beibehalten. Wir gehen also davon aus, dass sich Psychologie-Studierende, die einen Nebenjob haben und Psychologie-Studierende, die keinen Nebenjob haben, sich nicht in ihrem Intellekt unterscheiden.

\(H_0\): Die durchschnittliche Nerdiness von Psychologoiestudierenden unterscheidet sich nicht von ihrem Intellekt.

\(H_0\): \(\mu_0\) \(=\) \(\mu_1\)

\(H_1\): Die durchschnittliche Nerdiness von Psychologoiestudierenden unterscheidet sich von ihrem Intellekt.

\(H_1\): \(\mu_0\) \(≠\) \(\mu_1\)

Da die Nerdiness- und Intellekt-Werte, die verglichen werden sollen, immer von der selben Person stammen, sind die Werte voneinander abhängig. Daher wollen wir einen t-Test für abhängige Stichproben durchführen. Die Werte sind intervallskaliert, voneinander abhängig und die Differenzvariable ist normalverteilt, da wir bei einer Stichprobe von n ≥ 30 direkt davon ausgehen können. Somit sind alle Voraussetzungen für den t-Test erfüllt.

t.test(fb22$nerd, fb22$intel, paired = T)

## 
## 	Paired t-test
## 
## data:  fb22$nerd and fb22$intel
## t = -7.0571, df = 158, p-value = 5.052e-11
## alternative hypothesis: true mean difference is not equal to 0
## 95 percent confidence interval:
##  -0.5923110 -0.3332655
## sample estimates:
## mean difference 
##      -0.4627883

Der Gruppenunterschied ist signifikant (t(158) = -7.06 , p < .001), somit wird die Nullhypothese verworfen. Psychologiestudierende weisen unterschiedliche Werte auf der Skala Nerdiness und auf der Skala Intellekt auf.

Effektstärke:

library("effsize")

## Warning: Paket 'effsize' wurde unter R Version 4.2.2 erstellt

cohen.d(fb22$nerd, fb22$intel, paired = T, within = F)

## 
## Cohen's d
## 
## d estimate: -0.559661 (medium)
## 95 percent confidence interval:
##      lower      upper 
## -0.7274678 -0.3918542

Der Effekt ist mit -0.56 als mittel bis groß einzuschätzen.

Als erstes erstellen wir eine Variable mit der Anzahl an geschriebenen Wörtern.

fb22$woerter_grund <- str_count(fb22$grund, "\\w+")

Nun schauen wir uns den Zusammenhang der Variablen in einem Scatterplot an.

plot(x = fb22$woerter_grund, y = fb22$gewis)

Wir schließen einen nicht linearen Zusammenhang nicht aus und überprüfen nun die Normalverteilung der Variablen.

library(car)
qqPlot(fb22$gewis)

## [1] 54 80

qqPlot(fb22$woerter_grund)

## [1] 136  93

Die Normalverteilungsannahme ist nicht erfüllt. Daher können wir keine Pearson-Produkt-Moment Korrelation berechnen und berechnen stattdessen die Rangkorrelation nach Spearman, die nicht an die Normalverteilungsannahme gebunden ist.

cor.test(fb22$woerter_grund, fb22$gewis, method = "spearman", alternative = "greater")

## Warning in cor.test.default(fb22$woerter_grund, fb22$gewis, method =
## "spearman", : Kann exakten p-Wert bei Bindungen nicht berechnen

## 
## 	Spearman's rank correlation rho
## 
## data:  fb22$woerter_grund and fb22$gewis
## S = 466277, p-value = 0.3041
## alternative hypothesis: true rho is greater than 0
## sample estimates:
##       rho 
## 0.0432278

Es besteht kein positiver Zusammenhang zwischen Gewissenhaftigkeit und der Anzahl an geschriebenen Wörter bei der Begründung für das Psychologiestudium.

Die einzige Voraussetzung, die wir vor der Aufstellung des Regressionsmodell prüfen können, ist der lineare Zusammenhang der Variablen mit Hilfe eines Scatterplot.

plot(fb22$gewis, fb22$prok_ges, xlab = "Gewissenhaftigkeit", ylab = "Prokrastination", 
     main = "Zusammenhang zwischen Gewissenhaftigkeit und Prokrastination", pch = 19)
lines(loess.smooth(fb22$gewis, fb22$prok_ges), col = 'blue')

Die Voraussetzung ist erfüllt. Wir können nun also unser Regressionsmodell aufstellen.

fm <- lm(prok_ges ~ 1 + gewis, data = fb22)

Nun prüfen wir die anderen Voraussetungen.

par(mfrow = c(2, 2)) #vier Abbildungen gleichzeitig
plot(fm)

Der Q-Q-Plot oben rechts deutet auf Normalverteilung hin. Die rote Anpassungslinie des Scale-Location Plots unten links ist annähernd parallel zur x-Achse, sodass wir von Varianzhomogenität ausgehen können. Da auch der vierte Plot unten rechts nicht auf potentiell problematische einflussreiche Datenpunkte hindeutet, sind alle Vorausetzungen erfüllt.

fm

## 
## Call:
## lm(formula = prok_ges ~ 1 + gewis, data = fb22)
## 
## Coefficients:
## (Intercept)        gewis  
##      4.0282      -0.3922

confint(fm, level = .99)

##                  0.5 %     99.5 %
## (Intercept)  3.4658771  4.5906215
## gewis       -0.5352757 -0.2490569

In keiner der Intervalle ist die Null enthalten, sodass wir davon ausgehen können, dass die beiden Koeffizienten tatsächlich von Null verschieden sind.

summary(fm)

## 
## Call:
## lm(formula = prok_ges ~ 1 + gewis, data = fb22)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -1.24783 -0.35371 -0.05175  0.33846  1.04629 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  4.02825    0.21564  18.680  < 2e-16 ***
## gewis       -0.39217    0.05487  -7.147 3.27e-11 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.4524 on 155 degrees of freedom
##   (2 Beobachtungen als fehlend gelöscht)
## Multiple R-squared:  0.2478,	Adjusted R-squared:  0.243 
## F-statistic: 51.07 on 1 and 155 DF,  p-value: 3.273e-11

summary(fm)$r.squared

## [1] 0.2478399

Durch die Gewissenhaftigkeit kann 24.78% der Varianz von Prokrastination erklärt werden.

fm$coefficients[1] + 3.2*fm$coefficients[2]

## (Intercept) 
##    2.773317

#Alternativ:
predict(fm, newdata = data.frame(gewis = 3.2))

##        1 
## 2.773317

d <- -0.56 #Effektstärke
N <- 159 #Anzahl der Teilnehmenden von fb22
set.seed(4321)
tH1 <- replicate(n = 10^4, expr = {X <- rnorm(159) 
                                   Y <- rnorm(159) + d #Normalverteilte Stichproben mit Mittelwertsunterschied von d Standardabweichungen
                                   ttestH1 <- t.test(X, Y, var.equal = TRUE, paired = T) #Paired = T, da es sich um einen t-Test für abhängige Stichproben handelt
                                   ttestH1$p.value})
mean(tH1 < .05 )

## [1] 0.9989

1 - mean(tH1 < .05 )

## [1] 0.0011

Die Wahrscheinlichkeit eines \(\beta\)-Fehlers beträgt 0.11%.

set.seed(4321)
tH1 <- replicate(n = 10^4, expr = {X <- rnorm(159) 
                                   Y <- rnorm(159) + d 
                                   ttestH1 <- t.test(X, Y, var.equal = TRUE, paired = T)
                                   ttestH1$statistic})
power <- c(mean(abs(tH1) > qt(p = 1- 0.001/2, df = N)), mean(abs(tH1) > qt(p = 1- 0.01/2, df = N)), mean(abs(tH1) > qt(p = 1- 0.025/2, df = N)), mean(abs(tH1) > qt(p = 1- 0.05/2, df = N)), mean(abs(tH1) > qt(p = 1- 0.1/2, df = N)))

x <- c(.001, 0.01, 0.025, 0.05, 0.1)
plot(x = x, y = power, type = "b", main = "Power vs. Alpha")

Wir sehen das je größer das \(\alpha\)-Niveau ist, desto höher ist unsere Power. Mit unserer Stichprobengröße von n = 159 haben wir selbst bei einem hypothetischen \(\alpha\)-Niveau von 0.1% noch eine Power von knapp 95%.