Daten & Packages laden

Laden Sie die folgenden Packages und Data Frames:

Q1: In dem Dataframe stimm.df produzierten Versuchspersonen (Vpn) darunter zwei Altersgruppen (Alter) /pa, ba/ (K). VOT (vot) wurde gemessen. Prüfen Sie, ob die Stimmhaftigkeit und das Alter einen Einfluss auf VOT hatten.

summary(stimm.df)

##       vot            K           Vpn      Alter   
##  Min.   :-31.5000   ba:64   A      :16   Erw :48  
##  1st Qu.: -9.6250   pa:64   B      :16   Kind:80  
##  Median :  2.7000           C      :16            
##  Mean   :  0.2677           D      :16            
##  3rd Qu.:  9.1500           E      :16            
##  Max.   : 29.5000           F      :16            
##                             (Other):32

Die allgemine Formel:

y ~ FF + RF
y: vot
FF: Alter, K
RF: Vpn

Abbildung: beide Gruppen trennen /ba, pa/. Es wird wahrscheinlich eine Interaktion zwischen den FFs geben.

stimm.df %>% 
  ggplot() + 
  aes(x = K, y = vot, col = Alter) + 
  geom_boxplot()

Festellung von ‘within’ und ‘between’.

Alter ist “between” in Relation zu Vpn: (1|Vpn)

stimm.df %>%
  select(Vpn, Alter) %>% 
  table()

##    Alter
## Vpn Erw Kind
##   A   0   16
##   B   0   16
##   C   0   16
##   D  16    0
##   E  16    0
##   F  16    0
##   G   0   16
##   H   0   16

K ist “within” in Relation zu Vpn

stimm.df %>% 
  select(Vpn, K) %>% 
  table()

##    K
## Vpn ba pa
##   A  8  8
##   B  8  8
##   C  8  8
##   D  8  8
##   E  8  8
##   F  8  8
##   G  8  8
##   H  8  8

Alternativ mit einem Befehl:

stimm.df %>%
  mutate(Fac = interaction(Alter, K)) %>%
  select(Vpn, Fac) %>%
  table()

##    Fac
## Vpn Erw.ba Kind.ba Erw.pa Kind.pa
##   A      0       8      0       8
##   B      0       8      0       8
##   C      0       8      0       8
##   D      8       0      8       0
##   E      8       0      8       0
##   F      8       0      8       0
##   G      0       8      0       8
##   H      0       8      0       8

Die Vollständige Formel ist also vot ~ K * Alter + (K|Vpn).

Mit step() überprüfen, ob es nicht Faktoren gibt, die eliminiert werden sollten:

stimm.df %>%
  lmer(vot ~ K * Alter + (K|Vpn), .) %>%
  step()

## Backward reduced random-effect table:
## 
##                Eliminated npar  logLik    AIC    LRT Df Pr(>Chisq)  
## <none>                       8 -297.30 610.59                       
## K in (K | Vpn)          0    6 -299.82 611.64 5.0439  2     0.0803 .
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Backward reduced fixed-effect table:
## Degrees of freedom method: Satterthwaite 
## 
##         Eliminated Sum Sq Mean Sq NumDF  DenDF F value    Pr(>F)    
## K:Alter          0 933.71  933.71     1 5.9991  211.96 6.595e-06 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Model found:
## vot ~ K * Alter + (K | Vpn)

Das ist nicht der Fall.

Signifikanzen berechnen mit anova():

stimm.df %>%
  lmer(vot ~ K * Alter + (K|Vpn), .) %>%
  anova()

## Type III Analysis of Variance Table with Satterthwaite's method
##          Sum Sq Mean Sq NumDF  DenDF  F value    Pr(>F)    
## K       1926.48 1926.48     1 5.9991 437.3206 7.798e-07 ***
## Alter      1.12    1.12     1 6.0006   0.2532    0.6327    
## K:Alter  933.71  933.71     1 5.9991 211.9569 6.595e-06 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Aufgrund der signifikanten Interaktion werden post-hoc Tests mit emmeans() berechnet:

stimm.df %>%
  lmer(vot ~ K * Alter + (K|Vpn), .) %>%
  emmeans(., ~ K * Alter) %>%
  pairs(., simple = "each", combine=T)

##  Alter K  contrast   estimate    SE df t.ratio p.value
##  Erw   .  ba - pa      -23.41 1.044  6 -22.434  <.0001
##  Kind  .  ba - pa       -4.19 0.808  6  -5.188  0.0082
##  .     ba Erw - Kind   -14.54 9.970  6  -1.458  0.7801
##  .     pa Erw - Kind     4.68 9.668  6   0.484  1.0000
## 
## Degrees-of-freedom method: kenward-roger 
## P value adjustment: bonferroni method for 4 tests

Die Stimmhaftigkeit hatte einen signifikanten Einfluss auf die VOT (\(F[1, 6.0] = 437.3, p < 0.001\)). Es gab zusätzlich eine signifikante Interaktion zwischen Alter und Stimmhaftigkeit (\(F[1, 6.0] = 212.0, p < 0.001\)). Post-hoc Vergleiche zeigten signifikante VOT-Unterschiede zwischen /ba/ und /pa/ sowohl für Erwachsene (\(p < 0.001\)) als auch für Kinder (\(p < 0.01\)).

Q2: In dem Dataframe x24.df produzierten Versuchspersonen (Vpn) verschiedene Wörter (Wort). Euklidsche Entfernungen zum Schwavokal (ent) wurden für verschiedene Vokale (V) gemessen. Prüfen Sie durch eine Abbildung und statistischen Test, inwiefern Vokale die Entfernungen beeinflusst haben.

Faktoren:

y: ent
V: FF
Vpn, Wort: RF

summary(x24.df)

##       ent                Vpn           Wort     V      
##  Min.   :-2.86300   S1     : 36   W1     : 24   a:288  
##  1st Qu.:-0.66583   S10    : 36   W10    : 24   i:288  
##  Median : 0.02545   S11    : 36   W11    : 24   u:288  
##  Mean   : 0.02349   S12    : 36   W12    : 24          
##  3rd Qu.: 0.70928   S13    : 36   W13    : 24          
##  Max.   : 3.51348   S14    : 36   W14    : 24          
##                     (Other):648   (Other):720

Der Plot zeigt geringe Unterschiede zwischen /a, i, u/

x24.df %>%
  ggplot() +
  aes(y = ent, x = V) %>%
  geom_boxplot()

V ist “within” in Relation zu Vpn: (V|Vpn)

x24.df %>%
  select(Vpn, V) %>%
  table()

##      V
## Vpn    a  i  u
##   S1  12 12 12
##   S10 12 12 12
##   S11 12 12 12
##   S12 12 12 12
##   S13 12 12 12
##   S14 12 12 12
##   S15 12 12 12
##   S16 12 12 12
##   S17 12 12 12
##   S18 12 12 12
##   S19 12 12 12
##   S2  12 12 12
##   S20 12 12 12
##   S21 12 12 12
##   S22 12 12 12
##   S23 12 12 12
##   S24 12 12 12
##   S3  12 12 12
##   S4  12 12 12
##   S5  12 12 12
##   S6  12 12 12
##   S7  12 12 12
##   S8  12 12 12
##   S9  12 12 12

V ist “within” in Relation zu Wort: (V|Wort)

x24.df %>%
  select(Wort, V) %>%
  table()

##      V
## Wort  a i u
##   W1  8 8 8
##   W10 8 8 8
##   W11 8 8 8
##   W12 8 8 8
##   W13 8 8 8
##   W14 8 8 8
##   W15 8 8 8
##   W16 8 8 8
##   W17 8 8 8
##   W18 8 8 8
##   W19 8 8 8
##   W2  8 8 8
##   W20 8 8 8
##   W21 8 8 8
##   W22 8 8 8
##   W23 8 8 8
##   W24 8 8 8
##   W25 8 8 8
##   W26 8 8 8
##   W27 8 8 8
##   W28 8 8 8
##   W29 8 8 8
##   W3  8 8 8
##   W30 8 8 8
##   W31 8 8 8
##   W32 8 8 8
##   W33 8 8 8
##   W34 8 8 8
##   W35 8 8 8
##   W36 8 8 8
##   W4  8 8 8
##   W5  8 8 8
##   W6  8 8 8
##   W7  8 8 8
##   W8  8 8 8
##   W9  8 8 8

Die Vollständige Formel ist daher: ent ~ V + (V|Vpn) + (V|Wort)

Mit step() überprüfen, was eliminiert werden kann

x24.df %>%
  lmer(ent ~ V + (V|Vpn) + (V|Wort), .) %>%
  step()

## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
## Model failed to converge with max|grad| = 0.0025122 (tol = 0.002, component 1)

## boundary (singular) fit: see help('isSingular')

## Backward reduced random-effect table:
## 
##                 Eliminated npar  logLik    AIC     LRT Df Pr(>Chisq)    
## <none>                       16 -1017.7 2067.5                          
## V in (V | Wort)          1   11 -1018.2 2058.4   0.962  5     0.9656    
## V in (V | Vpn)           2    6 -1022.4 2056.8   8.313  5     0.1398    
## (1 | Wort)               0    5 -1150.2 2310.4 255.663  1     <2e-16 ***
## (1 | Vpn)                0    5 -1176.6 2363.1 308.351  1     <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Backward reduced fixed-effect table:
## Degrees of freedom method: Satterthwaite 
## 
##   Eliminated Sum Sq Mean Sq NumDF DenDF F value    Pr(>F)    
## V          0 24.105  12.053     2   803  23.559 1.141e-10 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Model found:
## ent ~ V + (1 | Wort) + (1 | Vpn)

Model found: ent ~ V + (1 | Wort) + (1 | Vpn)

Signifikanzen für das neue Modell berechnen:

x24.df %>%
  lmer(ent ~ V + (1 | Wort) + (1 | Vpn), .) %>%
  anova()

## Type III Analysis of Variance Table with Satterthwaite's method
##   Sum Sq Mean Sq NumDF DenDF F value    Pr(>F)    
## V 24.105  12.053     2   803  23.559 1.141e-10 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Wir könnten auch noch einen post-hoc Test durchführen, um zu sehen, welche Differenzen zwischen Vokalpaaren signifikant sind:

x24.df %>%
  lmer(ent ~ V + (1 | Wort) + (1 | Vpn), .) %>%
  emmeans(., ~V) %>%
  pairs(., simple = "each", combine=T)

##  contrast estimate     SE  df t.ratio p.value
##  a - i      -0.407 0.0596 803  -6.834  <.0001
##  a - u      -0.237 0.0596 803  -3.976  0.0002
##  i - u       0.170 0.0596 803   2.858  0.0131
## 
## Degrees-of-freedom method: kenward-roger 
## P value adjustment: bonferroni method for 3 tests

Vokal hat einen signifikanten Einfluss auf die Entfernung (\(F[2, 803] = 23.6, p < 0.001\)). Post-hoc Tests zeigten signifikante Unterschiede zwischen allen Vokalpaaren (a-i: \(p < 0.001\); a-u: \(p < 0.001\); i-u: \(p < 0.05\)).

Q3: In dem Dataframe rate.df produzierten Versuchspersonen (subject) aufgeteilt nach Geschlecht (gender) und Alter (age) verschiedene Wörter (word). Die Sprechgeschwindigkeit (rate) wurde gemessen. Prüfen Sie durch eine Abbildung und statistischen Test, ob die Sprechgeschwindigkeit durch Geschlecht und Alter beeinflusst wurde.
y: rate
FF: gender, age
RF: subject, word

summary(rate.df)

##     subject         word          rate           gender     age     
##  S1     : 30   A1     : 90   Min.   : 0.001484   F:450   old  :510  
##  S2     : 30   A2     : 90   1st Qu.: 2.019117   M:450   young:390  
##  S3     : 30   A3     : 90   Median : 4.714042                      
##  S4     : 30   A4     : 90   Mean   : 4.883285                      
##  S5     : 30   A5     : 90   3rd Qu.: 7.288738                      
##  S6     : 30   A6     : 90   Max.   :15.509703                      
##  (Other):720   (Other):360

Abbildung: gender scheint kaum einen Einfluss auf rate zu haben, Ältere hatten eine etwas höhere rate als Jüngere, und es gibt wahrscheinlich eine Interaktion (weil der Effekt von rate auf Männern und Frauen unterschiedlich ist):

rate.df %>% 
  ggplot() + 
  aes(y = rate, x = gender, col = age) + 
  geom_boxplot()

gender ist “between” in Relation zu subject: (1|subject)

rate.df %>% 
  select(subject, gender) %>% 
  table()

##        gender
## subject  F  M
##     S1   0 30
##     S2  30  0
##     S3  30  0
##     S4   0 30
##     S5   0 30
##     S6  30  0
##     S7  30  0
##     S8  30  0
##     S9   0 30
##     S10  0 30
##     S11 30  0
##     S12 30  0
##     S13  0 30
##     S14 30  0
##     S15 30  0
##     S16 30  0
##     S17 30  0
##     S18 30  0
##     S19 30  0
##     S20  0 30
##     S21 30  0
##     S22  0 30
##     S23  0 30
##     S24 30  0
##     S25  0 30
##     S26  0 30
##     S27  0 30
##     S28  0 30
##     S29  0 30
##     S30  0 30

age ist “between” in Relation zu subject: (1|subject)

rate.df %>% 
  select(subject, age) %>% 
  table()

##        age
## subject old young
##     S1    0    30
##     S2   30     0
##     S3   30     0
##     S4    0    30
##     S5    0    30
##     S6    0    30
##     S7   30     0
##     S8    0    30
##     S9    0    30
##     S10  30     0
##     S11  30     0
##     S12  30     0
##     S13   0    30
##     S14   0    30
##     S15  30     0
##     S16   0    30
##     S17   0    30
##     S18  30     0
##     S19  30     0
##     S20  30     0
##     S21  30     0
##     S22  30     0
##     S23  30     0
##     S24  30     0
##     S25   0    30
##     S26  30     0
##     S27  30     0
##     S28  30     0
##     S29   0    30
##     S30   0    30

gender ist “within” in Relation zu word: (gender|word)

rate.df %>% 
  select(word, gender) %>% 
  table()

##      gender
## word   F  M
##   A1  45 45
##   A2  45 45
##   A3  45 45
##   A4  45 45
##   A5  45 45
##   A6  45 45
##   A7  45 45
##   A8  45 45
##   A9  45 45
##   A10 45 45

age ist “within” in Relation zu word: (age|word)

rate.df %>% 
  select(word, age) %>% 
  table()

##      age
## word  old young
##   A1   51    39
##   A2   51    39
##   A3   51    39
##   A4   51    39
##   A5   51    39
##   A6   51    39
##   A7   51    39
##   A8   51    39
##   A9   51    39
##   A10  51    39

step() anwenden: alle Faktoren bleiben.

rate.df %>%
  lmer(rate ~ gender * age + (1|subject) + (gender+age|word), .) %>%
  step()

## Backward reduced random-effect table:
## 
##                                 Eliminated npar  logLik    AIC    LRT Df
## <none>                                       12 -1843.2 3710.3          
## (1 | subject)                            0   11 -1892.3 3806.7 98.329  1
## gender in (gender + age | word)          0    9 -1848.0 3714.0  9.685  3
## age in (gender + age | word)             0    9 -1859.7 3737.4 33.111  3
##                                 Pr(>Chisq)    
## <none>                                        
## (1 | subject)                    < 2.2e-16 ***
## gender in (gender + age | word)    0.02145 *  
## age in (gender + age | word)     3.052e-07 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Backward reduced fixed-effect table:
## Degrees of freedom method: Satterthwaite 
## 
##            Eliminated Sum Sq Mean Sq NumDF DenDF F value  Pr(>F)  
## gender:age          0 16.024  16.024     1    26  5.2013 0.03101 *
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Model found:
## rate ~ gender * age + (1 | subject) + (gender + age | word)

Signifikanzen berechnen mit anova():

rate.df %>%
  lmer(rate ~ gender * age + (1|subject) + (gender+age|word), .) %>%
  anova()

## Type III Analysis of Variance Table with Satterthwaite's method
##             Sum Sq Mean Sq NumDF  DenDF F value   Pr(>F)   
## gender      3.1786  3.1786     1 28.360  1.0318 0.318331   
## age        30.2124 30.2124     1 25.348  9.8069 0.004347 **
## gender:age 16.0238 16.0238     1 26.000  5.2013 0.031007 * 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Da die Interaktion signifikant ist, post-hoc Tests anwenden:

rate.df %>%
  lmer(rate ~ gender * age + (1|subject) + (gender+age|word), .) %>%
  emmeans(., ~ gender * age) %>%
  pairs(., simple = "each", combine=T)

##  age   gender contrast    estimate    SE   df t.ratio p.value
##  old   .      F - M         -1.109 0.452 29.4  -2.451  0.0817
##  young .      F - M          0.379 0.516 29.1   0.735  1.0000
##  .     F      old - young    0.570 0.543 31.7   1.050  1.0000
##  .     M      old - young    2.057 0.520 31.3   3.957  0.0016
## 
## Degrees-of-freedom method: kenward-roger 
## P value adjustment: bonferroni method for 4 tests

Die Sprechgeschwindigkeit wurde signifikant vom Alter beeinflusst (\(F[1, 25.4] = 9.8, p < 0.001\)), und es gab eine signifikante Interaktion zwischen Alter und Geschlecht (\(F[1, 26.0] = 5.2, p < 0.05\)). Post-hoc Tests zeigten einen signifikanten Unterschied zwischen den Altersgruppen in Männern (\(p < 0.01\)), aber nicht in Frauen. Der Unterschied zwischen älteren Männern und älteren Frauen war nicht ganz signifikant (\(p = 0.08\)).

Lösung zu Übung 10

Jonathan Harrington / Johanna Cronenberg

Juni 2022

Daten & Packages laden