nm = "Harrington_Jonathan"
library(lattice)
library(ez)
library(lme4)
source(file.path(pfadu, "phoc.txt"))
ai = read.table(file.path(pfadu, "ai.txt"))
amdat = read.table(file.path(pfadu, "amp.df.txt"))
clara = read.table(file.path(pfadu, "clara.txt"))
ga = read.table(file.path(pfadu, "gavowel.txt"))
kj = read.delim(file.path(pfadu, "kj.txt"))
stefan = read.table(file.path(pfadu, "stefan.txt"))
form = read.table(file.path(pfadu, "f1.schwa.txt"))

# 1
plot(Kiefer ~ Lippe, data = ai)
ai.lm = lm(Kiefer ~ Lippe, data = ai)
abline(ai.lm)
summary(ai.lm)
# Normalverteilt
shapiro.test(resid(ai.lm))
# OK
plot(resid(ai.lm))
# OK
acf(resid(ai.lm))
# Es gibt eine signifikante lineare Beziehung zwischen der Kiefer- und Lippenposition (R^2 = 0.27, F[1, 23] = 8.5, p < 0.01).
predict(ai.lm, data.frame(Lippe=-20))
# -24.98412
# 2
levels(amdat$V)
P = amdat$V == "i"
Q = !P
amdat.m = aggregate(cbind(P, Q) ~ amp, mean, data = amdat )
p = with(amdat.m, P/(P+Q))
amdat.m = cbind(amdat.m, p)
plot(p ~ amp, data = amdat.m)
amp.glm = glm(V ~ amp, binomial, data = amdat)
summary(amp.glm)
cf = coef(amp.glm)
-cf[1]/cf[2]
# 50.81446
# Die Vokalkategorie kann aus den Amplitude signifikant vorhergesagt werden (z = 2.0, p < 0.05). Der Umkipppunkt liegt bei 50.8.
# 3
bwplot(prdur ~ pos, data = clara)
with(clara, table(vp, pos))
with(clara, table(wort, pos))
pos.lmer = lmer(prdur ~ pos + (1|wort) + (1+pos|vp), data = clara) 
anova(pos.lmer)
ohne = update(pos.lmer, ~ . -pos)
anova(ohne, pos.lmer)
# Der Einfluss von der Position auf die Vokaldauer ist nicht ganz signifikant (p = 0.065).
# 4
bwplot(F2 ~ Dialekt | V, data = ga)
with(ga, table(Vpn, interaction(V, Dialekt)))
ga.m = aggregate(F2 ~ V * Dialekt * Vpn, mean, data = ga)
ezANOVA(ga.m, .(F2), .(Vpn), .(V), between = .(Dialekt))
p = phoc(ga.m, .(F2), .(Vpn), .(V, Dialekt))
round(phsel(p$res), 3)
round(phsel(p$res, 2), 3)
# Dialekt (F[1, 18] = 41.9, p < 0.001) sowie Vokal (F[1, 18] = 28.9, p < 0.001) hatten einen signifikanten Einfluss auf F1 und es gab eine signifikante Interaktion zwischen diesen Faktoren (F[1, 18] = 15.7, p < 0.001). Post-hoc Tests zeigten einen Unterschied zwischen /i, I/ für Dialekt D (p < 0.01) jedoch nicht für A; und einen Unterschied zwischen den Dialekten in /I/ (p < 0.01) jedoch nicht in /i/.
# 5
dim(kj)
# inwiefern die Wahl des Frikatives (Faktor fric) als 's' (alveolar) oder 'S' (retroflex) von der Emphase (Faktor emphatic) beeinflusst wird.
tab = with(kj, table(emphatic, fric))
p = prop.table(tab, 1)
barchart(p, auto.key=T, horizontal=F)
e.glm = glm(fric ~ emphatic, binomial, data = kj)
# Die Wahl des Frikatives wird signifikant von der Emphase beeinflusst (z = 4.2, p < 0.001).
# 6
labo = c(23.0, 5.0, 30.7, 17.4, 18.5, 15.7, 16.8, 30.8, 14.1, 13.5)
lese = c(3.1, 27.7, 46.1, 55.4, 22.1, 19.5, 8.0, 53.8, 28.0, 36.4)
spon = c(39.8, 34.2, 40.5, 47.3, 42.5, 38.4, 40.8, 38.6, 43.8, 40.9)
stil = c(rep("labo", 10), rep("lese", 10), rep("spon", 10))
vpn = rep(paste("S", 1:10, sep=""), 3)
rt = c(labo, lese, spon)
rt.df = data.frame(rt, Stil = factor(stil), Vpn = factor(vpn))
ezANOVA(rt.df, .(rt), .(Vpn), .(Stil))
round(c(2, 18) * 0.6699608, 1)
# Die Reaktionszeit wurde signifikant vom Sprachstil beeinflusst (F[1.3, 12.1] = 11.2, p < 0.01).
# 7
xyplot(F1 ~ Dur | Tempo, auto.key=T, data = stefan)
# Je größer die Dauer, umso höher F1, besonders in 'fast'.
# 8
bwplot(F1 ~ Kontext, data = form)
with(form, table(Vpn, Kontext))
kon.lmer = lmer(F1 ~ Kontext + (1+Kontext|Vpn), data = form) 
anova(kon.lmer)
ohne = update(kon.lmer, ~ . -Kontext)
anova(ohne, kon.lmer)
# F1 wurde signifikant vom Kontext beeinflusst (X^2[2] = 19.9, p < 0.001).