Data, documentation and analysis scripts for Investigating dialectal differences using articulography
Martijn Wieling (University of Groningen), Fabian Tomaschek (University of Tübingen), Denis Arnold (University of Tübingen), Mark Tiede (Haskins Laboratories), Franziska Bröker (University of Tüingen), Samuel Tile (University of Tübingen), Simon N. Wood (University of Bath), and R. Harald Baayen (University of Tübingen and University of Alberta)
1 Abstract
The present study uses electromagnetic articulography, by which the position of tongue and lips during speech is measured, for the study of dialect variation. By using generalized additive modeling to analyze the articulatory trajectories, we are able to reliably detect aggregate group differences, while simultaneously taking into account the individual variation of dozens of speakers. Our results show that two Dutch dialects show clear differences in their articulatory settings, with generally a more anterior tongue position in the dialect from Ubbergen in the southern half of the Netherlands than in the dialect of Ter Apel in the northern half of the Netherlands. A comparison with formant-based acoustic measurements further reveals that articulography is able to reveal interesting structural articulatory differences between dialects which are not visible when only focusing on the acoustic signal.
Journal: Revised version submitted (July 29, 2016) to Journal of Phonetics
Preprint: http://www.martijnwieling.nl/files/WielingEtAl-art.pdf
All source data: http://www.let.rug.nl/wieling/DiaArt/SourceData/
Keywords: Articulography; Dialectology; Generalized additive modeling; Articulatory setting
## Generated on: July 21, 2016 - 17:46:432 Libraries and functions
The following commands load the necessary functions and libraries and show the version information.
# install packages if not yet installed
packages <- c("mgcv","itsadug","lme4","parallel","MASS","reshape2")
if (length(setdiff(packages, rownames(installed.packages()))) > 0) {
install.packages(setdiff(packages, rownames(installed.packages())))
}
# load required packages
library(mgcv)
library(itsadug)
library(lme4)
library(parallel)
library(MASS)
library(reshape2)
# custom plotting functions
if (!file.exists('plotArt2D.R')) {
download.file('http://www.let.rug.nl/wieling/DiaArt/plotArt2D.R','plotArt2D.R')
}
source('plotArt2D.R')
# version information
R.version.string## [1] "R version 3.3.1 (2016-06-21)"cat(paste('mgcv version:',packageVersion('mgcv')))## mgcv version: 1.8.12cat(paste('itsadug version:',packageVersion('itsadug')))## itsadug version: 2.23 Dataset
The following shows the columns of the dataset and their explanation.
if (!file.exists('dat.rda')) {
download.file('http://www.let.rug.nl/wieling/DiaArt/dat.rda','dat.rda') # 77 MB
}
load('dat.rda')
dat = droplevels(dat[dat$YearBirth > 1990,],except=colnames(dat)[sapply(dat,is.ordered)]) # exclude older people3.1 Column names
The dataset consists of 1734402 rows and 102 columns with the following column names:
colnames(dat)## [1] "Speaker" "Group"
## [3] "IsTerApel" "Gender"
## [5] "YearBirth" "PlaceBirth"
## [7] "Word" "WordNr"
## [9] "Type" "Segment"
## [11] "SegmentNr" "Sensor"
## [13] "Axis" "SensorAxis"
## [15] "GroupTypeSensorAxis" "SpeakerSensorAxis"
## [17] "SpeakerTypeSensorAxis" "WordSensorAxis"
## [19] "WordGroupSensorAxis" "IsTA.T1.P"
## [21] "IsTA.T1.H" "IsTA.T2.P"
## [23] "IsTA.T2.H" "IsTA.T3.P"
## [25] "IsTA.T3.H" "IsCVC.T1.P"
## [27] "IsCVC.T1.H" "IsCVC.T2.P"
## [29] "IsCVC.T2.H" "IsCVC.T3.P"
## [31] "IsCVC.T3.H" "IsDia.T1.P"
## [33] "IsDia.T1.H" "IsDia.T2.P"
## [35] "IsDia.T2.H" "IsDia.T3.P"
## [37] "IsDia.T3.H" "IsTADia.T1.P"
## [39] "IsTADia.T1.H" "IsTADia.T2.P"
## [41] "IsTADia.T2.H" "IsTADia.T3.P"
## [43] "IsTADia.T3.H" "IsTACVC.T1.P"
## [45] "IsTACVC.T1.H" "IsTACVC.T2.P"
## [47] "IsTACVC.T2.H" "IsTACVC.T3.P"
## [49] "IsTACVC.T3.H" "IsTA.T1.PO"
## [51] "IsTA.T1.HO" "IsTA.T2.PO"
## [53] "IsTA.T2.HO" "IsTA.T3.PO"
## [55] "IsTA.T3.HO" "IsCVC.T1.PO"
## [57] "IsCVC.T1.HO" "IsCVC.T2.PO"
## [59] "IsCVC.T2.HO" "IsCVC.T3.PO"
## [61] "IsCVC.T3.HO" "IsDia.T1.PO"
## [63] "IsDia.T1.HO" "IsDia.T2.PO"
## [65] "IsDia.T2.HO" "IsDia.T3.PO"
## [67] "IsDia.T3.HO" "IsTACVC.T1.PO"
## [69] "IsTACVC.T1.HO" "IsTACVC.T2.PO"
## [71] "IsTACVC.T2.HO" "IsTACVC.T3.PO"
## [73] "IsTACVC.T3.HO" "IsTADia.T1.PO"
## [75] "IsTADia.T1.HO" "IsTADia.T2.PO"
## [77] "IsTADia.T2.HO" "IsTADia.T3.PO"
## [79] "IsTADia.T3.HO" "Word.start"
## [81] "Segment.start" "RecBlock"
## [83] "TimeInRecBlock" "Time.normWord"
## [85] "Time.normSegment" "Position.norm"
## [87] "RestPosition.norm" "RelPos.norm"
## [89] "Position.raw" "RestPosition.raw"
## [91] "RelPos.raw" "F1"
## [93] "F2" "F1.norm"
## [95] "F2.norm" "F1.man"
## [97] "F2.man" "F1.man.norm"
## [99] "F2.man.norm" "RPDistT1T2.raw"
## [101] "RPDistT2T3.raw" "RPDistT1T3.raw"3.2 Data description
- Speaker – ID of the speaker
- Group – Group of the speaker (Ter Apel in the North, or Ubbergen, further south)
- IsTerApel – Binary value equal to 1 for speakers of Ter Apel, and 0 for speakers from Ubbergen
- Gender – Gender of the speaker (F: Female, M: Male)
- YearBirth – Year of birth of the speaker (in years)
- PlaceBirth – Place of birth of the speaker
- Word – Word
- WordNr – Word number, i.e. the position in the experimen when the word was presented
- Type - ‘Standard’ for the CVC sequences, ‘Dialect’ for the dialect words
- Segment – Phonetic segment within the CVC sequence (annotated in XSampa)
- SegmentNr - Segment number, i.e. the position of the segment in the word
- Sensor - Tongue sensor, i.e. T1 (tongue tip), T2 (behind tongue tip), T3 (behind T2)
- Axis - Sensor axis, i.e. P: posterior position, or H: height
- SensorAxis - Combination of Sensor and Axis
- GroupTypeSensorAxis - Combination of Group, Type, Sensor and Axis
- SpeakerSensorAxis - Combination of Speaker, Sensor and Axis
- SpeakerTypeSensorAxis - Combination of Speaker, Type, Sensor and Axis
- WordSensorAxis - Combination of Word, Sensor and Axis
- WordGroupSensorAxis - Combination of Word, Group, Sensor and Axis
- IsTA.T1.P - Binary predictor equal to 1 if Group = “TerApel”, Sensor = “T1” and Axis = “P”, 0 otherwise
- IsTA.T1.H to IsTA.T3.H - Binary predictors, as above, but with different Sensors and/or Axes
- IsDia.T1.P - Binary predictor equal to 1 if Type = “Dialect”, Sensor = “T1” and Axis = “P”, 0 otherwise
- IsDia.T1.H to IsDia.T3.H - Binary predictors, as above, but with different Sensors and/or Axes
- IsCVC.T1.P - Binary predictor equal to 1 if Type = “Standard”, Sensor = “T1” and Axis = “P”, 0 otherwise
- IsCVC.T1.H to IsCVC.T3.H - Binary predictors, as above, but with different Sensors and/or Axes
- IsTADia.T1.P - Binary predictor equal to 1 if Group = “TerApel”, Type = “Dialect”, Sensor = “T1” and Axis = “P”, 0 otherwise
- IsTADia.T1.H to IsTADia.T3.H - Binary predictors, as above, but with different Sensors and/or Axes
- IsTACVC.T1.P - Binary predictor equal to 1 if Group = “TerApel”, Type = “Standard”, Sensor = “T1” and Axis = “P”, 0 otherwise
- IsTACVC.T1.H to IsTACVC.T3.H - Binary predictors, as above, but with different Sensors and/or Axes
- IsTA.T1.PO to IsTACVC.T3.HO - Ordered factor, equal to level “1” if the associated binary predictor equals 1, and level “0” if the binary predictor equals 0; the ordered factor can be used instead of a binary predictor to separate the non-linear difference from the constant (intercept) difference
- Word.start - Logical predictor equal to TRUE at the start of each new articulatory trajectory (per individual word pronunciation per sensor and axis separately), FALSE otheriwse
- Segment.start - Logical predictor equal to TRUE at the start of each new articulatory trajectory (per individual segment pronunciation per sensor and axis separately), FALSE otheriwse
- RecBlock - Sequence number of the recording block
- TimeInRecBlock - Timestamp in the recording block
- Time.normWord - Time points associated with the articulatory measurements, normalized per word pronunciation between 0 (start of the pronunciation) and 1 (end of the pronunciation)
- Time.normSegment - Time points associated with the articulatory measurements, normalized per segment pronunciation between 0 (start of the pronunciation) and 1 (end of the pronunciation)
- Position.norm - Normalized (between 0 and 1) position of the Sensor in the direction Axis
- RestPosition.norm - Normalized (between 0 and 1) non-speech resting position of the Sensor in the direction Axis
- RelPos.norm - Normalized (between 0 and 1) position of the Sensor in the direction Axis (compared to the rest position)
- Position.raw - Raw position of the Sensor in the direction Axis
- RestPosition.raw - Raw non-speech resting position of the Sensor in the direction Axis
- RelPos.raw - Raw position of the Sensor in the direction Axis (compared to the rest position)
- F1 - First formant (only for vowels)
- F2 - Second formant (only for vowels)
- F1.norm - First formant (only for vowels), normalized with Lobanov’s (1971) method
- F2.norm - Second formant (only for vowels), normalized with Lobanov’s (1971) method
- F1.man - First formant (only for vowels), manually corrected (subset)
- F2.man - Second formant (only for vowels), manually corrected (subset)
- F1.man.norm - First formant (only for vowels), manually corrected (subset), normalized with Lobanov’s (1971) method
- F2.man.norm - Second formant (only for vowels), manually corrected (subset), normalized with Lobanov’s (1971) method
- RPDistT1T2.raw - Distance in mm. between sensor T1 (front) to T2 (middle) per participant
- RPDistT2T3.raw - Distance in mm. between sensor T2 (middle) to T3 (back) per participant
- RPDistT1T3.raw - Distance in mm. between sensor T1 (front) to T3 (back) per participant
4 Descriptives
The following subsections show some descriptives for the dataset.
4.1 Gender distribution
subj = unique(dat[,c("Speaker","Group","Gender","YearBirth","RPDistT1T2.raw","RPDistT2T3.raw","RPDistT1T3.raw")])
table(subj$Group,subj$Gender)##
## F M
## TerApel 6 9
## Ubbergen 2 174.2 Year of birth
cat(paste('Average year of birth for Ter Apel speakers:',
round(mean(subj[subj$Group=='TerApel',]$YearBirth),2)))## Average year of birth for Ter Apel speakers: 1996.6cat(paste('Average year of birth for Ubbergen speakers:',
round(mean(subj[subj$Group=='Ubbergen',]$YearBirth),2)))## Average year of birth for Ubbergen speakers: 1996.474.3 Distance tongue sensors
cat(paste('Average T1-T3 distance for Ter Apel speakers:',
round(mean(subj[subj$Group=='TerApel',]$RPDistT1T3.raw),1)))## Average T1-T3 distance for Ter Apel speakers: 23.5cat(paste('Average year of birth for Ubbergen speakers:',
round(mean(subj[subj$Group=='Ubbergen',]$RPDistT1T3.raw),1)))## Average year of birth for Ubbergen speakers: 24.2par(mfrow=c(1,3))
boxplot(RPDistT1T3.raw ~ Group, data=subj, main='Distance T1-T3 (mm.)')
boxplot(RPDistT1T2.raw ~ Group, data=subj, main='Distance T1-T2 (mm.)')
boxplot(RPDistT2T3.raw ~ Group, data=subj, main='Distance T2-T3 (mm.)')
wilcox.test(RPDistT1T3.raw ~ Group, data=subj)##
## Wilcoxon rank sum test
##
## data: RPDistT1T3.raw by Group
## W = 117, p-value = 0.3908
## alternative hypothesis: true location shift is not equal to 04.4 Sound distribution
The following graph shows the distribution of the sounds (categorized as front, center, back) for the dialect words per group.
# relative proportions
m = matrix(c(0.389,0.271,0.144,0.204,0.111,0.129,0.171,0.164,0.04,0.111,0.144,0.121),nrow=2,ncol=6,byrow=T)
dimnames(m) = list(c("Consonants","Vowels"),c("TA (front)","UB (front)","TA (center)","UB (center)","TA (back)","UB (back)"))
barplot(m, col='white', axes=F, axisnames=F, yaxp=c(0,1,2), las=1,ylim=c(0,0.6))
cols1=c('cadetblue3','tomato4','cadetblue3','tomato4','cadetblue3','tomato4')
cols2=c('cadetblue1','tomato','cadetblue1','tomato','cadetblue1','tomato')
# add coloured bars
for (i in 1:ncol(m)){
xx = m
xx[,-i] <- NA
colnames(xx)[-i] <- NA
barplot(xx,col=c(cols1[i],cols2[i]), add=T, axes=F)
}
legend('topright',c('Consonants (TA)','Vowels (TA)','Consonants (UB)','Vowels (UB)'),fill=c('cadetblue3','cadetblue1','tomato4','tomato'))
axis(2)
box()
5 Word-specific models
In the following, several models are fitted for dialect words and CVC sequences (e.g., taat: [tat] and poop [pop]). For each word three models are fitted, the first to determine the rho value (for correcting autocorrelation in the residuals), the second model which corrects for the autocorrelation using the predetermined rho value. The third model is fit after model comparison has been conducted. Since the residuals were not completely adequate (some heteroscedasticity and non-normal distribution), we excluded the data for which the absolute standardized residuals of the model were greater than 2.5 SD (i.e. the data points for which the difference between the actual and fitted value was largest).
words = c('taarten','bogen','tol','kameel','taat','poop')for (word in words) {
# select subset of data, but keep ordered factors the same as original, otherwise contrasts get reset
subdat = droplevels(dat[dat$Word == word,],except=colnames(dat)[sapply(dat,is.ordered)])
## Fit models with DV RelPos.norm
# fit first model to determine autocorrelation in residuals
model0.rel <- bam(RelPos.norm ~ s(Time.normWord,by=GroupTypeSensorAxis,k=20) +
GroupTypeSensorAxis + s(Time.normWord,SpeakerSensorAxis,bs='fs',m=1),
data=subdat, method='fREML', gc.level=2, discrete=T, nthreads=32)
# assess autocorrelation in residuals
model0acf.rel = acf(resid(model0.rel),plot=F)
rhoval = as.vector(model0acf.rel[1]$acf)
# fit model which corrects for autocorrelation in residuals
model.rel <- bam(RelPos.norm ~ s(Time.normWord,by=GroupTypeSensorAxis, k=20) +
GroupTypeSensorAxis + s(Time.normWord,SpeakerSensorAxis,bs='fs',m=1),
data=subdat, method='fREML', gc.level=2, AR.start=Word.start, rho=rhoval,
discrete=T, nthreads=32)
smry.rel <- summary(model.rel)
save(model.rel,smry.rel,file=paste(word,'-group-rel.rda',sep=''))
# Model criticism (using gam.check, not shown as it clutters the output) shows
# that there is residuals are not optimally distributed (some heteroscedasticity,
# and not completely normally distributed). Consequently, we apply model criticism
# and refit the models on the basis of that data. Approximately 2-2.5% of the data
# is excluded (this data is not fit adequately by the model, and excluding it will
# likely improve the fit for the rest of the data).
subdat2 <- droplevels(subdat[abs(scale(resid(model.rel))) < 2.5, ],
except=colnames(subdat)[sapply(subdat,is.ordered)])
model.rel <- bam(RelPos.norm ~ s(Time.normWord,by=GroupTypeSensorAxis, k=20) +
GroupTypeSensorAxis + s(Time.normWord,SpeakerSensorAxis,bs='fs',m=1),
data=subdat2, method='fREML', gc.level=2, AR.start=Word.start, rho=rhoval,
discrete=T, nthreads=32)
smry.rel <- summary(model.rel)
save(model.rel,smry.rel,file=paste(word,'-group-rel-mc.rda',sep=''))
## Fit models with DV Position.norm
# fit first model to determine autocorrelation in residuals
model0 <- bam(Position.norm ~ RestPosition.norm + s(Time.normWord,by=GroupTypeSensorAxis,k=20) +
GroupTypeSensorAxis + s(Time.normWord,SpeakerSensorAxis,bs='fs',m=1),
data=subdat, method='fREML', gc.level=2, discrete=T, nthreads=32)
# assess autocorrelation in residuals
model0acf = acf(resid(model0),plot=F)
rhoval = as.vector(model0acf[1]$acf)
# fit model which corrects for autocorrelation in residuals
model <- bam(Position.norm ~ RestPosition.norm + s(Time.normWord,by=GroupTypeSensorAxis, k=20) +
GroupTypeSensorAxis + s(Time.normWord,SpeakerSensorAxis,bs='fs',m=1),
data=subdat, method='fREML', gc.level=2, AR.start=Word.start, rho=rhoval,
discrete=T, nthreads=32)
smry <- summary(model)
save(model,smry,file=paste(word,'-group.rda',sep=''))
# Model criticism (see above)
subdat2 <- droplevels(subdat[abs(scale(resid(model))) < 2.5, ],
except=colnames(subdat)[sapply(subdat,is.ordered)])
model <- bam(Position.norm ~ RestPosition.norm + s(Time.normWord,by=GroupTypeSensorAxis, k=20) +
GroupTypeSensorAxis + s(Time.normWord,SpeakerSensorAxis,bs='fs',m=1),
data=subdat2, method='fREML', gc.level=2, AR.start=Word.start, rho=rhoval,
discrete=T, nthreads=32)
smry <- summary(model)
save(model,smry,file=paste(word,'-group-mc.rda',sep=''))
}5.1 Vis. word-specific patterns
The visualization shows a two-dimensional representation of the fit of the model. As the model relative to the resting position yields values similar for the three sensors, this requires separate plots for each sensor. For the normalized position a single figure is sufficient, as it is normalized within the mouth (i.e. the T3 sensor is more back than T2, which is more back than T1).
5.1.1 Relative to resting position
par(mfrow=c(4,3))
for (word in c('taarten','bogen','tol','kameel')) {
if (!file.exists(paste(word,'-group-rel-mc.rda',sep=''))) {
download.file(paste('http://www.let.rug.nl/wieling/DiaArt/',word,'-group-rel-mc.rda',sep=''),
paste(word,'-group-rel-mc.rda',sep=''))
}
load(paste(word,'-group-rel-mc.rda',sep=''))
type = unique(dat[dat$Word==word,]$Type)
plotArt2D(model.rel, catvar='GroupTypeSensorAxis',
catlevels.x=c(paste('TerApel.',type,'.T1.P',sep=''),paste('Ubbergen.',type,'.T1.P',sep='')),
catlevels.y=c(paste('TerApel.',type,'.T1.H',sep=''),paste('Ubbergen.',type,'.T1.H',sep='')),
timevar='Time.normWord', collabels=c('Ter Apel', 'Ubbergen'),
main=paste('Rel. position of the T1 sensor: "',word,'"',sep=''),
xlab='Posterior position', ylab='Height', showPoints=T,
cols=list(c("cadetblue3","cadetblue1"),c("tomato4","tomato")),alpha=15,xlim=c(-1,1),ylim=c(-1,1))
plotArt2D(model.rel, catvar='GroupTypeSensorAxis',
catlevels.x=c(paste('TerApel.',type,'.T2.P',sep=''),paste('Ubbergen.',type,'.T2.P',sep='')),
catlevels.y=c(paste('TerApel.',type,'.T2.H',sep=''),paste('Ubbergen.',type,'.T2.H',sep='')),
timevar='Time.normWord', collabels=c('Ter Apel', 'Ubbergen'),
main=paste('Rel. position of the T2 sensor: "',word,'"',sep=''),
xlab='Posterior position', ylab='Height', showPoints=T,
cols=list(c("cadetblue3","cadetblue1"),c("tomato4","tomato")),alpha=15,xlim=c(-1,1),ylim=c(-1,1))
plotArt2D(model.rel, catvar='GroupTypeSensorAxis',
catlevels.x=c(paste('TerApel.',type,'.T3.P',sep=''),paste('Ubbergen.',type,'.T3.P',sep='')),
catlevels.y=c(paste('TerApel.',type,'.T3.H',sep=''),paste('Ubbergen.',type,'.T3.H',sep='')),
timevar='Time.normWord', collabels=c('Ter Apel', 'Ubbergen'),
main=paste('Rel. position of the T3 sensor: "',word,'"',sep=''),
xlab='Posterior position', ylab='Height', showPoints=T,
cols=list(c("cadetblue3","cadetblue1"),c("tomato4","tomato")),alpha=15,xlim=c(-1,1),ylim=c(-1,1))
}
par(mfrow=c(2,3))
for (word in c('taat','poop')) {
if (!file.exists(paste(word,'-group-rel-mc.rda',sep=''))) {
download.file(paste('http://www.let.rug.nl/wieling/DiaArt/',word,'-group-rel-mc.rda',sep=''),
paste(word,'-group-rel-mc.rda',sep=''))
}
load(paste(word,'-group-rel-mc.rda',sep=''))
if (word == 'taat') {
taatmodelrel = model.rel
}
type = unique(dat[dat$Word==word,]$Type)
plotArt2D(model.rel, catvar='GroupTypeSensorAxis',
catlevels.x=c(paste('TerApel.',type,'.T1.P',sep=''),paste('Ubbergen.',type,'.T1.P',sep='')),
catlevels.y=c(paste('TerApel.',type,'.T1.H',sep=''),paste('Ubbergen.',type,'.T1.H',sep='')),
timevar='Time.normWord', collabels=c('Ter Apel', 'Ubbergen'),
main=paste('Rel. position of the T1 sensor: "',word,'"',sep=''),
xlab='Posterior position', ylab='Height', showPoints=T,
cols=list(c("cadetblue3","cadetblue1"),c("tomato4","tomato")),alpha=15,xlim=c(-1,1),ylim=c(-1,1))
plotArt2D(model.rel, catvar='GroupTypeSensorAxis',
catlevels.x=c(paste('TerApel.',type,'.T2.P',sep=''),paste('Ubbergen.',type,'.T2.P',sep='')),
catlevels.y=c(paste('TerApel.',type,'.T2.H',sep=''),paste('Ubbergen.',type,'.T2.H',sep='')),
timevar='Time.normWord', collabels=c('Ter Apel', 'Ubbergen'),
main=paste('Rel. position of the T2 sensor: "',word,'"',sep=''),
xlab='Posterior position', ylab='Height', showPoints=T,
cols=list(c("cadetblue3","cadetblue1"),c("tomato4","tomato")),alpha=15,xlim=c(-1,1),ylim=c(-1,1))
plotArt2D(model.rel, catvar='GroupTypeSensorAxis',
catlevels.x=c(paste('TerApel.',type,'.T3.P',sep=''),paste('Ubbergen.',type,'.T3.P',sep='')),
catlevels.y=c(paste('TerApel.',type,'.T3.H',sep=''),paste('Ubbergen.',type,'.T3.H',sep='')),
timevar='Time.normWord', collabels=c('Ter Apel', 'Ubbergen'),
main=paste('Rel. position of the T3 sensor: "',word,'"',sep=''),
xlab='Posterior position', ylab='Height', showPoints=T,
cols=list(c("cadetblue3","cadetblue1"),c("tomato4","tomato")),alpha=15,xlim=c(-1,1),ylim=c(-1,1))
}
5.1.2 Normalized position
par(mfrow=c(length(words)/2,2))
for (word in words) {
if (!file.exists(paste(word,'-group.rda',sep=''))) {
download.file(paste('http://www.let.rug.nl/wieling/DiaArt/',word,'-group.rda',sep=''),
paste(word,'-group.rda',sep=''))
}
load(paste(word,'-group.rda',sep=''))
type = unique(dat[dat$Word==word,]$Type)
plotArt2D(model, catvar='GroupTypeSensorAxis',
catlevels.x=c(paste('TerApel.',type,'.T3.P',sep=''),paste('Ubbergen.',type,'.T3.P',sep=''),
paste('TerApel.',type,'.T2.P',sep=''),paste('Ubbergen.',type,'.T2.P',sep=''),
paste('TerApel.',type,'.T1.P',sep=''),paste('Ubbergen.',type,'.T1.P',sep='')),
catlevels.y=c(paste('TerApel.',type,'.T3.H',sep=''),paste('Ubbergen.',type,'.T3.H',sep=''),
paste('TerApel.',type,'.T2.H',sep=''),paste('Ubbergen.',type,'.T2.H',sep=''),
paste('TerApel.',type,'.T1.H',sep=''),paste('Ubbergen.',type,'.T1.H',sep='')),
timevar='Time.normWord', collabels=c('Ter Apel', 'Ubbergen'),
main=paste('Position of the three tongue sensors: "',word,'"',sep=''),
xlab='Posterior position', ylab='Height', showPoints=T,
cols=list(c("cadetblue3","cadetblue1"),c("tomato4","tomato")),alpha=15)
}
5.2 Assessing differences: “taat”
The following subsections show the formal assessment of the differences between the two dialect regions for the word “taat”. First by visualization, then by using binary difference curves, and finally by ordered factors.
5.2.1 Visualization
The following plots provide a visual impression of the differences.
5.2.1.1 Relative to resting position
par(mfrow=c(2,2))
plotSmooths(taatmodelrel,xvar='Time.normWord',catvar='GroupTypeSensorAxis',
catlevels=c('TerApel.Standard.T1.P','Ubbergen.Standard.T1.P'),
dropRanef='SpeakerSensorAxis',ylim=c(-0.5,1),legendPos='topleft',
main='T1 posterior position (relative): "taat"',xlab='Time (normalized)',
ylab='Posterior position',legendlabels=c('Ter Apel','Ubbergen'),
legendtitle='Group', colors=c('cadetblue3','tomato4'),cexPoints=1,
alphaPoints=0.04,showPoints=T)
plotSmooths(taatmodelrel,xvar='Time.normWord',catvar='GroupTypeSensorAxis',
catlevels=c('TerApel.Standard.T1.H','Ubbergen.Standard.T1.H'),
dropRanef='SpeakerSensorAxis',ylim=c(-0.5,1),legendPos='topleft',
main='T1 height (relative): "taat"',xlab='Time (normalized)',
ylab='Height',legendlabels=c('Ter Apel','Ubbergen'),
legendtitle='Group',colors=c('cadetblue3','tomato4'),cexPoints=1,
alphaPoints=0.04,showPoints=T)
plot_diff(taatmodelrel, view='Time.normWord', comp=list(GroupTypeSensorAxis =
c("TerApel.Standard.T1.P","Ubbergen.Standard.T1.P")), rm.ranef=T, print.summary=F,
main='T1 posterior position (rel.): Ter Apel vs. Ubbergen', xlab='Time (normalized)',
ylab='Posterior position difference', ylim=c(-0.325,0.325)); box()
plot_diff(taatmodelrel, view='Time.normWord', comp=list(GroupTypeSensorAxis =
c("TerApel.Standard.T1.H","Ubbergen.Standard.T1.H")), rm.ranef=T, print.summary=F,
main='T1 height (rel.): Ter Apel vs. Ubbergen', xlab='Time (normalized)',
ylab='Height difference', ylim=c(-0.325,0.325)); box() 
5.2.1.2 Normalized position
load('taat-group.rda')
taatmodel = model
par(mfrow=c(2,2))
plotSmooths(taatmodel,xvar='Time.normWord',catvar='GroupTypeSensorAxis',
catlevels=c('TerApel.Standard.T1.P','Ubbergen.Standard.T1.P'),
dropRanef='SpeakerSensorAxis',ylim=c(0.05,1),legendPos='topleft',
main='T1 posterior position: "taat"',xlab='Time (normalized)',
ylab='Posterior position',legendlabels=c('Ter Apel','Ubbergen'),
legendtitle='Group', colors=c('cadetblue3','tomato4'),cexPoints=1,
alphaPoints=0.04,showPoints=T)
plotSmooths(taatmodel,xvar='Time.normWord',catvar='GroupTypeSensorAxis',
catlevels=c('TerApel.Standard.T1.H','Ubbergen.Standard.T1.H'),
dropRanef='SpeakerSensorAxis',ylim=c(0.05,1),legendPos='topleft',
main='T1 height: "taat"',xlab='Time (normalized)',
ylab='Height',legendlabels=c('Ter Apel','Ubbergen'),
legendtitle='Group',colors=c('cadetblue3','tomato4'),cexPoints=1,
alphaPoints=0.04,showPoints=T)
plot_diff(taatmodel, view='Time.normWord', comp=list(GroupTypeSensorAxis =
c("TerApel.Standard.T1.P","Ubbergen.Standard.T1.P")), rm.ranef=T, print.summary=F,
main='T1 posterior position: Ter Apel vs. Ubbergen', xlab='Time (normalized)',
ylab='Posterior position difference', ylim=c(-0.325,0.325)); box()
plot_diff(taatmodel, view='Time.normWord', comp=list(GroupTypeSensorAxis =
c("TerApel.Standard.T1.H","Ubbergen.Standard.T1.H")), rm.ranef=T, print.summary=F,
main='T1 height: Ter Apel vs. Ubbergen', xlab='Time (normalized)',
ylab='Height difference', ylim=c(-0.325,0.325)); box() 
5.2.2 Formal diff. assessment
We can use ordered factors to formally test if there are intercept and non-linear differences and assess the significance of each of them separately.
5.2.2.1 Relative to resting position
subdat = droplevels(dat[dat$Word == 'taat',],except=colnames(dat)[sapply(dat,is.ordered)])
# fit first model to determine autocorrelation in residuals
model0 <- bam(RelPos.norm ~ s(Time.normWord, by=SensorAxis,k=20) + SensorAxis +
s(Time.normWord, by=IsTA.T1.PO,k=20) + IsTA.T1.PO +
s(Time.normWord, by=IsTA.T1.HO,k=20) + IsTA.T1.HO +
s(Time.normWord, by=IsTA.T2.PO,k=20) + IsTA.T2.PO +
s(Time.normWord, by=IsTA.T2.HO,k=20) + IsTA.T2.HO +
s(Time.normWord, by=IsTA.T3.PO,k=20) + IsTA.T3.PO +
s(Time.normWord, by=IsTA.T3.HO,k=20) + IsTA.T3.HO +
s(Time.normWord,SpeakerSensorAxis,bs='fs',m=1), data=subdat,
method='fREML', discrete=T)
# assess autocorrelation in residuals
model0acf = acf(resid(model0),plot=F)
rhoval = as.vector(model0acf[1]$acf)
# fit model which corrects for autocorrelation in residuals
modelof.rel <- bam(RelPos.norm ~ s(Time.normWord, by=SensorAxis,k=20) + SensorAxis +
s(Time.normWord, by=IsTA.T1.PO,k=20) + IsTA.T1.PO +
s(Time.normWord, by=IsTA.T1.HO,k=20) + IsTA.T1.HO +
s(Time.normWord, by=IsTA.T2.PO,k=20) + IsTA.T2.PO +
s(Time.normWord, by=IsTA.T2.HO,k=20) + IsTA.T2.HO +
s(Time.normWord, by=IsTA.T3.PO,k=20) + IsTA.T3.PO +
s(Time.normWord, by=IsTA.T3.HO,k=20) + IsTA.T3.HO +
s(Time.normWord,SpeakerSensorAxis,bs='fs',m=1), data=subdat, method='fREML',
gc.level=2, AR.start=Word.start, rho=rhoval, discrete=T)
smryof.rel <- summary(modelof.rel)
save(modelof.rel,smryof.rel,file='taat-of-rel.rda')
# Model criticism (see above)
subdat2 <- droplevels(subdat[abs(scale(resid(modelof.rel))) < 2.5, ],
except=colnames(subdat)[sapply(subdat,is.ordered)])
modelof.rel <- bam(RelPos.norm ~ s(Time.normWord, by=SensorAxis,k=20) + SensorAxis +
s(Time.normWord, by=IsTA.T1.PO,k=20) + IsTA.T1.PO +
s(Time.normWord, by=IsTA.T1.HO,k=20) + IsTA.T1.HO +
s(Time.normWord, by=IsTA.T2.PO,k=20) + IsTA.T2.PO +
s(Time.normWord, by=IsTA.T2.HO,k=20) + IsTA.T2.HO +
s(Time.normWord, by=IsTA.T3.PO,k=20) + IsTA.T3.PO +
s(Time.normWord, by=IsTA.T3.HO,k=20) + IsTA.T3.HO +
s(Time.normWord,SpeakerSensorAxis,bs='fs',m=1), data=subdat2, method='fREML',
gc.level=2, AR.start=Word.start, rho=rhoval, discrete=T)
smryof.rel <- summary(modelof.rel)
save(modelof.rel,smryof.rel,file='taat-of-rel-mc.rda')if (!file.exists('taat-of-rel-mc.rda')) {
download.file('http://www.let.rug.nl/wieling/DiaArt/taat-of-rel-mc.rda',
'taat-of-rel-mc.rda')
}
load('taat-of-rel-mc.rda')
smryof.rel # show summary##
## Family: gaussian
## Link function: identity
##
## Formula:
## RelPos.norm ~ s(Time.normWord, by = SensorAxis, k = 20) + SensorAxis +
## s(Time.normWord, by = IsTA.T1.PO, k = 20) + IsTA.T1.PO +
## s(Time.normWord, by = IsTA.T1.HO, k = 20) + IsTA.T1.HO +
## s(Time.normWord, by = IsTA.T2.PO, k = 20) + IsTA.T2.PO +
## s(Time.normWord, by = IsTA.T2.HO, k = 20) + IsTA.T2.HO +
## s(Time.normWord, by = IsTA.T3.PO, k = 20) + IsTA.T3.PO +
## s(Time.normWord, by = IsTA.T3.HO, k = 20) + IsTA.T3.HO +
## s(Time.normWord, SpeakerSensorAxis, bs = "fs", m = 1)
##
## Parametric coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.02206 0.03896 0.566 0.57121
## SensorAxisT2.P 0.03785 0.05511 0.687 0.49228
## SensorAxisT1.P 0.02112 0.05512 0.383 0.70168
## SensorAxisT3.H -0.34506 0.05507 -6.266 3.81e-10 ***
## SensorAxisT2.H -0.26100 0.05513 -4.734 2.22e-06 ***
## SensorAxisT1.H -0.16849 0.05513 -3.056 0.00224 **
## IsTA.T1.PO1 0.14920 0.05864 2.544 0.01096 *
## IsTA.T1.HO1 0.06325 0.05864 1.079 0.28081
## IsTA.T2.PO1 0.17742 0.05862 3.027 0.00248 **
## IsTA.T2.HO1 0.06615 0.05866 1.128 0.25947
## IsTA.T3.PO1 0.16851 0.05856 2.878 0.00401 **
## IsTA.T3.HO1 0.03586 0.05850 0.613 0.53991
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Approximate significance of smooth terms:
## edf Ref.df F p-value
## s(Time.normWord):SensorAxisT3.P 15.383 17.242 13.074 < 2e-16 ***
## s(Time.normWord):SensorAxisT2.P 15.561 17.339 15.563 < 2e-16 ***
## s(Time.normWord):SensorAxisT1.P 16.007 17.605 16.708 < 2e-16 ***
## s(Time.normWord):SensorAxisT3.H 12.784 15.238 13.827 < 2e-16 ***
## s(Time.normWord):SensorAxisT2.H 16.271 17.748 32.754 < 2e-16 ***
## s(Time.normWord):SensorAxisT1.H 17.141 18.240 37.535 < 2e-16 ***
## s(Time.normWord):IsTA.T1.PO1 8.761 11.047 2.405 0.00582 **
## s(Time.normWord):IsTA.T1.HO1 8.813 11.152 1.704 0.06268 .
## s(Time.normWord):IsTA.T2.PO1 7.971 10.090 2.321 0.00979 **
## s(Time.normWord):IsTA.T2.HO1 9.848 12.286 4.542 1.81e-07 ***
## s(Time.normWord):IsTA.T3.PO1 6.855 8.722 2.022 0.03539 *
## s(Time.normWord):IsTA.T3.HO1 5.978 7.575 1.694 0.09952 .
## s(Time.normWord,SpeakerSensorAxis) 1445.737 1835.000 15.892 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## R-sq.(adj) = 0.965 Deviance explained = 96.8%
## fREML = -44621 Scale est. = 0.0016276 n = 17639# show model criticism plots, supress textual output
sink("/dev/null"); gam.check(modelof.rel); sink()
5.2.2.2 Normalized position
# fit first model to determine autocorrelation in residuals
model0 <- bam(Position.norm ~ RestPosition.norm + s(Time.normWord, by=SensorAxis,k=20) + SensorAxis +
s(Time.normWord, by=IsTA.T1.PO,k=20) + IsTA.T1.PO +
s(Time.normWord, by=IsTA.T1.HO,k=20) + IsTA.T1.HO +
s(Time.normWord, by=IsTA.T2.PO,k=20) + IsTA.T2.PO +
s(Time.normWord, by=IsTA.T2.HO,k=20) + IsTA.T2.HO +
s(Time.normWord, by=IsTA.T3.PO,k=20) + IsTA.T3.PO +
s(Time.normWord, by=IsTA.T3.HO,k=20) + IsTA.T3.HO +
s(Time.normWord,SpeakerSensorAxis,bs='fs',m=1), data=subdat,
method='fREML', discrete=T)
# assess autocorrelation in residuals
model0acf = acf(resid(model0),plot=F)
rhoval = as.vector(model0acf[1]$acf)
# fit model which corrects for autocorrelation in residuals
modelof <- bam(Position.norm ~ RestPosition.norm + s(Time.normWord, by=SensorAxis,k=20) + SensorAxis +
s(Time.normWord, by=IsTA.T1.PO,k=20) + IsTA.T1.PO +
s(Time.normWord, by=IsTA.T1.HO,k=20) + IsTA.T1.HO +
s(Time.normWord, by=IsTA.T2.PO,k=20) + IsTA.T2.PO +
s(Time.normWord, by=IsTA.T2.HO,k=20) + IsTA.T2.HO +
s(Time.normWord, by=IsTA.T3.PO,k=20) + IsTA.T3.PO +
s(Time.normWord, by=IsTA.T3.HO,k=20) + IsTA.T3.HO +
s(Time.normWord,SpeakerSensorAxis,bs='fs',m=1), data=subdat, method='fREML',
gc.level=2, AR.start=Word.start, rho=rhoval, discrete=T)
smryof <- summary(modelof)
save(modelof,smryof,file='taat-of.rda')
# Model criticism (see above)
subdat2 <- droplevels(subdat[abs(scale(resid(modelof.rel))) < 2.5, ],
except=colnames(subdat)[sapply(subdat,is.ordered)])
modelof <- bam(Position.norm ~ RestPosition.norm + s(Time.normWord, by=SensorAxis,k=20) + SensorAxis +
s(Time.normWord, by=IsTA.T1.PO,k=20) + IsTA.T1.PO +
s(Time.normWord, by=IsTA.T1.HO,k=20) + IsTA.T1.HO +
s(Time.normWord, by=IsTA.T2.PO,k=20) + IsTA.T2.PO +
s(Time.normWord, by=IsTA.T2.HO,k=20) + IsTA.T2.HO +
s(Time.normWord, by=IsTA.T3.PO,k=20) + IsTA.T3.PO +
s(Time.normWord, by=IsTA.T3.HO,k=20) + IsTA.T3.HO +
s(Time.normWord,SpeakerSensorAxis,bs='fs',m=1), data=subdat2, method='fREML',
gc.level=2, AR.start=Word.start, rho=rhoval, discrete=T)
smryof <- summary(modelof)
save(modelof,smryof,file='taat-of-mc.rda')if (!file.exists('taat-of-mc.rda')) {
download.file('http://www.let.rug.nl/wieling/DiaArt/taat-of-mc.rda',
'taat-of-mc.rda')
}
load('taat-of-mc.rda')
smryof # show summary##
## Family: gaussian
## Link function: identity
##
## Formula:
## Position.norm ~ RestPosition.norm + s(Time.normWord, by = SensorAxis,
## k = 20) + SensorAxis + s(Time.normWord, by = IsTA.T1.PO,
## k = 20) + IsTA.T1.PO + s(Time.normWord, by = IsTA.T1.HO,
## k = 20) + IsTA.T1.HO + s(Time.normWord, by = IsTA.T2.PO,
## k = 20) + IsTA.T2.PO + s(Time.normWord, by = IsTA.T2.HO,
## k = 20) + IsTA.T2.HO + s(Time.normWord, by = IsTA.T3.PO,
## k = 20) + IsTA.T3.PO + s(Time.normWord, by = IsTA.T3.HO,
## k = 20) + IsTA.T3.HO + s(Time.normWord, SpeakerSensorAxis,
## bs = "fs", m = 1)
##
## Parametric coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.522748 0.033251 15.722 < 2e-16 ***
## RestPosition.norm 0.197127 0.045055 4.375 1.22e-05 ***
## SensorAxisT2.P -0.195558 0.026460 -7.391 1.53e-13 ***
## SensorAxisT1.P -0.387222 0.032512 -11.910 < 2e-16 ***
## SensorAxisT3.H -0.085159 0.025422 -3.350 0.000810 ***
## SensorAxisT2.H -0.116492 0.023934 -4.867 1.14e-06 ***
## SensorAxisT1.H -0.188522 0.023897 -7.889 3.24e-15 ***
## IsTA.T1.PO1 0.082926 0.025042 3.311 0.000930 ***
## IsTA.T1.HO1 -0.000634 0.025351 -0.025 0.980048
## IsTA.T2.PO1 0.093312 0.024993 3.734 0.000189 ***
## IsTA.T2.HO1 0.025229 0.025213 1.001 0.317025
## IsTA.T3.PO1 0.070939 0.024896 2.849 0.004385 **
## IsTA.T3.HO1 0.016461 0.025102 0.656 0.511969
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Approximate significance of smooth terms:
## edf Ref.df F p-value
## s(Time.normWord):SensorAxisT3.P 13.119 15.696 7.766 < 2e-16 ***
## s(Time.normWord):SensorAxisT2.P 13.568 16.032 9.372 < 2e-16 ***
## s(Time.normWord):SensorAxisT1.P 14.750 16.931 11.425 < 2e-16 ***
## s(Time.normWord):SensorAxisT3.H 13.200 15.633 17.215 < 2e-16 ***
## s(Time.normWord):SensorAxisT2.H 16.237 17.788 37.115 < 2e-16 ***
## s(Time.normWord):SensorAxisT1.H 17.305 18.384 48.388 < 2e-16 ***
## s(Time.normWord):IsTA.T1.PO1 5.525 7.005 1.380 0.20869
## s(Time.normWord):IsTA.T1.HO1 7.917 10.115 2.394 0.00834 **
## s(Time.normWord):IsTA.T2.PO1 4.943 6.227 1.661 0.12307
## s(Time.normWord):IsTA.T2.HO1 10.026 12.521 5.056 1.07e-08 ***
## s(Time.normWord):IsTA.T3.PO1 3.873 4.816 1.179 0.30566
## s(Time.normWord):IsTA.T3.HO1 7.032 8.912 2.659 0.00468 **
## s(Time.normWord,SpeakerSensorAxis) 1368.205 1823.000 5.886 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## R-sq.(adj) = 0.964 Deviance explained = 96.7%
## fREML = -49814 Scale est. = 0.00096409 n = 17790# show model criticism plots, supress textual output
sink("/dev/null"); gam.check(modelof); sink()
6 Aggregate model
6.1 Model fitting
In the following the aggregate model is fitted. Four types of models are fitted: the first model is used to determine the rho value (for correcting autocorrelation in the residuals), the second model fits separate trajectories for each level (this model is only used for some visualizations), the third model fits the model using difference curves. The model with difference curves yields p-values (separately for the constant intercept difference and the non-linear difference) assessing if the difference between the two speaker groups and the two types of words (dialect words vs. CVC sequences) is significant or not. The fourth model attempts to simplify the ordered-factor model by excluding fixed-effect factors and/or SFs which were not significant and whose inclusion was not warranted (using AIC comparisons).
Two variants of visualization-model and the simplified ordered factor models are fitted. As the residuals of these models were not completely adequate (some heteroscedasticity and non-normal distribution), we excluded the data for which the absolute standardized residuals of the model were greater than 2.5 SD (i.e. the data points for which the difference between the actual and fitted value was greatest). The visualization and model summaries shown are based on these models (though note that the results are highly similar to the original models).
6.1.1 Relative to resting position
Here the models are fitted using the position relative to the non-speech resting position. The models are saved as each model takes about 7 hours to fit using 32 CPUs.
# fit first model to determine autocorrelation in residuals
system.time(modelNoRho.rel <- bam(RelPos.norm ~ s(Time.normWord,by=GroupTypeSensorAxis, k=20) +
GroupTypeSensorAxis + s(Time.normWord,SpeakerTypeSensorAxis,bs='fs',m=1) +
s(Time.normWord,WordGroupSensorAxis,bs='fs',m=1), data=dat,
method='fREML', discrete=T, nthreads=32))
save(modelNoRho.rel,file='modelALL-rel-group-norho-1.8.12.rda')# assess autocorrelation in residuals
modelACF.rel = acf(resid(modelNoRho.rel),plot=F)
rhoval = as.vector(modelACF.rel[1]$acf)
# fit model which corrects for autocorrelation in residuals
system.time(model.rel <- bam(RelPos.norm ~ s(Time.normWord,by=GroupTypeSensorAxis, k=20) +
GroupTypeSensorAxis + s(Time.normWord,SpeakerTypeSensorAxis,bs='fs',m=1) +
s(Time.normWord,WordGroupSensorAxis,bs='fs',m=1), data=dat,
method='fREML', AR.start=Word.start, rho=rhoval, discrete=T, nthreads=32))
system.time(smry.rel <- summary(model.rel))
save(model.rel,smry.rel,file='modelALL-rel-group-1.8.12.rda') # model criticism
dat2 <- droplevels(dat[abs(scale(resid(model.rel))) < 2.5, ],
except=colnames(dat)[sapply(dat,is.ordered)])
# model after model criticism
system.time(model.rel <- bam(RelPos.norm ~ s(Time.normWord,by=GroupTypeSensorAxis, k=20) +
GroupTypeSensorAxis + s(Time.normWord,SpeakerTypeSensorAxis,bs='fs',m=1) +
s(Time.normWord,WordGroupSensorAxis,bs='fs',m=1), data=dat2,
method='fREML', AR.start=Word.start, rho=rhoval, discrete=T, nthreads=32))
system.time(smry.rel <- summary(model.rel))
save(model.rel,smry.rel,file='modelALL-rel-group-mc-1.8.12.rda') # fit model with ordered factor difference curve
system.time(modelof.rel <- bam(RelPos.norm ~ s(Time.normWord, by=SensorAxis,k=20) + SensorAxis +
s(Time.normWord, by=IsTA.T1.PO,k=20) + IsTA.T1.PO + s(Time.normWord, by=IsTA.T1.HO,k=20) + IsTA.T1.HO +
s(Time.normWord, by=IsTA.T2.PO,k=20) + IsTA.T2.PO + s(Time.normWord, by=IsTA.T2.HO,k=20) + IsTA.T2.HO +
s(Time.normWord, by=IsTA.T3.PO,k=20) + IsTA.T3.PO + s(Time.normWord, by=IsTA.T3.HO,k=20) + IsTA.T3.HO +
s(Time.normWord, by=IsCVC.T1.PO,k=20) + IsCVC.T1.PO + s(Time.normWord, by=IsCVC.T1.HO,k=20) + IsCVC.T1.HO +
s(Time.normWord, by=IsCVC.T2.PO,k=20) + IsCVC.T2.PO + s(Time.normWord, by=IsCVC.T2.HO,k=20) + IsCVC.T2.HO +
s(Time.normWord, by=IsCVC.T3.PO,k=20) + IsCVC.T3.PO + s(Time.normWord, by=IsCVC.T3.HO,k=20) + IsCVC.T3.HO +
s(Time.normWord, by=IsTACVC.T1.PO,k=20) + IsTACVC.T1.PO +
s(Time.normWord, by=IsTACVC.T1.HO,k=20) + IsTACVC.T1.HO +
s(Time.normWord, by=IsTACVC.T2.PO,k=20) + IsTACVC.T2.PO +
s(Time.normWord, by=IsTACVC.T2.HO,k=20) + IsTACVC.T2.HO +
s(Time.normWord, by=IsTACVC.T3.PO,k=20) + IsTACVC.T3.PO +
s(Time.normWord, by=IsTACVC.T3.HO,k=20) + IsTACVC.T3.HO +
s(Time.normWord,SpeakerTypeSensorAxis,bs='fs',m=1) +
s(Time.normWord,WordGroupSensorAxis,bs='fs',m=1), data=dat, method='fREML',
AR.start=Word.start, rho=rhoval, discrete=T, nthreads=32))
system.time(smryof.rel <- summary(modelof.rel))
save(modelof.rel,smryof.rel,file='modelALL-rel-of-1.8.12.rda')# The results of the previous model show that only the IsTA fixed effects and IsCVC smooths need to be included
# Model comparison confirms this as the AIC value of the most complex model is only 0.34 AIC units
# lower than the simplest model fit here. The AIC difference threshold of a more complex model we use
# is 2, so we retain the simplest model.
system.time(modelof.rel <- bam(RelPos.norm ~ s(Time.normWord, by=SensorAxis,k=20) + SensorAxis +
IsTA.T1.PO + IsTA.T1.HO + IsTA.T2.PO + IsTA.T2.HO + IsTA.T3.PO + IsTA.T3.HO +
s(Time.normWord, by=IsCVC.T1.PO,k=20) + s(Time.normWord, by=IsCVC.T1.HO,k=20) +
s(Time.normWord, by=IsCVC.T2.PO,k=20) + s(Time.normWord, by=IsCVC.T2.HO,k=20) +
s(Time.normWord, by=IsCVC.T3.PO,k=20) + s(Time.normWord, by=IsCVC.T3.HO,k=20) +
s(Time.normWord,SpeakerTypeSensorAxis,bs='fs',m=1) +
s(Time.normWord,WordGroupSensorAxis,bs='fs',m=1), data=dat, method='fREML',
AR.start=Word.start, rho=rhoval, discrete=T, nthreads=32))
system.time(smryof.rel <- summary(modelof.rel))
save(modelof.rel,smryof.rel,file='modelALL-rel-of-simplest-1.8.12.rda')# model criticism
dat2 <- droplevels(dat[abs(scale(resid(modelof.rel))) < 2.5, ],
except=colnames(dat)[sapply(dat,is.ordered)])
system.time(modelof.rel <- bam(RelPos.norm ~ s(Time.normWord, by=SensorAxis,k=20) + SensorAxis +
IsTA.T1.PO + IsTA.T1.HO + IsTA.T2.PO + IsTA.T2.HO + IsTA.T3.PO + IsTA.T3.HO +
s(Time.normWord, by=IsCVC.T1.PO,k=20) + s(Time.normWord, by=IsCVC.T1.HO,k=20) +
s(Time.normWord, by=IsCVC.T2.PO,k=20) + s(Time.normWord, by=IsCVC.T2.HO,k=20) +
s(Time.normWord, by=IsCVC.T3.PO,k=20) + s(Time.normWord, by=IsCVC.T3.HO,k=20) +
s(Time.normWord,SpeakerTypeSensorAxis,bs='fs',m=1) +
s(Time.normWord,WordGroupSensorAxis,bs='fs',m=1), data=dat, method='fREML',
AR.start=Word.start, rho=rhoval, discrete=T, nthreads=32))
system.time(smryof.rel <- summary(modelof.rel))
save(modelof.rel,smryof.rel,file='modelALL-rel-of-simplest-mc-1.8.12.rda')6.1.2 Normalized position
Here the models are fitted using the normalized position. The models are saved as each model takes about 7 hours to fit using 32 CPUs.
# fit first model to determine autocorrelation in residuals
system.time(modelNoRho <- bam(Position.norm ~ RestPosition.norm +
s(Time.normWord,by=GroupTypeSensorAxis, k=20) +
GroupTypeSensorAxis + s(Time.normWord,SpeakerTypeSensorAxis,bs='fs',m=1) +
s(Time.normWord,WordGroupSensorAxis,bs='fs',m=1), data=dat,
method='fREML', discrete=T, nthreads=32))
save(modelNoRho,file='modelALL-group-norho-1.8.12.rda')# assess autocorrelation in residuals
modelACF = acf(resid(modelNoRho),plot=F)
rhoval = as.vector(modelACF[1]$acf)
# fit model which corrects for autocorrelation in residuals
system.time(model <- bam(Position.norm ~ RestPosition.norm +
s(Time.normWord,by=GroupTypeSensorAxis, k=20) +
GroupTypeSensorAxis + s(Time.normWord,SpeakerTypeSensorAxis,bs='fs',m=1) +
s(Time.normWord,WordGroupSensorAxis,bs='fs',m=1), data=dat,
method='fREML', AR.start=Word.start, rho=rhoval, discrete=T, nthreads=32))
system.time(smry <- summary(model))
save(model,smry,file='modelALL-group-1.8.12.rda') # model criticism
dat2 <- droplevels(dat[abs(scale(resid(model))) < 2.5, ],
except=colnames(dat)[sapply(dat,is.ordered)])
# fit model which corrects for autocorrelation in residuals
system.time(model <- bam(Position.norm ~ RestPosition.norm +
s(Time.normWord,by=GroupTypeSensorAxis, k=20) +
GroupTypeSensorAxis + s(Time.normWord,SpeakerTypeSensorAxis,bs='fs',m=1) +
s(Time.normWord,WordGroupSensorAxis,bs='fs',m=1), data=dat2,
method='fREML', AR.start=Word.start, rho=rhoval, discrete=T, nthreads=32))
system.time(smry <- summary(model))
save(model,smry,file='modelALL-group-mc-1.8.12.rda') # fit model with ordered factor difference curve
system.time(modelof <- bam(Position.norm ~ RestPosition.norm + s(Time.normWord, by=SensorAxis,k=20) +
SensorAxis + s(Time.normWord, by=IsTA.T1.PO,k=20) + IsTA.T1.PO +
s(Time.normWord, by=IsTA.T1.HO,k=20) + IsTA.T1.HO +
s(Time.normWord, by=IsTA.T2.PO,k=20) + IsTA.T2.PO +
s(Time.normWord, by=IsTA.T2.HO,k=20) + IsTA.T2.HO +
s(Time.normWord, by=IsTA.T3.PO,k=20) + IsTA.T3.PO +
s(Time.normWord, by=IsTA.T3.HO,k=20) + IsTA.T3.HO +
s(Time.normWord, by=IsCVC.T1.PO,k=20) + IsCVC.T1.PO +
s(Time.normWord, by=IsCVC.T1.HO,k=20) + IsCVC.T1.HO +
s(Time.normWord, by=IsCVC.T2.PO,k=20) + IsCVC.T2.PO +
s(Time.normWord, by=IsCVC.T2.HO,k=20) + IsCVC.T2.HO +
s(Time.normWord, by=IsCVC.T3.PO,k=20) + IsCVC.T3.PO +
s(Time.normWord, by=IsCVC.T3.HO,k=20) + IsCVC.T3.HO +
s(Time.normWord, by=IsTACVC.T1.PO,k=20) + IsTACVC.T1.PO +
s(Time.normWord, by=IsTACVC.T1.HO,k=20) + IsTACVC.T1.HO +
s(Time.normWord, by=IsTACVC.T2.PO,k=20) + IsTACVC.T2.PO +
s(Time.normWord, by=IsTACVC.T2.HO,k=20) + IsTACVC.T2.HO +
s(Time.normWord, by=IsTACVC.T3.PO,k=20) + IsTACVC.T3.PO +
s(Time.normWord, by=IsTACVC.T3.HO,k=20) + IsTACVC.T3.HO +
s(Time.normWord,SpeakerTypeSensorAxis,bs='fs',m=1) +
s(Time.normWord,WordGroupSensorAxis,bs='fs',m=1), data=dat, method='fREML',
AR.start=Word.start, rho=rhoval, discrete=T, nthreads=32))
system.time(smryof <- summary(modelof))
save(modelof,smryof,file='modelALL-of-1.8.12.rda')# The results of the previous model show that only the IsTA fixed effects need to be included
# Model comparison confirms this as the AIC value of the most complex model is not lower than
# the simpler model. Note that the IsTA and IsTACVC smooths are necessary still.
system.time(modelof <- bam(Position.norm ~ RestPosition.norm + s(Time.normWord, by=SensorAxis,k=20) +
SensorAxis + s(Time.normWord, by=IsTA.T1.PO,k=20) + IsTA.T1.PO +
s(Time.normWord, by=IsTA.T1.HO,k=20) + IsTA.T1.HO +
s(Time.normWord, by=IsTA.T2.PO,k=20) + IsTA.T2.PO +
s(Time.normWord, by=IsTA.T2.HO,k=20) + IsTA.T2.HO +
s(Time.normWord, by=IsTA.T3.PO,k=20) + IsTA.T3.PO +
s(Time.normWord, by=IsTA.T3.HO,k=20) + IsTA.T3.HO +
s(Time.normWord, by=IsCVC.T1.PO,k=20) +
s(Time.normWord, by=IsCVC.T1.HO,k=20) +
s(Time.normWord, by=IsCVC.T2.PO,k=20) +
s(Time.normWord, by=IsCVC.T2.HO,k=20) +
s(Time.normWord, by=IsCVC.T3.PO,k=20) +
s(Time.normWord, by=IsCVC.T3.HO,k=20) +
s(Time.normWord, by=IsTACVC.T1.PO,k=20) +
s(Time.normWord, by=IsTACVC.T1.HO,k=20) +
s(Time.normWord, by=IsTACVC.T2.PO,k=20) +
s(Time.normWord, by=IsTACVC.T2.HO,k=20) +
s(Time.normWord, by=IsTACVC.T3.PO,k=20) +
s(Time.normWord, by=IsTACVC.T3.HO,k=20) +
s(Time.normWord,SpeakerTypeSensorAxis,bs='fs',m=1) +
s(Time.normWord,WordGroupSensorAxis,bs='fs',m=1), data=dat, method='fREML',
AR.start=Word.start, rho=rhoval, discrete=T, nthreads=32))
system.time(smryof <- summary(modelof))
save(modelof,smryof,file='modelALL-of-simpler-1.8.12.rda')# model criticism
dat2 <- droplevels(dat[abs(scale(resid(modelof))) < 2.5, ],
except=colnames(dat)[sapply(dat,is.ordered)])
# fit model with ordered factor difference curve
system.time(modelof <- bam(Position.norm ~ RestPosition.norm + s(Time.normWord, by=SensorAxis,k=20) +
SensorAxis + s(Time.normWord, by=IsTA.T1.PO,k=20) + IsTA.T1.PO +
s(Time.normWord, by=IsTA.T1.HO,k=20) + IsTA.T1.HO +
s(Time.normWord, by=IsTA.T2.PO,k=20) + IsTA.T2.PO +
s(Time.normWord, by=IsTA.T2.HO,k=20) + IsTA.T2.HO +
s(Time.normWord, by=IsTA.T3.PO,k=20) + IsTA.T3.PO +
s(Time.normWord, by=IsTA.T3.HO,k=20) + IsTA.T3.HO +
s(Time.normWord, by=IsCVC.T1.PO,k=20) +
s(Time.normWord, by=IsCVC.T1.HO,k=20) +
s(Time.normWord, by=IsCVC.T2.PO,k=20) +
s(Time.normWord, by=IsCVC.T2.HO,k=20) +
s(Time.normWord, by=IsCVC.T3.PO,k=20) +
s(Time.normWord, by=IsCVC.T3.HO,k=20) +
s(Time.normWord, by=IsTACVC.T1.PO,k=20) +
s(Time.normWord, by=IsTACVC.T1.HO,k=20) +
s(Time.normWord, by=IsTACVC.T2.PO,k=20) +
s(Time.normWord, by=IsTACVC.T2.HO,k=20) +
s(Time.normWord, by=IsTACVC.T3.PO,k=20) +
s(Time.normWord, by=IsTACVC.T3.HO,k=20) +
s(Time.normWord,SpeakerTypeSensorAxis,bs='fs',m=1) +
s(Time.normWord,WordGroupSensorAxis,bs='fs',m=1), data=dat2, method='fREML',
AR.start=Word.start, rho=rhoval, discrete=T, nthreads=32))
system.time(smryof <- summary(modelof))
save(modelof,smryof,file='modelALL-of-simpler-mc-1.8.12.rda')6.2 Visualization
if (!file.exists('modelALL-group-mc-1.8.12.rda')) {
download.file('http://www.let.rug.nl/wieling/DiaArt/modelALL-group-mc-1.8.12.rda',
'modelALL-group-mc-1.8.12.rda')
}
load('modelALL-group-mc-1.8.12.rda')
if (!file.exists('modelALL-rel-group-mc-1.8.12.rda')) {
download.file('http://www.let.rug.nl/wieling/DiaArt/modelALL-rel-group-mc-1.8.12.rda',
'modelALL-rel-group-mc-1.8.12.rda')
}
load('modelALL-rel-group-mc-1.8.12.rda')
if (!file.exists('modelALL-rel-group-norho-1.8.12.rda')) {
download.file('http://www.let.rug.nl/wieling/DiaArt/modelALL-rel-group-norho-1.8.12.rda',
'modelALL-rel-group-norho-1.8.12.rda')
}
load('modelALL-rel-group-norho-1.8.12.rda')
if (!file.exists('modelALL-rel-of-simplest-mc-1.8.12.rda')) {
download.file('http://www.let.rug.nl/wieling/DiaArt/modelALL-rel-of-simplest-mc-1.8.12.rda',
'modelALL-rel-of-simplest-mc-1.8.12.rda')
}
load('modelALL-rel-of-simplest-mc-1.8.12.rda')6.2.1 Individual variation
The following graph visualizes the individual variation.
plot(model.rel,select=25,ylab='Position (normalized)', xlab='Time (normalized)')
6.2.2 Autocorrelation
The following graph visualizes the autocorrelation.
par(mfrow=c(1,2))
acf_resid(modelNoRho.rel, main='Original autocorrelation in residuals',
ylab='Autocorrelation magnitude',max_lag=30)
acf_resid(model.rel, main='Corrected autocorrelation in residuals',
ylab='Autocorrelation magnitude',max_lag=30)
6.2.3 Tongue movement
6.2.3.1 Relative to resting position
The following graphs visualize the tongue trajectories in two dimensions for the dialect words and the CVC sequences for the position relative to the resting position.
par(mfcol=c(3,2))
# plotArt2D does not work with ordered factors, so it needs the full model
# (which is a bit too complex)
plotArt2D(model.rel, catvar='GroupTypeSensorAxis',
catlevels.x=c('TerApel.Dialect.T1.P','Ubbergen.Dialect.T1.P'),
catlevels.y=c('TerApel.Dialect.T1.H','Ubbergen.Dialect.T1.H'),
timevar='Time.normWord', collabels=c('Ter Apel', 'Ubbergen'),
main='Rel. position of the T1 sensor: dialect words',
xlab='Posterior position (rel.)', ylab='Height (rel.)', showPoints=T,
cols=list(c("cadetblue3","cadetblue1"),c("tomato4","tomato")),alpha=15,xlim=c(-1,1),ylim=c(-1,1))
plotArt2D(model.rel, catvar='GroupTypeSensorAxis',
catlevels.x=c('TerApel.Dialect.T2.P','Ubbergen.Dialect.T2.P'),
catlevels.y=c('TerApel.Dialect.T2.H','Ubbergen.Dialect.T2.H'),
timevar='Time.normWord', collabels=c('Ter Apel', 'Ubbergen'),
main='Rel. position of the T2 sensor: dialect words',
xlab='Posterior position (rel.)', ylab='Height (rel.)', showPoints=T,
cols=list(c("cadetblue3","cadetblue1"),c("tomato4","tomato")),alpha=15,xlim=c(-1,1),ylim=c(-1,1))
plotArt2D(model.rel, catvar='GroupTypeSensorAxis',
catlevels.x=c('TerApel.Dialect.T3.P','Ubbergen.Dialect.T3.P'),
catlevels.y=c('TerApel.Dialect.T3.H','Ubbergen.Dialect.T3.H'),
timevar='Time.normWord', collabels=c('Ter Apel', 'Ubbergen'),
main='Rel. position of the T3 sensor: dialect words',
xlab='Posterior position (rel.)', ylab='Height (rel.)', showPoints=T,
cols=list(c("cadetblue3","cadetblue1"),c("tomato4","tomato")),alpha=15,xlim=c(-1,1),ylim=c(-1,1))
plotArt2D(model.rel, catvar='GroupTypeSensorAxis',
catlevels.x=c('TerApel.Standard.T1.P','Ubbergen.Standard.T1.P'),
catlevels.y=c('TerApel.Standard.T1.H','Ubbergen.Standard.T1.H'),
timevar='Time.normWord', collabels=c('Ter Apel', 'Ubbergen'),
main='Rel. position of the T1 sensor: Dutch CVC seq.',
xlab='Posterior position (rel.)', ylab='Height (rel.)', showPoints=T,
cols=list(c("cadetblue3","cadetblue1"),c("tomato4","tomato")),alpha=15,xlim=c(-1,1),ylim=c(-1,1))
plotArt2D(model.rel, catvar='GroupTypeSensorAxis',
catlevels.x=c('TerApel.Standard.T2.P','Ubbergen.Standard.T2.P'),
catlevels.y=c('TerApel.Standard.T2.H','Ubbergen.Standard.T2.H'),
timevar='Time.normWord', collabels=c('Ter Apel', 'Ubbergen'),
main='Rel. position of the T2 sensor: Dutch CVC seq.',
xlab='Posterior position (rel.)', ylab='Height (rel.)', showPoints=T,
cols=list(c("cadetblue3","cadetblue1"),c("tomato4","tomato")),alpha=15,xlim=c(-1,1),ylim=c(-1,1))
plotArt2D(model.rel, catvar='GroupTypeSensorAxis',
catlevels.x=c('TerApel.Standard.T3.P','Ubbergen.Standard.T3.P'),
catlevels.y=c('TerApel.Standard.T3.H','Ubbergen.Standard.T3.H'),
timevar='Time.normWord', collabels=c('Ter Apel', 'Ubbergen'),
main='Rel. position of the T3 sensor: Dutch CVC seq.',
xlab='Posterior position (rel.)', ylab='Height (rel.)', showPoints=T,
cols=list(c("cadetblue3","cadetblue1"),c("tomato4","tomato")),alpha=15,xlim=c(-1,1),ylim=c(-1,1))
6.2.3.2 Normalized position
The following graph visualizes the tongue trajectories in two dimensions for the dialect words and the CVC sequences for the normalized position.
par(mfrow=c(1,2))
plotArt2D(model, catvar='GroupTypeSensorAxis',
catlevels.x=c('TerApel.Dialect.T1.P','Ubbergen.Dialect.T1.P','TerApel.Dialect.T2.P',
'Ubbergen.Dialect.T2.P','TerApel.Dialect.T3.P','Ubbergen.Dialect.T3.P'),
catlevels.y=c('TerApel.Dialect.T1.H','Ubbergen.Dialect.T1.H','TerApel.Dialect.T2.H',
'Ubbergen.Dialect.T2.H','TerApel.Dialect.T3.H','Ubbergen.Dialect.T3.H'),
timevar='Time.normWord', collabels=c('Ter Apel', 'Ubbergen'),
xlab='Posterior position', ylab='Height', showPoints=T,
main='Pos. of the tongue sensors: dialect words',
cols=list(c("cadetblue3","cadetblue1"),c("tomato4","tomato")),
alpha=2, cexPoints=0.4)
plotArt2D(model, catvar='GroupTypeSensorAxis',
catlevels.x=c('TerApel.Standard.T1.P','Ubbergen.Standard.T1.P','TerApel.Standard.T2.P',
'Ubbergen.Standard.T2.P','TerApel.Standard.T3.P','Ubbergen.Standard.T3.P'),
catlevels.y=c('TerApel.Standard.T1.H','Ubbergen.Standard.T1.H','TerApel.Standard.T2.H',
'Ubbergen.Standard.T2.H','TerApel.Standard.T3.H','Ubbergen.Standard.T3.H'),
timevar='Time.normWord', collabels=c('Ter Apel', 'Ubbergen'),
xlab='Posterior position', ylab='Height', showPoints=T,
main='Pos. of the tongue sensors: Dutch CVC seq.',
cols=list(c("cadetblue3","cadetblue1"),c("tomato4","tomato")),
alpha=3,cexPoints=0.45)
6.2.4 Tongue differences
The following graphs visualize the tongue trajectory differences.
6.2.4.1 Dia.: rel. to rest.
# Here we visualize the ordered factor model.
par(mfrow=c(4,3))
plotSmooths(modelof.rel,xvar='Time.normWord',catvar='IsTA.T1.PO',
catlevels=c(1,0), cond=list(SensorAxis='T1.P',IsCVC.T1.PO=0),
dropRanef=c('SpeakerTypeSensorAxis','WordGroupSensorAxis'),
ylim=c(-0.5,1),legendPos='topleft',main='T1 rel. posterior position',
xlab='Time (normalized)',ylab='Posterior position',
legendlabels=c('Ter Apel','Ubbergen'),legendtitle='Group',
colors=c('cadetblue3','tomato4'),cexPoints=0.5,showPoints=F)
plotSmooths(modelof.rel,xvar='Time.normWord',catvar='IsTA.T2.PO',
catlevels=c(1,0), cond=list(SensorAxis='T2.P',IsCVC.T2.PO=0),
dropRanef=c('SpeakerTypeSensorAxis','WordGroupSensorAxis'),
ylim=c(-0.5,1),legendPos='topleft',main='T2 rel. posterior position',
xlab='Time (normalized)',ylab='Posterior position',
legendlabels=c('Ter Apel','Ubbergen'),legendtitle='Group',
colors=c('cadetblue3','tomato4'),cexPoints=0.5,showPoints=F)
plotSmooths(modelof.rel,xvar='Time.normWord',catvar='IsTA.T3.PO',
catlevels=c(1,0), cond=list(SensorAxis='T3.P',IsCVC.T3.PO=0),
dropRanef=c('SpeakerTypeSensorAxis','WordGroupSensorAxis'),
ylim=c(-0.5,1),legendPos='topleft',main='T3 rel. posterior position',
xlab='Time (normalized)',ylab='Posterior position',
legendlabels=c('Ter Apel','Ubbergen'),legendtitle='Group',
colors=c('cadetblue3','tomato4'),cexPoints=0.5,showPoints=F)
plot_diff(modelof.rel, view='Time.normWord', comp=list(IsTA.T1.PO =
c(1,0)), cond=list(SensorAxis='T1.P',IsCVC.T1.PO=0), rm.ranef=T, print.summary=F,
main='T1 rel. posterior position: Ter Apel vs. Ubbergen', xlab='Time (normalized)',
ylab='Posterior position difference', ylim=c(-0.23,0.35)); box()
plot_diff(modelof.rel, view='Time.normWord', comp=list(IsTA.T2.PO =
c(1,0)), cond=list(SensorAxis='T2.P',IsCVC.T2.PO=0), rm.ranef=T, print.summary=F,
main='T2 rel. posterior position: Ter Apel vs. Ubbergen', xlab='Time (normalized)',
ylab='Posterior position difference', ylim=c(-0.23,0.35)); box()
plot_diff(modelof.rel, view='Time.normWord', comp=list(IsTA.T3.PO =
c(1,0)), cond=list(SensorAxis='T3.P',IsCVC.T3.PO=0), rm.ranef=T, print.summary=F,
main='T3 rel. posterior position: Ter Apel vs. Ubbergen', xlab='Time (normalized)',
ylab='Posterior position difference', ylim=c(-0.23,0.35)); box()
plotSmooths(modelof.rel,xvar='Time.normWord',catvar='IsTA.T1.HO',
catlevels=c(1,0), cond=list(SensorAxis='T1.H',IsCVC.T1.HO=0),
dropRanef=c('SpeakerTypeSensorAxis','WordGroupSensorAxis'),
ylim=c(-0.5,1),legendPos='topleft',main='T1 rel. height',
xlab='Time (normalized)',ylab='Height',
legendlabels=c('Ter Apel','Ubbergen'),legendtitle='Group',
colors=c('cadetblue3','tomato4'),cexPoints=0.5,showPoints=F)
plotSmooths(modelof.rel,xvar='Time.normWord',catvar='IsTA.T2.HO',
catlevels=c(1,0), cond=list(SensorAxis='T2.H',IsCVC.T2.HO=0),
dropRanef=c('SpeakerTypeSensorAxis','WordGroupSensorAxis'),
ylim=c(-0.5,1),legendPos='topleft',main='T2 rel. height',
xlab='Time (normalized)',ylab='Height',
legendlabels=c('Ter Apel','Ubbergen'),legendtitle='Group',
colors=c('cadetblue3','tomato4'),cexPoints=0.5,showPoints=F)
plotSmooths(modelof.rel,xvar='Time.normWord',catvar='IsTA.T3.HO',
catlevels=c(1,0), cond=list(SensorAxis='T3.H',IsCVC.T3.HO=0),
dropRanef=c('SpeakerTypeSensorAxis','WordGroupSensorAxis'),
ylim=c(-0.5,1),legendPos='topleft',main='T3 rel. height',
xlab='Time (normalized)',ylab='Height',
legendlabels=c('Ter Apel','Ubbergen'),legendtitle='Group',
colors=c('cadetblue3','tomato4'),cexPoints=0.5,showPoints=F)
plot_diff(modelof.rel, view='Time.normWord', comp=list(IsTA.T1.HO =
c(1,0)), cond=list(SensorAxis='T1.H',IsCVC.T1.HO=0), rm.ranef=T, print.summary=F,
main='T1 rel. height: Ter Apel vs. Ubbergen', xlab='Time (normalized)',
ylab='Height difference', ylim=c(-0.23,0.35)); box()
plot_diff(modelof.rel, view='Time.normWord', comp=list(IsTA.T2.HO =
c(1,0)), cond=list(SensorAxis='T2.H',IsCVC.T2.HO=0), rm.ranef=T, print.summary=F,
main='T2 rel. height: Ter Apel vs. Ubbergen', xlab='Time (normalized)',
ylab='Height difference', ylim=c(-0.23,0.35)); box()
plot_diff(modelof.rel, view='Time.normWord', comp=list(IsTA.T3.HO =
c(1,0)), cond=list(SensorAxis='T3.H',IsCVC.T3.HO=0), rm.ranef=T, print.summary=F,
main='T3 rel. height: Ter Apel vs. Ubbergen', xlab='Time (normalized)',
ylab='Height difference', ylim=c(-0.23,0.35)); box() 
6.2.4.2 CVC: rel. to rest.
par(mfrow=c(4,3))
plotSmooths(modelof.rel,xvar='Time.normWord',catvar='IsTA.T1.PO',
catlevels=c(1,0), cond=list(SensorAxis='T1.P',IsCVC.T1.PO=1),
dropRanef=c('SpeakerTypeSensorAxis','WordGroupSensorAxis'),
ylim=c(-0.5,1),legendPos='topleft',main='T1 rel. posterior position',
xlab='Time (normalized)',ylab='Posterior position',
legendlabels=c('Ter Apel','Ubbergen'),legendtitle='Group',
colors=c('cadetblue3','tomato4'),cexPoints=0.5,showPoints=F)
plotSmooths(modelof.rel,xvar='Time.normWord',catvar='IsTA.T2.PO',
catlevels=c(1,0), cond=list(SensorAxis='T2.P',IsCVC.T2.PO=1),
dropRanef=c('SpeakerTypeSensorAxis','WordGroupSensorAxis'),
ylim=c(-0.5,1),legendPos='topleft',main='T2 rel. posterior position',
xlab='Time (normalized)',ylab='Posterior position',
legendlabels=c('Ter Apel','Ubbergen'),legendtitle='Group',
colors=c('cadetblue3','tomato4'),cexPoints=0.5,showPoints=F)
plotSmooths(modelof.rel,xvar='Time.normWord',catvar='IsTA.T3.PO',
catlevels=c(1,0), cond=list(SensorAxis='T3.P',IsCVC.T3.PO=1),
dropRanef=c('SpeakerTypeSensorAxis','WordGroupSensorAxis'),
ylim=c(-0.5,1),legendPos='topleft',main='T3 rel. posterior position',
xlab='Time (normalized)',ylab='Posterior position',
legendlabels=c('Ter Apel','Ubbergen'),legendtitle='Group',
colors=c('cadetblue3','tomato4'),cexPoints=0.5,showPoints=F)
plot_diff(modelof.rel, view='Time.normWord', comp=list(IsTA.T1.PO =
c(1,0)), cond=list(SensorAxis='T1.P',IsCVC.T1.PO=1), rm.ranef=T, print.summary=F,
main='T1 rel. posterior position: Ter Apel vs. Ubbergen', xlab='Time (normalized)',
ylab='Posterior position difference', ylim=c(-0.23,0.35)); box()
plot_diff(modelof.rel, view='Time.normWord', comp=list(IsTA.T2.PO =
c(1,0)), cond=list(SensorAxis='T2.P',IsCVC.T2.PO=1), rm.ranef=T, print.summary=F,
main='T2 rel. posterior position: Ter Apel vs. Ubbergen', xlab='Time (normalized)',
ylab='Posterior position difference', ylim=c(-0.23,0.35)); box()
plot_diff(modelof.rel, view='Time.normWord', comp=list(IsTA.T3.PO =
c(1,0)), cond=list(SensorAxis='T3.P',IsCVC.T3.PO=1), rm.ranef=T, print.summary=F,
main='T3 rel. posterior position: Ter Apel vs. Ubbergen', xlab='Time (normalized)',
ylab='Posterior position difference', ylim=c(-0.23,0.35)); box()
plotSmooths(modelof.rel,xvar='Time.normWord',catvar='IsTA.T1.HO',
catlevels=c(1,0), cond=list(SensorAxis='T1.H',IsCVC.T1.HO=1),
dropRanef=c('SpeakerTypeSensorAxis','WordGroupSensorAxis'),
ylim=c(-0.5,1),legendPos='topleft',main='T1 rel. height',
xlab='Time (normalized)',ylab='Height',
legendlabels=c('Ter Apel','Ubbergen'),legendtitle='Group',
colors=c('cadetblue3','tomato4'),cexPoints=0.5,showPoints=F)
plotSmooths(modelof.rel,xvar='Time.normWord',catvar='IsTA.T2.HO',
catlevels=c(1,0), cond=list(SensorAxis='T2.H',IsCVC.T2.HO=1),
dropRanef=c('SpeakerTypeSensorAxis','WordGroupSensorAxis'),
ylim=c(-0.5,1),legendPos='topleft',main='T2 rel. height',
xlab='Time (normalized)',ylab='Height',
legendlabels=c('Ter Apel','Ubbergen'),legendtitle='Group',
colors=c('cadetblue3','tomato4'),cexPoints=0.5,showPoints=F)
plotSmooths(modelof.rel,xvar='Time.normWord',catvar='IsTA.T3.HO',
catlevels=c(1,0), cond=list(SensorAxis='T3.H',IsCVC.T3.HO=1),
dropRanef=c('SpeakerTypeSensorAxis','WordGroupSensorAxis'),
ylim=c(-0.5,1),legendPos='topleft',main='T3 rel. height',
xlab='Time (normalized)',ylab='Height',
legendlabels=c('Ter Apel','Ubbergen'),legendtitle='Group',
colors=c('cadetblue3','tomato4'),cexPoints=0.5,showPoints=F)
plot_diff(modelof.rel, view='Time.normWord', comp=list(IsTA.T1.HO =
c(1,0)), cond=list(SensorAxis='T1.H',IsCVC.T1.HO=1), rm.ranef=T, print.summary=F,
main='T1 rel. height: Ter Apel vs. Ubbergen', xlab='Time (normalized)',
ylab='Height difference', ylim=c(-0.23,0.35)); box()
plot_diff(modelof.rel, view='Time.normWord', comp=list(IsTA.T2.HO =
c(1,0)), cond=list(SensorAxis='T2.H',IsCVC.T2.HO=1), rm.ranef=T, print.summary=F,
main='T2 rel. height: Ter Apel vs. Ubbergen', xlab='Time (normalized)',
ylab='Height difference', ylim=c(-0.23,0.35)); box()
plot_diff(modelof.rel, view='Time.normWord', comp=list(IsTA.T3.HO =
c(1,0)), cond=list(SensorAxis='T3.H',IsCVC.T3.HO=1), rm.ranef=T, print.summary=F,
main='T3 rel. height: Ter Apel vs. Ubbergen', xlab='Time (normalized)',
ylab='Height difference', ylim=c(-0.23,0.35)); box() 
6.2.4.3 Dia.: norm. pos.
# As the model for the normalized position contains all SFs
# (but some fixed-effect factor contrasts are excluded), we
# use the slightly more complex full model for visualization.
par(mfrow=c(4,3))
plotSmooths(model,xvar='Time.normWord',catvar='GroupTypeSensorAxis',
catlevels=c('TerApel.Dialect.T1.P','Ubbergen.Dialect.T1.P'),
dropRanef=c('SpeakerTypeSensorAxis','WordGroupSensorAxis'),
ylim=c(0.05,1),legendPos='topleft',main='T1 posterior position',
xlab='Time (normalized)',ylab='Posterior position',
legendlabels=c('Ter Apel','Ubbergen'),legendtitle='Group',
colors=c('cadetblue3','tomato4'),cexPoints=0.5,showPoints=F)
plotSmooths(model,xvar='Time.normWord',catvar='GroupTypeSensorAxis',
catlevels=c('TerApel.Dialect.T2.P','Ubbergen.Dialect.T2.P'),
dropRanef=c('SpeakerTypeSensorAxis','WordGroupSensorAxis'),
ylim=c(0.05,1),legendPos='topleft',main='T2 posterior position',
xlab='Time (normalized)',ylab='Posterior position',
legendlabels=c('Ter Apel','Ubbergen'),legendtitle='Group',
colors=c('cadetblue3','tomato4'),cexPoints=0.5,showPoints=F)
plotSmooths(model,xvar='Time.normWord',catvar='GroupTypeSensorAxis',
catlevels=c('TerApel.Dialect.T3.P','Ubbergen.Dialect.T3.P'),
dropRanef=c('SpeakerTypeSensorAxis','WordGroupSensorAxis'),
ylim=c(0.05,1),legendPos='bottomleft',main='T3 posterior position',
xlab='Time (normalized)',ylab='Posterior position',
legendlabels=c('Ter Apel','Ubbergen'),legendtitle='Group',
colors=c('cadetblue3','tomato4'),cexPoints=0.5,showPoints=F)
plot_diff(model, view='Time.normWord', comp=list(GroupTypeSensorAxis =
c("TerApel.Dialect.T1.P","Ubbergen.Dialect.T1.P")), rm.ranef=T, print.summary=F,
main='T1 posterior position: Ter Apel vs. Ubbergen', xlab='Time (normalized)',
ylab='Posterior position difference', ylim=c(-0.23,0.35)); box()
plot_diff(model, view='Time.normWord', comp=list(GroupTypeSensorAxis =
c("TerApel.Dialect.T2.P","Ubbergen.Dialect.T2.P")), rm.ranef=T, print.summary=F,
main='T2 posterior position: Ter Apel vs. Ubbergen', xlab='Time (normalized)',
ylab='Posterior position difference', ylim=c(-0.23,0.35)); box()
plot_diff(model, view='Time.normWord', comp=list(GroupTypeSensorAxis =
c("TerApel.Dialect.T3.P","Ubbergen.Dialect.T3.P")), rm.ranef=T, print.summary=F,
main='T3 posterior position: Ter Apel vs. Ubbergen', xlab='Time (normalized)',
ylab='Posterior position difference', ylim=c(-0.23,0.35)); box()
plotSmooths(model,xvar='Time.normWord',catvar='GroupTypeSensorAxis',
catlevels=c('TerApel.Dialect.T1.H','Ubbergen.Dialect.T1.H'),
dropRanef=c('SpeakerTypeSensorAxis','WordGroupSensorAxis'),
ylim=c(0.05,1),legendPos='topleft',main='T1 height',
xlab='Time (normalized)',ylab='Height',
legendlabels=c('Ter Apel','Ubbergen'),legendtitle='Group',
colors=c('cadetblue3','tomato4'),cexPoints=0.5,showPoints=F)
plotSmooths(model,xvar='Time.normWord',catvar='GroupTypeSensorAxis',
catlevels=c('TerApel.Dialect.T2.H','Ubbergen.Dialect.T2.H'),
dropRanef=c('SpeakerTypeSensorAxis','WordGroupSensorAxis'),
ylim=c(0.05,1),legendPos='topleft',main='T2 height',
xlab='Time (normalized)',ylab='Height',
legendlabels=c('Ter Apel','Ubbergen'),legendtitle='Group',
colors=c('cadetblue3','tomato4'),cexPoints=0.5,showPoints=F)
plotSmooths(model,xvar='Time.normWord',catvar='GroupTypeSensorAxis',
catlevels=c('TerApel.Dialect.T3.H','Ubbergen.Dialect.T3.H'),
dropRanef=c('SpeakerTypeSensorAxis','WordGroupSensorAxis'),
ylim=c(0.05,1),legendPos='bottomleft',main='T3 height',
xlab='Time (normalized)',ylab='Height',
legendlabels=c('Ter Apel','Ubbergen'),legendtitle='Group',
colors=c('cadetblue3','tomato4'),cexPoints=0.5,showPoints=F)
plot_diff(model, view='Time.normWord', comp=list(GroupTypeSensorAxis =
c("TerApel.Dialect.T1.H","Ubbergen.Dialect.T1.H")), rm.ranef=T, print.summary=F,
main='T1 height: Ter Apel vs. Ubbergen', xlab='Time (normalized)',
ylab='Height difference', ylim=c(-0.23,0.35)); box()
plot_diff(model, view='Time.normWord', comp=list(GroupTypeSensorAxis =
c("TerApel.Dialect.T1.H","Ubbergen.Dialect.T2.H")), rm.ranef=T, print.summary=F,
main='T2 height: Ter Apel vs. Ubbergen', xlab='Time (normalized)',
ylab='Height difference', ylim=c(-0.23,0.35)); box()
plot_diff(model, view='Time.normWord', comp=list(GroupTypeSensorAxis =
c("TerApel.Dialect.T3.H","Ubbergen.Dialect.T3.H")), rm.ranef=T, print.summary=F,
main='T3 height: Ter Apel vs. Ubbergen', xlab='Time (normalized)',
ylab='Height difference', ylim=c(-0.23,0.35)); box() 
6.2.4.4 CVC: norm. pos.
par(mfrow=c(4,3))
plotSmooths(model,xvar='Time.normWord',catvar='GroupTypeSensorAxis',
catlevels=c('TerApel.Standard.T1.P','Ubbergen.Standard.T1.P'),
dropRanef=c('SpeakerTypeSensorAxis','WordGroupSensorAxis'),
ylim=c(0.05,1),legendPos='topleft',main='T1 posterior position',
xlab='Time (normalized)',ylab='Posterior position',
legendlabels=c('Ter Apel','Ubbergen'),legendtitle='Group',
colors=c('cadetblue3','tomato4'),cexPoints=0.5,showPoints=F)
plotSmooths(model,xvar='Time.normWord',catvar='GroupTypeSensorAxis',
catlevels=c('TerApel.Standard.T2.P','Ubbergen.Standard.T2.P'),
dropRanef=c('SpeakerTypeSensorAxis','WordGroupSensorAxis'),
ylim=c(0.05,1),legendPos='topleft',main='T2 posterior position',
xlab='Time (normalized)',ylab='Posterior position',
legendlabels=c('Ter Apel','Ubbergen'),legendtitle='Group',
colors=c('cadetblue3','tomato4'),cexPoints=0.5,showPoints=F)
plotSmooths(model,xvar='Time.normWord',catvar='GroupTypeSensorAxis',
catlevels=c('TerApel.Standard.T3.P','Ubbergen.Standard.T3.P'),
dropRanef=c('SpeakerTypeSensorAxis','WordGroupSensorAxis'),
ylim=c(0.05,1),legendPos='bottomleft',main='T3 posterior position',
xlab='Time (normalized)',ylab='Posterior position',
legendlabels=c('Ter Apel','Ubbergen'),legendtitle='Group',
colors=c('cadetblue3','tomato4'),cexPoints=0.5,showPoints=F)
plot_diff(model, view='Time.normWord', comp=list(GroupTypeSensorAxis =
c("TerApel.Standard.T1.P","Ubbergen.Standard.T1.P")), rm.ranef=T, print.summary=F,
main='T1 posterior position: Ter Apel vs. Ubbergen', xlab='Time (normalized)',
ylab='Posterior position difference', ylim=c(-0.23,0.35)); box()
plot_diff(model, view='Time.normWord', comp=list(GroupTypeSensorAxis =
c("TerApel.Standard.T2.P","Ubbergen.Standard.T2.P")), rm.ranef=T, print.summary=F,
main='T2 posterior position: Ter Apel vs. Ubbergen', xlab='Time (normalized)',
ylab='Posterior position difference', ylim=c(-0.23,0.35)); box()
plot_diff(model, view='Time.normWord', comp=list(GroupTypeSensorAxis =
c("TerApel.Standard.T3.P","Ubbergen.Standard.T3.P")), rm.ranef=T, print.summary=F,
main='T3 posterior position: Ter Apel vs. Ubbergen', xlab='Time (normalized)',
ylab='Posterior position difference', ylim=c(-0.23,0.35)); box()
plotSmooths(model,xvar='Time.normWord',catvar='GroupTypeSensorAxis',
catlevels=c('TerApel.Standard.T1.H','Ubbergen.Standard.T1.H'),
dropRanef=c('SpeakerTypeSensorAxis','WordGroupSensorAxis'),
ylim=c(0.05,1),legendPos='topleft',main='T1 height',
xlab='Time (normalized)',ylab='Height',
legendlabels=c('Ter Apel','Ubbergen'),legendtitle='Group',
colors=c('cadetblue3','tomato4'),cexPoints=0.5,showPoints=F)
plotSmooths(model,xvar='Time.normWord',catvar='GroupTypeSensorAxis',
catlevels=c('TerApel.Standard.T2.H','Ubbergen.Standard.T2.H'),
dropRanef=c('SpeakerTypeSensorAxis','WordGroupSensorAxis'),
ylim=c(0.05,1),legendPos='topleft',main='T2 height',
xlab='Time (normalized)',ylab='Height',
legendlabels=c('Ter Apel','Ubbergen'),legendtitle='Group',
colors=c('cadetblue3','tomato4'),cexPoints=0.5,showPoints=F)
plotSmooths(model,xvar='Time.normWord',catvar='GroupTypeSensorAxis',
catlevels=c('TerApel.Standard.T3.H','Ubbergen.Standard.T3.H'),
dropRanef=c('SpeakerTypeSensorAxis','WordGroupSensorAxis'),
ylim=c(0.05,1),legendPos='bottomleft',main='T3 height',
xlab='Time (normalized)',ylab='Height',
legendlabels=c('Ter Apel','Ubbergen'),legendtitle='Group',
colors=c('cadetblue3','tomato4'),cexPoints=0.5,showPoints=F)
plot_diff(model, view='Time.normWord', comp=list(GroupTypeSensorAxis =
c("TerApel.Standard.T1.H","Ubbergen.Standard.T1.H")), rm.ranef=T, print.summary=F,
main='T1 height: Ter Apel vs. Ubbergen', xlab='Time (normalized)',
ylab='Height difference', ylim=c(-0.23,0.35)); box()
plot_diff(model, view='Time.normWord', comp=list(GroupTypeSensorAxis =
c("TerApel.Standard.T1.H","Ubbergen.Standard.T2.H")), rm.ranef=T, print.summary=F,
main='T2 height: Ter Apel vs. Ubbergen', xlab='Time (normalized)',
ylab='Height difference', ylim=c(-0.23,0.35)); box()
plot_diff(model, view='Time.normWord', comp=list(GroupTypeSensorAxis =
c("TerApel.Standard.T3.H","Ubbergen.Standard.T3.H")), rm.ranef=T, print.summary=F,
main='T3 height: Ter Apel vs. Ubbergen', xlab='Time (normalized)',
ylab='Height difference', ylim=c(-0.23,0.35)); box() 
6.3 Formal difference assessment
6.3.1 Relative to resting position
smryof.rel # show summary assessing significant differences for position relative to the non-speech resting position##
## Family: gaussian
## Link function: identity
##
## Formula:
## RelPos.norm ~ s(Time.normWord, by = SensorAxis, k = 20) + SensorAxis +
## IsTA.T1.PO + IsTA.T1.HO + IsTA.T2.PO + IsTA.T2.HO + IsTA.T3.PO +
## IsTA.T3.HO + s(Time.normWord, by = IsCVC.T1.PO, k = 20) +
## s(Time.normWord, by = IsCVC.T1.HO, k = 20) + s(Time.normWord,
## by = IsCVC.T2.PO, k = 20) + s(Time.normWord, by = IsCVC.T2.HO,
## k = 20) + s(Time.normWord, by = IsCVC.T3.PO, k = 20) + s(Time.normWord,
## by = IsCVC.T3.HO, k = 20) + s(Time.normWord, SpeakerTypeSensorAxis,
## bs = "fs", m = 1) + s(Time.normWord, WordGroupSensorAxis,
## bs = "fs", m = 1)
##
## Parametric coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.08758 0.02756 3.178 0.00148 **
## SensorAxisT2.P 0.05456 0.03899 1.399 0.16172
## SensorAxisT1.P 0.05883 0.03900 1.509 0.13140
## SensorAxisT3.H -0.26699 0.03898 -6.849 7.45e-12 ***
## SensorAxisT2.H -0.29821 0.03900 -7.647 2.05e-14 ***
## SensorAxisT1.H -0.28941 0.03901 -7.419 1.18e-13 ***
## IsTA.T1.PO1 0.10231 0.04092 2.500 0.01242 *
## IsTA.T1.HO1 0.03544 0.04092 0.866 0.38647
## IsTA.T2.PO1 0.12625 0.04092 3.085 0.00204 **
## IsTA.T2.HO1 0.01746 0.04092 0.427 0.66964
## IsTA.T3.PO1 0.12831 0.04092 3.135 0.00172 **
## IsTA.T3.HO1 -0.03002 0.04092 -0.733 0.46328
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Approximate significance of smooth terms:
## edf Ref.df F p-value
## s(Time.normWord):SensorAxisT3.P 7.171 9.39 2.546 0.0101
## s(Time.normWord):SensorAxisT2.P 11.584 13.45 8.056 < 2e-16
## s(Time.normWord):SensorAxisT1.P 14.043 15.29 11.022 < 2e-16
## s(Time.normWord):SensorAxisT3.H 9.992 12.15 11.057 < 2e-16
## s(Time.normWord):SensorAxisT2.H 12.180 13.93 24.672 < 2e-16
## s(Time.normWord):SensorAxisT1.H 16.873 17.37 18.181 < 2e-16
## s(Time.normWord):IsCVC.T1.PO1 13.420 14.84 3.802 1.16e-06
## s(Time.normWord):IsCVC.T1.HO1 14.190 15.41 5.894 3.80e-12
## s(Time.normWord):IsCVC.T2.PO1 14.181 15.38 4.670 3.36e-09
## s(Time.normWord):IsCVC.T2.HO1 15.574 16.40 8.651 < 2e-16
## s(Time.normWord):IsCVC.T3.PO1 15.177 16.09 6.745 1.05e-15
## s(Time.normWord):IsCVC.T3.HO1 14.971 15.94 7.484 < 2e-16
## s(Time.normWord,SpeakerTypeSensorAxis) 3268.178 3661.00 128.618 < 2e-16
## s(Time.normWord,WordGroupSensorAxis) 10243.391 10468.00 92.272 < 2e-16
##
## s(Time.normWord):SensorAxisT3.P *
## s(Time.normWord):SensorAxisT2.P ***
## s(Time.normWord):SensorAxisT1.P ***
## s(Time.normWord):SensorAxisT3.H ***
## s(Time.normWord):SensorAxisT2.H ***
## s(Time.normWord):SensorAxisT1.H ***
## s(Time.normWord):IsCVC.T1.PO1 ***
## s(Time.normWord):IsCVC.T1.HO1 ***
## s(Time.normWord):IsCVC.T2.PO1 ***
## s(Time.normWord):IsCVC.T2.HO1 ***
## s(Time.normWord):IsCVC.T3.PO1 ***
## s(Time.normWord):IsCVC.T3.HO1 ***
## s(Time.normWord,SpeakerTypeSensorAxis) ***
## s(Time.normWord,WordGroupSensorAxis) ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## R-sq.(adj) = 0.898 Deviance explained = 89.9%
## fREML = -4.341e+06 Scale est. = 0.0045429 n = 1698513# show model criticism plots, supress textual output
sink("/dev/null"); gam.check(modelof.rel); sink()
6.3.2 Normalized position
if (!file.exists('modelALL-of-simpler-mc-1.8.12.rda')) {
download.file('http://www.let.rug.nl/wieling/DiaArt/modelALL-of-simpler-mc-1.8.12.rda',
'modelALL-of-simpler-mc-1.8.12.rda')
}
load('modelALL-of-simpler-mc-1.8.12.rda')
smryof # show summary assessing significant differences##
## Family: gaussian
## Link function: identity
##
## Formula:
## Position.norm ~ RestPosition.norm + s(Time.normWord, by = SensorAxis,
## k = 20) + SensorAxis + s(Time.normWord, by = IsTA.T1.PO,
## k = 20) + IsTA.T1.PO + s(Time.normWord, by = IsTA.T1.HO,
## k = 20) + IsTA.T1.HO + s(Time.normWord, by = IsTA.T2.PO,
## k = 20) + IsTA.T2.PO + s(Time.normWord, by = IsTA.T2.HO,
## k = 20) + IsTA.T2.HO + s(Time.normWord, by = IsTA.T3.PO,
## k = 20) + IsTA.T3.PO + s(Time.normWord, by = IsTA.T3.HO,
## k = 20) + IsTA.T3.HO + s(Time.normWord, by = IsCVC.T1.PO,
## k = 20) + s(Time.normWord, by = IsCVC.T1.HO, k = 20) + s(Time.normWord,
## by = IsCVC.T2.PO, k = 20) + s(Time.normWord, by = IsCVC.T2.HO,
## k = 20) + s(Time.normWord, by = IsCVC.T3.PO, k = 20) + s(Time.normWord,
## by = IsCVC.T3.HO, k = 20) + s(Time.normWord, by = IsTACVC.T1.PO,
## k = 20) + s(Time.normWord, by = IsTACVC.T1.HO, k = 20) +
## s(Time.normWord, by = IsTACVC.T2.PO, k = 20) + s(Time.normWord,
## by = IsTACVC.T2.HO, k = 20) + s(Time.normWord, by = IsTACVC.T3.PO,
## k = 20) + s(Time.normWord, by = IsTACVC.T3.HO, k = 20) +
## s(Time.normWord, SpeakerTypeSensorAxis, bs = "fs", m = 1) +
## s(Time.normWord, WordGroupSensorAxis, bs = "fs", m = 1)
##
## Parametric coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.488663 0.016365 29.861 < 2e-16 ***
## RestPosition.norm 0.307116 0.017765 17.287 < 2e-16 ***
## SensorAxisT2.P -0.157504 0.017369 -9.068 < 2e-16 ***
## SensorAxisT1.P -0.310254 0.018932 -16.388 < 2e-16 ***
## SensorAxisT3.H -0.036120 0.017153 -2.106 0.035230 *
## SensorAxisT2.H -0.141752 0.016827 -8.424 < 2e-16 ***
## SensorAxisT1.H -0.259200 0.016875 -15.360 < 2e-16 ***
## IsTA.T1.PO1 0.051374 0.017232 2.981 0.002870 **
## IsTA.T1.HO1 -0.013861 0.017563 -0.789 0.429970
## IsTA.T2.PO1 0.065260 0.017240 3.785 0.000154 ***
## IsTA.T2.HO1 -0.009458 0.017334 -0.546 0.585308
## IsTA.T3.PO1 0.052510 0.017237 3.046 0.002316 **
## IsTA.T3.HO1 -0.037064 0.017292 -2.143 0.032076 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Approximate significance of smooth terms:
## edf Ref.df F
## s(Time.normWord):SensorAxisT3.P 4.592 6.278 1.566
## s(Time.normWord):SensorAxisT2.P 9.558 11.701 4.914
## s(Time.normWord):SensorAxisT1.P 12.670 14.229 8.352
## s(Time.normWord):SensorAxisT3.H 10.893 12.906 12.019
## s(Time.normWord):SensorAxisT2.H 12.757 14.343 27.974
## s(Time.normWord):SensorAxisT1.H 17.133 17.550 20.090
## s(Time.normWord):IsTA.T1.PO1 1.011 1.019 0.015
## s(Time.normWord):IsTA.T1.HO1 8.306 10.549 2.845
## s(Time.normWord):IsTA.T2.PO1 1.180 1.312 0.538
## s(Time.normWord):IsTA.T2.HO1 1.012 1.021 2.433
## s(Time.normWord):IsTA.T3.PO1 1.005 1.008 1.235
## s(Time.normWord):IsTA.T3.HO1 1.030 1.052 1.629
## s(Time.normWord):IsCVC.T1.PO1 11.980 13.719 2.894
## s(Time.normWord):IsCVC.T1.HO1 14.668 15.708 6.058
## s(Time.normWord):IsCVC.T2.PO1 12.811 14.318 3.346
## s(Time.normWord):IsCVC.T2.HO1 15.895 16.596 9.106
## s(Time.normWord):IsCVC.T3.PO1 13.820 15.066 4.556
## s(Time.normWord):IsCVC.T3.HO1 15.599 16.372 6.483
## s(Time.normWord):IsTACVC.T1.PO1 1.005 1.008 2.070
## s(Time.normWord):IsTACVC.T1.HO1 2.312 3.047 3.094
## s(Time.normWord):IsTACVC.T2.PO1 1.005 1.010 0.021
## s(Time.normWord):IsTACVC.T2.HO1 5.121 6.960 1.111
## s(Time.normWord):IsTACVC.T3.PO1 1.005 1.009 0.371
## s(Time.normWord):IsTACVC.T3.HO1 3.160 4.320 1.456
## s(Time.normWord,SpeakerTypeSensorAxis) 3281.139 3661.000 45.225
## s(Time.normWord,WordGroupSensorAxis) 10255.011 10466.000 107.750
## p-value
## s(Time.normWord):SensorAxisT3.P 0.147731
## s(Time.normWord):SensorAxisT2.P 5.24e-08 ***
## s(Time.normWord):SensorAxisT1.P < 2e-16 ***
## s(Time.normWord):SensorAxisT3.H < 2e-16 ***
## s(Time.normWord):SensorAxisT2.H < 2e-16 ***
## s(Time.normWord):SensorAxisT1.H < 2e-16 ***
## s(Time.normWord):IsTA.T1.PO1 0.901662
## s(Time.normWord):IsTA.T1.HO1 0.001092 **
## s(Time.normWord):IsTA.T2.PO1 0.576080
## s(Time.normWord):IsTA.T2.HO1 0.119814
## s(Time.normWord):IsTA.T3.PO1 0.266374
## s(Time.normWord):IsTA.T3.HO1 0.197277
## s(Time.normWord):IsCVC.T1.PO1 0.000316 ***
## s(Time.normWord):IsCVC.T1.HO1 3.00e-13 ***
## s(Time.normWord):IsCVC.T2.PO1 1.66e-05 ***
## s(Time.normWord):IsCVC.T2.HO1 < 2e-16 ***
## s(Time.normWord):IsCVC.T3.PO1 8.43e-09 ***
## s(Time.normWord):IsCVC.T3.HO1 4.32e-15 ***
## s(Time.normWord):IsTACVC.T1.PO1 0.149724
## s(Time.normWord):IsTACVC.T1.HO1 0.026439 *
## s(Time.normWord):IsTACVC.T2.PO1 0.885762
## s(Time.normWord):IsTACVC.T2.HO1 0.347337
## s(Time.normWord):IsTACVC.T3.PO1 0.545959
## s(Time.normWord):IsTACVC.T3.HO1 0.229430
## s(Time.normWord,SpeakerTypeSensorAxis) < 2e-16 ***
## s(Time.normWord,WordGroupSensorAxis) < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## R-sq.(adj) = 0.911 Deviance explained = 91.2%
## fREML = -5.0377e+06 Scale est. = 0.0019818 n = 1693270# show model criticism plots, supress textual output
sink("/dev/null"); gam.check(modelof); sink()
6.4 Validation: words
To assess if the results with respect to the dialect words are not caused by the specific phonological dialect differences, we select the five words which are pronounced similarly in the two dialects (see Table 1 in the manuscript): “kameel”, “leeuw”, “speen”, “tol”, “wiel” and formally assess the differences.
6.4.1 Model fitting results
In the following the validation model is fitted. Three models are fitted: the first model is used to determine the rho value (for correcting autocorrelation in the residuals), the second model is used for visualization, and the third model fits the model using difference curves, thereby yielding p-values assessing if the difference between the two speaker groups is significant (separately for the constant intercept difference, and the non-linear difference) or not for the subset of the five dialect words. The models are saved to prevent having to redo the computations.
6.4.1.1 Relative to resting position
subdat = droplevels(dat[dat$Word %in% c("kameel","leeuw","speen","tol","wiel"),],
except=colnames(dat)[sapply(dat,is.ordered)])
subdat$GroupSensorAxis = interaction(subdat$Group,subdat$Sensor,subdat$Axis)
# fit first model to determine autocorrelation in residuals
modelNoRho.rel <- bam(RelPos.norm ~ s(Time.normWord,by=GroupSensorAxis, k=10) +
GroupSensorAxis + s(Time.normWord,SpeakerSensorAxis,bs='fs',m=1) +
s(Time.normWord,WordGroupSensorAxis,bs='fs',m=1), data=subdat,
method='fREML', discrete=T, nthreads=32)
save(modelNoRho.rel,file='modelVAL-rel-group-norho-1.8.12.rda')# assess autocorrelation in residuals
modelACF.rel = acf(resid(modelNoRho.rel),plot=F)
rhoval = as.vector(modelACF.rel[1]$acf)
model.rel <- bam(RelPos.norm ~ s(Time.normWord,by=GroupSensorAxis, k=10) +
GroupSensorAxis + s(Time.normWord,SpeakerSensorAxis,bs='fs',m=1) +
s(Time.normWord,WordGroupSensorAxis,bs='fs',m=1), data=subdat,
method='fREML', AR.start=Word.start, rho=rhoval, discrete=T, nthreads=32)
save(model.rel,file='modelVAL-rel-group-1.8.12.rda')# model criticism
subdat2 <- droplevels(subdat[abs(scale(resid(model.rel))) < 2.5, ],
except=colnames(subdat)[sapply(subdat,is.ordered)])
model.rel <- bam(RelPos.norm ~ s(Time.normWord,by=GroupSensorAxis, k=10) +
GroupSensorAxis + s(Time.normWord,SpeakerSensorAxis,bs='fs',m=1) +
s(Time.normWord,WordGroupSensorAxis,bs='fs',m=1), data=subdat2,
method='fREML', AR.start=Word.start, rho=rhoval, discrete=T, nthreads=32)
save(model.rel,file='modelVAL-rel-group-mc-1.8.12.rda')# fit model with ordered factor difference curve
modelof.rel <- bam(RelPos.norm ~ s(Time.normWord, by=SensorAxis,k=10) + SensorAxis +
IsTA.T1.PO + IsTA.T1.HO + IsTA.T2.PO + IsTA.T2.HO + IsTA.T3.PO + IsTA.T3.HO +
s(Time.normWord,SpeakerSensorAxis,bs='fs',m=1) +
s(Time.normWord,WordGroupSensorAxis,bs='fs',m=1), data=subdat, method='fREML',
AR.start=Word.start, rho=rhoval, discrete=T, nthreads=32)
smryof.rel <- summary(modelof.rel)
save(modelof.rel,smryof.rel,file='modelVAL-rel-of-simplest-1.8.12.rda')# model criticism
subdat2 <- droplevels(subdat[abs(scale(resid(modelof.rel))) < 2.5, ],
except=colnames(subdat)[sapply(subdat,is.ordered)])
# fit model with ordered factor difference curve
modelof.rel <- bam(RelPos.norm ~ s(Time.normWord, by=SensorAxis,k=10) + SensorAxis +
IsTA.T1.PO + IsTA.T1.HO + IsTA.T2.PO + IsTA.T2.HO + IsTA.T3.PO + IsTA.T3.HO +
s(Time.normWord,SpeakerSensorAxis,bs='fs',m=1) +
s(Time.normWord,WordGroupSensorAxis,bs='fs',m=1), data=subdat2, method='fREML',
AR.start=Word.start, rho=rhoval, discrete=T, nthreads=32)
smryof.rel <- summary(modelof.rel)
save(modelof.rel,smryof.rel,file='modelVAL-rel-of-simplest-mc-1.8.12.rda')if (!file.exists('modelVAL-rel-of-simplest-mc-1.8.12.rda')) {
download.file('http://www.let.rug.nl/wieling/DiaArt/modelVAL-rel-of-simplest-mc-1.8.12.rda',
'modelVAL-rel-of-simplest-mc-1.8.12.rda')
}
load('modelVAL-rel-of-simplest-mc-1.8.12.rda')
smryof.rel # show summary assessing significant differences for position rel. to. n.s. rest. pos.##
## Family: gaussian
## Link function: identity
##
## Formula:
## RelPos.norm ~ s(Time.normWord, by = SensorAxis, k = 10) + SensorAxis +
## IsTA.T1.PO + IsTA.T1.HO + IsTA.T2.PO + IsTA.T2.HO + IsTA.T3.PO +
## IsTA.T3.HO + s(Time.normWord, SpeakerSensorAxis, bs = "fs",
## m = 1) + s(Time.normWord, WordGroupSensorAxis, bs = "fs",
## m = 1)
##
## Parametric coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.072124 0.053769 1.341 0.179803
## SensorAxisT2.P 0.033950 0.075973 0.447 0.654965
## SensorAxisT1.P 0.037409 0.075919 0.493 0.622196
## SensorAxisT3.H -0.257927 0.075933 -3.397 0.000682 ***
## SensorAxisT2.H -0.265702 0.075925 -3.500 0.000466 ***
## SensorAxisT1.H -0.180875 0.076037 -2.379 0.017372 *
## IsTA.T1.PO1 0.101535 0.077273 1.314 0.188858
## IsTA.T1.HO1 -0.006613 0.077271 -0.086 0.931799
## IsTA.T2.PO1 0.140651 0.077271 1.820 0.068726 .
## IsTA.T2.HO1 -0.003261 0.077271 -0.042 0.966338
## IsTA.T3.PO1 0.122943 0.077313 1.590 0.111796
## IsTA.T3.HO1 -0.039095 0.077313 -0.506 0.613087
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Approximate significance of smooth terms:
## edf Ref.df F p-value
## s(Time.normWord):SensorAxisT3.P 4.871 5.174 1.503 0.1895
## s(Time.normWord):SensorAxisT2.P 4.391 4.717 1.276 0.2470
## s(Time.normWord):SensorAxisT1.P 3.976 4.320 0.537 0.6518
## s(Time.normWord):SensorAxisT3.H 4.096 4.438 1.708 0.1203
## s(Time.normWord):SensorAxisT2.H 4.025 4.367 4.448 0.0012 **
## s(Time.normWord):SensorAxisT1.H 4.868 5.170 2.978 0.0101 *
## s(Time.normWord,SpeakerSensorAxis) 1447.976 1824.000 20.323 <2e-16 ***
## s(Time.normWord,WordGroupSensorAxis) 504.470 528.000 86.856 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## R-sq.(adj) = 0.898 Deviance explained = 90%
## fREML = -2.2004e+05 Scale est. = 0.0034064 n = 83836# show model criticism plots, supress textual output
sink("/dev/null"); gam.check(modelof.rel); sink()
6.4.1.2 Normalized position
# fit first model to determine autocorrelation in residuals
modelNoRho <- bam(Position.norm ~ RestPosition.norm + s(Time.normWord,by=GroupSensorAxis, k=10) +
GroupSensorAxis + s(Time.normWord,SpeakerSensorAxis,bs='fs',m=1) +
s(Time.normWord,WordGroupSensorAxis,bs='fs',m=1), data=subdat,
method='fREML', discrete=T, nthreads=32)
save(modelNoRho,file='modelVAL-group-norho-1.8.12.rda')# assess autocorrelation in residuals
modelACF = acf(resid(modelNoRho),plot=F)
rhoval = as.vector(modelACF[1]$acf)
# fit first model to determine autocorrelation in residuals
model <- bam(Position.norm ~ RestPosition.norm + s(Time.normWord,by=GroupSensorAxis, k=10) +
GroupSensorAxis + s(Time.normWord,SpeakerSensorAxis,bs='fs',m=1) +
s(Time.normWord,WordGroupSensorAxis,bs='fs',m=1), data=subdat,
method='fREML', AR.start=Word.start, rho=rhoval, discrete=T, nthreads=32)
save(model,file='modelVAL-group-1.8.12.rda')# model criticism
subdat2 <- droplevels(subdat[abs(scale(resid(model))) < 2.5, ],
except=colnames(subdat)[sapply(subdat,is.ordered)])
# fit first model to determine autocorrelation in residuals
model <- bam(Position.norm ~ RestPosition.norm + s(Time.normWord,by=GroupSensorAxis, k=10) +
GroupSensorAxis + s(Time.normWord,SpeakerSensorAxis,bs='fs',m=1) +
s(Time.normWord,WordGroupSensorAxis,bs='fs',m=1), data=subdat2,
method='fREML', AR.start=Word.start, rho=rhoval, discrete=T, nthreads=32)
save(model,file='modelVAL-group-mc-1.8.12.rda')# fit model with ordered factor difference curve
modelof <- bam(Position.norm ~ RestPosition.norm + s(Time.normWord, by=SensorAxis,k=10) +
SensorAxis + s(Time.normWord, by=IsTA.T1.PO,k=10) + IsTA.T1.PO +
s(Time.normWord, by=IsTA.T1.HO,k=10) + IsTA.T1.HO +
s(Time.normWord, by=IsTA.T2.PO,k=10) + IsTA.T2.PO +
s(Time.normWord, by=IsTA.T2.HO,k=10) + IsTA.T2.HO +
s(Time.normWord, by=IsTA.T3.PO,k=10) + IsTA.T3.PO +
s(Time.normWord, by=IsTA.T3.HO,k=10) + IsTA.T3.HO +
s(Time.normWord,SpeakerSensorAxis,bs='fs',m=1) +
s(Time.normWord,WordGroupSensorAxis,bs='fs',m=1), data=subdat, method='fREML',
AR.start=Word.start, rho=rhoval, discrete=T, nthreads=32)
smryof <- summary(modelof)
save(modelof,smryof,file='modelVAL-of-1.8.12.rda')# model criticism
subdat2 <- droplevels(subdat[abs(scale(resid(modelof))) < 2.5, ],
except=colnames(subdat)[sapply(subdat,is.ordered)])
# fit model with ordered factor difference curve
modelof <- bam(Position.norm ~ RestPosition.norm + s(Time.normWord, by=SensorAxis,k=10) +
SensorAxis + s(Time.normWord, by=IsTA.T1.PO,k=10) + IsTA.T1.PO +
s(Time.normWord, by=IsTA.T1.HO,k=10) + IsTA.T1.HO +
s(Time.normWord, by=IsTA.T2.PO,k=10) + IsTA.T2.PO +
s(Time.normWord, by=IsTA.T2.HO,k=10) + IsTA.T2.HO +
s(Time.normWord, by=IsTA.T3.PO,k=10) + IsTA.T3.PO +
s(Time.normWord, by=IsTA.T3.HO,k=10) + IsTA.T3.HO +
s(Time.normWord,SpeakerSensorAxis,bs='fs',m=1) +
s(Time.normWord,WordGroupSensorAxis,bs='fs',m=1), data=subdat2, method='fREML',
AR.start=Word.start, rho=rhoval, discrete=T, nthreads=32)
smryof <- summary(modelof)
save(modelof,smryof,file='modelVAL-of-mc-1.8.12.rda')if (!file.exists('modelVAL-of-mc-1.8.12.rda')) {
download.file('http://www.let.rug.nl/wieling/DiaArt/modelVAL-of-mc-1.8.12.rda',
'modelVAL-of-mc-1.8.12.rda')
}
load('modelVAL-of-mc-1.8.12.rda')
smryof # show summary assessing significant differences##
## Family: gaussian
## Link function: identity
##
## Formula:
## Position.norm ~ RestPosition.norm + s(Time.normWord, by = SensorAxis,
## k = 10) + SensorAxis + s(Time.normWord, by = IsTA.T1.PO,
## k = 10) + IsTA.T1.PO + s(Time.normWord, by = IsTA.T1.HO,
## k = 10) + IsTA.T1.HO + s(Time.normWord, by = IsTA.T2.PO,
## k = 10) + IsTA.T2.PO + s(Time.normWord, by = IsTA.T2.HO,
## k = 10) + IsTA.T2.HO + s(Time.normWord, by = IsTA.T3.PO,
## k = 10) + IsTA.T3.PO + s(Time.normWord, by = IsTA.T3.HO,
## k = 10) + IsTA.T3.HO + s(Time.normWord, SpeakerSensorAxis,
## bs = "fs", m = 1) + s(Time.normWord, WordGroupSensorAxis,
## bs = "fs", m = 1)
##
## Parametric coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.53516 0.03655 14.640 < 2e-16 ***
## RestPosition.norm 0.22282 0.03458 6.443 1.18e-10 ***
## SensorAxisT2.P -0.18703 0.04226 -4.426 9.63e-06 ***
## SensorAxisT1.P -0.36734 0.04472 -8.215 < 2e-16 ***
## SensorAxisT3.H -0.01753 0.04210 -0.416 0.6771
## SensorAxisT2.H -0.10455 0.04148 -2.521 0.0117 *
## SensorAxisT1.H -0.18256 0.04170 -4.378 1.20e-05 ***
## IsTA.T1.PO1 0.05863 0.04125 1.421 0.1552
## IsTA.T1.HO1 -0.07218 0.04194 -1.721 0.0852 .
## IsTA.T2.PO1 0.06784 0.04163 1.629 0.1032
## IsTA.T2.HO1 -0.04100 0.04126 -0.994 0.3203
## IsTA.T3.PO1 0.04933 0.04129 1.195 0.2322
## IsTA.T3.HO1 -0.03963 0.04129 -0.960 0.3372
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Approximate significance of smooth terms:
## edf Ref.df F p-value
## s(Time.normWord):SensorAxisT3.P 3.173 3.532 0.707 0.56184
## s(Time.normWord):SensorAxisT2.P 2.705 3.050 0.299 0.79950
## s(Time.normWord):SensorAxisT1.P 3.095 3.454 0.363 0.69312
## s(Time.normWord):SensorAxisT3.H 4.782 5.086 2.592 0.02299 *
## s(Time.normWord):SensorAxisT2.H 4.115 4.450 4.245 0.00144 **
## s(Time.normWord):SensorAxisT1.H 5.305 5.569 3.107 0.00613 **
## s(Time.normWord):IsTA.T1.PO1 1.001 1.001 1.059 0.30323
## s(Time.normWord):IsTA.T1.HO1 2.277 2.616 0.135 0.85717
## s(Time.normWord):IsTA.T2.PO1 1.913 2.212 0.856 0.43807
## s(Time.normWord):IsTA.T2.HO1 1.000 1.001 0.070 0.79136
## s(Time.normWord):IsTA.T3.PO1 1.001 1.001 0.116 0.73417
## s(Time.normWord):IsTA.T3.HO1 1.004 1.006 1.003 0.31591
## s(Time.normWord,SpeakerSensorAxis) 1451.143 1836.000 8.984 < 2e-16 ***
## s(Time.normWord,WordGroupSensorAxis) 504.675 540.000 93.255 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## R-sq.(adj) = 0.922 Deviance explained = 92.4%
## fREML = -2.5359e+05 Scale est. = 0.0015283 n = 83536# show model criticism plots, supress textual output
sink("/dev/null"); gam.check(modelof); sink()
6.4.2 Vis.: tongue movement
6.4.2.1 Relative to resting position
if (!file.exists('modelVAL-rel-group-mc-1.8.12.rda')) {
download.file('http://www.let.rug.nl/wieling/DiaArt/modelVAL-rel-group-mc-1.8.12.rda',
'modelVAL-rel-group-mc-1.8.12.rda')
}
load('modelVAL-rel-group-mc-1.8.12.rda')
par(mfrow=c(3,1))
plotArt2D(model.rel, catvar='GroupSensorAxis',
catlevels.x=c('TerApel.T1.P','Ubbergen.T1.P'),
catlevels.y=c('TerApel.T1.H','Ubbergen.T1.H'),
timevar='Time.normWord', collabels=c('Ter Apel', 'Ubbergen'),
main='Rel. position of the T1 sensor',
xlab='Posterior position (rel.)', ylab='Height (rel.)', showPoints=T,
cols=list(c("cadetblue3","cadetblue1"),c("tomato4","tomato")),alpha=15,xlim=c(-1,1),ylim=c(-1,1))
plotArt2D(model.rel, catvar='GroupSensorAxis',
catlevels.x=c('TerApel.T2.P','Ubbergen.T2.P'),
catlevels.y=c('TerApel.T2.H','Ubbergen.T2.H'),
timevar='Time.normWord', collabels=c('Ter Apel', 'Ubbergen'),
main='Rel. position of the T2 sensor',
xlab='Posterior position (rel.)', ylab='Height (rel.)', showPoints=T,
cols=list(c("cadetblue3","cadetblue1"),c("tomato4","tomato")),alpha=15,xlim=c(-1,1),ylim=c(-1,1))
plotArt2D(model.rel, catvar='GroupSensorAxis',
catlevels.x=c('TerApel.T3.P','Ubbergen.T3.P'),
catlevels.y=c('TerApel.T3.H','Ubbergen.T3.H'),
timevar='Time.normWord', collabels=c('Ter Apel', 'Ubbergen'),
main='Rel. position of the T3 sensor',
xlab='Posterior position (rel.)', ylab='Height (rel.)', showPoints=T,
cols=list(c("cadetblue3","cadetblue1"),c("tomato4","tomato")),alpha=15,xlim=c(-1,1),ylim=c(-1,1))
6.4.2.2 Normalized position
if (!file.exists('modelVAL-group-mc-1.8.12.rda')) {
download.file('http://www.let.rug.nl/wieling/DiaArt/modelVAL-group-mc-1.8.12.rda',
'modelVAL-group-mc-1.8.12.rda')
}
load('modelVAL-group-mc-1.8.12.rda')
plotArt2D(model, catvar='GroupSensorAxis',
catlevels.x=c('TerApel.T1.P','Ubbergen.T1.P','TerApel.T2.P',
'Ubbergen.T2.P','TerApel.T3.P','Ubbergen.T3.P'),
catlevels.y=c('TerApel.T1.H','Ubbergen.T1.H','TerApel.T2.H',
'Ubbergen.T2.H','TerApel.T3.H','Ubbergen.T3.H'),
timevar='Time.normWord', collabels=c('Ter Apel', 'Ubbergen'),
xlab='Posterior position', ylab='Height', showPoints=T,
main='Position of the three tongue sensors',
cols=list(c("cadetblue3","cadetblue1"),c("tomato4","tomato")),
alpha=2, cexPoints=0.4)
6.4.3 Vis.: tongue differences
6.4.3.1 Relative to resting position
par(mfrow=c(4,3))
plotSmooths(modelof.rel,xvar='Time.normWord',catvar='IsTA.T1.PO',
catlevels=c(1,0), cond=list(SensorAxis='T1.P'),
dropRanef=c('SpeakerSensorAxis','WordGroupSensorAxis'),
ylim=c(-0.5,1),legendPos='topleft',main='T1 rel. posterior position',
xlab='Time (normalized)',ylab='Posterior position',
legendlabels=c('Ter Apel','Ubbergen'),legendtitle='Group',
colors=c('cadetblue3','tomato4'),cexPoints=0.5,showPoints=F)
plotSmooths(modelof.rel,xvar='Time.normWord',catvar='IsTA.T2.PO',
catlevels=c(1,0), cond=list(SensorAxis='T2.P'),
dropRanef=c('SpeakerSensorAxis','WordGroupSensorAxis'),
ylim=c(-0.5,1),legendPos='topleft',main='T2 rel. posterior position',
xlab='Time (normalized)',ylab='Posterior position',
legendlabels=c('Ter Apel','Ubbergen'),legendtitle='Group',
colors=c('cadetblue3','tomato4'),cexPoints=0.5,showPoints=F)
plotSmooths(modelof.rel,xvar='Time.normWord',catvar='IsTA.T3.PO',
catlevels=c(1,0), cond=list(SensorAxis='T3.P'),
dropRanef=c('SpeakerSensorAxis','WordGroupSensorAxis'),
ylim=c(-0.5,1),legendPos='topleft',main='T3 rel. posterior position',
xlab='Time (normalized)',ylab='Posterior position',
legendlabels=c('Ter Apel','Ubbergen'),legendtitle='Group',
colors=c('cadetblue3','tomato4'),cexPoints=0.5,showPoints=F)
plot_diff(modelof.rel, view='Time.normWord', comp=list(IsTA.T1.PO =
c(1,0)), cond=list(SensorAxis='T1.P'), rm.ranef=T, print.summary=F,
main='T1 rel. posterior position: Ter Apel vs. Ubbergen', xlab='Time (normalized)',
ylab='Posterior position difference', ylim=c(-0.23,0.35)); box()
plot_diff(modelof.rel, view='Time.normWord', comp=list(IsTA.T2.PO =
c(1,0)), cond=list(SensorAxis='T2.P'), rm.ranef=T, print.summary=F,
main='T2 rel. posterior position: Ter Apel vs. Ubbergen', xlab='Time (normalized)',
ylab='Posterior position difference', ylim=c(-0.23,0.35)); box()
plot_diff(modelof.rel, view='Time.normWord', comp=list(IsTA.T3.PO =
c(1,0)), cond=list(SensorAxis='T3.P'), rm.ranef=T, print.summary=F,
main='T3 rel. posterior position: Ter Apel vs. Ubbergen', xlab='Time (normalized)',
ylab='Posterior position difference', ylim=c(-0.23,0.35)); box()
plotSmooths(modelof.rel,xvar='Time.normWord',catvar='IsTA.T1.HO',
catlevels=c(1,0), cond=list(SensorAxis='T1.H'),
dropRanef=c('SpeakerSensorAxis','WordGroupSensorAxis'),
ylim=c(-0.5,1),legendPos='topleft',main='T1 rel. height',
xlab='Time (normalized)',ylab='Height',
legendlabels=c('Ter Apel','Ubbergen'),legendtitle='Group',
colors=c('cadetblue3','tomato4'),cexPoints=0.5,showPoints=F)
plotSmooths(modelof.rel,xvar='Time.normWord',catvar='IsTA.T2.HO',
catlevels=c(1,0), cond=list(SensorAxis='T2.H'),
dropRanef=c('SpeakerSensorAxis','WordGroupSensorAxis'),
ylim=c(-0.5,1),legendPos='topleft',main='T2 rel. height',
xlab='Time (normalized)',ylab='Height',
legendlabels=c('Ter Apel','Ubbergen'),legendtitle='Group',
colors=c('cadetblue3','tomato4'),cexPoints=0.5,showPoints=F)
plotSmooths(modelof.rel,xvar='Time.normWord',catvar='IsTA.T3.HO',
catlevels=c(1,0), cond=list(SensorAxis='T3.H'),
dropRanef=c('SpeakerSensorAxis','WordGroupSensorAxis'),
ylim=c(-0.5,1),legendPos='topleft',main='T3 rel. height',
xlab='Time (normalized)',ylab='Height',
legendlabels=c('Ter Apel','Ubbergen'),legendtitle='Group',
colors=c('cadetblue3','tomato4'),cexPoints=0.5,showPoints=F)
plot_diff(modelof.rel, view='Time.normWord', comp=list(IsTA.T1.HO =
c(1,0)), cond=list(SensorAxis='T1.H'), rm.ranef=T, print.summary=F,
main='T1 rel. height: Ter Apel vs. Ubbergen', xlab='Time (normalized)',
ylab='Height difference', ylim=c(-0.23,0.35)); box()
plot_diff(modelof.rel, view='Time.normWord', comp=list(IsTA.T2.HO =
c(1,0)), cond=list(SensorAxis='T2.H'), rm.ranef=T, print.summary=F,
main='T2 rel. height: Ter Apel vs. Ubbergen', xlab='Time (normalized)',
ylab='Height difference', ylim=c(-0.23,0.35)); box()
plot_diff(modelof.rel, view='Time.normWord', comp=list(IsTA.T3.HO =
c(1,0)), cond=list(SensorAxis='T3.H'), rm.ranef=T, print.summary=F,
main='T3 rel. height: Ter Apel vs. Ubbergen', xlab='Time (normalized)',
ylab='Height difference', ylim=c(-0.23,0.35)); box() 
6.4.3.2 Normalized position
par(mfrow=c(4,3))
plotSmooths(model,xvar='Time.normWord',catvar='GroupSensorAxis',
catlevels=c('TerApel.T1.P','Ubbergen.T1.P'),
dropRanef=c('SpeakerSensorAxis','WordGroupSensorAxis'),
ylim=c(-0.5,1),legendPos='topleft',main='T1 rel. posterior position',
xlab='Time (normalized)',ylab='Posterior position',
legendlabels=c('Ter Apel','Ubbergen'),legendtitle='Group',
colors=c('cadetblue3','tomato4'),cexPoints=0.5,showPoints=F)
plotSmooths(model,xvar='Time.normWord',catvar='GroupSensorAxis',
catlevels=c('TerApel.T2.P','Ubbergen.T2.P'),
dropRanef=c('SpeakerSensorAxis','WordGroupSensorAxis'),
ylim=c(-0.5,1),legendPos='topleft',main='T2 rel. posterior position',
xlab='Time (normalized)',ylab='Posterior position',
legendlabels=c('Ter Apel','Ubbergen'),legendtitle='Group',
colors=c('cadetblue3','tomato4'),cexPoints=0.5,showPoints=F)
plotSmooths(model,xvar='Time.normWord',catvar='GroupSensorAxis',
catlevels=c('TerApel.T3.P','Ubbergen.T3.P'),
dropRanef=c('SpeakerSensorAxis','WordGroupSensorAxis'),
ylim=c(-0.5,1),legendPos='topleft',main='T3 rel. posterior position',
xlab='Time (normalized)',ylab='Posterior position',
legendlabels=c('Ter Apel','Ubbergen'),legendtitle='Group',
colors=c('cadetblue3','tomato4'),cexPoints=0.5,showPoints=F)
plot_diff(model, view='Time.normWord', comp=list(GroupSensorAxis =
c("TerApel.T1.P","Ubbergen.T1.P")), rm.ranef=T, print.summary=F,
main='T1 posterior position: Ter Apel vs. Ubbergen', xlab='Time (normalized)',
ylab='Posterior position difference', ylim=c(-0.23,0.35)); box()
plot_diff(model, view='Time.normWord', comp=list(GroupSensorAxis =
c("TerApel.T2.P","Ubbergen.T2.P")), rm.ranef=T, print.summary=F,
main='T2 posterior position: Ter Apel vs. Ubbergen', xlab='Time (normalized)',
ylab='Posterior position difference', ylim=c(-0.23,0.35)); box()
plot_diff(model, view='Time.normWord', comp=list(GroupSensorAxis =
c("TerApel.T3.P","Ubbergen.T3.P")), rm.ranef=T, print.summary=F,
main='T3 posterior position: Ter Apel vs. Ubbergen', xlab='Time (normalized)',
ylab='Posterior position difference', ylim=c(-0.23,0.35)); box()
plotSmooths(model,xvar='Time.normWord',catvar='GroupSensorAxis',
catlevels=c('TerApel.T1.H','Ubbergen.T1.H'),
dropRanef=c('SpeakerSensorAxis','WordGroupSensorAxis'),
ylim=c(-0.5,1),legendPos='topleft',main='T1 rel. height',
xlab='Time (normalized)',ylab='Height',
legendlabels=c('Ter Apel','Ubbergen'),legendtitle='Group',
colors=c('cadetblue3','tomato4'),cexPoints=0.5,showPoints=F)
plotSmooths(model,xvar='Time.normWord',catvar='GroupSensorAxis',
catlevels=c('TerApel.T2.H','Ubbergen.T2.H'),
dropRanef=c('SpeakerSensorAxis','WordGroupSensorAxis'),
ylim=c(-0.5,1),legendPos='topleft',main='T2 rel. height',
xlab='Time (normalized)',ylab='Height',
legendlabels=c('Ter Apel','Ubbergen'),legendtitle='Group',
colors=c('cadetblue3','tomato4'),cexPoints=0.5,showPoints=F)
plotSmooths(model,xvar='Time.normWord',catvar='GroupSensorAxis',
catlevels=c('TerApel.T3.H','Ubbergen.T3.H'),
dropRanef=c('SpeakerSensorAxis','WordGroupSensorAxis'),
ylim=c(-0.5,1),legendPos='topleft',main='T3 rel. height',
xlab='Time (normalized)',ylab='Height',
legendlabels=c('Ter Apel','Ubbergen'),legendtitle='Group',
colors=c('cadetblue3','tomato4'),cexPoints=0.5,showPoints=F)
plot_diff(model, view='Time.normWord', comp=list(GroupSensorAxis =
c("TerApel.T1.H","Ubbergen.T1.H")), rm.ranef=T, print.summary=F,
main='T1 height: Ter Apel vs. Ubbergen', xlab='Time (normalized)',
ylab='Height difference', ylim=c(-0.23,0.35)); box()
plot_diff(model, view='Time.normWord', comp=list(GroupSensorAxis =
c("TerApel.T2.H","Ubbergen.T2.H")), rm.ranef=T, print.summary=F,
main='T2 height: Ter Apel vs. Ubbergen', xlab='Time (normalized)',
ylab='Height difference', ylim=c(-0.23,0.35)); box()
plot_diff(model, view='Time.normWord', comp=list(GroupSensorAxis =
c("TerApel.T3.H","Ubbergen.T3.H")), rm.ranef=T, print.summary=F,
main='T3 height: Ter Apel vs. Ubbergen', xlab='Time (normalized)',
ylab='Height difference', ylim=c(-0.23,0.35)); box() 
6.5 Validation: segments
A second validation approach is shown in this section. Here we only focus on the pronunciation of a single segment (/t/), and assess if the same distinctions can be observed as in the general model.
6.5.1 Model fitting results
In the following the second validation model is fitted. Three models are fitted: the first model is used to determine the rho value (for correcting autocorrelation in the residuals), the second model is used for visualization, and the third model fits the model using difference curves, thereby yielding p-values assessing if the difference between the two speaker groups is significant (separately for the constant intercept difference, and the non-linear difference) or not for the subset of the five dialect words. The models are saved to prevent having to redo the computations.
6.5.1.1 Relative to resting position
subdat = droplevels(dat[dat$Segment == "t",], except=colnames(dat)[sapply(dat,is.ordered)])
# fit first model to determine autocorrelation in residuals
modelNoRho.rel <- bam(RelPos.norm ~ s(Time.normSegment,by=GroupTypeSensorAxis, k=10) +
GroupTypeSensorAxis + s(Time.normSegment,SpeakerTypeSensorAxis,bs='fs',m=1) +
s(Time.normSegment,WordGroupSensorAxis,bs='fs',m=1), data=subdat,
method='fREML', discrete=T, nthreads=32)
save(modelNoRho.rel,file='modelT-rel-group-norho-1.8.12.rda')# assess autocorrelation in residuals
modelACF.rel = acf(resid(modelNoRho.rel),plot=F)
rhoval = as.vector(modelACF.rel[1]$acf)
# fit model which corrects for autocorrelation in residuals
model.rel <- bam(RelPos.norm ~ s(Time.normSegment,by=GroupTypeSensorAxis, k=10) +
GroupTypeSensorAxis + s(Time.normSegment,SpeakerTypeSensorAxis,bs='fs',m=1) +
s(Time.normSegment,WordGroupSensorAxis,bs='fs',m=1), data=subdat,
method='fREML', AR.start=Segment.start, rho=rhoval, discrete=T, nthreads=32)
smry.rel <- summary(model.rel)
save(model.rel,smry.rel,file='modelT-rel-group-1.8.12.rda') # model criticism
subdat2 <- droplevels(subdat[abs(scale(resid(model.rel))) < 2.5, ],
except=colnames(subdat)[sapply(subdat,is.ordered)])
# fit model which corrects for autocorrelation in residuals
model.rel <- bam(RelPos.norm ~ s(Time.normSegment,by=GroupTypeSensorAxis, k=10) +
GroupTypeSensorAxis + s(Time.normSegment,SpeakerTypeSensorAxis,bs='fs',m=1) +
s(Time.normSegment,WordGroupSensorAxis,bs='fs',m=1), data=subdat2,
method='fREML', AR.start=Segment.start, rho=rhoval, discrete=T, nthreads=32)
smry.rel <- summary(model.rel)
save(model.rel,smry.rel,file='modelT-rel-group-mc-1.8.12.rda') # fit model with ordered factor difference curve
modelof.rel <- bam(RelPos.norm ~ s(Time.normSegment, by=SensorAxis,k=10) + SensorAxis +
IsTA.T1.PO + IsTA.T1.HO + IsTA.T2.PO + IsTA.T2.HO + IsTA.T3.PO + IsTA.T3.HO +
s(Time.normSegment, by=IsCVC.T1.PO,k=10) + s(Time.normSegment, by=IsCVC.T1.HO,k=10) +
s(Time.normSegment, by=IsCVC.T2.PO,k=10) + s(Time.normSegment, by=IsCVC.T2.HO,k=10) +
s(Time.normSegment, by=IsCVC.T3.PO,k=10) + s(Time.normSegment, by=IsCVC.T3.HO,k=10) +
s(Time.normSegment,SpeakerTypeSensorAxis,bs='fs',m=1) +
s(Time.normSegment,WordGroupSensorAxis,bs='fs',m=1), data=subdat, method='fREML',
AR.start=Segment.start, rho=rhoval, discrete=T, nthreads=32)
smryof.rel <- summary(modelof.rel)
save(modelof.rel,smryof.rel,file='modelT-rel-of-simplest-1.8.12.rda')# model criticism
subdat2 <- droplevels(subdat[abs(scale(resid(modelof.rel))) < 2.5, ],
except=colnames(subdat)[sapply(subdat,is.ordered)])
# fit model with ordered factor difference curve
modelof.rel <- bam(RelPos.norm ~ s(Time.normSegment, by=SensorAxis,k=10) + SensorAxis +
IsTA.T1.PO + IsTA.T1.HO + IsTA.T2.PO + IsTA.T2.HO + IsTA.T3.PO + IsTA.T3.HO +
s(Time.normSegment, by=IsCVC.T1.PO,k=10) + s(Time.normSegment, by=IsCVC.T1.HO,k=10) +
s(Time.normSegment, by=IsCVC.T2.PO,k=10) + s(Time.normSegment, by=IsCVC.T2.HO,k=10) +
s(Time.normSegment, by=IsCVC.T3.PO,k=10) + s(Time.normSegment, by=IsCVC.T3.HO,k=10) +
s(Time.normSegment,SpeakerTypeSensorAxis,bs='fs',m=1) +
s(Time.normSegment,WordGroupSensorAxis,bs='fs',m=1), data=subdat2, method='fREML',
AR.start=Segment.start, rho=rhoval, discrete=T, nthreads=32)
smryof.rel <- summary(modelof.rel)
save(modelof.rel,smryof.rel,file='modelT-rel-of-simplest-mc-1.8.12.rda')if (!file.exists('modelT-rel-of-simplest-mc-1.8.12.rda')) {
download.file('http://www.let.rug.nl/wieling/DiaArt/modelT-rel-of-simplest-mc-1.8.12.rda',
'modelT-rel-of-simplest-mc-1.8.12.rda')
}
load('modelT-rel-of-simplest-mc-1.8.12.rda')
smryof.rel # assess significant differences for position relative to the non-speech resting position##
## Family: gaussian
## Link function: identity
##
## Formula:
## RelPos.norm ~ s(Time.normSegment, by = SensorAxis, k = 10) +
## SensorAxis + IsTA.T1.PO + IsTA.T1.HO + IsTA.T2.PO + IsTA.T2.HO +
## IsTA.T3.PO + IsTA.T3.HO + s(Time.normSegment, by = IsCVC.T1.PO,
## k = 10) + s(Time.normSegment, by = IsCVC.T1.HO, k = 10) +
## s(Time.normSegment, by = IsCVC.T2.PO, k = 10) + s(Time.normSegment,
## by = IsCVC.T2.HO, k = 10) + s(Time.normSegment, by = IsCVC.T3.PO,
## k = 10) + s(Time.normSegment, by = IsCVC.T3.HO, k = 10) +
## s(Time.normSegment, SpeakerTypeSensorAxis, bs = "fs", m = 1) +
## s(Time.normSegment, WordGroupSensorAxis, bs = "fs", m = 1)
##
## Parametric coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -0.029401 0.028498 -1.032 0.302220
## SensorAxisT2.P 0.032653 0.040303 0.810 0.417830
## SensorAxisT1.P 0.017513 0.040303 0.435 0.663900
## SensorAxisT3.H -0.137541 0.040301 -3.413 0.000643 ***
## SensorAxisT2.H -0.059442 0.040303 -1.475 0.140248
## SensorAxisT1.H -0.001227 0.040302 -0.030 0.975709
## IsTA.T1.PO1 0.175472 0.042467 4.132 3.60e-05 ***
## IsTA.T1.HO1 0.045276 0.042466 1.066 0.286356
## IsTA.T2.PO1 0.215062 0.042467 5.064 4.11e-07 ***
## IsTA.T2.HO1 0.008329 0.042466 0.196 0.844508
## IsTA.T3.PO1 0.199560 0.042468 4.699 2.62e-06 ***
## IsTA.T3.HO1 -0.015019 0.042468 -0.354 0.723588
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Approximate significance of smooth terms:
## edf Ref.df F p-value
## s(Time.normSegment):SensorAxisT3.P 6.992 7.445 28.059 <2e-16
## s(Time.normSegment):SensorAxisT2.P 6.927 7.388 28.263 <2e-16
## s(Time.normSegment):SensorAxisT1.P 7.041 7.471 24.483 <2e-16
## s(Time.normSegment):SensorAxisT3.H 4.502 4.941 24.492 <2e-16
## s(Time.normSegment):SensorAxisT2.H 6.968 7.395 40.496 <2e-16
## s(Time.normSegment):SensorAxisT1.H 7.329 7.690 53.571 <2e-16
## s(Time.normSegment):IsCVC.T1.PO1 2.138 2.326 0.503 0.5449
## s(Time.normSegment):IsCVC.T1.HO1 3.920 4.315 0.802 0.5336
## s(Time.normSegment):IsCVC.T2.PO1 1.000 1.000 0.411 0.5216
## s(Time.normSegment):IsCVC.T2.HO1 2.570 2.815 1.579 0.2847
## s(Time.normSegment):IsCVC.T3.PO1 1.000 1.000 0.074 0.7860
## s(Time.normSegment):IsCVC.T3.HO1 4.094 4.509 1.978 0.0898
## s(Time.normSegment,SpeakerTypeSensorAxis) 2334.809 3661.000 74.385 <2e-16
## s(Time.normSegment,WordGroupSensorAxis) 2654.333 3512.000 14.439 <2e-16
##
## s(Time.normSegment):SensorAxisT3.P ***
## s(Time.normSegment):SensorAxisT2.P ***
## s(Time.normSegment):SensorAxisT1.P ***
## s(Time.normSegment):SensorAxisT3.H ***
## s(Time.normSegment):SensorAxisT2.H ***
## s(Time.normSegment):SensorAxisT1.H ***
## s(Time.normSegment):IsCVC.T1.PO1
## s(Time.normSegment):IsCVC.T1.HO1
## s(Time.normSegment):IsCVC.T2.PO1
## s(Time.normSegment):IsCVC.T2.HO1
## s(Time.normSegment):IsCVC.T3.PO1
## s(Time.normSegment):IsCVC.T3.HO1 .
## s(Time.normSegment,SpeakerTypeSensorAxis) ***
## s(Time.normSegment,WordGroupSensorAxis) ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## R-sq.(adj) = 0.895 Deviance explained = 89.8%
## fREML = -3.3749e+05 Scale est. = 0.0022689 n = 150601# show model criticism plots, supress textual output
sink("/dev/null"); gam.check(modelof.rel); sink()
6.5.1.2 Normalized position
# fit first model to determine autocorrelation in residuals
modelNoRho <- bam(Position.norm ~ RestPosition.norm +
s(Time.normSegment,by=GroupTypeSensorAxis, k=10) +
GroupTypeSensorAxis + s(Time.normSegment,SpeakerTypeSensorAxis,bs='fs',m=1) +
s(Time.normSegment,WordGroupSensorAxis,bs='fs',m=1), data=subdat,
method='fREML', discrete=T, nthreads=32)
save(modelNoRho,file='modelT-group-norho-1.8.12.rda')# assess autocorrelation in residuals
modelACF = acf(resid(modelNoRho),plot=F)
rhoval = as.vector(modelACF[1]$acf)
# fit model which corrects for autocorrelation in residuals
model <- bam(Position.norm ~ RestPosition.norm + s(Time.normSegment,by=GroupTypeSensorAxis, k=10) +
GroupTypeSensorAxis + s(Time.normSegment,SpeakerTypeSensorAxis,bs='fs',m=1) +
s(Time.normSegment,WordGroupSensorAxis,bs='fs',m=1), data=subdat,
method='fREML', AR.start=Segment.start, rho=rhoval, discrete=T, nthreads=32)
smry <- summary(model)
save(model,smry,file='modelT-group-1.8.12.rda') # model criticism
subdat2 <- droplevels(subdat[abs(scale(resid(model))) < 2.5, ],
except=colnames(subdat)[sapply(subdat,is.ordered)])
# fit model which corrects for autocorrelation in residuals
model <- bam(Position.norm ~ RestPosition.norm + s(Time.normSegment,by=GroupTypeSensorAxis, k=10) +
GroupTypeSensorAxis + s(Time.normSegment,SpeakerTypeSensorAxis,bs='fs',m=1) +
s(Time.normSegment,WordGroupSensorAxis,bs='fs',m=1), data=subdat2,
method='fREML', AR.start=Segment.start, rho=rhoval, discrete=T, nthreads=32)
smry <- summary(model)
save(model,smry,file='modelT-group-mc-1.8.12.rda') # fit model with ordered factor difference curve
modelof <- bam(Position.norm ~ RestPosition.norm + s(Time.normSegment, by=SensorAxis,k=10) +
SensorAxis + s(Time.normSegment, by=IsTA.T1.PO,k=10) + IsTA.T1.PO +
s(Time.normSegment, by=IsTA.T1.HO,k=10) + IsTA.T1.HO +
s(Time.normSegment, by=IsTA.T2.PO,k=10) + IsTA.T2.PO +
s(Time.normSegment, by=IsTA.T2.HO,k=10) + IsTA.T2.HO +
s(Time.normSegment, by=IsTA.T3.PO,k=10) + IsTA.T3.PO +
s(Time.normSegment, by=IsTA.T3.HO,k=10) + IsTA.T3.HO +
s(Time.normSegment, by=IsCVC.T1.PO,k=10) +
s(Time.normSegment, by=IsCVC.T1.HO,k=10) +
s(Time.normSegment, by=IsCVC.T2.PO,k=10) +
s(Time.normSegment, by=IsCVC.T2.HO,k=10) +
s(Time.normSegment, by=IsCVC.T3.PO,k=10) +
s(Time.normSegment, by=IsCVC.T3.HO,k=10) +
s(Time.normSegment, by=IsTACVC.T1.PO,k=10) +
s(Time.normSegment, by=IsTACVC.T1.HO,k=10) +
s(Time.normSegment, by=IsTACVC.T2.PO,k=10) +
s(Time.normSegment, by=IsTACVC.T2.HO,k=10) +
s(Time.normSegment, by=IsTACVC.T3.PO,k=10) +
s(Time.normSegment, by=IsTACVC.T3.HO,k=10) +
s(Time.normSegment,SpeakerTypeSensorAxis,bs='fs',m=1) +
s(Time.normSegment,WordGroupSensorAxis,bs='fs',m=1), data=subdat, method='fREML',
AR.start=Segment.start, rho=rhoval, discrete=T, nthreads=32)
smryof <- summary(modelof)
save(modelof,smryof,file='modelT-of-simpler-1.8.12.rda')# model criticism
subdat2 <- droplevels(subdat[abs(scale(resid(modelof))) < 2.5, ],
except=colnames(subdat)[sapply(subdat,is.ordered)])
# fit model with ordered factor difference curve
modelof <- bam(Position.norm ~ RestPosition.norm + s(Time.normSegment, by=SensorAxis,k=10) +
SensorAxis + s(Time.normSegment, by=IsTA.T1.PO,k=10) + IsTA.T1.PO +
s(Time.normSegment, by=IsTA.T1.HO,k=10) + IsTA.T1.HO +
s(Time.normSegment, by=IsTA.T2.PO,k=10) + IsTA.T2.PO +
s(Time.normSegment, by=IsTA.T2.HO,k=10) + IsTA.T2.HO +
s(Time.normSegment, by=IsTA.T3.PO,k=10) + IsTA.T3.PO +
s(Time.normSegment, by=IsTA.T3.HO,k=10) + IsTA.T3.HO +
s(Time.normSegment, by=IsCVC.T1.PO,k=10) +
s(Time.normSegment, by=IsCVC.T1.HO,k=10) +
s(Time.normSegment, by=IsCVC.T2.PO,k=10) +
s(Time.normSegment, by=IsCVC.T2.HO,k=10) +
s(Time.normSegment, by=IsCVC.T3.PO,k=10) +
s(Time.normSegment, by=IsCVC.T3.HO,k=10) +
s(Time.normSegment, by=IsTACVC.T1.PO,k=10) +
s(Time.normSegment, by=IsTACVC.T1.HO,k=10) +
s(Time.normSegment, by=IsTACVC.T2.PO,k=10) +
s(Time.normSegment, by=IsTACVC.T2.HO,k=10) +
s(Time.normSegment, by=IsTACVC.T3.PO,k=10) +
s(Time.normSegment, by=IsTACVC.T3.HO,k=10) +
s(Time.normSegment,SpeakerTypeSensorAxis,bs='fs',m=1) +
s(Time.normSegment,WordGroupSensorAxis,bs='fs',m=1), data=subdat2, method='fREML',
AR.start=Segment.start, rho=rhoval, discrete=T, nthreads=32)
smryof <- summary(modelof)
save(modelof,smryof,file='modelT-of-simpler-mc-1.8.12.rda')if (!file.exists('modelT-of-simpler-mc-1.8.12.rda')) {
download.file('http://www.let.rug.nl/wieling/DiaArt/modelT-of-simpler-mc-1.8.12.rda',
'modelT-of-simpler-mc-1.8.12.rda')
}
load('modelT-of-simpler-mc-1.8.12.rda')
smryof # show summary assessing significant differences##
## Family: gaussian
## Link function: identity
##
## Formula:
## Position.norm ~ RestPosition.norm + s(Time.normSegment, by = SensorAxis,
## k = 10) + SensorAxis + s(Time.normSegment, by = IsTA.T1.PO,
## k = 10) + IsTA.T1.PO + s(Time.normSegment, by = IsTA.T1.HO,
## k = 10) + IsTA.T1.HO + s(Time.normSegment, by = IsTA.T2.PO,
## k = 10) + IsTA.T2.PO + s(Time.normSegment, by = IsTA.T2.HO,
## k = 10) + IsTA.T2.HO + s(Time.normSegment, by = IsTA.T3.PO,
## k = 10) + IsTA.T3.PO + s(Time.normSegment, by = IsTA.T3.HO,
## k = 10) + IsTA.T3.HO + s(Time.normSegment, by = IsCVC.T1.PO,
## k = 10) + s(Time.normSegment, by = IsCVC.T1.HO, k = 10) +
## s(Time.normSegment, by = IsCVC.T2.PO, k = 10) + s(Time.normSegment,
## by = IsCVC.T2.HO, k = 10) + s(Time.normSegment, by = IsCVC.T3.PO,
## k = 10) + s(Time.normSegment, by = IsCVC.T3.HO, k = 10) +
## s(Time.normSegment, by = IsTACVC.T1.PO, k = 10) + s(Time.normSegment,
## by = IsTACVC.T1.HO, k = 10) + s(Time.normSegment, by = IsTACVC.T2.PO,
## k = 10) + s(Time.normSegment, by = IsTACVC.T2.HO, k = 10) +
## s(Time.normSegment, by = IsTACVC.T3.PO, k = 10) + s(Time.normSegment,
## by = IsTACVC.T3.HO, k = 10) + s(Time.normSegment, SpeakerTypeSensorAxis,
## bs = "fs", m = 1) + s(Time.normSegment, WordGroupSensorAxis,
## bs = "fs", m = 1)
##
## Parametric coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.48508 0.01861 26.072 < 2e-16 ***
## RestPosition.norm 0.21337 0.02154 9.907 < 2e-16 ***
## SensorAxisT2.P -0.19254 0.01863 -10.333 < 2e-16 ***
## SensorAxisT1.P -0.38295 0.02073 -18.476 < 2e-16 ***
## SensorAxisT3.H 0.05934 0.01830 3.243 0.00118 **
## SensorAxisT2.H 0.02296 0.01782 1.288 0.19780
## SensorAxisT1.H -0.06947 0.01782 -3.899 9.66e-05 ***
## IsTA.T1.PO1 0.09575 0.01841 5.201 1.98e-07 ***
## IsTA.T1.HO1 -0.01902 0.01853 -1.027 0.30448
## IsTA.T2.PO1 0.11297 0.01841 6.137 8.46e-10 ***
## IsTA.T2.HO1 -0.02189 0.01842 -1.188 0.23469
## IsTA.T3.PO1 0.09075 0.01842 4.928 8.32e-07 ***
## IsTA.T3.HO1 -0.02628 0.01841 -1.427 0.15351
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Approximate significance of smooth terms:
## edf Ref.df F
## s(Time.normSegment):SensorAxisT3.P 6.394 6.886 15.364
## s(Time.normSegment):SensorAxisT2.P 6.593 7.069 19.107
## s(Time.normSegment):SensorAxisT1.P 6.948 7.391 26.331
## s(Time.normSegment):SensorAxisT3.H 5.496 5.978 19.973
## s(Time.normSegment):SensorAxisT2.H 7.299 7.673 40.378
## s(Time.normSegment):SensorAxisT1.H 7.320 7.647 45.976
## s(Time.normSegment):IsTA.T1.PO1 1.001 1.001 0.639
## s(Time.normSegment):IsTA.T1.HO1 3.173 3.492 1.121
## s(Time.normSegment):IsTA.T2.PO1 1.001 1.001 0.616
## s(Time.normSegment):IsTA.T2.HO1 1.011 1.014 16.633
## s(Time.normSegment):IsTA.T3.PO1 1.001 1.001 0.223
## s(Time.normSegment):IsTA.T3.HO1 1.001 1.002 7.439
## s(Time.normSegment):IsCVC.T1.PO1 1.001 1.001 2.402
## s(Time.normSegment):IsCVC.T1.HO1 4.310 4.732 1.036
## s(Time.normSegment):IsCVC.T2.PO1 1.001 1.001 0.790
## s(Time.normSegment):IsCVC.T2.HO1 2.528 2.763 1.357
## s(Time.normSegment):IsCVC.T3.PO1 1.001 1.001 0.674
## s(Time.normSegment):IsCVC.T3.HO1 3.268 3.593 1.187
## s(Time.normSegment):IsTACVC.T1.PO1 1.001 1.001 2.316
## s(Time.normSegment):IsTACVC.T1.HO1 1.043 1.052 0.005
## s(Time.normSegment):IsTACVC.T2.PO1 1.001 1.001 0.825
## s(Time.normSegment):IsTACVC.T2.HO1 1.305 1.366 1.326
## s(Time.normSegment):IsTACVC.T3.PO1 1.001 1.001 1.793
## s(Time.normSegment):IsTACVC.T3.HO1 1.001 1.002 0.663
## s(Time.normSegment,SpeakerTypeSensorAxis) 2404.509 3660.000 27.524
## s(Time.normSegment,WordGroupSensorAxis) 2680.591 3511.000 16.087
## p-value
## s(Time.normSegment):SensorAxisT3.P < 2e-16 ***
## s(Time.normSegment):SensorAxisT2.P < 2e-16 ***
## s(Time.normSegment):SensorAxisT1.P < 2e-16 ***
## s(Time.normSegment):SensorAxisT3.H < 2e-16 ***
## s(Time.normSegment):SensorAxisT2.H < 2e-16 ***
## s(Time.normSegment):SensorAxisT1.H < 2e-16 ***
## s(Time.normSegment):IsTA.T1.PO1 0.42383
## s(Time.normSegment):IsTA.T1.HO1 0.29584
## s(Time.normSegment):IsTA.T2.PO1 0.43249
## s(Time.normSegment):IsTA.T2.HO1 4.21e-05 ***
## s(Time.normSegment):IsTA.T3.PO1 0.63676
## s(Time.normSegment):IsTA.T3.HO1 0.00637 **
## s(Time.normSegment):IsCVC.T1.PO1 0.12111
## s(Time.normSegment):IsCVC.T1.HO1 0.39576
## s(Time.normSegment):IsCVC.T2.PO1 0.37418
## s(Time.normSegment):IsCVC.T2.HO1 0.37596
## s(Time.normSegment):IsCVC.T3.PO1 0.41170
## s(Time.normSegment):IsCVC.T3.HO1 0.27689
## s(Time.normSegment):IsTACVC.T1.PO1 0.12804
## s(Time.normSegment):IsTACVC.T1.HO1 0.93382
## s(Time.normSegment):IsTACVC.T2.PO1 0.36374
## s(Time.normSegment):IsTACVC.T2.HO1 0.34331
## s(Time.normSegment):IsTACVC.T3.PO1 0.18047
## s(Time.normSegment):IsTACVC.T3.HO1 0.41531
## s(Time.normSegment,SpeakerTypeSensorAxis) < 2e-16 ***
## s(Time.normSegment,WordGroupSensorAxis) < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## R-sq.(adj) = 0.953 Deviance explained = 95.5%
## fREML = -4.0278e+05 Scale est. = 0.00092265 n = 150358# show model criticism plots, supress textual output
sink("/dev/null"); gam.check(modelof); sink()
6.5.2 Vis.: tongue movement
6.5.2.1 Relative to resting position
if (!file.exists('modelT-rel-group-mc-1.8.12.rda')) {
download.file('http://www.let.rug.nl/wieling/DiaArt/modelT-rel-group-mc-1.8.12.rda',
'modelT-rel-group-mc-1.8.12.rda')
}
load('modelT-rel-group-mc-1.8.12.rda')
par(mfcol=c(3,2))
plotArt2D(model.rel, catvar='GroupTypeSensorAxis',
catlevels.x=c('TerApel.Dialect.T1.P','Ubbergen.Dialect.T1.P'),
catlevels.y=c('TerApel.Dialect.T1.H','Ubbergen.Dialect.T1.H'),
timevar='Time.normSegment', collabels=c('Ter Apel', 'Ubbergen'),
main='Rel. position of the T1 sensor: dialect /t/',
xlab='Posterior position (rel.)', ylab='Height (rel.)', showPoints=T,
cols=list(c("cadetblue3","cadetblue1"),c("tomato4","tomato")),alpha=15,xlim=c(-1,1),ylim=c(-1,1))
plotArt2D(model.rel, catvar='GroupTypeSensorAxis',
catlevels.x=c('TerApel.Dialect.T2.P','Ubbergen.Dialect.T2.P'),
catlevels.y=c('TerApel.Dialect.T2.H','Ubbergen.Dialect.T2.H'),
timevar='Time.normSegment', collabels=c('Ter Apel', 'Ubbergen'),
main='Rel. position of the T2 sensor: dialect /t/',
xlab='Posterior position (rel.)', ylab='Height (rel.)', showPoints=T,
cols=list(c("cadetblue3","cadetblue1"),c("tomato4","tomato")),alpha=15,xlim=c(-1,1),ylim=c(-1,1))
plotArt2D(model.rel, catvar='GroupTypeSensorAxis',
catlevels.x=c('TerApel.Dialect.T3.P','Ubbergen.Dialect.T3.P'),
catlevels.y=c('TerApel.Dialect.T3.H','Ubbergen.Dialect.T3.H'),
timevar='Time.normSegment', collabels=c('Ter Apel', 'Ubbergen'),
main='Rel. position of the T3 sensor: dialect /t/',
xlab='Posterior position (rel.)', ylab='Height (rel.)', showPoints=T,
cols=list(c("cadetblue3","cadetblue1"),c("tomato4","tomato")),alpha=15,xlim=c(-1,1),ylim=c(-1,1))
plotArt2D(model.rel, catvar='GroupTypeSensorAxis',
catlevels.x=c('TerApel.Standard.T1.P','Ubbergen.Standard.T1.P'),
catlevels.y=c('TerApel.Standard.T1.H','Ubbergen.Standard.T1.H'),
timevar='Time.normSegment', collabels=c('Ter Apel', 'Ubbergen'),
main='Rel. position of the T1 sensor: Dutch CVC /t/',
xlab='Posterior position (rel.)', ylab='Height (rel.)', showPoints=T,
cols=list(c("cadetblue3","cadetblue1"),c("tomato4","tomato")),alpha=15,xlim=c(-1,1),ylim=c(-1,1))
plotArt2D(model.rel, catvar='GroupTypeSensorAxis',
catlevels.x=c('TerApel.Standard.T2.P','Ubbergen.Standard.T2.P'),
catlevels.y=c('TerApel.Standard.T2.H','Ubbergen.Standard.T2.H'),
timevar='Time.normSegment', collabels=c('Ter Apel', 'Ubbergen'),
main='Rel. position of the T2 sensor: Dutch CVC /t/',
xlab='Posterior position (rel.)', ylab='Height (rel.)', showPoints=T,
cols=list(c("cadetblue3","cadetblue1"),c("tomato4","tomato")),alpha=15,xlim=c(-1,1),ylim=c(-1,1))
plotArt2D(model.rel, catvar='GroupTypeSensorAxis',
catlevels.x=c('TerApel.Standard.T3.P','Ubbergen.Standard.T3.P'),
catlevels.y=c('TerApel.Standard.T3.H','Ubbergen.Standard.T3.H'),
timevar='Time.normSegment', collabels=c('Ter Apel', 'Ubbergen'),
main='Rel. position of the T3 sensor: Dutch CVC /t/',
xlab='Posterior position (rel.)', ylab='Height (rel.)', showPoints=T,
cols=list(c("cadetblue3","cadetblue1"),c("tomato4","tomato")),alpha=15,xlim=c(-1,1),ylim=c(-1,1))
6.5.2.2 Normalized position
if (!file.exists('modelT-group-mc-1.8.12.rda')) {
download.file('http://www.let.rug.nl/wieling/DiaArt/modelT-group-mc-1.8.12.rda',
'modelT-group-mc-1.8.12.rda')
}
load('modelT-group-mc-1.8.12.rda')
par(mfrow=c(1,2))
plotArt2D(model, catvar='GroupTypeSensorAxis',
catlevels.x=c('TerApel.Dialect.T1.P','Ubbergen.Dialect.T1.P','TerApel.Dialect.T2.P',
'Ubbergen.Dialect.T2.P','TerApel.Dialect.T3.P','Ubbergen.Dialect.T3.P'),
catlevels.y=c('TerApel.Dialect.T1.H','Ubbergen.Dialect.T1.H','TerApel.Dialect.T2.H',
'Ubbergen.Dialect.T2.H','TerApel.Dialect.T3.H','Ubbergen.Dialect.T3.H'),
timevar='Time.normSegment', collabels=c('Ter Apel', 'Ubbergen'),
xlab='Posterior position', ylab='Height', showPoints=T,
main='Pos. of the tongue sensors: dialect /t/',
cols=list(c("cadetblue3","cadetblue1"),c("tomato4","tomato")),
alpha=2, cexPoints=0.4)
plotArt2D(model, catvar='GroupTypeSensorAxis',
catlevels.x=c('TerApel.Standard.T1.P','Ubbergen.Standard.T1.P','TerApel.Standard.T2.P',
'Ubbergen.Standard.T2.P','TerApel.Standard.T3.P','Ubbergen.Standard.T3.P'),
catlevels.y=c('TerApel.Standard.T1.H','Ubbergen.Standard.T1.H','TerApel.Standard.T2.H',
'Ubbergen.Standard.T2.H','TerApel.Standard.T3.H','Ubbergen.Standard.T3.H'),
timevar='Time.normSegment', collabels=c('Ter Apel', 'Ubbergen'),
xlab='Posterior position', ylab='Height', showPoints=T,
main='Pos. of the tongue sensors: Dutch CVC /t/',
cols=list(c("cadetblue3","cadetblue1"),c("tomato4","tomato")),
alpha=3,cexPoints=0.45)
6.5.3 Vis.: tongue differences
6.5.3.1 Dia.: rel. to rest.
par(mfrow=c(4,3))
plotSmooths(modelof.rel,xvar='Time.normSegment',catvar='IsTA.T1.PO',
catlevels=c(1,0), cond=list(SensorAxis='T1.P',IsCVC.T1.PO=0),
dropRanef=c('SpeakerTypeSensorAxis','WordGroupSensorAxis'),
ylim=c(-0.5,1),legendPos='topleft',main='T1 rel. posterior position: /t/',
xlab='Time (normalized)',ylab='Posterior position',
legendlabels=c('Ter Apel','Ubbergen'),legendtitle='Group',
colors=c('cadetblue3','tomato4'),cexPoints=0.5,showPoints=F)
plotSmooths(modelof.rel,xvar='Time.normSegment',catvar='IsTA.T2.PO',
catlevels=c(1,0), cond=list(SensorAxis='T2.P',IsCVC.T2.PO=0),
dropRanef=c('SpeakerTypeSensorAxis','WordGroupSensorAxis'),
ylim=c(-0.5,1),legendPos='topleft',main='T2 rel. posterior position: /t/',
xlab='Time (normalized)',ylab='Posterior position',
legendlabels=c('Ter Apel','Ubbergen'),legendtitle='Group',
colors=c('cadetblue3','tomato4'),cexPoints=0.5,showPoints=F)
plotSmooths(modelof.rel,xvar='Time.normSegment',catvar='IsTA.T3.PO',
catlevels=c(1,0), cond=list(SensorAxis='T3.P',IsCVC.T3.PO=0),
dropRanef=c('SpeakerTypeSensorAxis','WordGroupSensorAxis'),
ylim=c(-0.5,1),legendPos='topleft',main='T3 rel. posterior position: /t/',
xlab='Time (normalized)',ylab='Posterior position',
legendlabels=c('Ter Apel','Ubbergen'),legendtitle='Group',
colors=c('cadetblue3','tomato4'),cexPoints=0.5,showPoints=F)
plot_diff(modelof.rel, view='Time.normSegment', comp=list(IsTA.T1.PO =
c(1,0)), cond=list(SensorAxis='T1.P',IsCVC.T1.PO=0), rm.ranef=T, print.summary=F,
main='T1 rel. posterior position: Ter Apel vs. Ubbergen', xlab='Time (normalized)',
ylab='Posterior position difference', ylim=c(-0.23,0.35)); box()
plot_diff(modelof.rel, view='Time.normSegment', comp=list(IsTA.T2.PO =
c(1,0)), cond=list(SensorAxis='T2.P',IsCVC.T2.PO=0), rm.ranef=T, print.summary=F,
main='T2 rel. posterior position: Ter Apel vs. Ubbergen', xlab='Time (normalized)',
ylab='Posterior position difference', ylim=c(-0.23,0.35)); box()
plot_diff(modelof.rel, view='Time.normSegment', comp=list(IsTA.T3.PO =
c(1,0)), cond=list(SensorAxis='T3.P',IsCVC.T3.PO=0), rm.ranef=T, print.summary=F,
main='T3 rel. posterior position: Ter Apel vs. Ubbergen', xlab='Time (normalized)',
ylab='Posterior position difference', ylim=c(-0.23,0.35)); box()
plotSmooths(modelof.rel,xvar='Time.normSegment',catvar='IsTA.T1.HO',
catlevels=c(1,0), cond=list(SensorAxis='T1.H',IsCVC.T1.HO=0),
dropRanef=c('SpeakerTypeSensorAxis','WordGroupSensorAxis'),
ylim=c(-0.5,1),legendPos='topleft',main='T1 rel. height: /t/',
xlab='Time (normalized)',ylab='Height',
legendlabels=c('Ter Apel','Ubbergen'),legendtitle='Group',
colors=c('cadetblue3','tomato4'),cexPoints=0.5,showPoints=F)
plotSmooths(modelof.rel,xvar='Time.normSegment',catvar='IsTA.T2.HO',
catlevels=c(1,0), cond=list(SensorAxis='T2.H',IsCVC.T2.HO=0),
dropRanef=c('SpeakerTypeSensorAxis','WordGroupSensorAxis'),
ylim=c(-0.5,1),legendPos='topleft',main='T2 rel. height: /t/',
xlab='Time (normalized)',ylab='Height',
legendlabels=c('Ter Apel','Ubbergen'),legendtitle='Group',
colors=c('cadetblue3','tomato4'),cexPoints=0.5,showPoints=F)
plotSmooths(modelof.rel,xvar='Time.normSegment',catvar='IsTA.T3.HO',
catlevels=c(1,0), cond=list(SensorAxis='T3.H',IsCVC.T3.HO=0),
dropRanef=c('SpeakerTypeSensorAxis','WordGroupSensorAxis'),
ylim=c(-0.5,1),legendPos='topleft',main='T3 rel. height: /t/',
xlab='Time (normalized)',ylab='Height',
legendlabels=c('Ter Apel','Ubbergen'),legendtitle='Group',
colors=c('cadetblue3','tomato4'),cexPoints=0.5,showPoints=F)
plot_diff(modelof.rel, view='Time.normSegment', comp=list(IsTA.T1.HO =
c(1,0)), cond=list(SensorAxis='T1.H',IsCVC.T1.HO=0), rm.ranef=T, print.summary=F,
main='T1 rel. height: Ter Apel vs. Ubbergen', xlab='Time (normalized)',
ylab='Height difference', ylim=c(-0.23,0.35)); box()
plot_diff(modelof.rel, view='Time.normSegment', comp=list(IsTA.T2.HO =
c(1,0)), cond=list(SensorAxis='T2.H',IsCVC.T2.HO=0), rm.ranef=T, print.summary=F,
main='T2 rel. height: Ter Apel vs. Ubbergen', xlab='Time (normalized)',
ylab='Height difference', ylim=c(-0.23,0.35)); box()
plot_diff(modelof.rel, view='Time.normSegment', comp=list(IsTA.T3.HO =
c(1,0)), cond=list(SensorAxis='T3.H',IsCVC.T3.HO=0), rm.ranef=T, print.summary=F,
main='T3 rel. height: Ter Apel vs. Ubbergen', xlab='Time (normalized)',
ylab='Height difference', ylim=c(-0.23,0.35)); box() 
6.5.3.2 CVC: rel. to rest.
par(mfrow=c(4,3))
plotSmooths(modelof.rel,xvar='Time.normSegment',catvar='IsTA.T1.PO',
catlevels=c(1,0), cond=list(SensorAxis='T1.P',IsCVC.T1.PO=1),
dropRanef=c('SpeakerTypeSensorAxis','WordGroupSensorAxis'),
ylim=c(-0.5,1),legendPos='topleft',main='T1 rel. posterior position: /t/',
xlab='Time (normalized)',ylab='Posterior position',
legendlabels=c('Ter Apel','Ubbergen'),legendtitle='Group',
colors=c('cadetblue3','tomato4'),cexPoints=0.5,showPoints=F)
plotSmooths(modelof.rel,xvar='Time.normSegment',catvar='IsTA.T2.PO',
catlevels=c(1,0), cond=list(SensorAxis='T2.P',IsCVC.T2.PO=1),
dropRanef=c('SpeakerTypeSensorAxis','WordGroupSensorAxis'),
ylim=c(-0.5,1),legendPos='topleft',main='T2 rel. posterior position: /t/',
xlab='Time (normalized)',ylab='Posterior position',
legendlabels=c('Ter Apel','Ubbergen'),legendtitle='Group',
colors=c('cadetblue3','tomato4'),cexPoints=0.5,showPoints=F)
plotSmooths(modelof.rel,xvar='Time.normSegment',catvar='IsTA.T3.PO',
catlevels=c(1,0), cond=list(SensorAxis='T3.P',IsCVC.T3.PO=1),
dropRanef=c('SpeakerTypeSensorAxis','WordGroupSensorAxis'),
ylim=c(-0.5,1),legendPos='topleft',main='T3 rel. posterior position: /t/',
xlab='Time (normalized)',ylab='Posterior position',
legendlabels=c('Ter Apel','Ubbergen'),legendtitle='Group',
colors=c('cadetblue3','tomato4'),cexPoints=0.5,showPoints=F)
plot_diff(modelof.rel, view='Time.normSegment', comp=list(IsTA.T1.PO =
c(1,0)), cond=list(SensorAxis='T1.P',IsCVC.T1.PO=1), rm.ranef=T, print.summary=F,
main='T1 rel. posterior position: Ter Apel vs. Ubbergen', xlab='Time (normalized)',
ylab='Posterior position difference', ylim=c(-0.23,0.35)); box()
plot_diff(modelof.rel, view='Time.normSegment', comp=list(IsTA.T2.PO =
c(1,0)), cond=list(SensorAxis='T2.P',IsCVC.T2.PO=1), rm.ranef=T, print.summary=F,
main='T2 rel. posterior position: Ter Apel vs. Ubbergen', xlab='Time (normalized)',
ylab='Posterior position difference', ylim=c(-0.23,0.35)); box()
plot_diff(modelof.rel, view='Time.normSegment', comp=list(IsTA.T3.PO =
c(1,0)), cond=list(SensorAxis='T3.P',IsCVC.T3.PO=1), rm.ranef=T, print.summary=F,
main='T3 rel. posterior position: Ter Apel vs. Ubbergen', xlab='Time (normalized)',
ylab='Posterior position difference', ylim=c(-0.23,0.35)); box()
plotSmooths(modelof.rel,xvar='Time.normSegment',catvar='IsTA.T1.HO',
catlevels=c(1,0), cond=list(SensorAxis='T1.H',IsCVC.T1.HO=1),
dropRanef=c('SpeakerTypeSensorAxis','WordGroupSensorAxis'),
ylim=c(-0.5,1),legendPos='topleft',main='T1 rel. height: /t/',
xlab='Time (normalized)',ylab='Height',
legendlabels=c('Ter Apel','Ubbergen'),legendtitle='Group',
colors=c('cadetblue3','tomato4'),cexPoints=0.5,showPoints=F)
plotSmooths(modelof.rel,xvar='Time.normSegment',catvar='IsTA.T2.HO',
catlevels=c(1,0), cond=list(SensorAxis='T2.H',IsCVC.T2.HO=1),
dropRanef=c('SpeakerTypeSensorAxis','WordGroupSensorAxis'),
ylim=c(-0.5,1),legendPos='topleft',main='T2 rel. height: /t/',
xlab='Time (normalized)',ylab='Height',
legendlabels=c('Ter Apel','Ubbergen'),legendtitle='Group',
colors=c('cadetblue3','tomato4'),cexPoints=0.5,showPoints=F)
plotSmooths(modelof.rel,xvar='Time.normSegment',catvar='IsTA.T3.HO',
catlevels=c(1,0), cond=list(SensorAxis='T3.H',IsCVC.T3.HO=1),
dropRanef=c('SpeakerTypeSensorAxis','WordGroupSensorAxis'),
ylim=c(-0.5,1),legendPos='topleft',main='T3 rel. height: /t/',
xlab='Time (normalized)',ylab='Height',
legendlabels=c('Ter Apel','Ubbergen'),legendtitle='Group',
colors=c('cadetblue3','tomato4'),cexPoints=0.5,showPoints=F)
plot_diff(modelof.rel, view='Time.normSegment', comp=list(IsTA.T1.HO =
c(1,0)), cond=list(SensorAxis='T1.H',IsCVC.T1.HO=1), rm.ranef=T, print.summary=F,
main='T1 rel. height: Ter Apel vs. Ubbergen', xlab='Time (normalized)',
ylab='Height difference', ylim=c(-0.23,0.35)); box()
plot_diff(modelof.rel, view='Time.normSegment', comp=list(IsTA.T2.HO =
c(1,0)), cond=list(SensorAxis='T2.H',IsCVC.T2.HO=1), rm.ranef=T, print.summary=F,
main='T2 rel. height: Ter Apel vs. Ubbergen', xlab='Time (normalized)',
ylab='Height difference', ylim=c(-0.23,0.35)); box()
plot_diff(modelof.rel, view='Time.normSegment', comp=list(IsTA.T3.HO =
c(1,0)), cond=list(SensorAxis='T3.H',IsCVC.T3.HO=1), rm.ranef=T, print.summary=F,
main='T3 rel. height: Ter Apel vs. Ubbergen', xlab='Time (normalized)',
ylab='Height difference', ylim=c(-0.23,0.35)); box() 
6.5.3.3 Dia.: norm. pos.
par(mfrow=c(4,3))
plotSmooths(model,xvar='Time.normSegment',catvar='GroupTypeSensorAxis',
catlevels=c('TerApel.Dialect.T1.P','Ubbergen.Dialect.T1.P'),
dropRanef=c('SpeakerTypeSensorAxis','WordGroupSensorAxis'),
ylim=c(0.05,1),legendPos='topleft',main='T1 posterior position: /t/',
xlab='Time (normalized)',ylab='Posterior position',
legendlabels=c('Ter Apel','Ubbergen'),legendtitle='Group',
colors=c('cadetblue3','tomato4'),cexPoints=0.5,showPoints=F)
plotSmooths(model,xvar='Time.normSegment',catvar='GroupTypeSensorAxis',
catlevels=c('TerApel.Dialect.T2.P','Ubbergen.Dialect.T2.P'),
dropRanef=c('SpeakerTypeSensorAxis','WordGroupSensorAxis'),
ylim=c(0.05,1),legendPos='topleft',main='T2 posterior position: /t/',
xlab='Time (normalized)',ylab='Posterior position',
legendlabels=c('Ter Apel','Ubbergen'),legendtitle='Group',
colors=c('cadetblue3','tomato4'),cexPoints=0.5,showPoints=F)
plotSmooths(model,xvar='Time.normSegment',catvar='GroupTypeSensorAxis',
catlevels=c('TerApel.Dialect.T3.P','Ubbergen.Dialect.T3.P'),
dropRanef=c('SpeakerTypeSensorAxis','WordGroupSensorAxis'),
ylim=c(0.05,1),legendPos='bottomleft',main='T3 posterior position: /t/',
xlab='Time (normalized)',ylab='Posterior position',
legendlabels=c('Ter Apel','Ubbergen'),legendtitle='Group',
colors=c('cadetblue3','tomato4'),cexPoints=0.5,showPoints=F)
plot_diff(model, view='Time.normSegment', comp=list(GroupTypeSensorAxis =
c("TerApel.Dialect.T1.P","Ubbergen.Dialect.T1.P")), rm.ranef=T, print.summary=F,
main='T1 posterior position: Ter Apel vs. Ubbergen', xlab='Time (normalized)',
ylab='Posterior position difference', ylim=c(-0.23,0.35)); box()
plot_diff(model, view='Time.normSegment', comp=list(GroupTypeSensorAxis =
c("TerApel.Dialect.T2.P","Ubbergen.Dialect.T2.P")), rm.ranef=T, print.summary=F,
main='T2 posterior position: Ter Apel vs. Ubbergen', xlab='Time (normalized)',
ylab='Posterior position difference', ylim=c(-0.23,0.35)); box()
plot_diff(model, view='Time.normSegment', comp=list(GroupTypeSensorAxis =
c("TerApel.Dialect.T3.P","Ubbergen.Dialect.T3.P")), rm.ranef=T, print.summary=F,
main='T3 posterior position: Ter Apel vs. Ubbergen', xlab='Time (normalized)',
ylab='Posterior position difference', ylim=c(-0.23,0.35)); box()
plotSmooths(model,xvar='Time.normSegment',catvar='GroupTypeSensorAxis',
catlevels=c('TerApel.Dialect.T1.H','Ubbergen.Dialect.T1.H'),
dropRanef=c('SpeakerTypeSensorAxis','WordGroupSensorAxis'),
ylim=c(0.05,1),legendPos='topleft',main='T1 height: /t/',
xlab='Time (normalized)',ylab='Height',
legendlabels=c('Ter Apel','Ubbergen'),legendtitle='Group',
colors=c('cadetblue3','tomato4'),cexPoints=0.5,showPoints=F)
plotSmooths(model,xvar='Time.normSegment',catvar='GroupTypeSensorAxis',
catlevels=c('TerApel.Dialect.T2.H','Ubbergen.Dialect.T2.H'),
dropRanef=c('SpeakerTypeSensorAxis','WordGroupSensorAxis'),
ylim=c(0.05,1),legendPos='topleft',main='T2 height: /t/',
xlab='Time (normalized)',ylab='Height',
legendlabels=c('Ter Apel','Ubbergen'),legendtitle='Group',
colors=c('cadetblue3','tomato4'),cexPoints=0.5,showPoints=F)
plotSmooths(model,xvar='Time.normSegment',catvar='GroupTypeSensorAxis',
catlevels=c('TerApel.Dialect.T3.H','Ubbergen.Dialect.T3.H'),
dropRanef=c('SpeakerTypeSensorAxis','WordGroupSensorAxis'),
ylim=c(0.05,1),legendPos='bottomleft',main='T3 height: /t/',
xlab='Time (normalized)',ylab='Height',
legendlabels=c('Ter Apel','Ubbergen'),legendtitle='Group',
colors=c('cadetblue3','tomato4'),cexPoints=0.5,showPoints=F)
plot_diff(model, view='Time.normSegment', comp=list(GroupTypeSensorAxis =
c("TerApel.Dialect.T1.H","Ubbergen.Dialect.T1.H")), rm.ranef=T, print.summary=F,
main='T1 height: Ter Apel vs. Ubbergen', xlab='Time (normalized)',
ylab='Height difference', ylim=c(-0.23,0.35)); box()
plot_diff(model, view='Time.normSegment', comp=list(GroupTypeSensorAxis =
c("TerApel.Dialect.T1.H","Ubbergen.Dialect.T2.H")), rm.ranef=T, print.summary=F,
main='T2 height: Ter Apel vs. Ubbergen', xlab='Time (normalized)',
ylab='Height difference', ylim=c(-0.23,0.35)); box()
plot_diff(model, view='Time.normSegment', comp=list(GroupTypeSensorAxis =
c("TerApel.Dialect.T3.H","Ubbergen.Dialect.T3.H")), rm.ranef=T, print.summary=F,
main='T3 height: Ter Apel vs. Ubbergen', xlab='Time (normalized)',
ylab='Height difference', ylim=c(-0.23,0.35)); box() 
6.5.3.4 CVC: norm. pos.
par(mfrow=c(4,3))
plotSmooths(model,xvar='Time.normSegment',catvar='GroupTypeSensorAxis',
catlevels=c('TerApel.Standard.T1.P','Ubbergen.Standard.T1.P'),
dropRanef=c('SpeakerTypeSensorAxis','WordGroupSensorAxis'),
ylim=c(0.05,1),legendPos='topleft',main='T1 posterior position: /t/',
xlab='Time (normalized)',ylab='Posterior position',
legendlabels=c('Ter Apel','Ubbergen'),legendtitle='Group',
colors=c('cadetblue3','tomato4'),cexPoints=0.5,showPoints=F)
plotSmooths(model,xvar='Time.normSegment',catvar='GroupTypeSensorAxis',
catlevels=c('TerApel.Standard.T2.P','Ubbergen.Standard.T2.P'),
dropRanef=c('SpeakerTypeSensorAxis','WordGroupSensorAxis'),
ylim=c(0.05,1),legendPos='topleft',main='T2 posterior position: /t/',
xlab='Time (normalized)',ylab='Posterior position',
legendlabels=c('Ter Apel','Ubbergen'),legendtitle='Group',
colors=c('cadetblue3','tomato4'),cexPoints=0.5,showPoints=F)
plotSmooths(model,xvar='Time.normSegment',catvar='GroupTypeSensorAxis',
catlevels=c('TerApel.Standard.T3.P','Ubbergen.Standard.T3.P'),
dropRanef=c('SpeakerTypeSensorAxis','WordGroupSensorAxis'),
ylim=c(0.05,1),legendPos='bottomleft',main='T3 posterior position: /t/',
xlab='Time (normalized)',ylab='Posterior position',
legendlabels=c('Ter Apel','Ubbergen'),legendtitle='Group',
colors=c('cadetblue3','tomato4'),cexPoints=0.5,showPoints=F)
plot_diff(model, view='Time.normSegment', comp=list(GroupTypeSensorAxis =
c("TerApel.Standard.T1.P","Ubbergen.Standard.T1.P")), rm.ranef=T, print.summary=F,
main='T1 posterior position: Ter Apel vs. Ubbergen', xlab='Time (normalized)',
ylab='Posterior position difference', ylim=c(-0.23,0.35)); box()
plot_diff(model, view='Time.normSegment', comp=list(GroupTypeSensorAxis =
c("TerApel.Standard.T2.P","Ubbergen.Standard.T2.P")), rm.ranef=T, print.summary=F,
main='T2 posterior position: Ter Apel vs. Ubbergen', xlab='Time (normalized)',
ylab='Posterior position difference', ylim=c(-0.23,0.35)); box()
plot_diff(model, view='Time.normSegment', comp=list(GroupTypeSensorAxis =
c("TerApel.Standard.T3.P","Ubbergen.Standard.T3.P")), rm.ranef=T, print.summary=F,
main='T3 posterior position: Ter Apel vs. Ubbergen', xlab='Time (normalized)',
ylab='Posterior position difference', ylim=c(-0.23,0.35)); box()
plotSmooths(model,xvar='Time.normSegment',catvar='GroupTypeSensorAxis',
catlevels=c('TerApel.Standard.T1.H','Ubbergen.Standard.T1.H'),
dropRanef=c('SpeakerTypeSensorAxis','WordGroupSensorAxis'),
ylim=c(0.05,1),legendPos='topleft',main='T1 height: /t/',
xlab='Time (normalized)',ylab='Height',
legendlabels=c('Ter Apel','Ubbergen'),legendtitle='Group',
colors=c('cadetblue3','tomato4'),cexPoints=0.5,showPoints=F)
plotSmooths(model,xvar='Time.normSegment',catvar='GroupTypeSensorAxis',
catlevels=c('TerApel.Standard.T2.H','Ubbergen.Standard.T2.H'),
dropRanef=c('SpeakerTypeSensorAxis','WordGroupSensorAxis'),
ylim=c(0.05,1),legendPos='topleft',main='T2 height: /t/',
xlab='Time (normalized)',ylab='Height',
legendlabels=c('Ter Apel','Ubbergen'),legendtitle='Group',
colors=c('cadetblue3','tomato4'),cexPoints=0.5,showPoints=F)
plotSmooths(model,xvar='Time.normSegment',catvar='GroupTypeSensorAxis',
catlevels=c('TerApel.Standard.T3.H','Ubbergen.Standard.T3.H'),
dropRanef=c('SpeakerTypeSensorAxis','WordGroupSensorAxis'),
ylim=c(0.05,1),legendPos='bottomleft',main='T3 height: /t/',
xlab='Time (normalized)',ylab='Height',
legendlabels=c('Ter Apel','Ubbergen'),legendtitle='Group',
colors=c('cadetblue3','tomato4'),cexPoints=0.5,showPoints=F)
plot_diff(model, view='Time.normSegment', comp=list(GroupTypeSensorAxis =
c("TerApel.Standard.T1.H","Ubbergen.Standard.T1.H")), rm.ranef=T, print.summary=F,
main='T1 height: Ter Apel vs. Ubbergen', xlab='Time (normalized)',
ylab='Height difference', ylim=c(-0.23,0.35)); box()
plot_diff(model, view='Time.normSegment', comp=list(GroupTypeSensorAxis =
c("TerApel.Standard.T1.H","Ubbergen.Standard.T2.H")), rm.ranef=T, print.summary=F,
main='T2 height: Ter Apel vs. Ubbergen', xlab='Time (normalized)',
ylab='Height difference', ylim=c(-0.23,0.35)); box()
plot_diff(model, view='Time.normSegment', comp=list(GroupTypeSensorAxis =
c("TerApel.Standard.T3.H","Ubbergen.Standard.T3.H")), rm.ranef=T, print.summary=F,
main='T3 height: Ter Apel vs. Ubbergen', xlab='Time (normalized)',
ylab='Height difference', ylim=c(-0.23,0.35)); box() 
7 Comparison with LDA
In this section, the results are determined on the basis of Linear Discriminant Analysis, for comparison with the results on the basis of generalized additive modeling. First the LDA output (model) is shown, then it is assessed if the group means are different. Subsequently, the confusion matrix is shown and finally the classification performance is displayed
7.1 Dia.: rel. to rest.
dia = droplevels(dat[dat$Type == 'Dialect',],except=colnames(dat)[sapply(dat,is.ordered)])
# extract relevant columns from dialect data set
ld = dia[!is.na(dia$RelPos.norm),c("Speaker","Group","Word","WordNr","RecBlock","Segment",
"SensorAxis","Time.normWord","RelPos.norm")]
# convert to wide format, with separate columns for each sensor/axis
wide = dcast(ld, Speaker + Group + Word + WordNr + RecBlock + Segment + Time.normWord ~ SensorAxis, value.var = "RelPos.norm")7.1.1 Segment: /a/
sgm = 'a'
# Focus on consistent target segment (rows with missing values are excluded)
seg = droplevels(na.omit(subset(wide,Segment==sgm)),except=colnames(dat)[sapply(dat,is.ordered)])
# LDA: Note that the group means generally show directional distances consistent
# with the GAMs results: TerApel more back than Ubbergen
print(seg.lda <- lda(Group ~ T1.P + T2.P + T3.P + T1.H + T2.H + T3.H, data=seg,
na.action=na.omit)) # LDA output## Call:
## lda(Group ~ T1.P + T2.P + T3.P + T1.H + T2.H + T3.H, data = seg,
## na.action = na.omit)
##
## Prior probabilities of groups:
## TerApel Ubbergen
## 0.5821017 0.4178983
##
## Group means:
## T1.P T2.P T3.P T1.H T2.H T3.H
## TerApel 0.2983400 0.3635284 0.3176029 -0.2956635 -0.3965395 -0.4126569
## Ubbergen 0.2959386 0.3098752 0.2496226 -0.3454005 -0.3741849 -0.3519997
##
## Coefficients of linear discriminants:
## LD1
## T1.P 10.8676866
## T2.P -8.2509709
## T3.P -3.4521996
## T1.H -2.2620743
## T2.H 0.7300483
## T3.H -1.2692388# Test if group means are different
seg.m = manova(cbind(seg$T1.P, seg$T2.P, seg$T3.P, seg$T1.H, seg$T2.H, seg$T3.H) ~
seg$Group)
print(summary(seg.m)) # test if group means different## Df Pillai approx F num Df den Df Pr(>F)
## seg$Group 1 0.10738 123.31 6 6150 < 2.2e-16 ***
## Residuals 6155
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1seg.p = predict(seg.lda,seg[,8:13]) # prediction performance
k = (seg.p$class==seg$Group)
print(table(seg.p$class,seg$Group)) # confusion matrix##
## TerApel Ubbergen
## TerApel 2777 1507
## Ubbergen 807 1066print(binom.test(sum(k,na.rm=T),length(k))) # classification performance##
## Exact binomial test
##
## data: sum(k, na.rm = T) and length(k)
## number of successes = 3843, number of trials = 6157, p-value <
## 2.2e-16
## alternative hypothesis: true probability of success is not equal to 0.5
## 95 percent confidence interval:
## 0.6119319 0.6362856
## sample estimates:
## probability of success
## 0.62416767.1.2 Segment: /i/
sgm = 'i'
# Focus on consistent target segment (rows with missing values are excluded)
seg = droplevels(na.omit(subset(wide,Segment==sgm)),except=colnames(dat)[sapply(dat,is.ordered)])
# LDA: Note that the group means generally show directional distances consistent
# with the GAMs results: TerApel more back than Ubbergen
print(seg.lda <- lda(Group ~ T1.P + T2.P + T3.P + T1.H + T2.H + T3.H, data=seg,
na.action=na.omit)) # LDA output## Call:
## lda(Group ~ T1.P + T2.P + T3.P + T1.H + T2.H + T3.H, data = seg,
## na.action = na.omit)
##
## Prior probabilities of groups:
## TerApel Ubbergen
## 0.3823364 0.6176636
##
## Group means:
## T1.P T2.P T3.P T1.H T2.H
## TerApel 0.12391526 0.12177238 0.07360501 -0.09334144 -0.03970893
## Ubbergen 0.07195072 0.02446204 -0.02628757 -0.11093845 -0.02613122
## T3.H
## TerApel -0.04210169
## Ubbergen 0.03697294
##
## Coefficients of linear discriminants:
## LD1
## T1.P 9.2412398
## T2.P -10.5096029
## T3.P 0.2279499
## T1.H 0.7960121
## T2.H -3.2145730
## T3.H 2.4858751# Test if group means are different
seg.m = manova(cbind(seg$T1.P, seg$T2.P, seg$T3.P, seg$T1.H, seg$T2.H, seg$T3.H) ~
seg$Group)
print(summary(seg.m)) # test if group means different## Df Pillai approx F num Df den Df Pr(>F)
## seg$Group 1 0.092945 121.51 6 7115 < 2.2e-16 ***
## Residuals 7120
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1seg.p = predict(seg.lda,seg[,8:13]) # prediction performance
k = (seg.p$class==seg$Group)
print(table(seg.p$class,seg$Group)) # confusion matrix##
## TerApel Ubbergen
## TerApel 923 498
## Ubbergen 1800 3901print(binom.test(sum(k,na.rm=T),length(k))) # classification performance##
## Exact binomial test
##
## data: sum(k, na.rm = T) and length(k)
## number of successes = 4824, number of trials = 7122, p-value <
## 2.2e-16
## alternative hypothesis: true probability of success is not equal to 0.5
## 95 percent confidence interval:
## 0.6663393 0.6881910
## sample estimates:
## probability of success
## 0.67733787.1.3 Segment: /o/
sgm = 'o'
# Focus on consistent target segment (rows with missing values are excluded)
seg = droplevels(na.omit(subset(wide,Segment==sgm)),except=colnames(dat)[sapply(dat,is.ordered)])
# LDA: Note that the group means generally show directional distances consistent
# with the GAMs results: TerApel more back than Ubbergen
print(seg.lda <- lda(Group ~ T1.P + T2.P + T3.P + T1.H + T2.H + T3.H, data=seg,
na.action=na.omit)) # LDA output## Call:
## lda(Group ~ T1.P + T2.P + T3.P + T1.H + T2.H + T3.H, data = seg,
## na.action = na.omit)
##
## Prior probabilities of groups:
## TerApel Ubbergen
## 0.2965537 0.7034463
##
## Group means:
## T1.P T2.P T3.P T1.H T2.H T3.H
## TerApel 0.3976885 0.4626208 0.4186643 -0.3924383 -0.4600567 -0.4001220
## Ubbergen 0.4111568 0.4110829 0.3354374 -0.3679921 -0.3454321 -0.2354018
##
## Coefficients of linear discriminants:
## LD1
## T1.P 7.14797585
## T2.P -0.08572443
## T3.P -6.94317785
## T1.H 2.19083422
## T2.H -2.72330928
## T3.H 3.66923646# Test if group means are different
seg.m = manova(cbind(seg$T1.P, seg$T2.P, seg$T3.P, seg$T1.H, seg$T2.H, seg$T3.H) ~
seg$Group)
print(summary(seg.m)) # test if group means different## Df Pillai approx F num Df den Df Pr(>F)
## seg$Group 1 0.17962 257.05 6 7044 < 2.2e-16 ***
## Residuals 7049
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1seg.p = predict(seg.lda,seg[,8:13]) # prediction performance
k = (seg.p$class==seg$Group)
print(table(seg.p$class,seg$Group)) # confusion matrix##
## TerApel Ubbergen
## TerApel 927 463
## Ubbergen 1164 4497print(binom.test(sum(k,na.rm=T),length(k))) # classification performance##
## Exact binomial test
##
## data: sum(k, na.rm = T) and length(k)
## number of successes = 5424, number of trials = 7051, p-value <
## 2.2e-16
## alternative hypothesis: true probability of success is not equal to 0.5
## 95 percent confidence interval:
## 0.7592376 0.7790445
## sample estimates:
## probability of success
## 0.76925267.1.4 Segment: /k/
sgm = 'k'
# Focus on consistent target segment (rows with missing values are excluded)
seg = droplevels(na.omit(subset(wide,Segment==sgm)),except=colnames(dat)[sapply(dat,is.ordered)])
# LDA: Note that the group means generally show directional distances consistent
# with the GAMs results: TerApel more back than Ubbergen
print(seg.lda <- lda(Group ~ T1.P + T2.P + T3.P + T1.H + T2.H + T3.H, data=seg,
na.action=na.omit)) # LDA output## Call:
## lda(Group ~ T1.P + T2.P + T3.P + T1.H + T2.H + T3.H, data = seg,
## na.action = na.omit)
##
## Prior probabilities of groups:
## TerApel Ubbergen
## 0.3606262 0.6393738
##
## Group means:
## T1.P T2.P T3.P T1.H T2.H T3.H
## TerApel 0.2102795 0.1819909 0.12860390 -0.2137019 -0.1151633 -0.02379903
## Ubbergen 0.1310669 0.0625236 -0.01136857 -0.2267128 -0.1524040 0.01291928
##
## Coefficients of linear discriminants:
## LD1
## T1.P 3.617376
## T2.P -0.114885
## T3.P -5.896268
## T1.H 4.583441
## T2.H -6.048600
## T3.H 2.565392# Test if group means are different
seg.m = manova(cbind(seg$T1.P, seg$T2.P, seg$T3.P, seg$T1.H, seg$T2.H, seg$T3.H) ~
seg$Group)
print(summary(seg.m)) # test if group means different## Df Pillai approx F num Df den Df Pr(>F)
## seg$Group 1 0.1321 140.79 6 5550 < 2.2e-16 ***
## Residuals 5555
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1seg.p = predict(seg.lda,seg[,8:13]) # prediction performance
k = (seg.p$class==seg$Group)
print(table(seg.p$class,seg$Group)) # confusion matrix##
## TerApel Ubbergen
## TerApel 702 394
## Ubbergen 1302 3159print(binom.test(sum(k,na.rm=T),length(k))) # classification performance##
## Exact binomial test
##
## data: sum(k, na.rm = T) and length(k)
## number of successes = 3861, number of trials = 5557, p-value <
## 2.2e-16
## alternative hypothesis: true probability of success is not equal to 0.5
## 95 percent confidence interval:
## 0.6825020 0.7068919
## sample estimates:
## probability of success
## 0.69479947.1.5 Segment: /t/
sgm = 't'
# Focus on consistent target segment (rows with missing values are excluded)
seg = droplevels(na.omit(subset(wide,Segment==sgm)),except=colnames(dat)[sapply(dat,is.ordered)])
# LDA: Note that the group means generally show directional distances consistent
# with the GAMs results: TerApel more back than Ubbergen
print(seg.lda <- lda(Group ~ T1.P + T2.P + T3.P + T1.H + T2.H + T3.H, data=seg,
na.action=na.omit)) # LDA output## Call:
## lda(Group ~ T1.P + T2.P + T3.P + T1.H + T2.H + T3.H, data = seg,
## na.action = na.omit)
##
## Prior probabilities of groups:
## TerApel Ubbergen
## 0.3797885 0.6202115
##
## Group means:
## T1.P T2.P T3.P T1.H T2.H
## TerApel 0.184390030 0.24640178 0.19403245 0.02570194 -0.10488566
## Ubbergen 0.003359028 0.02103585 -0.01595956 -0.02277729 -0.09364206
## T3.H
## TerApel -0.2185697
## Ubbergen -0.1826918
##
## Coefficients of linear discriminants:
## LD1
## T1.P 1.618331
## T2.P -4.055928
## T3.P -2.751187
## T1.H -2.882678
## T2.H 2.904030
## T3.H -2.801540# Test if group means are different
seg.m = manova(cbind(seg$T1.P, seg$T2.P, seg$T3.P, seg$T1.H, seg$T2.H, seg$T3.H) ~
seg$Group)
print(summary(seg.m)) # test if group means different## Df Pillai approx F num Df den Df Pr(>F)
## seg$Group 1 0.27558 712.89 6 11244 < 2.2e-16 ***
## Residuals 11249
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1seg.p = predict(seg.lda,seg[,8:13]) # prediction performance
k = (seg.p$class==seg$Group)
print(table(seg.p$class,seg$Group)) # confusion matrix##
## TerApel Ubbergen
## TerApel 2486 995
## Ubbergen 1787 5983print(binom.test(sum(k,na.rm=T),length(k))) # classification performance##
## Exact binomial test
##
## data: sum(k, na.rm = T) and length(k)
## number of successes = 8469, number of trials = 11251, p-value <
## 2.2e-16
## alternative hypothesis: true probability of success is not equal to 0.5
## 95 percent confidence interval:
## 0.7446521 0.7606831
## sample estimates:
## probability of success
## 0.75273317.2 CVC: rel. to rest.
cvc = droplevels(dat[dat$Type == 'Standard',],except=colnames(dat)[sapply(dat,is.ordered)])
# extract relevant columns from dialect data set
ld = cvc[!is.na(cvc$RelPos.norm),c("Speaker","Group","Word","WordNr","RecBlock","Segment",
"SensorAxis","Time.normWord","RelPos.norm")]
# convert to wide format, with separate columns for each sensor/axis
wide = dcast(ld, Speaker + Group + Word + WordNr + RecBlock + Segment + Time.normWord ~ SensorAxis,
value.var = "RelPos.norm")7.2.1 Segment: /a/
sgm = 'a'
# Focus on consistent target segment (rows with missing values are excluded)
seg = droplevels(na.omit(subset(wide,Segment==sgm)),except=colnames(dat)[sapply(dat,is.ordered)])
# LDA: Note that the group means generally show directional distances consistent
# with the GAMs results: TerApel more back than Ubbergen
print(seg.lda <- lda(Group ~ T1.P + T2.P + T3.P + T1.H + T2.H + T3.H, data=seg,
na.action=na.omit)) # LDA output## Call:
## lda(Group ~ T1.P + T2.P + T3.P + T1.H + T2.H + T3.H, data = seg,
## na.action = na.omit)
##
## Prior probabilities of groups:
## TerApel Ubbergen
## 0.4117944 0.5882056
##
## Group means:
## T1.P T2.P T3.P T1.H T2.H T3.H
## TerApel 0.2511470 0.2673904 0.2115473 -0.2806899 -0.2737933 -0.2862689
## Ubbergen 0.1831389 0.1872420 0.1393220 -0.3591472 -0.4040835 -0.3526878
##
## Coefficients of linear discriminants:
## LD1
## T1.P 0.9828192
## T2.P -4.2605071
## T3.P 0.1250222
## T1.H 0.5004260
## T2.H -5.4010267
## T3.H 1.4361220# Test if group means are different
seg.m = manova(cbind(seg$T1.P, seg$T2.P, seg$T3.P, seg$T1.H, seg$T2.H, seg$T3.H) ~
seg$Group)
print(summary(seg.m)) # test if group means different## Df Pillai approx F num Df den Df Pr(>F)
## seg$Group 1 0.1444 334.17 6 11880 < 2.2e-16 ***
## Residuals 11885
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1seg.p = predict(seg.lda,seg[,8:13]) # prediction performance
k = (seg.p$class==seg$Group)
print(table(seg.p$class,seg$Group)) # confusion matrix##
## TerApel Ubbergen
## TerApel 2399 1402
## Ubbergen 2496 5590print(binom.test(sum(k,na.rm=T),length(k))) # classification performance##
## Exact binomial test
##
## data: sum(k, na.rm = T) and length(k)
## number of successes = 7989, number of trials = 11887, p-value <
## 2.2e-16
## alternative hypothesis: true probability of success is not equal to 0.5
## 95 percent confidence interval:
## 0.6635560 0.6805171
## sample estimates:
## probability of success
## 0.67207877.2.2 Segment: /i/
sgm = 'i'
# Focus on consistent target segment (rows with missing values are excluded)
seg = droplevels(na.omit(subset(wide,Segment==sgm)),except=colnames(dat)[sapply(dat,is.ordered)])
# LDA: Note that the group means generally show directional distances consistent
# with the GAMs results: TerApel more back than Ubbergen
print(seg.lda <- lda(Group ~ T1.P + T2.P + T3.P + T1.H + T2.H + T3.H, data=seg,
na.action=na.omit)) # LDA output## Call:
## lda(Group ~ T1.P + T2.P + T3.P + T1.H + T2.H + T3.H, data = seg,
## na.action = na.omit)
##
## Prior probabilities of groups:
## TerApel Ubbergen
## 0.3802838 0.6197162
##
## Group means:
## T1.P T2.P T3.P T1.H T2.H
## TerApel 0.09541896 0.05973739 0.02247993 -0.1005452 0.02779174
## Ubbergen 0.01669677 -0.05240699 -0.08710099 -0.1400982 -0.02126190
## T3.H
## TerApel 0.04531369
## Ubbergen 0.08464939
##
## Coefficients of linear discriminants:
## LD1
## T1.P -0.2280195
## T2.P -0.6160234
## T3.P -2.1279041
## T1.H 1.4066378
## T2.H -6.9119926
## T3.H 4.6022282# Test if group means are different
seg.m = manova(cbind(seg$T1.P, seg$T2.P, seg$T3.P, seg$T1.H, seg$T2.H, seg$T3.H) ~
seg$Group)
print(summary(seg.m)) # test if group means different## Df Pillai approx F num Df den Df Pr(>F)
## seg$Group 1 0.12675 160.07 6 6617 < 2.2e-16 ***
## Residuals 6622
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1seg.p = predict(seg.lda,seg[,8:13]) # prediction performance
k = (seg.p$class==seg$Group)
print(table(seg.p$class,seg$Group)) # confusion matrix##
## TerApel Ubbergen
## TerApel 925 413
## Ubbergen 1594 3692print(binom.test(sum(k,na.rm=T),length(k))) # classification performance##
## Exact binomial test
##
## data: sum(k, na.rm = T) and length(k)
## number of successes = 4617, number of trials = 6624, p-value <
## 2.2e-16
## alternative hypothesis: true probability of success is not equal to 0.5
## 95 percent confidence interval:
## 0.6857836 0.7080644
## sample estimates:
## probability of success
## 0.69701097.2.3 Segment: /o/
sgm = 'o'
# Focus on consistent target segment (rows with missing values are excluded)
seg = droplevels(na.omit(subset(wide,Segment==sgm)),except=colnames(dat)[sapply(dat,is.ordered)])
# LDA: Note that the group means generally show directional distances consistent
# with the GAMs results: TerApel more back than Ubbergen
print(seg.lda <- lda(Group ~ T1.P + T2.P + T3.P + T1.H + T2.H + T3.H, data=seg,
na.action=na.omit)) # LDA output## Call:
## lda(Group ~ T1.P + T2.P + T3.P + T1.H + T2.H + T3.H, data = seg,
## na.action = na.omit)
##
## Prior probabilities of groups:
## TerApel Ubbergen
## 0.4694052 0.5305948
##
## Group means:
## T1.P T2.P T3.P T1.H T2.H T3.H
## TerApel 0.4811949 0.4822163 0.4004611 -0.3341532 -0.2590566 -0.2040705
## Ubbergen 0.3504057 0.3322055 0.2639479 -0.3576541 -0.3168370 -0.2040628
##
## Coefficients of linear discriminants:
## LD1
## T1.P 1.46160583
## T2.P -6.01427911
## T3.P -0.02132278
## T1.H 1.83844661
## T2.H -4.32910233
## T3.H 0.59043576# Test if group means are different
seg.m = manova(cbind(seg$T1.P, seg$T2.P, seg$T3.P, seg$T1.H, seg$T2.H, seg$T3.H) ~
seg$Group)
print(summary(seg.m)) # test if group means different## Df Pillai approx F num Df den Df Pr(>F)
## seg$Group 1 0.17442 246.63 6 7004 < 2.2e-16 ***
## Residuals 7009
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1seg.p = predict(seg.lda,seg[,8:13]) # prediction performance
k = (seg.p$class==seg$Group)
print(table(seg.p$class,seg$Group)) # confusion matrix##
## TerApel Ubbergen
## TerApel 1885 887
## Ubbergen 1406 2833print(binom.test(sum(k,na.rm=T),length(k))) # classification performance##
## Exact binomial test
##
## data: sum(k, na.rm = T) and length(k)
## number of successes = 4718, number of trials = 7011, p-value <
## 2.2e-16
## alternative hypothesis: true probability of success is not equal to 0.5
## 95 percent confidence interval:
## 0.6618196 0.6839215
## sample estimates:
## probability of success
## 0.67294257.2.4 Segment: /k/
sgm = 'k'
# Focus on consistent target segment (rows with missing values are excluded)
seg = droplevels(na.omit(subset(wide,Segment==sgm)),except=colnames(dat)[sapply(dat,is.ordered)])
# LDA: Note that the group means generally show directional distances consistent
# with the GAMs results: TerApel more back than Ubbergen
print(seg.lda <- lda(Group ~ T1.P + T2.P + T3.P + T1.H + T2.H + T3.H, data=seg,
na.action=na.omit)) # LDA output## Call:
## lda(Group ~ T1.P + T2.P + T3.P + T1.H + T2.H + T3.H, data = seg,
## na.action = na.omit)
##
## Prior probabilities of groups:
## TerApel Ubbergen
## 0.4372423 0.5627577
##
## Group means:
## T1.P T2.P T3.P T1.H T2.H
## TerApel 0.2101638 0.17403656 0.122076192 -0.2348595 -0.1181657
## Ubbergen 0.1395976 0.07290217 0.004042285 -0.2376367 -0.1507524
## T3.H
## TerApel -0.0280079581
## Ubbergen -0.0008192913
##
## Coefficients of linear discriminants:
## LD1
## T1.P 1.095545
## T2.P 2.301364
## T3.P -6.771176
## T1.H 4.095776
## T2.H -6.060380
## T3.H 3.154495# Test if group means are different
seg.m = manova(cbind(seg$T1.P, seg$T2.P, seg$T3.P, seg$T1.H, seg$T2.H, seg$T3.H) ~
seg$Group)
print(summary(seg.m)) # test if group means different## Df Pillai approx F num Df den Df Pr(>F)
## seg$Group 1 0.12476 328.22 6 13816 < 2.2e-16 ***
## Residuals 13821
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1seg.p = predict(seg.lda,seg[,8:13]) # prediction performance
k = (seg.p$class==seg$Group)
print(table(seg.p$class,seg$Group)) # confusion matrix##
## TerApel Ubbergen
## TerApel 2875 1457
## Ubbergen 3169 6322print(binom.test(sum(k,na.rm=T),length(k))) # classification performance##
## Exact binomial test
##
## data: sum(k, na.rm = T) and length(k)
## number of successes = 9197, number of trials = 13823, p-value <
## 2.2e-16
## alternative hypothesis: true probability of success is not equal to 0.5
## 95 percent confidence interval:
## 0.6574037 0.6732074
## sample estimates:
## probability of success
## 0.66534047.2.5 Segment: /t/
sgm = 't'
# Focus on consistent target segment (rows with missing values are excluded)
seg = droplevels(na.omit(subset(wide,Segment==sgm)),except=colnames(dat)[sapply(dat,is.ordered)])
# LDA: Note that the group means generally show directional distances consistent
# with the GAMs results: TerApel more back than Ubbergen
print(seg.lda <- lda(Group ~ T1.P + T2.P + T3.P + T1.H + T2.H + T3.H, data=seg,
na.action=na.omit)) # LDA output## Call:
## lda(Group ~ T1.P + T2.P + T3.P + T1.H + T2.H + T3.H, data = seg,
## na.action = na.omit)
##
## Prior probabilities of groups:
## TerApel Ubbergen
## 0.4549017 0.5450983
##
## Group means:
## T1.P T2.P T3.P T1.H T2.H
## TerApel 0.172753660 0.228453978 0.18022593 0.02205958 -0.07300474
## Ubbergen -0.009194163 0.009306568 -0.02768242 -0.03876585 -0.08605565
## T3.H
## TerApel -0.1724440
## Ubbergen -0.1586318
##
## Coefficients of linear discriminants:
## LD1
## T1.P 0.6932234
## T2.P -1.0329802
## T3.P -5.2924764
## T1.H -3.1944102
## T2.H 2.4589583
## T3.H -2.7941848# Test if group means are different
seg.m = manova(cbind(seg$T1.P, seg$T2.P, seg$T3.P, seg$T1.H, seg$T2.H, seg$T3.H) ~
seg$Group)
print(summary(seg.m)) # test if group means different## Df Pillai approx F num Df den Df Pr(>F)
## seg$Group 1 0.30308 1016.8 6 14029 < 2.2e-16 ***
## Residuals 14034
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1seg.p = predict(seg.lda,seg[,8:13]) # prediction performance
k = (seg.p$class==seg$Group)
print(table(seg.p$class,seg$Group)) # confusion matrix##
## TerApel Ubbergen
## TerApel 4198 1707
## Ubbergen 2187 5944print(binom.test(sum(k,na.rm=T),length(k))) # classification performance##
## Exact binomial test
##
## data: sum(k, na.rm = T) and length(k)
## number of successes = 10142, number of trials = 14036, p-value <
## 2.2e-16
## alternative hypothesis: true probability of success is not equal to 0.5
## 95 percent confidence interval:
## 0.7150823 0.7299664
## sample estimates:
## probability of success
## 0.72257057.3 Dia.: norm. pos.
dia = droplevels(dat[dat$Type == 'Dialect',],except=colnames(dat)[sapply(dat,is.ordered)])
# extract relevant columns from dialect data set
ld = dia[!is.na(dia$Position.norm),c("Speaker","Group","Word","WordNr","RecBlock","Segment",
"SensorAxis","Time.normWord","Position.norm")]
# convert to wide format, with separate columns for each sensor/axis
wide = dcast(ld, Speaker + Group + Word + WordNr + RecBlock + Segment + Time.normWord ~ SensorAxis, value.var = "Position.norm")7.3.1 Segment: /a/
sgm = 'a'
# Focus on consistent target segment (rows with missing values are excluded)
seg = droplevels(na.omit(subset(wide,Segment==sgm)),except=colnames(dat)[sapply(dat,is.ordered)])
# LDA: Note that the group means generally show directional distances consistent
# with the GAMs results: TerApel more back than Ubbergen
print(seg.lda <- lda(Group ~ T1.P + T2.P + T3.P + T1.H + T2.H + T3.H, data=seg,
na.action=na.omit)) # LDA output## Call:
## lda(Group ~ T1.P + T2.P + T3.P + T1.H + T2.H + T3.H, data = seg,
## na.action = na.omit)
##
## Prior probabilities of groups:
## TerApel Ubbergen
## 0.5821017 0.4178983
##
## Group means:
## T1.P T2.P T3.P T1.H T2.H T3.H
## TerApel 0.2884896 0.5487679 0.7733534 0.2683634 0.4083982 0.5307826
## Ubbergen 0.2954047 0.5252838 0.7533199 0.2735023 0.4699272 0.6183857
##
## Coefficients of linear discriminants:
## LD1
## T1.P 10.8951007
## T2.P -16.7115693
## T3.P 4.1925291
## T1.H -1.2288903
## T2.H 0.5585611
## T3.H 4.7725685# Test if group means are different
seg.m = manova(cbind(seg$T1.P, seg$T2.P, seg$T3.P, seg$T1.H, seg$T2.H, seg$T3.H) ~
seg$Group)
print(summary(seg.m)) # test if group means different## Df Pillai approx F num Df den Df Pr(>F)
## seg$Group 1 0.14355 171.81 6 6150 < 2.2e-16 ***
## Residuals 6155
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1seg.p = predict(seg.lda,seg[,8:13]) # prediction performance
k = (seg.p$class==seg$Group)
print(table(seg.p$class,seg$Group)) # confusion matrix##
## TerApel Ubbergen
## TerApel 2807 1290
## Ubbergen 777 1283print(binom.test(sum(k,na.rm=T),length(k))) # classification performance##
## Exact binomial test
##
## data: sum(k, na.rm = T) and length(k)
## number of successes = 4090, number of trials = 6157, p-value <
## 2.2e-16
## alternative hypothesis: true probability of success is not equal to 0.5
## 95 percent confidence interval:
## 0.6523319 0.6760814
## sample estimates:
## probability of success
## 0.66428467.3.2 Segment: /i/
sgm = 'i'
# Focus on consistent target segment (rows with missing values are excluded)
seg = droplevels(na.omit(subset(wide,Segment==sgm)),except=colnames(dat)[sapply(dat,is.ordered)])
# LDA: Note that the group means generally show directional distances consistent
# with the GAMs results: TerApel more back than Ubbergen
print(seg.lda <- lda(Group ~ T1.P + T2.P + T3.P + T1.H + T2.H + T3.H, data=seg,
na.action=na.omit)) # LDA output## Call:
## lda(Group ~ T1.P + T2.P + T3.P + T1.H + T2.H + T3.H, data = seg,
## na.action = na.omit)
##
## Prior probabilities of groups:
## TerApel Ubbergen
## 0.3823364 0.6176636
##
## Group means:
## T1.P T2.P T3.P T1.H T2.H T3.H
## TerApel 0.1924658 0.4219172 0.6465321 0.4195726 0.6671540 0.8041137
## Ubbergen 0.1729815 0.3771206 0.6174998 0.4780974 0.7148096 0.8820725
##
## Coefficients of linear discriminants:
## LD1
## T1.P 7.247748
## T2.P -15.911149
## T3.P 7.604597
## T1.H 7.397769
## T2.H -5.405397
## T3.H 7.784712# Test if group means are different
seg.m = manova(cbind(seg$T1.P, seg$T2.P, seg$T3.P, seg$T1.H, seg$T2.H, seg$T3.H) ~
seg$Group)
print(summary(seg.m)) # test if group means different## Df Pillai approx F num Df den Df Pr(>F)
## seg$Group 1 0.23268 359.59 6 7115 < 2.2e-16 ***
## Residuals 7120
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1seg.p = predict(seg.lda,seg[,8:13]) # prediction performance
k = (seg.p$class==seg$Group)
print(table(seg.p$class,seg$Group)) # confusion matrix##
## TerApel Ubbergen
## TerApel 1488 611
## Ubbergen 1235 3788print(binom.test(sum(k,na.rm=T),length(k))) # classification performance##
## Exact binomial test
##
## data: sum(k, na.rm = T) and length(k)
## number of successes = 5276, number of trials = 7122, p-value <
## 2.2e-16
## alternative hypothesis: true probability of success is not equal to 0.5
## 95 percent confidence interval:
## 0.7304588 0.7509500
## sample estimates:
## probability of success
## 0.74080317.3.3 Segment: /o/
sgm = 'o'
# Focus on consistent target segment (rows with missing values are excluded)
seg = droplevels(na.omit(subset(wide,Segment==sgm)),except=colnames(dat)[sapply(dat,is.ordered)])
# LDA: Note that the group means generally show directional distances consistent
# with the GAMs results: TerApel more back than Ubbergen
print(seg.lda <- lda(Group ~ T1.P + T2.P + T3.P + T1.H + T2.H + T3.H, data=seg,
na.action=na.omit)) # LDA output## Call:
## lda(Group ~ T1.P + T2.P + T3.P + T1.H + T2.H + T3.H, data = seg,
## na.action = na.omit)
##
## Prior probabilities of groups:
## TerApel Ubbergen
## 0.2965537 0.7034463
##
## Group means:
## T1.P T2.P T3.P T1.H T2.H T3.H
## TerApel 0.3479011 0.6080675 0.8207941 0.1921084 0.3729722 0.5510732
## Ubbergen 0.3654176 0.5875125 0.8125776 0.2581623 0.4644356 0.6668559
##
## Coefficients of linear discriminants:
## LD1
## T1.P 13.429591
## T2.P -16.866704
## T3.P 3.934086
## T1.H 4.284749
## T2.H -3.327624
## T3.H 6.472680# Test if group means are different
seg.m = manova(cbind(seg$T1.P, seg$T2.P, seg$T3.P, seg$T1.H, seg$T2.H, seg$T3.H) ~
seg$Group)
print(summary(seg.m)) # test if group means different## Df Pillai approx F num Df den Df Pr(>F)
## seg$Group 1 0.2541 399.93 6 7044 < 2.2e-16 ***
## Residuals 7049
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1seg.p = predict(seg.lda,seg[,8:13]) # prediction performance
k = (seg.p$class==seg$Group)
print(table(seg.p$class,seg$Group)) # confusion matrix##
## TerApel Ubbergen
## TerApel 986 425
## Ubbergen 1105 4535print(binom.test(sum(k,na.rm=T),length(k))) # classification performance##
## Exact binomial test
##
## data: sum(k, na.rm = T) and length(k)
## number of successes = 5521, number of trials = 7051, p-value <
## 2.2e-16
## alternative hypothesis: true probability of success is not equal to 0.5
## 95 percent confidence interval:
## 0.7732014 0.7925830
## sample estimates:
## probability of success
## 0.78300957.3.4 Segment: /k/
sgm = 'k'
# Focus on consistent target segment (rows with missing values are excluded)
seg = droplevels(na.omit(subset(wide,Segment==sgm)),except=colnames(dat)[sapply(dat,is.ordered)])
# LDA: Note that the group means generally show directional distances consistent
# with the GAMs results: TerApel more back than Ubbergen
print(seg.lda <- lda(Group ~ T1.P + T2.P + T3.P + T1.H + T2.H + T3.H, data=seg,
na.action=na.omit)) # LDA output## Call:
## lda(Group ~ T1.P + T2.P + T3.P + T1.H + T2.H + T3.H, data = seg,
## na.action = na.omit)
##
## Prior probabilities of groups:
## TerApel Ubbergen
## 0.3606262 0.6393738
##
## Group means:
## T1.P T2.P T3.P T1.H T2.H T3.H
## TerApel 0.2406583 0.4561015 0.6801682 0.3239159 0.6076817 0.8131827
## Ubbergen 0.2044865 0.3964919 0.6235718 0.3789839 0.6233843 0.8696122
##
## Coefficients of linear discriminants:
## LD1
## T1.P 0.6916924
## T2.P -1.6564183
## T3.P -3.3082188
## T1.H 8.4164682
## T2.H -8.5030686
## T3.H 11.2276039# Test if group means are different
seg.m = manova(cbind(seg$T1.P, seg$T2.P, seg$T3.P, seg$T1.H, seg$T2.H, seg$T3.H) ~
seg$Group)
print(summary(seg.m)) # test if group means different## Df Pillai approx F num Df den Df Pr(>F)
## seg$Group 1 0.25697 319.9 6 5550 < 2.2e-16 ***
## Residuals 5555
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1seg.p = predict(seg.lda,seg[,8:13]) # prediction performance
k = (seg.p$class==seg$Group)
print(table(seg.p$class,seg$Group)) # confusion matrix##
## TerApel Ubbergen
## TerApel 1041 455
## Ubbergen 963 3098print(binom.test(sum(k,na.rm=T),length(k))) # classification performance##
## Exact binomial test
##
## data: sum(k, na.rm = T) and length(k)
## number of successes = 4139, number of trials = 5557, p-value <
## 2.2e-16
## alternative hypothesis: true probability of success is not equal to 0.5
## 95 percent confidence interval:
## 0.7331473 0.7562477
## sample estimates:
## probability of success
## 0.74482637.3.5 Segment: /t/
sgm = 't'
# Focus on consistent target segment (rows with missing values are excluded)
seg = droplevels(na.omit(subset(wide,Segment==sgm)),except=colnames(dat)[sapply(dat,is.ordered)])
# LDA: Note that the group means generally show directional distances consistent
# with the GAMs results: TerApel more back than Ubbergen
print(seg.lda <- lda(Group ~ T1.P + T2.P + T3.P + T1.H + T2.H + T3.H, data=seg,
na.action=na.omit)) # LDA output## Call:
## lda(Group ~ T1.P + T2.P + T3.P + T1.H + T2.H + T3.H, data = seg,
## na.action = na.omit)
##
## Prior probabilities of groups:
## TerApel Ubbergen
## 0.3797885 0.6202115
##
## Group means:
## T1.P T2.P T3.P T1.H T2.H T3.H
## TerApel 0.2331964 0.4936606 0.7146968 0.5107506 0.6171621 0.6627596
## Ubbergen 0.1335811 0.3764822 0.6251091 0.5437202 0.6681299 0.7230922
##
## Coefficients of linear discriminants:
## LD1
## T1.P -2.743224e+00
## T2.P -1.148939e+01
## T3.P -1.211778e+00
## T1.H 3.944973e+00
## T2.H 4.909268e-05
## T3.H 1.160113e+00# Test if group means are different
seg.m = manova(cbind(seg$T1.P, seg$T2.P, seg$T3.P, seg$T1.H, seg$T2.H, seg$T3.H) ~
seg$Group)
print(summary(seg.m)) # test if group means different## Df Pillai approx F num Df den Df Pr(>F)
## seg$Group 1 0.46693 1641.5 6 11244 < 2.2e-16 ***
## Residuals 11249
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1seg.p = predict(seg.lda,seg[,8:13]) # prediction performance
k = (seg.p$class==seg$Group)
print(table(seg.p$class,seg$Group)) # confusion matrix##
## TerApel Ubbergen
## TerApel 3144 581
## Ubbergen 1129 6397print(binom.test(sum(k,na.rm=T),length(k))) # classification performance##
## Exact binomial test
##
## data: sum(k, na.rm = T) and length(k)
## number of successes = 9541, number of trials = 11251, p-value <
## 2.2e-16
## alternative hypothesis: true probability of success is not equal to 0.5
## 95 percent confidence interval:
## 0.8412454 0.8546010
## sample estimates:
## probability of success
## 0.84801357.4 CVC: norm. pos.
cvc = droplevels(dat[dat$Type == 'Standard',],except=colnames(dat)[sapply(dat,is.ordered)])
# extract relevant columns from dialect data set
ld = cvc[!is.na(cvc$Position.norm),c("Speaker","Group","Word","WordNr","RecBlock","Segment",
"SensorAxis","Time.normWord","Position.norm")]
# convert to wide format, with separate columns for each sensor/axis
wide = dcast(ld, Speaker + Group + Word + WordNr + RecBlock + Segment + Time.normWord ~ SensorAxis,
value.var = "Position.norm")7.4.1 Segment: /a/
sgm = 'a'
# Focus on consistent target segment (rows with missing values are excluded)
seg = droplevels(na.omit(subset(wide,Segment==sgm)),except=colnames(dat)[sapply(dat,is.ordered)])
# LDA: Note that the group means generally show directional distances consistent
# with the GAMs results: TerApel more back than Ubbergen
print(seg.lda <- lda(Group ~ T1.P + T2.P + T3.P + T1.H + T2.H + T3.H, data=seg,
na.action=na.omit)) # LDA output## Call:
## lda(Group ~ T1.P + T2.P + T3.P + T1.H + T2.H + T3.H, data = seg,
## na.action = na.omit)
##
## Prior probabilities of groups:
## TerApel Ubbergen
## 0.4117944 0.5882056
##
## Group means:
## T1.P T2.P T3.P T1.H T2.H T3.H
## TerApel 0.2768308 0.5096285 0.7264438 0.2733597 0.4924067 0.6138644
## Ubbergen 0.2445156 0.4700675 0.7095327 0.2795118 0.4309849 0.5812407
##
## Coefficients of linear discriminants:
## LD1
## T1.P 0.06740496
## T2.P -13.81404834
## T3.P 7.89382648
## T1.H 7.48159689
## T2.H -13.09579244
## T3.H 4.82765287# Test if group means are different
seg.m = manova(cbind(seg$T1.P, seg$T2.P, seg$T3.P, seg$T1.H, seg$T2.H, seg$T3.H) ~
seg$Group)
print(summary(seg.m)) # test if group means different## Df Pillai approx F num Df den Df Pr(>F)
## seg$Group 1 0.22787 584.35 6 11880 < 2.2e-16 ***
## Residuals 11885
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1seg.p = predict(seg.lda,seg[,8:13]) # prediction performance
k = (seg.p$class==seg$Group)
print(table(seg.p$class,seg$Group)) # confusion matrix##
## TerApel Ubbergen
## TerApel 2862 1496
## Ubbergen 2033 5496print(binom.test(sum(k,na.rm=T),length(k))) # classification performance##
## Exact binomial test
##
## data: sum(k, na.rm = T) and length(k)
## number of successes = 8358, number of trials = 11887, p-value <
## 2.2e-16
## alternative hypothesis: true probability of success is not equal to 0.5
## 95 percent confidence interval:
## 0.6948167 0.7113259
## sample estimates:
## probability of success
## 0.70312117.4.2 Segment: /i/
sgm = 'i'
# Focus on consistent target segment (rows with missing values are excluded)
seg = droplevels(na.omit(subset(wide,Segment==sgm)),except=colnames(dat)[sapply(dat,is.ordered)])
# LDA: Note that the group means generally show directional distances consistent
# with the GAMs results: TerApel more back than Ubbergen
print(seg.lda <- lda(Group ~ T1.P + T2.P + T3.P + T1.H + T2.H + T3.H, data=seg,
na.action=na.omit)) # LDA output## Call:
## lda(Group ~ T1.P + T2.P + T3.P + T1.H + T2.H + T3.H, data = seg,
## na.action = na.omit)
##
## Prior probabilities of groups:
## TerApel Ubbergen
## 0.3802838 0.6197162
##
## Group means:
## T1.P T2.P T3.P T1.H T2.H T3.H
## TerApel 0.1892289 0.4001834 0.6294153 0.4154809 0.7183436 0.8674979
## Ubbergen 0.1465314 0.3370562 0.5875179 0.4483677 0.7088200 0.9149643
##
## Coefficients of linear discriminants:
## LD1
## T1.P -0.4147103
## T2.P -11.6364837
## T3.P 3.7200229
## T1.H 7.3998139
## T2.H -6.7918788
## T3.H 9.1025510# Test if group means are different
seg.m = manova(cbind(seg$T1.P, seg$T2.P, seg$T3.P, seg$T1.H, seg$T2.H, seg$T3.H) ~
seg$Group)
print(summary(seg.m)) # test if group means different## Df Pillai approx F num Df den Df Pr(>F)
## seg$Group 1 0.29632 464.41 6 6617 < 2.2e-16 ***
## Residuals 6622
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1seg.p = predict(seg.lda,seg[,8:13]) # prediction performance
k = (seg.p$class==seg$Group)
print(table(seg.p$class,seg$Group)) # confusion matrix##
## TerApel Ubbergen
## TerApel 1380 595
## Ubbergen 1139 3510print(binom.test(sum(k,na.rm=T),length(k))) # classification performance##
## Exact binomial test
##
## data: sum(k, na.rm = T) and length(k)
## number of successes = 4890, number of trials = 6624, p-value <
## 2.2e-16
## alternative hypothesis: true probability of success is not equal to 0.5
## 95 percent confidence interval:
## 0.7274594 0.7487798
## sample estimates:
## probability of success
## 0.73822467.4.3 Segment: /o/
sgm = 'o'
# Focus on consistent target segment (rows with missing values are excluded)
seg = droplevels(na.omit(subset(wide,Segment==sgm)),except=colnames(dat)[sapply(dat,is.ordered)])
# LDA: Note that the group means generally show directional distances consistent
# with the GAMs results: TerApel more back than Ubbergen
print(seg.lda <- lda(Group ~ T1.P + T2.P + T3.P + T1.H + T2.H + T3.H, data=seg,
na.action=na.omit)) # LDA output## Call:
## lda(Group ~ T1.P + T2.P + T3.P + T1.H + T2.H + T3.H, data = seg,
## na.action = na.omit)
##
## Prior probabilities of groups:
## TerApel Ubbergen
## 0.4694052 0.5305948
##
## Group means:
## T1.P T2.P T3.P T1.H T2.H T3.H
## TerApel 0.3882965 0.6152761 0.8235561 0.2410817 0.4935025 0.6750423
## Ubbergen 0.3511231 0.5605024 0.7790910 0.2851098 0.5202344 0.7153457
##
## Coefficients of linear discriminants:
## LD1
## T1.P 10.625518
## T2.P -21.716484
## T3.P 2.085492
## T1.H 2.772129
## T2.H -2.077684
## T3.H 2.242552# Test if group means are different
seg.m = manova(cbind(seg$T1.P, seg$T2.P, seg$T3.P, seg$T1.H, seg$T2.H, seg$T3.H) ~
seg$Group)
print(summary(seg.m)) # test if group means different## Df Pillai approx F num Df den Df Pr(>F)
## seg$Group 1 0.15518 214.43 6 7004 < 2.2e-16 ***
## Residuals 7009
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1seg.p = predict(seg.lda,seg[,8:13]) # prediction performance
k = (seg.p$class==seg$Group)
print(table(seg.p$class,seg$Group)) # confusion matrix##
## TerApel Ubbergen
## TerApel 2117 1086
## Ubbergen 1174 2634print(binom.test(sum(k,na.rm=T),length(k))) # classification performance##
## Exact binomial test
##
## data: sum(k, na.rm = T) and length(k)
## number of successes = 4751, number of trials = 7011, p-value <
## 2.2e-16
## alternative hypothesis: true probability of success is not equal to 0.5
## 95 percent confidence interval:
## 0.6665657 0.6885852
## sample estimates:
## probability of success
## 0.67764947.4.4 Segment: /k/
sgm = 'k'
# Focus on consistent target segment (rows with missing values are excluded)
seg = droplevels(na.omit(subset(wide,Segment==sgm)),except=colnames(dat)[sapply(dat,is.ordered)])
# LDA: Note that the group means generally show directional distances consistent
# with the GAMs results: TerApel more back than Ubbergen
print(seg.lda <- lda(Group ~ T1.P + T2.P + T3.P + T1.H + T2.H + T3.H, data=seg,
na.action=na.omit)) # LDA output## Call:
## lda(Group ~ T1.P + T2.P + T3.P + T1.H + T2.H + T3.H, data = seg,
## na.action = na.omit)
##
## Prior probabilities of groups:
## TerApel Ubbergen
## 0.4372423 0.5627577
##
## Group means:
## T1.P T2.P T3.P T1.H T2.H T3.H
## TerApel 0.2521966 0.4582699 0.6802532 0.3168509 0.6204981 0.8314069
## Ubbergen 0.2108464 0.4007065 0.6301511 0.3694252 0.6239095 0.8608882
##
## Coefficients of linear discriminants:
## LD1
## T1.P 1.4131097
## T2.P -6.1621114
## T3.P -0.4133136
## T1.H 9.7580341
## T2.H -7.7571450
## T3.H 5.1378433# Test if group means are different
seg.m = manova(cbind(seg$T1.P, seg$T2.P, seg$T3.P, seg$T1.H, seg$T2.H, seg$T3.H) ~
seg$Group)
print(summary(seg.m)) # test if group means different## Df Pillai approx F num Df den Df Pr(>F)
## seg$Group 1 0.18331 516.84 6 13816 < 2.2e-16 ***
## Residuals 13821
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1seg.p = predict(seg.lda,seg[,8:13]) # prediction performance
k = (seg.p$class==seg$Group)
print(table(seg.p$class,seg$Group)) # confusion matrix##
## TerApel Ubbergen
## TerApel 3627 1933
## Ubbergen 2417 5846print(binom.test(sum(k,na.rm=T),length(k))) # classification performance##
## Exact binomial test
##
## data: sum(k, na.rm = T) and length(k)
## number of successes = 9473, number of trials = 13823, p-value <
## 2.2e-16
## alternative hypothesis: true probability of success is not equal to 0.5
## 95 percent confidence interval:
## 0.6774909 0.6930452
## sample estimates:
## probability of success
## 0.68530717.4.5 Segment: /t/
sgm = 't'
# Focus on consistent target segment (rows with missing values are excluded)
seg = droplevels(na.omit(subset(wide,Segment==sgm)),except=colnames(dat)[sapply(dat,is.ordered)])
# LDA: Note that the group means generally show directional distances consistent
# with the GAMs results: TerApel more back than Ubbergen
print(seg.lda <- lda(Group ~ T1.P + T2.P + T3.P + T1.H + T2.H + T3.H, data=seg,
na.action=na.omit)) # LDA output## Call:
## lda(Group ~ T1.P + T2.P + T3.P + T1.H + T2.H + T3.H, data = seg,
## na.action = na.omit)
##
## Prior probabilities of groups:
## TerApel Ubbergen
## 0.4549017 0.5450983
##
## Group means:
## T1.P T2.P T3.P T1.H T2.H T3.H
## TerApel 0.2323473 0.4870403 0.7098105 0.5134148 0.6499338 0.7099436
## Ubbergen 0.1277839 0.3684543 0.6163056 0.5241529 0.6670491 0.7390113
##
## Coefficients of linear discriminants:
## LD1
## T1.P -1.9025114
## T2.P -11.3122355
## T3.P -1.9630638
## T1.H 3.7142222
## T2.H -2.2511185
## T3.H 0.2668908# Test if group means are different
seg.m = manova(cbind(seg$T1.P, seg$T2.P, seg$T3.P, seg$T1.H, seg$T2.H, seg$T3.H) ~
seg$Group)
print(summary(seg.m)) # test if group means different## Df Pillai approx F num Df den Df Pr(>F)
## seg$Group 1 0.4269 1741.7 6 14029 < 2.2e-16 ***
## Residuals 14034
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1seg.p = predict(seg.lda,seg[,8:13]) # prediction performance
k = (seg.p$class==seg$Group)
print(table(seg.p$class,seg$Group)) # confusion matrix##
## TerApel Ubbergen
## TerApel 4826 1063
## Ubbergen 1559 6588print(binom.test(sum(k,na.rm=T),length(k))) # classification performance##
## Exact binomial test
##
## data: sum(k, na.rm = T) and length(k)
## number of successes = 11414, number of trials = 14036, p-value <
## 2.2e-16
## alternative hypothesis: true probability of success is not equal to 0.5
## 95 percent confidence interval:
## 0.8066464 0.8196127
## sample estimates:
## probability of success
## 0.81319468 Comparison with formants
In this section, the articulatory results are compared to the acoustic results. For a subset of the data we obtained manual formant measurements. The correlation between the manual and automatic formant measurments was 0.87 for F1 and 0.83 for F2.
8.1 Correlations
Tables of the correlations are shown, both F1 (automatic and manual) vs. height and F2 (automatic and manual) vs. posterior position. Additionally, one significance test is shown for the lowest correlation (to illustrate that all correlations are significant).
8.1.1 Dia.: rel. to rest.
# correlations of F1 with height
t1h = with(subset(dia,SensorAxis=='T1.H'),cor(RelPos.norm,F1.norm,use='pair'))
t2h = with(subset(dia,SensorAxis=='T2.H'),cor(RelPos.norm,F1.norm,use='pair'))
t3h = with(subset(dia,SensorAxis=='T3.H'),cor(RelPos.norm,F1.norm,use='pair'))
th = mean(c(t1h,t2h,t3h))
# correlations of manually corrected F1 with height
t1hm = with(subset(dia,SensorAxis=='T1.H'),cor(RelPos.norm,F1.man.norm,use='pair'))
t2hm = with(subset(dia,SensorAxis=='T2.H'),cor(RelPos.norm,F1.man.norm,use='pair'))
t3hm = with(subset(dia,SensorAxis=='T3.H'),cor(RelPos.norm,F1.man.norm,use='pair'))
thm = mean(c(t1hm,t2hm,t3hm))
corF1H = matrix(c(t1h,t1hm,t2h,t2hm,t3h,t3hm,th,thm),nrow=4,ncol=2,byrow=T)
dimnames(corF1H) = list(c("T1.height","T2.height","T3.height","Mean"),c("F1","F1.man"))
corF1H## F1 F1.man
## T1.height -0.1679014 -0.1583810
## T2.height -0.2259878 -0.2275624
## T3.height -0.2638554 -0.2761599
## Mean -0.2192482 -0.2207011# correlations of F2 with posterior position
t1p = with(subset(dia,SensorAxis=='T1.P'),cor(RelPos.norm,F2.norm,use='pair'))
t2p = with(subset(dia,SensorAxis=='T2.P'),cor(RelPos.norm,F2.norm,use='pair'))
t3p = with(subset(dia,SensorAxis=='T3.P'),cor(RelPos.norm,F2.norm,use='pair'))
tp = mean(c(t1p,t2p,t3p))
# correlations of manually corrected F2 with posterior position
t1pm = with(subset(dia,SensorAxis=='T1.P'),cor(RelPos.norm,F2.man.norm,use='pair'))
t2pm = with(subset(dia,SensorAxis=='T2.P'),cor(RelPos.norm,F2.man.norm,use='pair'))
t3pm = with(subset(dia,SensorAxis=='T3.P'),cor(RelPos.norm,F2.man.norm,use='pair'))
tpm = mean(c(t1pm,t2pm,t3pm))
corF2P = matrix(c(t1p,t1pm,t2p,t2pm,t3p,t3pm,tp,tpm),nrow=4,ncol=2,byrow=T)
dimnames(corF2P) = list(c("T1.ppos","T2.ppos","T3.ppos","Mean"),c("F2","F2.man"))
corF2P## F2 F2.man
## T1.ppos -0.4044525 -0.4117515
## T2.ppos -0.4255202 -0.4513392
## T3.ppos -0.4229440 -0.4441585
## Mean -0.4176389 -0.4357497# all correlations are significant, example for weakest correlation:
with(subset(dia,SensorAxis=='T1.H'),cor.test(RelPos.norm,F1.man.norm,use='pair'))##
## Pearson's product-moment correlation
##
## data: RelPos.norm and F1.man.norm
## t = -18.802, df = 13740, p-value < 2.2e-16
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## -0.1746384 -0.1420374
## sample estimates:
## cor
## -0.1583818.1.2 CVC: rel. to rest.
# correlations of F1 with height
t1h = with(subset(cvc,SensorAxis=='T1.H'),cor(RelPos.norm,F1.norm,use='pair'))
t2h = with(subset(cvc,SensorAxis=='T2.H'),cor(RelPos.norm,F1.norm,use='pair'))
t3h = with(subset(cvc,SensorAxis=='T3.H'),cor(RelPos.norm,F1.norm,use='pair'))
th = mean(c(t1h,t2h,t3h))
# correlations of manually corrected F1 with height
t1hm = with(subset(cvc,SensorAxis=='T1.H'),cor(RelPos.norm,F1.man.norm,use='pair'))
t2hm = with(subset(cvc,SensorAxis=='T2.H'),cor(RelPos.norm,F1.man.norm,use='pair'))
t3hm = with(subset(cvc,SensorAxis=='T3.H'),cor(RelPos.norm,F1.man.norm,use='pair'))
thm = mean(c(t1hm,t2hm,t3hm))
corF1H = matrix(c(t1h,t1hm,t2h,t2hm,t3h,t3hm,th,thm),nrow=4,ncol=2,byrow=T)
dimnames(corF1H) = list(c("T1.height","T2.height","T3.height","Mean"),c("F1","F1.man"))
corF1H## F1 F1.man
## T1.height -0.3112370 -0.3318803
## T2.height -0.4368489 -0.4440837
## T3.height -0.5055426 -0.5103887
## Mean -0.4178762 -0.4287842# correlations of F2 with posterior position
t1p = with(subset(cvc,SensorAxis=='T1.P'),cor(RelPos.norm,F2.norm,use='pair'))
t2p = with(subset(cvc,SensorAxis=='T2.P'),cor(RelPos.norm,F2.norm,use='pair'))
t3p = with(subset(cvc,SensorAxis=='T3.P'),cor(RelPos.norm,F2.norm,use='pair'))
tp = mean(c(t1p,t2p,t3p))
# correlations of manually corrected F2 with posterior position
t1pm = with(subset(cvc,SensorAxis=='T1.P'),cor(RelPos.norm,F2.man.norm,use='pair'))
t2pm = with(subset(cvc,SensorAxis=='T2.P'),cor(RelPos.norm,F2.man.norm,use='pair'))
t3pm = with(subset(cvc,SensorAxis=='T3.P'),cor(RelPos.norm,F2.man.norm,use='pair'))
tpm = mean(c(t1pm,t2pm,t3pm))
corF2P = matrix(c(t1p,t1pm,t2p,t2pm,t3p,t3pm,tp,tpm),nrow=4,ncol=2,byrow=T)
dimnames(corF2P) = list(c("T1.ppos","T2.ppos","T3.ppos","Mean"),c("F2","F2.man"))
corF2P## F2 F2.man
## T1.ppos -0.5162875 -0.6299737
## T2.ppos -0.5109528 -0.6318354
## T3.ppos -0.5032342 -0.6206608
## Mean -0.5101582 -0.6274899# all correlations are significant, example for weakest correlation:
with(subset(cvc,SensorAxis=='T1.H'),cor.test(RelPos.norm,F1.man.norm,use='pair'))##
## Pearson's product-moment correlation
##
## data: RelPos.norm and F1.man.norm
## t = -42.666, df = 14707, p-value < 2.2e-16
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## -0.3461844 -0.3174220
## sample estimates:
## cor
## -0.33188038.1.3 Dia.: norm. pos.
# correlations of F1 with height
t1h = with(subset(dia,SensorAxis=='T1.H'),cor(Position.norm,F1.norm,use='pair'))
t2h = with(subset(dia,SensorAxis=='T2.H'),cor(Position.norm,F1.norm,use='pair'))
t3h = with(subset(dia,SensorAxis=='T3.H'),cor(Position.norm,F1.norm,use='pair'))
th = mean(c(t1h,t2h,t3h))
# correlations of manually corrected F1 with height
t1hm = with(subset(dia,SensorAxis=='T1.H'),cor(Position.norm,F1.man.norm,use='pair'))
t2hm = with(subset(dia,SensorAxis=='T2.H'),cor(Position.norm,F1.man.norm,use='pair'))
t3hm = with(subset(dia,SensorAxis=='T3.H'),cor(Position.norm,F1.man.norm,use='pair'))
thm = mean(c(t1hm,t2hm,t3hm))
corF1H = matrix(c(t1h,t1hm,t2h,t2hm,t3h,t3hm,th,thm),nrow=4,ncol=2,byrow=T)
dimnames(corF1H) = list(c("T1.height","T2.height","T3.height","Mean"),c("F1","F1.man"))
corF1H## F1 F1.man
## T1.height -0.1712611 -0.1648214
## T2.height -0.2593233 -0.2516495
## T3.height -0.3252296 -0.3153555
## Mean -0.2519380 -0.2439421# correlations of F2 with posterior position
t1p = with(subset(dia,SensorAxis=='T1.P'),cor(Position.norm,F2.norm,use='pair'))
t2p = with(subset(dia,SensorAxis=='T2.P'),cor(Position.norm,F2.norm,use='pair'))
t3p = with(subset(dia,SensorAxis=='T3.P'),cor(Position.norm,F2.norm,use='pair'))
tp = mean(c(t1p,t2p,t3p))
# correlations of manually corrected F2 with posterior position
t1pm = with(subset(dia,SensorAxis=='T1.P'),cor(Position.norm,F2.man.norm,use='pair'))
t2pm = with(subset(dia,SensorAxis=='T2.P'),cor(Position.norm,F2.man.norm,use='pair'))
t3pm = with(subset(dia,SensorAxis=='T3.P'),cor(Position.norm,F2.man.norm,use='pair'))
tpm = mean(c(t1pm,t2pm,t3pm))
corF2P = matrix(c(t1p,t1pm,t2p,t2pm,t3p,t3pm,tp,tpm),nrow=4,ncol=2,byrow=T)
dimnames(corF2P) = list(c("T1.ppos","T2.ppos","T3.ppos","Mean"),c("F2","F2.man"))
corF2P## F2 F2.man
## T1.ppos -0.4497491 -0.4791477
## T2.ppos -0.5149078 -0.5578914
## T3.ppos -0.5230816 -0.5561236
## Mean -0.4959129 -0.5310542# all correlations are significant, example for weakest correlation:
with(subset(dia,SensorAxis=='T1.H'),cor.test(Position.norm,F1.man.norm,use='pair'))##
## Pearson's product-moment correlation
##
## data: Position.norm and F1.man.norm
## t = -19.588, df = 13740, p-value < 2.2e-16
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## -0.1810423 -0.1485109
## sample estimates:
## cor
## -0.16482148.1.4 CVC: norm. pos.
# correlations of F1 with height
t1h = with(subset(cvc,SensorAxis=='T1.H'),cor(Position.norm,F1.norm,use='pair'))
t2h = with(subset(cvc,SensorAxis=='T2.H'),cor(Position.norm,F1.norm,use='pair'))
t3h = with(subset(cvc,SensorAxis=='T3.H'),cor(Position.norm,F1.norm,use='pair'))
th = mean(c(t1h,t2h,t3h))
# correlations of manually corrected F1 with height
t1hm = with(subset(cvc,SensorAxis=='T1.H'),cor(Position.norm,F1.man.norm,use='pair'))
t2hm = with(subset(cvc,SensorAxis=='T2.H'),cor(Position.norm,F1.man.norm,use='pair'))
t3hm = with(subset(cvc,SensorAxis=='T3.H'),cor(Position.norm,F1.man.norm,use='pair'))
thm = mean(c(t1hm,t2hm,t3hm))
corF1H = matrix(c(t1h,t1hm,t2h,t2hm,t3h,t3hm,th,thm),nrow=4,ncol=2,byrow=T)
dimnames(corF1H) = list(c("T1.height","T2.height","T3.height","Mean"),c("F1","F1.man"))
corF1H## F1 F1.man
## T1.height -0.3699667 -0.3691073
## T2.height -0.5350495 -0.5529481
## T3.height -0.6419573 -0.6585886
## Mean -0.5156578 -0.5268813# correlations of F2 with posterior position
t1p = with(subset(cvc,SensorAxis=='T1.P'),cor(Position.norm,F2.norm,use='pair'))
t2p = with(subset(cvc,SensorAxis=='T2.P'),cor(Position.norm,F2.norm,use='pair'))
t3p = with(subset(cvc,SensorAxis=='T3.P'),cor(Position.norm,F2.norm,use='pair'))
tp = mean(c(t1p,t2p,t3p))
# correlations of manually corrected F2 with posterior position
t1pm = with(subset(cvc,SensorAxis=='T1.P'),cor(Position.norm,F2.man.norm,use='pair'))
t2pm = with(subset(cvc,SensorAxis=='T2.P'),cor(Position.norm,F2.man.norm,use='pair'))
t3pm = with(subset(cvc,SensorAxis=='T3.P'),cor(Position.norm,F2.man.norm,use='pair'))
tpm = mean(c(t1pm,t2pm,t3pm))
corF2P = matrix(c(t1p,t1pm,t2p,t2pm,t3p,t3pm,tp,tpm),nrow=4,ncol=2,byrow=T)
dimnames(corF2P) = list(c("T1.ppos","T2.ppos","T3.ppos","Mean"),c("F2","F2.man"))
corF2P## F2 F2.man
## T1.ppos -0.5848831 -0.6507445
## T2.ppos -0.6273474 -0.7202059
## T3.ppos -0.6199128 -0.7157745
## Mean -0.6107144 -0.6955750# all correlations are significant, example for weakest correlation:
with(subset(cvc,SensorAxis=='T1.H'),cor.test(Position.norm,F1.man.norm,use='pair'))##
## Pearson's product-moment correlation
##
## data: Position.norm and F1.man.norm
## t = -48.164, df = 14707, p-value < 2.2e-16
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## -0.3829836 -0.3550645
## sample estimates:
## cor
## -0.36910738.2 Visualization
As the correlations between the tongue position and the formant measurements were highest for the manual formant measurements, these will be used in the following.
8.2.1 Dia.: rel. to rest.
sensoraxis = c('T1.H','T2.H','T3.H','T1.P','T2.P','T3.P')
par(mfrow=c(2,3))
for (sa in sensoraxis) {
# select sensor and axis
tmp = dia[dia$SensorAxis==sa,]
# labels, etc. dependent on sensoraxis
if (sa %in% c('T1.P','T2.P','T3.P')) {
xl = 'Rel. posterior position (normalized)'
yl = 'F2 man. (normalized)'
tmp$F.norm = tmp$F2.man.norm # F2 corresponds with posterior position
} else {
xl = 'Rel. height (normalized)'
yl = 'F1 man. (normalized)'
tmp$F.norm = tmp$F1.man.norm # F1 corresponds with height
}
# obtain regression line
reg1 <- lm(tmp$F.norm ~ tmp$RelPos.norm)
# scatterplot of position and F1 valuess
plot(tmp$RelPos.norm, tmp$F.norm, xlab=xl, ylab=yl,
main=paste('Dialect words:',substr(sa,1,2)), col='grey', cex.lab=2,
cex.main=2,cex.lab=1.5,xlim=c(-1,1),ylim=c(-5,5))
abline(reg1,lty=2)
}
8.2.2 CVC: rel. to rest.
sensoraxis = c('T1.H','T2.H','T3.H','T1.P','T2.P','T3.P')
par(mfrow=c(2,3))
for (sa in sensoraxis) {
# select sensor and axis
tmp = cvc[cvc$SensorAxis==sa,]
# labels, etc. dependent on sensoraxis
if (sa %in% c('T1.P','T2.P','T3.P')) {
xl = 'Rel. posterior position (normalized)'
yl = 'F2 man. (normalized)'
tmp$F.norm = tmp$F2.man.norm # F2 corresponds with posterior position
} else {
xl = 'Rel. height (normalized)'
yl = 'F1 man. (normalized)'
tmp$F.norm = tmp$F1.man.norm # F1 corresponds with height
}
# obtain regression line
reg1 <- lm(tmp$F.norm ~ tmp$RelPos.norm)
# scatterplot of position and F1 valuess
plot(tmp$RelPos.norm, tmp$F.norm, xlab=xl, ylab=yl,
main=paste('CVC sequences:',substr(sa,1,2)), col='grey', cex.lab=2,
cex.main=2,cex.lab=1.5,xlim=c(-1,1),ylim=c(-5,5))
abline(reg1,lty=2)
}
8.2.3 Dia.: norm. pos.
sensoraxis = c('T1.H','T2.H','T3.H','T1.P','T2.P','T3.P')
par(mfrow=c(2,3))
for (sa in sensoraxis) {
# select sensor and axis
tmp = dia[dia$SensorAxis==sa,]
# labels, etc. dependent on sensoraxis
if (sa %in% c('T1.P','T2.P','T3.P')) {
xl = 'Posterior position (normalized)'
yl = 'F2 man. (normalized)'
tmp$F.norm = tmp$F2.man.norm # F2 corresponds with posterior position
} else {
xl = 'Height (normalized)'
yl = 'F1 man. (normalized)'
tmp$F.norm = tmp$F1.man.norm # F1 corresponds with height
}
# obtain regression line
reg1 <- lm(tmp$F.norm ~ tmp$Position.norm)
# scatterplot of position and F1 valuess
plot(tmp$Position.norm, tmp$F.norm, xlab=xl, ylab=yl,
main=paste('Dialect words:',substr(sa,1,2)), col='gray', cex.lab=2,
cex.main=2,cex.lab=1.5,xlim=c(0,1),ylim=c(-5,5))
abline(reg1,lty=2)
}
8.2.4 CVC: norm. pos.
sensoraxis = c('T1.H','T2.H','T3.H','T1.P','T2.P','T3.P')
par(mfrow=c(2,3))
for (sa in sensoraxis) {
# select sensor and axis
tmp = cvc[cvc$SensorAxis==sa,]
# labels, etc. dependent on sensoraxis
if (sa %in% c('T1.P','T2.P','T3.P')) {
xl = 'Posterior position (normalized)'
yl = 'F2 man. (normalized)'
tmp$F.norm = tmp$F2.man.norm # F2 corresponds with posterior position
} else {
xl = 'Height (normalized)'
yl = 'F1 man. (normalized)'
tmp$F.norm = tmp$F1.man.norm # F1 corresponds with height
}
# obtain regression line
reg1 <- lm(tmp$F.norm ~ tmp$Position.norm)
# scatterplot of position and F1 valuess
plot(tmp$Position.norm, tmp$F.norm, xlab=xl, ylab=yl,
main=paste('CVC sequences:',substr(sa,1,2)), col='grey', cex.lab=2,
cex.main=2,cex.lab=1.5,xlim=c(0,1),ylim=c(-5,5))
abline(reg1,lty=2)
}
8.3 Group differences
A total of 2 x 3 models are shown. The first assesses if the F1 differs between the two groups, the second if the relative height (with respect to the resting position) differs between the two groups, and the third if the normalized height differs between the two groups. The other three models assess the same for F2 and posterior position. As the manual formant measurements appear to be better than the automatic formant measurements, we report only the first.
8.3.1 Height
# select formants (not separated per axis and sensor)
formants = unique(dat[,c("Speaker","Group","Type","Word","WordNr","Segment",
"SegmentNr","Time.normWord","F1.norm","F2.norm",
"F1.man.norm","F2.man.norm")])
# compare to Ubbergen: set as reference level
formants$Group = relevel(formants$Group,'Ubbergen')
# no signficant differences between Ter Apel vs. Ubbergen for height (all |t|'s < 2)
f1 = summary(lmer(F1.man.norm ~ Type + Group:Type + (1+Type|Speaker) + (1+Group*Type|Segment) +
(1+Group|Word), data=formants))
f1$call## lmer(formula = F1.man.norm ~ Type + Group:Type + (1 + Type |
## Speaker) + (1 + Group * Type | Segment) + (1 + Group | Word),
## data = formants)f1$coef## Estimate Std. Error t value
## (Intercept) -0.044270104 0.09274240 -0.4773448
## TypeStandard 0.066849917 0.08435913 0.7924443
## TypeDialect:GroupTerApel -0.009081118 0.08006338 -0.1134241
## TypeStandard:GroupTerApel 0.187323261 0.10273139 1.8234277datWithF1man = dat[dat$Axis=='H' & !is.na(dat$F1.man.norm),]
datWithF1man$Group = relevel(datWithF1man$Group,'Ubbergen')
# sensor height (only vowels, all three sensors) - RelPos.norm - all non-significant
hgtr = summary(lmer(RelPos.norm ~ Type + Group:Type + (1+Type|Speaker) + (1+Group*Type|Segment) +
(1+Group|Word), data=datWithF1man))
hgtr$call## lmer(formula = RelPos.norm ~ Type + Group:Type + (1 + Type |
## Speaker) + (1 + Group * Type | Segment) + (1 + Group | Word),
## data = datWithF1man)hgtr$coef## Estimate Std. Error t value
## (Intercept) -0.263688689 0.03684044 -7.15758751
## TypeStandard -0.011371768 0.04224563 -0.26918215
## TypeDialect:GroupTerApel -0.004463798 0.05044855 -0.08848219
## TypeStandard:GroupTerApel 0.054791888 0.05598286 0.97872613# sensor height (only vowels, all three sensors) - Position.norm - all non-significant
hgt = summary(lmer(Position.norm ~ RestPosition.norm + Type + Group:Type + (1+Type|Speaker) +
(1+Group*Type|Segment) + (1+Group|Word), data=datWithF1man))
hgt$call## lmer(formula = Position.norm ~ RestPosition.norm + Type + Group:Type +
## (1 + Type | Speaker) + (1 + Group * Type | Segment) + (1 +
## Group | Word), data = datWithF1man)hgt$coef## Estimate Std. Error t value
## (Intercept) -0.204881591 0.029763712 -6.8836033
## RestPosition.norm 1.005950335 0.002706759 371.6438476
## TypeStandard -0.008421790 0.031351615 -0.2686238
## TypeDialect:GroupTerApel -0.004983199 0.041216985 -0.1209016
## TypeStandard:GroupTerApel 0.043560773 0.044619703 0.97626778.3.2 Posterior position
# Mixed model shows higher F2 in Ter Apel for CVC words (all |t|'s < 2)
f2 = summary(lmer(F2.man.norm ~ Type + Group:Type + (1+Type|Speaker) + (1+Group*Type|Segment) +
(1+Group|Word), data=formants))
f2$call## lmer(formula = F2.man.norm ~ Type + Group:Type + (1 + Type |
## Speaker) + (1 + Group * Type | Segment) + (1 + Group | Word),
## data = formants)f2$coef## Estimate Std. Error t value
## (Intercept) -0.15677282 0.11882722 -1.3193342
## TypeStandard 0.20663516 0.10175513 2.0307101
## TypeDialect:GroupTerApel -0.11008159 0.07516263 -1.4645787
## TypeStandard:GroupTerApel 0.04066193 0.11618967 0.3499616datWithF2man = dat[dat$Axis=='P' & !is.na(dat$F2.man.norm),]
datWithF2man$Group = relevel(datWithF2man$Group,'Ubbergen')
# sensor posterior position (only vowels, all three sensors) - RelPos.norm
# Higher posterior position for Ter Apel for CVC sequences
pptr = summary(lmer(RelPos.norm ~ Type + Group:Type + (1+Type|Speaker) + (1+Group*Type|Segment) +
(1+Group|Word), data=datWithF2man))
pptr$call## lmer(formula = RelPos.norm ~ Type + Group:Type + (1 + Type |
## Speaker) + (1 + Group * Type | Segment) + (1 + Group | Word),
## data = datWithF2man)pptr$coef## Estimate Std. Error t value
## (Intercept) 0.20889910 0.04610375 4.5310649
## TypeStandard -0.07269806 0.02991260 -2.4303486
## TypeDialect:GroupTerApel 0.05824367 0.05929770 0.9822249
## TypeStandard:GroupTerApel 0.10227196 0.04920654 2.0784220# sensor posterior position (only vowels, all three sensors) - Position.norm
# Higher posterior position for Ter Apel for CVC sequences +
# CVC seqeunces are pronounced more anterior than dialect in Ubbergen
ppt = summary(lmer(Position.norm ~ RestPosition.norm + Type + Group:Type + (1+Type|Speaker) +
(1+Group*Type|Segment) + (1+Group|Word), data=datWithF2man))
ppt$call## lmer(formula = Position.norm ~ RestPosition.norm + Type + Group:Type +
## (1 + Type | Speaker) + (1 + Group * Type | Segment) + (1 +
## Group | Word), data = datWithF2man)ppt$coef## Estimate Std. Error t value
## (Intercept) 0.14114902 0.0240281925 5.8743088
## RestPosition.norm 0.92381916 0.0009264154 997.1975908
## TypeStandard -0.04055203 0.0154591696 -2.6231698
## TypeDialect:GroupTerApel 0.02669065 0.0301379302 0.8856165
## TypeStandard:GroupTerApel 0.05273219 0.0256783877 2.05356309 Replication
To replicate the analysis presented above, you can just copy the following lines to the most recent version of R. Please note that you first need to install Pandoc. Warning: when replicating this analysis, several data sets and fitted models will need to be downloaded, amounting to about 100 GB!
download.file('http://www.let.rug.nl/wieling/DiaArt/analysis.Rmd', 'analysis.Rmd')
library(rmarkdown)
render('analysis.Rmd') # generates html file with results
browseURL(paste('file://', file.path(getwd(),'analysis.html'), sep='')) # shows result