Bitte eingeben:

Nachname:
Vorname:
Email:

Zeit erlaubt: 90 Minuten. Bitte alle Fragen beantworten und Ihre Rmd-Datei regelmäßig speichern. Schicken Sie am Ende der Klausur Ihre Rmd Datei an Jonathan Harrington Email = jmh@phonetik.uni-muenchen.de.

Daten & Packages laden

Laden Sie die folgenden Packages und Data-Frames:

library(tidyverse)
library(broom)
library(gridExtra)
library(lmerTest)
library(emmeans)
library(MuMIn)
library(afex)
sigmoid = function(x, k = 0, m = 1) {
  exp(m * x + k) / (1 + exp(m * x + k))
}
urla = "https://www.phonetik.uni-muenchen.de/studium_lehre/"
urlb = "lehrmaterialien/R_speech_processing/Rdf"
url = paste0(urla, urlb)
syntax.df = read.table(file.path(url, "syntax.df.txt"), 
                          stringsAsFactors = T)

s.df = read.table(file.path(url, "sret.df.txt"), 
                          stringsAsFactors = T)
bund.df = read.table(file.path(url, "bund.df.txt"), 
                          stringsAsFactors = T)
g.df = read.table(file.path(url, "geschwindigkeit.df.txt"), 
                          stringsAsFactors = T)

Fragen

Q1: In dem Data-Frame syntax.df wurden die Reaktionszeiten im Millisekunden (Zeit) von Versuchspersonen (Faktor Vpn) gemessen, um den Unterschied zwischen aktiven und passiven Konstruktionen (Faktor Syntax) zu erkennen. Die Versuchspersonen wurden aufgeteilt nach Geschlecht (Faktor G). Prüfen Sie durch eine Abbildung und statistischen Test, ob die Reaktionszeiten von der Syntax und Geschlecht beeinflusst wurden.

syntax.df %>% ggplot +
  aes(y = Zeit, x = Syntax, col = G) +
  geom_boxplot()

syntax.df %>%
aov_4(Zeit ~ Syntax * G + (1|Vpn), .)

## Contrasts set to contr.sum for the following variables: Syntax, G

## Anova Table (Type 3 tests)
## 
## Response: Zeit
##     Effect    df     MSE      F  ges p.value
## 1   Syntax 1, 59 8334.70   1.56 .026    .217
## 2        G 1, 59 8334.70 3.25 + .052    .077
## 3 Syntax:G 1, 59 8334.70 4.18 * .066    .045
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '+' 0.1 ' ' 1

syntax.df %>%
  aov_4(Zeit ~ Syntax * G + (1|Vpn), .) %>%
  emmeans(., ~ Syntax * G) %>%
  pairs(., simple="each", combine=T)

## Contrasts set to contr.sum for the following variables: Syntax, G

##  G Syntax contrast       estimate   SE df t.ratio p.value
##  F .      Aktiv - Passiv   -21.09 26.8 59  -0.787  1.0000
##  M .      Aktiv - Passiv    87.12 45.6 59   1.909  0.2447
##  . Aktiv  F - M             -6.41 37.9 59  -0.169  1.0000
##  . Passiv F - M            101.81 36.9 59   2.758  0.0309
## 
## P value adjustment: bonferroni method for 4 tests

Q2: Die mittlere Grundfrequenz (Hz) von 20 Frauen wurden gemessen (davor). Die Grundfrequenz derselben Frauen wurde noch einmal gemessen, nachdem Sie an einem Wahrnehmungsexperiment teilgenommen hatten (danach). Prüfen Sie durch eine Abbildung und statistischen Test, ob das Wahrnehmungsexperiment einen Einfluss auf die Grundfrequenz dieser 20 Frauen hatte.

davor = c(220,  200,  190,  240,  250,  250,  280,  220,  300,  270,  240,  180,  160,  190,  190,  280,  240,  250,  250,  230)

danach =  c(240, 220, 190, 220, 280, 260, 280, 240, 300, 290, 250, 200, 170, 180, 180, 280, 260, 270, 270, 240)

boxplot(davor-danach)

t.test(davor-danach)

## 
##  One Sample t-test
## 
## data:  davor - danach
## t = -3.2262, df = 19, p-value = 0.004445
## alternative hypothesis: true mean is not equal to 0
## 95 percent confidence interval:
##  -15.663255  -3.336745
## sample estimates:
## mean of x 
##      -9.5

Q3: Der Data-Frame s.df zeigt die Antworten von 46 verschiedenen Hörern (Vpn),nob Sie ‘passt’ mit einem ‘s’ oder ‘ʃ’ wahrgenommen hatten (Faktor Phon). Der Data-Frame zeigt auch, wie weit weg im Km. sie von München wohnten (Faktor Ent). Prüfen Sie durch eine Abbildung und statistischen Test, ob die Wahl zwischen ‘s’ oder ‘ʃ’ von der Entfernung beeinflusst wurde. Was wäre die Proportion der ‘ʃ’-Antworten, für eine Versuchsperson, die 35 Km von München wohnt?

s.df %>%
  group_by(Ent, Phon) %>%
  summarise(n = n()) %>%
  mutate(prop = n/sum(n)) %>%
  filter(Phon == levels(Phon)[2]) %>%
  ggplot() +
  aes(y = prop, x = Ent) +
  geom_point() +
  ylab("Proportion 'ʃ' Antworten")

## `summarise()` has regrouped the output.
## ℹ Summaries were computed grouped by Ent and Phon.
## ℹ Output is grouped by Ent.
## ℹ Use `summarise(.groups = "drop_last")` to silence this message.
## ℹ Use `summarise(.by = c(Ent, Phon))` for per-operation grouping
##   (`?dplyr::dplyr_by`) instead.

s.df %>%
  glm(Phon ~ Ent, ., family=binomial) %>%
  anova(test="Chisq")

## Analysis of Deviance Table
## 
## Model: binomial, link: logit
## 
## Response: Phon
## 
## Terms added sequentially (first to last)
## 
## 
##      Df Deviance Resid. Df Resid. Dev  Pr(>Chi)    
## NULL                    45     62.371              
## Ent   1   18.207        44     44.164 1.981e-05 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

km = s.df %>%
  glm(Phon ~ Ent, ., family=binomial) %>%
  coef()
km

## (Intercept)         Ent 
## -3.00857929  0.09226579

sigmoid(35, km[1], km[2])

##       Ent 
## 0.5549579

Q4: Die folgenden Daten zeigen F2 (F2) und Dauerwerte (Dauer) von einem Vokal produziert von 12 verschiedenen Versuchspersonen. Prüfen Sie zuerst durch eine Abbildung, ob eine Beziehung zwischen F2 und Dauer besteht. Entfernen Sie danach die drei Ausreißer, und prüfen Sie dann durch einen statistischen Test ob eine Beziehung zwischen F2 und Dauer besteht.

F2 = c(651, 762, 856, 1063, 1190, 
1298, 1421, 1440, 1518, 2800, 2900, 3100 )

Dauer = c(230, 260, 300, 340, 430, 480, 520, 570, 580, 600,620, 640)

plot(Dauer, F2)

df = data.frame(F2, Dauer)
df %>% filter(F2 < 2000) %>%
lm(F2 ~ Dauer, .) %>%
  summary()

## 
## Call:
## lm(formula = F2 ~ Dauer, data = .)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -62.782 -14.675  -8.205  15.137  98.942 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 167.6829    58.9390   2.845   0.0249 *  
## Dauer         2.3423     0.1367  17.135 5.66e-07 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 51.83 on 7 degrees of freedom
## Multiple R-squared:  0.9767, Adjusted R-squared:  0.9734 
## F-statistic: 293.6 on 1 and 7 DF,  p-value: 5.66e-07

Q5: Der Data-Frame bund.df zeigt Entscheidungen von 337 verschiedenen Veruchspersonen, ob Sie den Unterschied zwischen Kirche und Kirsche erkannt hatten (Faktor Urteil). Die Versuchspersonen wurden in zwei Altersgruppen aufgetteilt (Faktor: Alter) und ob Sie aus Hessen oder Schleswig-Holstein stammten (Faktor: Bland). Prüfen Sie, durch eine Abbilung einen statistischen Test, ob die Erkennung durch das Alter und/oder Bundesland beeinflusst wurde.

bund.df %>%
  ggplot +
  aes(fill = Urteil, x = Alter) +
  geom_bar(position= "fill") +
  facet_wrap(~Bland)

bund.df %>%
  glm(Urteil ~ Alter * Bland, 
      family = binomial, .) %>%
  anova(., test='Chisq')

## Analysis of Deviance Table
## 
## Model: binomial, link: logit
## 
## Response: Urteil
## 
## Terms added sequentially (first to last)
## 
## 
##             Df Deviance Resid. Df Resid. Dev  Pr(>Chi)    
## NULL                          336     463.11              
## Alter        1    8.893       335     454.22  0.002863 ** 
## Bland        1  162.593       334     291.63 < 2.2e-16 ***
## Alter:Bland  1    0.482       333     291.14  0.487332    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Q6: Der Data-Frame g.df zeigt die Geschwindigkeit der Zungenspitze (g) in der Erzeugung von zwei Konsonantenverbindungen /nt/ und /nd/ (Faktor Coda) produziert von zwei Dialektgruppen BRE (britisch-englisch) und USE (amerikanisch-englisch). Die Konsonantenverbindungen wurden von verschiedenen Versuchspersonen (Faktor Vpn) in verschiedenen Wörtern (Faktor Wort) produziert. Prüfen Sie, durch eine Abbbilung und einen statistischen Test, ob die Geschwindigkeit vom Coda und/oder Dialekt beeinflusst wurde.

g.df %>% 
  ggplot +
  aes(y = g, x = Coda, col=Dialekt) +
  geom_boxplot()

g.df %>%
  lmer(g ~ Coda * Dialekt + (Coda|Vpn) + (Dialekt|Wort), .) %>%step()

## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, : Model failed to converge with max|grad| = 0.00367162 (tol = 0.002, component 1)
##   See ?lme4::convergence and ?lme4::troubleshooting.

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

## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, : Model failed to converge with max|grad| = 0.00376865 (tol = 0.002, component 1)
##   See ?lme4::convergence and ?lme4::troubleshooting.

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

## Backward reduced random-effect table:
## 
##                             Eliminated npar   logLik    AIC    LRT Df
## <none>                                   11  -838.87 1699.7          
## Dialekt in (Dialekt | Wort)          1    9  -839.35 1696.7   0.95  2
## Coda in (Coda | Vpn)                 0    7  -846.93 1707.9  15.17  2
## (1 | Wort)                           0    8 -1007.11 2030.2 335.54  1
##                             Pr(>Chisq)    
## <none>                                    
## Dialekt in (Dialekt | Wort)  0.6211157    
## Coda in (Coda | Vpn)         0.0005084 ***
## (1 | Wort)                   < 2.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)    
## Coda:Dialekt          0   71.3    71.3     1 41.125  54.541 4.652e-09 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Model found:
## g ~ Coda + Dialekt + (Coda | Vpn) + (1 | Wort) + Coda:Dialekt

g.df %>%
  lmer(g ~ Coda + Dialekt + (Coda | Vpn) + (1 | Wort) + Coda:Dialekt, .) %>% anova()

## Type III Analysis of Variance Table with Satterthwaite's method
##              Sum Sq Mean Sq NumDF  DenDF F value    Pr(>F)    
## Coda         25.707  25.707     1 10.274 19.6650  0.001185 ** 
## Dialekt      12.836  12.836     1 41.101  9.8191  0.003182 ** 
## Coda:Dialekt 71.300  71.300     1 41.125 54.5413 4.652e-09 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

g.df %>%
  lmer(g ~ Coda + Dialekt + (Coda | Vpn) + (1 | Wort) + Coda:Dialekt, .) %>%
    emmeans(.,  ~ Coda|Dialekt) %>%
pairs(., simple = "each", combine=T)

##  Dialekt Coda contrast  estimate    SE   df t.ratio p.value
##  BRE     .    nd - nt    -3.0275 0.961 10.6  -3.151  0.0387
##  USE     .    nd - nt    -5.4342 0.975 11.2  -5.574  0.0006
##  .       nd   BRE - USE   2.4613 0.336 41.0   7.316 <0.0001
##  .       nt   BRE - USE   0.0546 0.512 41.0   0.107  1.0000
## 
## Degrees-of-freedom method: kenward-roger 
## P value adjustment: bonferroni method for 4 tests

Klausurvorbereitung 5

Jonathan Harrington / Lilian von Bressensdorf

Bitte eingeben:

Daten & Packages laden

Fragen