/nt, nd/
Jonathan Harrington
- 1 Preliminaries
- 1.1 Figures
- 1.2 keep only monosyllables
- 1.3 Create a segment identifier
- 1.4 Change speaker id to a factor
- 1.5 remove S41
- 1.6 Identify nasality and change vowel labels
- 1.7 give orthographic labels
- 1.8 Read in kinematic markers for nasalisation
- 1.9 Read in kinematic markers for tongue tip
- 1.10 Acoustic times
- 1.11 data-frame of tongue tip data
- 2 Themes
- 3 Intra-gestural velum analysis
- 4 Inter-gestural analysis of tongue tip and velum
- 5 Nasalization relative to the acoustic VN boundary
- 6 Intra-gestural tongue tip analysis
- 6.1 Method
- 6.2 Two sets of boxplots for the four parameters
- 6.3 Comparison of /nd, nt/ on peak tongue tip displacement (1)
- 6.4 Comparison of /nd, nt/ on peak tongue tip velocity raising (param 2)
- 6.5 Comparison of /nd, nt/ on tongue tip articulatory duration (param 3)
- 6.6 Comparison of /nd, nt/ on duration between TT-maxvel-on and TT peak displacement (param 4)
- 7 Compensatory lengthening
- 8 Schematic outlines
- 9 Figure in responses to reviewers
Load libraries and data:
# for time_in_sequence() function
library(tidyverse)
library(gridExtra)
library(emuR)
library(lmerTest)
library(emmeans)
library(glmmTMB)
library(bbmle)
#Rda Files
pfad = "/Users/cunha/Documents/projects/MRI_E/language/files"
#emu_DB
pfademu = "/Users/cunha/Documents/projects/MRI_E/DB/version_oct2024"
# directory for saving figures
pfadfigs = "/Users/cunha/Documents/projects/MRI_E/language/figs"
pfadfigs2 = pfadfigs
load(file = file.path(pfad,
"erc_mrinasals_concatsigs_prenasalraising_v4_rsnonan_prevowelVokalCodapostcoda_A_tdn__IEAVe__i_pbfszS_01.Rda"))1 Preliminaries
1.1 Figures
- Fig 2. fig2schematic.pdf
- Fig 3. fig3_nt.pdf
- Fig. 4. fig4ntb.pdf
- Fig. 5. fig5nt.pdf
- Fig. 6. fig.asynch.paper.pdf
- Fig. 7. t_align2.pdf
- Fig. 8. tt_vel_box.pdf
- Fig. 9. fig1paperntrev.pdf
- Fig. 10. fig2nt.pdf
- Fig. 11. fig.ttipaper.pdf
- Fig. 12. figttdisplvel.pdf
- Fig. 13. figttduration.pdf
- Fig. 14. durplot.pdf
These figures are created in nt_prob5_rev.Rmd
- Fig. 15. figalignprob.pdf
- Fig. 16. peryin1.pdf
- Fig. 17. SPL1.pdf
- Fig. 18. tmin.pdf
- Fig. 19. peryinfig.pdf
- Fig. 20. figscheme_new.pdf
- Fig. 21. model_paper.pdf
1.2 keep only monosyllables
1.3 Create a segment identifier
This is just speaker and trial number pasted together
1.4 Change speaker id to a factor
1.5 remove S41
1.6 Identify nasality and change vowel labels
dt.df = df_erc_prenasalraising %>%
mutate(Nasality =
case_when(substring(coda, 1, 1) %in% c("m", "n", "N") ~ "n",
TRUE ~ "o")) %>%
# change 'vowel labels
mutate(vowel = case_when(vowel == "{" ~ "æ",
vowel == "E" ~ "É›",
vowel == "V" ~ "ʌ",
vowel == "I" ~ "ɪ",
vowel == "ei" ~ "eɪ")) %>%
# change the factor order for vowels
mutate(vowel = factor(vowel,
levels =
c("æ", "eɪ", "ʌ", "ɛ", "ɪ")))
table(dt.df$Nasality)##
## n o
## 908730 433292##
## æ eɪ ʌ ɛ ɪ
## 269077 296357 241698 269259 2656311.7 give orthographic labels
# read in word table
words = read.table(file.path(pfad, "codeprosortho_list_corx.txt"))
# strip off final two characters in dt.df$labs
n = nchar(as.character(dt.df$labs))
w = substring(dt.df$labs, 1, n-2)
# match this to the first column of words
m = match(w, words[,1])
# check there are no NAs
any(is.na(m))## [1] FALSE# these are the word labels
wfin = words[m,2]
# bind them in to dt.df
dt.df$orth = factor(wfin)
# divide USE speakers in 3 and 4 regions
table(dt.df$speaker)##
## S1 S10 S11 S12 S13 S14 S15 S16 S17 S18 S2 S20 S21
## 30485 28163 32042 32141 32352 32606 27953 31057 29020 24808 25976 29359 30360
## S22 S23 S24 S25 S26 S27 S28 S29 S3 S30 S31 S32 S33
## 25289 31369 34138 34949 29749 29057 31930 34998 32023 31691 29339 33287 35759
## S34 S35 S36 S37 S38 S39 S4 S40 S42 S43 S44 S45 S5
## 33123 30108 29331 31562 38701 35238 30090 33978 26019 33552 30053 29453 36590
## S6 S7 S8 S9
## 34046 27841 30282 32155# 3 US regions - US_northeast, US_south, US_west
dt.df= dt.df %>%
mutate(region3 = recode (speaker, "S1" = "BR", "S10" = "BR","S11" = "BR","S12" = "BR","S13" = "BR",
"S14" = "US_northeast","S15" = "BR","S16" = "BR","S17" = "BR","S18" = "BR",
"S2" = "US_south","S20"="BR", "S21" = "BR","S22" = "BR","S23" = "BR","S24" = "US_northeast",
"S25" = "US_west", "S26" = "BR", "S27" = "US_west", "S28" = "US_south","S29" = "BR",
"S3" = "US_south","S30" = "US_northeast","S31" = "US_northeast","S32" = "BR","S33" = "BR",
"S34" = "US_northeast","S35" = "US_northeast",
"S36" = "BR","S37" = "BR","S38" = "BR","S39" = "BR","S4" = "US_west","S5" = "US_west",
"S6" = "US_northeast","S7" = "US_west", "S8" = "BR","S9" = "BR",
"S40" = "BR", "S42" = "US_west","S43" = "BR", "S44" = "BR","S45" = "BR"))
# split US_northeast (7/16 speakers)
# in US_Atlantic and Midland to obtain roughtly the same amount of speakers per group
dt.df= dt.df %>%
mutate(region4 = recode (speaker, "S1" = "BR", "S10" = "BR","S11" = "BR","S12" = "BR","S13" = "BR",
"S14" = "US_Atlantic","S15" = "BR","S16" = "BR","S17" = "BR","S18" = "BR",
"S2" = "US_south","S20"="BR", "S21" = "BR","S22" = "BR","S23" = "BR","S24" = "US_midland",
"S25" = "US_west", "S26" = "BR", "S27" = "US_west", "S28" = "US_south","S29" = "BR",
"S3" = "US_south","S30" = "US_Atlantic","S31" = "US_midland","S32" = "BR","S33" = "BR",
"S34" = "US_Atlantic","S35" = "US_midland",
"S36" = "BR","S37" = "BR","S38" = "BR","S39" = "BR","S4" = "US_west","S5" = "US_west",
"S6" = "US_midland","S7" = "US_west", "S8" = "BR","S9" = "BR",
"S40" = "BR", "S42" = "US_west","S43" = "BR", "S44" = "BR","S45" = "BR"))
table(dt.df$region3)##
## BR US_northeast US_south US_west
## 842496 225051 89929 184546##
## BR US_Atlantic US_south US_midland US_west
## 842496 97420 89929 127631 1845461.8 Read in kinematic markers for nasalisation
load(file.path(pfad,
"erc_mrinasals_allsubjects_artaku_allsegandsig_table_v2_rsnonan_addlang_addtt_sig.Rda"))
dim(df_erc_prenasalraising)## [1] 12415 174# code for segment identification, as before
# code for segment identification, as before
df_erc_prenasalraising = df_erc_prenasalraising %>%
mutate(rowind = paste(speaker, trialnumber, sep="."))
df_erc = df_erc_prenasalraising %>%
select(velumopening_gesture_on,
velumopening_gesture_off,
velumopening_maxvel_on,
velumopening_maxvel_off,
velumopening_maxcon_on,
velumopening_nucleus_on,
velumopening_nucleus_off,
velumopening_nucleus_dur,
velum2USV_velumopening_maxvel_onset,
velum2USV_velumopening_maxvel_offset,
velum2US_velumopening_maxcon_onset,
velum2US_velumopening_nucleus_midpoint,
velum2US_velumopening_gesture_onset,
Vokal_on,
rowind
)
# join to dt.df
dt.df = left_join(dt.df, df_erc,
by = "rowind")
rm(df_erc, df_erc_prenasalraising)
# obtain time series offset
timeseriesoffset = dt.df %>%
group_by (rowind) %>%
filter(segment == "Vokal") %>%
slice_head(n = 1) %>%
select(time_in_sequence, rowind) %>%
rename(timeseriesoffset = time_in_sequence) %>%
ungroup()
# join to dt.df
dt.df = left_join(dt.df, timeseriesoffset, by = "rowind")
# obtain lineuptime and subtract
dt.df = dt.df %>%
mutate(
lineuptime = Vokal_on - timeseriesoffset,
velumopening_gesture_on =
velumopening_gesture_on - lineuptime,
velumopening_gesture_off =
velumopening_gesture_off - lineuptime,
velumopening_maxvel_on =
velumopening_maxvel_on - lineuptime,
velumopening_maxvel_off =
velumopening_maxvel_off - lineuptime,
velumopening_maxcon_on =
velumopening_maxcon_on - lineuptime,
velumopening_nucleus_on =
velumopening_nucleus_on - lineuptime,
velumopening_nucleus_off =
velumopening_nucleus_off - lineuptime)1.9 Read in kinematic markers for tongue tip
load(file.path(pfad,
"erc_mrinasals_allsubjects_artaku_allsegandsig_table_v2_rsnonan_addlang_addtt_sig.Rda"))
dim(df_erc_prenasalraising)## [1] 12415 174# code for segment identification, as before
df_erc_prenasalraising = df_erc_prenasalraising %>%
mutate(rowind = paste(speaker, trialnumber, sep="."))
# code for segment identification, as before
df_erc_prenasalraising = df_erc_prenasalraising %>%
mutate(rowind = paste(speaker, trialnumber, sep="."))
df_erc = df_erc_prenasalraising %>%
select(alveolarconstriction_maxcon_on,
alveolarconstriction_nucleus_on,
alveolarconstriction_nucleus_off,
alveolarconstriction_maxvel_on,
alveolarconstriction_maxvel_off,
alveolarconstriction_nucleus_dur,
alveolarconstriction_maxvel_dur,
# displacements
alvUS_alveolarconstriction_maxvel_onset,
alvUS_alveolarconstriction_maxvel_offset,
alvUS_alveolarconstriction_maxcon_onset,
alvUS_alveolarconstriction_nucleus_onset,
alvUS_alveolarconstriction_nucleus_offset,
# position at gesture onset
alvUS_alveolarconstriction_gesture_onset,
# position at vowel minimum
alvUS_Vokal_min,
# velocities
alvUSV_alveolarconstriction_maxvel_onset,
alvUSV_alveolarconstriction_maxvel_offset,
Vokal_on,
rowind)
# left join to dt.df
dt.df = left_join(dt.df, df_erc,
by = "rowind")
rm(df_erc, df_erc_prenasalraising)
# subtract lineuptime
dt.df = dt.df %>%
mutate(alveolarconstriction_maxcon_on =
alveolarconstriction_maxcon_on - lineuptime,
alveolarconstriction_nucleus_off =
alveolarconstriction_nucleus_off - lineuptime,
alveolarconstriction_nucleus_on =
alveolarconstriction_nucleus_on - lineuptime,
alveolarconstriction_maxvel_on =
alveolarconstriction_maxvel_on - lineuptime,
alveolarconstriction_maxvel_off =
alveolarconstriction_maxvel_off - lineuptime) 1.10 Acoustic times
times.df = dt.df %>%
group_by(rowind) %>%
filter(segment == "Vokal") %>%
slice_tail(n=1) %>%
mutate(endv_time = time_in_sequence,
midv_time = (endv_time+timeseriesoffset)/2) %>%
select(rowind, midv_time, endv_time) %>%
ungroup()
# now join this to dt.df
dt.df = left_join(dt.df, times.df,
by = "rowind")(Amended 21.06.2024). This is to include a marker for the beginning of acoustic vowel periodicity that is included in the data-frame periodicV.df.txt, derived as follows:
autobuild_linkFromTimes(phys_db, superlevelName = "Wort", sublevelName = "Vokal") summary(phys_db)
autobuild_linkFromTimes(phys_db, superlevelName = "Wort", sublevelName = "vowelfor") add_linkDefinition(phys_db, "ONE_TO_MANY", "Wort", "vowelfor")
## INFO: Checking if cache needs update for 44 sessions and 13577 bundles ...
## INFO: Performing precheck and calculating checksums (== MD5 sums) for _annot.json files ...
## INFO: Nothing to update!## serve(phys_db, useViewer=F)
## The following functions were carried out
## in order to link tiers:
##autobuild_linkFromTimes(phys_db,
## superlevelName = "Wort",
## sublevelName = "Vokal")
##autobuild_linkFromTimes(phys_db,
## superlevelName = "Wort",
## sublevelName = "vowelfor")
##add_linkDefinition(phys_db, "ONE_TO_MANY",
## "Wort", "vowelfor")
## All segments of Vokal tier
vok.s = query(phys_db, "Vokal =~.*")
## as above without empty "" labels
vok.s = vok.s[vok.s$labels!="",]
## All segments from vowelfor tier
v.s = query(phys_db, "vowelfor =~.*")
## as above without empty "" labels
v.s = v.s[v.s$labels!="",]
## Test matching bundles
all(vok.s$bundle == v.s$bundle)## [1] TRUE## get speaker-id
speaker = substring(v.s$bundle, 20, 22)
speaker = substring(speaker, 2, nchar(speaker))
speaker = as.numeric(speaker)
## get Trial-id
trial = as.numeric(substring(v.s$bundle,
nchar(v.s$bundle)-3,
nchar(v.s$bundle)))
##paste speaker.id and trial.id together
## to turn it into a character(!). This is needed
## so that a character vector is stored and then
## a character vector is read back in
id = paste("T",
paste(as.character(speaker),
as.character(trial), sep="."), sep=".")
## build the data frame
#df = data.frame(Vstart = vok.s$start/1000,
# Vend = vok.s$end/1000,
# V2start = v.s$start/1000,
# V2end = v.s$end/1000,
# rowind = id)
## write out the data-frame
#write.table(df, file = file.path(pfad, "periodicV.df.txt"), quote=F)df has 4 columns that were obtained with the Emu script from the database ercnasals_audio_emuDB containing acoustic segmentations right at the end of this document. The four columns in periodicV.df.txt are:
Vstart: start of the vowel as defined in the database tierVokalVend: end fo the vowel as defined in the database tierVokalVstart2: acoustic onset of periodicity of the vowel extracted from the database tiervowelforVend2: end fo the vowel as defined in the database tiervowelfor=Vstart
df = read.table(file.path(pfad, "periodicV.df.txt"))
# make rowind match with that of dt.df
df$rowind = as.character(substring(df$rowind, 3,
nchar(df$rowind)))
# join to dt.df
dt.df = left_join(dt.df, df, by="rowind")Verify that Vend - Vstart is the same as endv_time - timeseriesoffset. They are except for a 2 ms difference on average (i.e. a rounding error).
# dt.df %>%
# mutate(v1 = Vend - Vstart,
# v2 = endv_time - timeseriesoffset,
#d = v1 - v2) %>%
# summarise(mean(d), sd(d))Now define the onset of periodicity in relation to timeseriesoffset. To do this, subtract Vstart from V2start then add that to timeseriesoffset
dt.df = dt.df %>%
# this is the duration from the start of the vowel to the the beginning of periodicity
mutate(d = V2start - Vstart,
# add this duration to `timeseriesoffset` which is also the start of the vowel but on a different time scale
Vperiodiconset = timeseriesoffset + d)Verify for any segment that Vperiodiconset corresponds to the start of the vowel in the vowelfor tier. This is done for segment 1.51 which is a production of ‘pant’. This says that the duration from the start of the vowel to the onset of periodicity is 0.1065625 s.
#speaker.i = 1
#trial.i = 51
#i = paste(speaker.i, trial.i, sep=".")
#dt.df %>%
# filter(rowind %in% i) %>%
# mutate(d = Vperiodiconset - timeseriesoffset) %>%
# pull(d) %>% unique()Get the corresponding bundle from the Emu database. This matches the above time exactly.
Add an additional column, Vowelonset2 which has the same start times as timeseriesoffset for /p, b/ initial words, otherwise Vperiodiconset
dt.df = dt.df %>%
mutate(Vowelonset2 =
ifelse(onset %in% c("p", "b"),
timeseriesoffset, Vperiodiconset))Are there any non-values in the times of velum gesture? Yes, 10 of them:
gaps = dt.df %>%
filter(coda %in% c("n", "nd", "nz")) %>%
filter(segment == "Vokal") %>%
group_by(rowind) %>%
slice_tail(n=1) %>%
filter(is.na(velumopening_maxcon_on) |
is.na(velumopening_maxvel_off) |
is.na(velumopening_maxvel_on)) %>%
pull(rowind)
gaps## [1] "14.259" "29.22" "3.299" "30.261" "34.131" "38.147" "38.216" "38.257"
## [9] "39.136" "40.49"Add CV variable
1.11 data-frame of tongue tip data
tt.rowind = dt.df %>%
filter(Nasality == "n") %>%
filter(segment == "Vokal") %>%
group_by(rowind) %>%
slice_tail(n=1) %>%
ungroup() %>%
# choose ones that have values for the kinematic events
filter(!is.na(alveolarconstriction_nucleus_on)) %>%
filter(!is.na(alveolarconstriction_nucleus_off)) %>%
pull(rowind)
tt.df = dt.df %>%
filter(rowind %in% tt.rowind)
# number of segments: 1337
tt.df %>% pull(rowind) %>% n_distinct()## [1] 1439tt.df$orth = factor(tt.df$orth)
tt.df$onset = factor(tt.df$onset)
tt.df$vowel= factor(tt.df$vowel)
tt.df$coda = factor(tt.df$coda)tt.df %>%
filter(coda %in% c("nt", "nd")) %>%
filter(segment == "Vokal") %>%
group_by(rowind) %>%
slice_tail(n=1) %>%
# remove 2 NA
filter(!(is.na(velum2USV_velumopening_maxvel_offset))) %>%
rename(Dialect = language) %>% nrow()## [1] 701#write.table(dt.df, file.path(pfad,
# "dtphysnt.df.txt"),
# quote=F)
#write.table(tt.df, file.path(pfad,
# "ttphysnt.df.txt"),
# quote=F)A count of the data
dt.df %>%
filter(coda %in% c("d", "t", "nt", "nd")) %>%
filter(segment == "Vokal") %>%
group_by(rowind) %>%
slice_tail(n=1) %>%
ungroup() %>%
group_by(coda, language) %>%
summarise(count = n()) %>%
ungroup() %>%
pivot_wider(names_from=coda, values_from=count) %>%
relocate(language, nt, nd, t, d)## `summarise()` has grouped output by 'coda'. You can override using the
## `.groups` argument.## # A tibble: 2 × 5
## language nt nd t d
## <chr> <int> <int> <int> <int>
## 1 BRE 269 456 452 376
## 2 USE 159 272 278 2272 Themes
theme_michigan1 <-
function(n = 24){
theme(
axis.text = element_text(size=n),
axis.title.x = element_text(size=n),
axis.title.y = element_text(size=n),
text = element_text(size=n))
}
theme_phon =
function(atextx = 18, atexty = 18, atitlex=
18, atitley = 18, ptitle=24, strip.text.x = 24,
lpos = "bottom", othertext=24, ltitle =24){
# e.g. atexty = element_blank()
theme(
axis.text.x = element_text(size=atextx),
axis.title.x = element_text(size=atitley),
axis.text.y = element_text(size=atexty),
axis.title.y = element_text(size=atitley),
plot.title = element_text(size = ptitle),
legend.position=lpos,
legend.title = ltitle,
strip.text.x =element_text(size=strip.text.x),
text = element_text(size=othertext))
}
theme_michigan2 <-
function(n = 24){
theme(
axis.text.x = element_blank(),
axis.title.x = element_blank(),
legend.title = element_blank(),
axis.text.y = element_text(size=24),
plot.title = element_text(size = 32),
legend.position="top",
text = element_text(size=n))
}
theme_michigan2epaper <-
function(n = 32, k = 28, position="bottom"){
theme(
axis.text.x = element_text(size=k),
axis.title.x = element_text(size=k),
axis.text.y = element_text(size=k),
axis.title.y = element_text(size=k),
strip.text.x = element_text(size = n),
legend.title = element_text(size = n),
legend.position=position,
text = element_text(size=n))
}
theme_michigan2x <-
function(n = 24){
theme(
text = element_text(size=n),
axis.text.x = element_blank(),
axis.title.x = element_blank(),
legend.title = element_blank(),
axis.text.y = element_text(size=20),
axis.title.y = element_text(size=n),
plot.title = element_text(size = 28),
legend.position = "none")
}
theme_michigan2dpaper <-
function(n = 24, k = 18){
theme(
axis.text.x = element_text(size=k),
axis.title.x = element_text(size=k),
axis.text.y = element_text(size=k),
axis.title.y = element_text(size=k),
plot.title = element_text(size = n),
legend.position="bottom",
text = element_text(size=n))
}
theme_michigan2apaper <-
function(n = 24, legend.pos="none", k = 18){
theme(
axis.text.x = element_blank(),
axis.title.x = element_blank(),
axis.text.y = element_text(size=k),
axis.title.y = element_text(size=k),
plot.title = element_text(size = n),
legend.position=legend.pos,
text = element_text(size=n))
}
theme_michigan2fpaper <-
function(n = 24, k = 18){
theme(
axis.text.x = element_blank(),
axis.title.x = element_blank(),
axis.text.y = element_text(size=k),
axis.title.y = element_text(size=k),
plot.title = element_text(size = n))
}
theme_michigan2gpaper <-
function(n = 24, k = 18){
theme(
axis.text.x = element_text(size=k),
axis.title.x = element_text(size=k),
axis.text.y = element_text(size=k),
axis.title.y = element_text(size=k),
plot.title = element_text(size = n))
}
theme_michigan3 <-
function(n = 24){
theme(
legend.position = "none",
axis.text.y = element_text(size=20),
axis.title.y = element_text(size=n),
plot.title = element_text(size = 28),
text = element_text(size=n))
}
theme_michigan5 =
function(n = 18, m = 32, i = 20){
theme(
axis.text = element_text(size=n),
axis.title = element_text(size=i),
plot.title = element_text(size = m),
legend.position="top",
text = element_text(size=n))
}
theme_michigan8 <-
function(n = 48){
theme(
strip.text.x = element_text(size = 40),
legend.title = element_text(size=40),
legend.text = element_text(size=40),
axis.title.x = element_text(size=36),
axis.title.y = element_text(size=44),
axis.text.x = element_text(size=32),
axis.text.y = element_text(size=32),
legend.position="top",
text = element_text(size=n))
}
theme_michigan9 <-
function(n = 36){
theme(
axis.title.x = element_text(size=n),
axis.title.y = element_text(size=n),
axis.text.x = element_text(size=26),
axis.text.y = element_text(size=26),
legend.position="top",
text = element_text(size=n))
}
theme_michigan10 <-
function(n = 36){
theme(
axis.text = element_text(size=n),
axis.title.x = element_text(size=n),
axis.title.y = element_text(size=n),
legend.position="top",
text = element_text(size=n))
}
theme_michigan10t =
function(n = 36){
theme(
axis.text = element_text(size=n),
axis.title.x = element_text(size=n),
axis.title.y = element_text(size=n),
legend.position="top",
legend.title = element_blank(),
text = element_text(size=n))
}
theme_michigan11t =
function(n = 32, k = 28, position="bottom"){
theme(
axis.text.x = element_text(size=k),
axis.title.x = element_text(size=n),
axis.text.y = element_text(size=k),
axis.title.y = element_text(size=n),
strip.text.x = element_text(size = n),
legend.position=position,
legend.title = element_blank(),
text = element_text(size=n))
}
theme_michigan2hpaper =
function(n = 32, k = 28, position="bottom"){
theme(
axis.text = element_blank(),
axis.title = element_text(size=k),
legend.title = element_text(size = n),
legend.position=position,
text = element_text(size=n))
}
theme_michigan2xpaper =
function(n = 32, k = 28, position="bottom"){
theme(
axis.text = element_blank(),
axis.title = element_text(size=k),
legend.position="none",
text = element_text(size=n))
}write out dt.df
3 Intra-gestural velum analysis
3.1 Method
j = "24.63"
# get some kinematic parameters
maxcon = dt.df %>%
filter(rowind == j) %>%
pull(velumopening_maxcon_on) %>%
unique()
velon = dt.df %>%
filter(rowind == j) %>%
pull(velumopening_maxvel_on) %>%
unique()
veloff = dt.df %>%
filter(rowind == j) %>%
pull(velumopening_maxvel_off) %>%
unique()
# times of plateau of peak displacement
nucleuson = dt.df %>%
filter(rowind == j) %>%
pull(velumopening_nucleus_on) %>%
unique()
nucleusoff = dt.df %>%
filter(rowind == j) %>%
pull(velumopening_nucleus_off) %>%
unique()
# average over plateau
plateau = dt.df %>%
filter(rowind == j) %>%
filter(time_in_sequence >= velumopening_nucleus_on) %>%
filter(time_in_sequence <= velumopening_nucleus_off) %>%
summarise(displ = mean(velum2US)) %>%
pull(displ)
# the peak displacement value
pkdisp = dt.df %>%
filter(rowind == j) %>%
pull(velum2US) %>% max()
# get the peak velocity value
pkvel = dt.df %>%
filter(rowind == j) %>%
mutate(velocity = 500.5 * c(stats::filter(velum2US, c(.5, 0, -.5)))) %>%
pull(velocity) %>% max(na.rm=T)
# get the peak velocity minimum
pkvel.raise = dt.df %>%
filter(rowind == j) %>%
mutate(velocity = 500.5 * c(stats::filter(velum2US, c(.5, 0, -.5)))) %>%
pull(velocity) %>% min(na.rm=T)
# readjust slightly for plotting purposes
pkvel.raise = -7.6
j = "24.63"
d1paper = dt.df %>%
filter(rowind == j) %>%
ggplot +
aes(y = velum2US, x = time_in_sequence) +
geom_line(linewidth=1.5) +
#geom_segment(aes(y = velum2US, x = time_in_sequence),
# x = maxcon, y = plateau,
# xend = 0, yend = plateau, lty=2,
# arrow=arrow(ends="last", type="closed")) +
geom_segment(aes(y = velum2US, x = time_in_sequence),
x = (nucleuson+nucleusoff)/2, y = plateau,
xend = (nucleuson+nucleusoff)/2, yend = 0, lwd=1.5,
arrow=arrow(ends="both", type="closed")) +
ylab("Displacement") +
geom_vline(xintercept = c(nucleuson, nucleusoff),
lty=2, linewidth=1.5) +
theme_michigan2apaper(k = 24) +
scale_colour_manual(values = cols)
v1paper = dt.df %>%
filter(rowind == j) %>%
mutate(velocity = 500.5 * c(stats::filter(velum2US, c(.5, 0, -.5)))) %>%
ggplot +
aes(y = velocity, x = time_in_sequence) +
geom_line(linewidth=1.5) +
geom_vline(
xintercept = c(velon, veloff),
lty=2, linewidth=1.5) +
geom_segment(aes(y = velocity, x = time_in_sequence),
x = velon, y = pkvel,
xend = velon, yend = 0, lwd=1.5,
arrow=arrow(ends="first", type="closed")) +
geom_segment(aes(y = velocity, x = time_in_sequence),
x = veloff, y = pkvel.raise,
xend = veloff, yend = 0, lwd=1.5,
arrow=arrow(ends="first", type="closed")) +
geom_hline(yintercept = 0) +
geom_segment(aes(y = velum2US, x = time_in_sequence),
x = velon, y = 0,
xend = veloff, yend = 0, lty=2,
arrow=arrow(ends="both", type="closed")) +
ylab("Velocity (units/s)") +
xlab("Time (s)") +
theme_michigan2dpaper(k = 24) +
scale_colour_manual(values = cols)
# we need this to align the x-axis of the two
# plots. Without it, v1paper is right shifted
# because of the extra space taken up
# by the y-axis tick-mark-labels
gA <- ggplotGrob(d1paper)
gB <- ggplotGrob(v1paper)## Warning: Removed 2 rows containing missing values or values outside the scale range
## (`geom_line()`).
## TableGrob (1 x 1) "arrange": 1 grobs
## z cells name grob
## 1 1 (1-1,1-1) arrange gtable[layout]ggsave(filename = file.path(pfadfigs, "fig3_nt.png"),
plot = fig3_nt,
width = 25,
height = 20,
units = "cm")## Aligned at acoustic vowel onset (all vowels)
z = dt.df %>%
mutate(Vowelonset2 =
ifelse(onset %in% c("p", "b"),
timeseriesoffset, Vperiodiconset))
v.df = dt.df %>%
filter(coda %in% c("nd", "nt")) %>%
mutate(reltime =
plyr::round_any(1000 *
(time_in_sequence -
velumopening_maxcon_on), 5),
coda = factor(coda))
aconset.t = v.df %>%
rename(Dialect = language) %>%
filter(coda %in% c("nt", "nd")) %>%
filter(segment == "Vokal") %>%
group_by(rowind) %>%
slice_tail(n=1) %>%
mutate(intval2 = endv_time - velumopening_maxcon_on,
intval1 = Vowelonset2 -
velumopening_maxcon_on) %>%
group_by(vowel, coda, Dialect) %>%
summarise(m2 = mean(intval2, na.rm=T) * 1000,
m1 = mean(intval1, na.rm=T) * 1000) %>% ungroup()## `summarise()` has grouped output by 'vowel', 'coda'. You can override using the
## `.groups` argument.# Aligned at peak velum lowering
v.df = dt.df %>%
filter(coda %in% c("nd", "nt")) %>%
mutate(reltime =
plyr::round_any(1000 *
(time_in_sequence -
velumopening_maxcon_on), 5),
coda = factor(coda))
aconset.t = v.df %>%
rename(Dialect = language) %>%
filter(coda %in% c("nt", "nd")) %>%
filter(segment == "Vokal") %>%
group_by(rowind) %>%
slice_tail(n=1) %>%
mutate(intval2 = endv_time - velumopening_maxcon_on,
intval1 = Vowelonset2 -
velumopening_maxcon_on) %>%
group_by(vowel, coda, Dialect) %>%
summarise(m2 = mean(intval2, na.rm=T) * 1000,
m1 = mean(intval1, na.rm=T) * 1000) %>% ungroup()## `summarise()` has grouped output by 'vowel', 'coda'. You can override using the
## `.groups` argument.n =48; k = 32; i = 28
lwd = 1.5
fig4ntb = v.df %>%
group_by(language, coda, vowel, reltime) %>%
summarise(velum = mean(velum2US)) %>%
ungroup() %>%
rename(Dialect = language) %>%
ggplot +
aes(y = velum, x = reltime, col = coda,
group = interaction(Dialect, coda, vowel)) +
geom_line(linewidth=lwd) +
scale_x_continuous("Time (ms)", breaks = c(-200, 0, 100)) +
coord_cartesian(xlim =c(-300, 150)) +
ylab("Velum displacement") +
facet_wrap(Dialect ~ vowel, ncol=5) +
theme_phon(lpos="top",
atextx=i,
atexty=k,
atitlex=k,
atitley=k,
strip.text.x = k,
ptitle=n,
ltitle=element_blank(),
othertext=n) +
geom_vline(xintercept=0, lty=2, linewidth=lwd) +
geom_vline(data = aconset.t,
aes(xintercept=m2, col = coda),
lty=3,linewidth=lwd) +
geom_vline(data = aconset.t,
aes(xintercept=m1, col = coda),
lty=1,linewidth=.75) +
scale_colour_manual(values = cols.coda) ## `summarise()` has grouped output by 'language', 'coda', 'vowel'. You can
## override using the `.groups` argument.
3.2 Displacement
Displacement is averaged over the plateau velum movement
displ.df = dt.df %>%
filter(!is.na(velum2US_velumopening_gesture_onset)) %>%
mutate(velum2US =
velum2US - velum2US_velumopening_gesture_onset) %>%
filter(coda %in% c("nt", "nd")) %>%
filter(time_in_sequence >= velumopening_nucleus_on) %>%
filter(time_in_sequence <= velumopening_nucleus_off) %>%
group_by(rowind, language,
coda, CV, speaker) %>%
summarise(displ = mean(velum2US)) %>%
rename(Dialect = language) %>%
ungroup() ## `summarise()` has grouped output by 'rowind', 'language', 'coda', 'CV'. You can
## override using the `.groups` argument.## Backward reduced random-effect table:
##
## Eliminated npar logLik AIC LRT Df Pr(>Chisq)
## <none> 11 1066.3 -2110.6
## Dialect in (Dialect | CV) 0 9 1059.1 -2100.3 14.345 2 0.0007674
## coda in (coda | speaker) 0 9 1038.4 -2058.7 55.880 2 7.341e-13
##
## <none>
## Dialect in (Dialect | CV) ***
## coda in (coda | speaker) ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Backward reduced fixed-effect table:
## Degrees of freedom method: Satterthwaite
##
## Eliminated Sum Sq Mean Sq NumDF DenDF F value Pr(>F)
## coda:Dialect 1 0.01365 0.01365 1 42.477 1.8706 0.1786
## Dialect 2 0.00225 0.00225 1 43.226 0.3080 0.5818
## coda 0 0.31900 0.31900 1 50.756 43.6915 2.295e-08 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Model found:
## displ ~ coda + (Dialect | CV) + (coda | speaker)The model found was displ ~ coda + (Dialect | CV) + (coda | speaker). Further simplification of RF so that it converges
## Type III Analysis of Variance Table with Satterthwaite's method
## Sum Sq Mean Sq NumDF DenDF F value Pr(>F)
## coda 0.319 0.319 1 50.756 43.691 2.295e-08 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Estimated marginal means
## coda emmean SE df lower.CL upper.CL
## nd 0.703 0.0161 54.1 0.671 0.736
## nt 0.632 0.0182 54.2 0.595 0.668
##
## Degrees-of-freedom method: kenward-roger
## Confidence level used: 0.953.3 peak velocity of velum lowering and raising
3.3.1 figure
Calculate velocity from displacement signal for plotting purposes only.
dt.df = dt.df %>%
group_by(rowind) %>%
# mutliplied by the sample rate
mutate(velum2USV = 500.5 *
c(stats::filter(velum2US, c(.5, 0, -.5)))) %>%
ungroup()Aggregate plot of velum velocity
n =48; k = 32; i = 28
lwd = 1.5
fig5nt = dt.df %>%
filter(coda %in% c("nd", "nt")) %>%
mutate(reltime =
plyr::round_any(1000 *
(time_in_sequence -
velumopening_maxcon_on), 5),
coda = factor(coda)) %>%
group_by(language, coda, vowel, reltime) %>%
summarise(velum = mean(velum2USV, na.rm=T)) %>%
ungroup() %>%
rename(Dialect = language) %>%
ggplot +
aes(y = velum, x = reltime, col = coda,
group = interaction(Dialect, coda, vowel)) +
geom_line(linewidth=lwd) +
scale_x_continuous("Time (ms)", breaks = c(-100, 0, 100)) +
coord_cartesian(xlim =c(-200, 200)) +
ylab("Velocity") +
facet_wrap(Dialect ~ vowel, ncol=5) +
theme_phon(lpos="top",
atextx=i,
atexty=k,
atitlex=k,
atitley=k,
strip.text.x = k,
ptitle=n,
ltitle=element_blank(),
othertext=n) +
scale_colour_manual(values = cols.coda) ## `summarise()` has grouped output by 'language', 'coda', 'vowel'. You can
## override using the `.groups` argument.## Warning: Removed 15 rows containing missing values or values outside the scale range
## (`geom_line()`).
ggsave(filename = file.path(pfadfigs2, "fig5nt.pdf"),
plot = fig5nt,
device=cairo_pdf,
width = 45,
height = 30,
units = "cm")## Warning: Removed 15 rows containing missing values or values outside the scale range
## (`geom_line()`).3.3.2 statistics
3.3.2.1 lowering
pklower.df = dt.df %>%
filter(coda %in% c("nt", "nd")) %>%
filter(segment == "Vokal") %>%
group_by(rowind) %>%
slice_tail(n=1) %>%
# remove 2 NA
filter(!(is.na(velum2USV_velumopening_maxvel_onset))) %>%
rename(Dialect = language)
pklower.df %>%
lmer(velum2USV_velumopening_maxvel_onset ~
coda * Dialect +
(Dialect|CV) +
( coda | speaker), .) %>%
step()## boundary (singular) fit: see help('isSingular')## Warning: Model failed to converge with 1 negative eigenvalue: -5.2e+00## boundary (singular) fit: see help('isSingular')
## boundary (singular) fit: see help('isSingular')
## boundary (singular) fit: see help('isSingular')
## boundary (singular) fit: see help('isSingular')
## boundary (singular) fit: see help('isSingular')## Backward reduced random-effect table:
##
## Eliminated npar logLik AIC LRT Df Pr(>Chisq)
## <none> 11 -1750.8 3523.6
## coda in (coda | speaker) 1 9 -1750.9 3519.8 0.12 2 0.94156
## Dialect in (Dialect | CV) 0 7 -1754.9 3523.8 8.07 2 0.01767
## (1 | speaker) 0 8 -2076.8 4169.5 651.76 1 < 2e-16
##
## <none>
## coda in (coda | speaker)
## Dialect in (Dialect | CV) *
## (1 | speaker) ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Backward reduced fixed-effect table:
## Degrees of freedom method: Satterthwaite
##
## Eliminated Sum Sq Mean Sq NumDF DenDF F value Pr(>F)
## coda:Dialect 1 1.236 1.236 1 971.54 1.2054 0.2725
## Dialect 2 0.136 0.136 1 42.37 0.1327 0.7174
## coda 0 39.638 39.638 1 916.63 38.6606 7.652e-10 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Model found:
## velum2USV_velumopening_maxvel_onset ~ coda + (Dialect | CV) + (1 | speaker)# model found
pklower.df %>%
lmer(velum2USV_velumopening_maxvel_onset ~ coda + (1 | CV) + (1 | speaker), .) %>%
anova()## Type III Analysis of Variance Table with Satterthwaite's method
## Sum Sq Mean Sq NumDF DenDF F value Pr(>F)
## coda 38.447 38.447 1 991.8 37.166 1.552e-09 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# EMM
pklower.df %>%
lmer(velum2USV_velumopening_maxvel_onset ~ coda + (1 | CV) + (1 | speaker), .) %>%
emmeans(., ~coda)## coda emmean SE df lower.CL upper.CL
## nd 6.17 0.187 58.7 5.80 6.55
## nt 6.63 0.193 65.1 6.25 7.02
##
## Degrees-of-freedom method: kenward-roger
## Confidence level used: 0.95Get the means for coda and vowel. For coda: /nd/ = 6.17; /nt/ = 6.63.
3.3.2.2 raising
pkraise.df = dt.df %>%
filter(coda %in% c("nt", "nd")) %>%
filter(segment == "Vokal") %>%
group_by(rowind) %>%
slice_tail(n=1) %>%
# remove 2 NA
filter(!(is.na(velum2USV_velumopening_maxvel_offset))) %>%
rename(Dialect = language)Model found: velum2USV_velumopening_maxvel_offset ~ (Dialect | CV) + (coda | speaker)
pkraise.df %>%
lmer(velum2USV_velumopening_maxvel_offset ~
coda * Dialect +
(Dialect|CV) +
( coda | speaker), .) %>%
step()## boundary (singular) fit: see help('isSingular')
## boundary (singular) fit: see help('isSingular')
## boundary (singular) fit: see help('isSingular')
## boundary (singular) fit: see help('isSingular')
## boundary (singular) fit: see help('isSingular')## Backward reduced random-effect table:
##
## Eliminated npar logLik AIC LRT Df Pr(>Chisq)
## <none> 11 -1766.8 3555.7
## Dialect in (Dialect | CV) 0 9 -1770.7 3559.4 7.684 2 0.02145
## coda in (coda | speaker) 0 9 -1830.3 3678.7 126.959 2 < 2e-16
##
## <none>
## Dialect in (Dialect | CV) *
## coda in (coda | speaker) ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Backward reduced fixed-effect table:
## Degrees of freedom method: Satterthwaite
##
## Eliminated Sum Sq Mean Sq NumDF DenDF F value Pr(>F)
## coda:Dialect 1 0.23738 0.23738 1 41.437 0.2355 0.6300
## Dialect 2 0.46707 0.46707 1 42.581 0.4634 0.4997
## coda 3 2.07891 2.07891 1 43.625 2.0624 0.1581
##
## Model found:
## velum2USV_velumopening_maxvel_offset ~ (Dialect | CV) + (coda | speaker)3.4 articulatory duration
artdur.df = dt.df %>%
group_by(rowind) %>%
slice_head(n = 1) %>%
ungroup() %>%
filter(coda %in% c("nt", "nd")) %>%
mutate(art_time =
velumopening_maxvel_off -
velumopening_maxvel_on
) %>%
rename(Dialect = language)
artdur.df %>%
lmer(art_time ~ coda * Dialect +
(Dialect|CV) +
(coda|speaker), .) %>%
step()## boundary (singular) fit: see help('isSingular')## Backward reduced random-effect table:
##
## Eliminated npar logLik AIC LRT Df Pr(>Chisq)
## <none> 11 1773.0 -3524.1
## Dialect in (Dialect | CV) 0 9 1769.4 -3520.8 7.333 2 0.02557
## coda in (coda | speaker) 0 9 1697.8 -3377.6 150.455 2 < 2e-16
##
## <none>
## Dialect in (Dialect | CV) *
## coda in (coda | speaker) ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Backward reduced fixed-effect table:
## Degrees of freedom method: Satterthwaite
##
## Eliminated Sum Sq Mean Sq NumDF DenDF F value Pr(>F)
## coda:Dialect 1 0.000005 0.000005 1 41.044 0.0026 0.9597
## Dialect 2 0.000092 0.000092 1 42.526 0.0442 0.8344
## coda 0 0.159901 0.159901 1 47.929 76.6920 1.638e-11 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Model found:
## art_time ~ coda + (Dialect | CV) + (coda | speaker)# model found
artdur.df %>%
lmer(art_time ~ coda + (Dialect | CV)
+ (coda | speaker), .) %>%
anova()## Type III Analysis of Variance Table with Satterthwaite's method
## Sum Sq Mean Sq NumDF DenDF F value Pr(>F)
## coda 0.1599 0.1599 1 47.929 76.692 1.638e-11 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# EMM
artdur.df %>%
lmer(art_time ~ coda + (Dialect | CV)
+ (coda | speaker), .) %>%
emmeans(., ~coda)## coda emmean SE df lower.CL upper.CL
## nd 0.260 0.01010 53.7 0.239 0.280
## nt 0.192 0.00991 53.8 0.172 0.212
##
## Degrees-of-freedom method: kenward-roger
## Confidence level used: 0.954 Inter-gestural analysis of tongue tip and velum
4.1 method (fig.asynch.paper.png)
Word is band, BRE speaker.
j = "1.239"
# velum kinematic parameters
maxcon.vel = tt.df %>%
filter(rowind == j) %>%
pull(velumopening_maxcon_on) %>%
unique()
velon.vel = tt.df %>%
filter(rowind == j) %>%
pull(velumopening_maxvel_on) %>%
unique()
veloff.vel = tt.df %>%
filter(rowind == j) %>%
pull(velumopening_maxvel_off) %>%
unique()
plateau.on.tt = tt.df %>%
filter(rowind == j) %>%
pull(alveolarconstriction_nucleus_on) %>%
unique()
plateau.off.tt = tt.df %>%
filter(rowind == j) %>%
pull(alveolarconstriction_nucleus_off) %>%
unique()
ttmax.t = (plateau.on.tt + plateau.off.tt)/2
# TT raising pk velocity max
velon.tt = tt.df %>%
filter(rowind == j) %>%
pull(alveolarconstriction_maxvel_on) %>%
unique()
# set the time scale to be the same for
# TT and velum
xlim.trade = tt.df %>%
filter(rowind == j) %>%
pull(time_in_sequence) %>%
range()n = 54; k = 40
yendline = 1
velum_asynch_paper = tt.df %>%
filter(rowind == j) %>%
filter(time_in_sequence >= timeseriesoffset) %>%
filter(time_in_sequence <= velumopening_maxvel_off) %>%
ggplot +
aes(y = velum2US, x = time_in_sequence) +
geom_line(linewidth = lwd) +
coord_cartesian(xlim = c(0.1, veloff.vel), ylim = c(0.18, 1.12)) +
scale_y_continuous("Displacement", breaks = c(.4, .6, .8)) +
ggtitle("Velum") +
geom_segment(aes(y = velum2US, x = time_in_sequence),
x = maxcon.vel, y = .1,
xend = maxcon.vel, yend = yendline, lty=2, lwd=lwd, col="black") +
geom_segment(aes(y = velum2US, x = time_in_sequence),
x = velon.tt, y = .1,
xend = velon.tt, yend = yendline, lty=2, lwd=lwd, col="slategray") +
geom_segment(aes(y = velum2US, x = time_in_sequence),
x = ttmax.t, y = .1,
xend = ttmax.t, yend = yendline, lty=2, lwd=lwd, col="slategray") +
geom_segment(aes(y = velum2US, x = time_in_sequence),
x = velon.tt, y = .5,
xend = maxcon.vel, yend = .5, col="black",
arrow=arrow(ends="both", type="closed")) +
geom_segment(aes(y = velum2US, x = time_in_sequence),
x = ttmax.t, y = .3,
xend = maxcon.vel, yend = .3, col="black",
arrow=arrow(ends="both", type="closed")) +
annotate("text", x=mean(c(velon.tt, maxcon.vel)), y=0.57,
label="italic(i[1])",
parse=TRUE,
size=n/.pt) +
annotate("text", x=mean(c(maxcon.vel, ttmax.t)), y=0.37,
label="italic(i[2])",
parse=TRUE,
size=n/.pt) +
annotate("text", x=c(velon.tt, maxcon.vel, ttmax.t),
y = rep(1.09, 3),
label=c("italic(t[1])", "italic(t[2])", "italic(t[3])"),
parse=TRUE,
size=n/.pt) +
theme_michigan2fpaper(n= n, k = k)
# draw tongue tip with kinematic markers
tt_asynch_paper = tt.df %>%
filter(rowind == j) %>%
filter(time_in_sequence >= timeseriesoffset) %>%
filter(time_in_sequence <= velumopening_maxvel_off) %>%
ggplot +
aes(y = alvUS, x = time_in_sequence) +
geom_line(col="slategray", linewidth = lwd) +
coord_cartesian(xlim = c(0.1, veloff.vel)) +
geom_vline(xintercept = c(velon.tt, ttmax.t),
lty=2, linewidth = lwd,
col = c("slategray", "slategray")) +
xlab("Time (s)") +
ylab("Displacement") +
ggtitle("Tongue tip") +
theme_michigan2gpaper(n = n, k = k)
fig.asynch.paper =
grid.arrange(velum_asynch_paper,
tt_asynch_paper, nrow=2)
ggsave(filename = file.path(pfadfigs,
"fig.asynch.paper.pdf"),
plot = fig.asynch.paper,
device = cairo_pdf,
width = 45,
height = 30,
units = "cm")
fig.asynch.paper## TableGrob (2 x 1) "arrange": 2 grobs
## z cells name grob
## 1 1 (1-1,1-1) arrange gtable[layout]
## 2 2 (2-2,1-1) arrange gtable[layout]4.2 Aggregated plot
Parameters:
x2.df = tt.df %>%
filter(coda %in% c("nt", "nd")) %>%
mutate(
peakVE = (velumopening_nucleus_on +
velumopening_nucleus_off)/2,
peakTT = (alveolarconstriction_nucleus_on +
alveolarconstriction_nucleus_off)/2,
zerot = peakVE,
reltime =
plyr::round_any(1000 *
(time_in_sequence - zerot), 5),
coda = factor(coda))
tt2.maxr.t = x2.df %>%
rename(Dialect = language) %>%
group_by(vowel, coda, Dialect) %>%
summarise(m1 = mean(alveolarconstriction_maxvel_on -
zerot, na.rm=T) * 1000,
m2 = mean(peakTT -
zerot, na.rm=T) * 1000,
m3 = mean(endv_time -
zerot, na.rm=T) * 1000) %>%
ungroup()## `summarise()` has grouped output by 'vowel', 'coda'. You can override using the
## `.groups` argument.Plot:
t_align2 = x2.df %>%
group_by(language, coda, vowel, reltime) %>%
summarise(tt = mean(alvUS - alvUS_Vokal_min)) %>%
ungroup() %>%
rename(Dialect = language) %>%
ggplot +
aes(y = tt, x = reltime, col = coda,
group = interaction(Dialect, coda, vowel)) +
geom_line(linewidth=1.2) +
scale_x_continuous("Time (ms)", breaks = c(-100, 0, 100)) +
ylab("Tongue tip height") +
facet_wrap(Dialect ~ vowel, ncol=3) +
coord_cartesian(xlim = c(-150, 150)) +
geom_vline(xintercept=0, lty=2) +
theme_michigan2epaper(position="top") +
theme(legend.title = element_blank()) +
geom_vline(data = tt2.maxr.t,
aes(xintercept=m2, col = coda), lty=2,
linewidth=1.5) +
geom_vline(data = tt2.maxr.t, aes(xintercept=m1,
col = coda), lty=2,
linewidth=1.5) +
geom_vline(data = tt2.maxr.t,
aes(xintercept=m3, col = coda), lty=1,
linewidth=.5) +
# ggtitle("Tongue tip height",
# subtitle = "Aligned at peak velum opening") +
scale_colour_manual(values = cols.coda) ## `summarise()` has grouped output by 'language', 'coda', 'vowel'. You can
## override using the `.groups` argument.ggsave(filename = file.path(pfadfigs,
"t_align2.pdf"),
plot = t_align2,
device=cairo_pdf,
width = 40,
height = 30,
units = "cm")## Warning: Removed 1 row containing missing values or values outside the scale range
## (`geom_line()`).## Warning: Removed 1 row containing missing values or values outside the scale range
## (`geom_line()`).
Parameters i1, i2
z.df = tt.df %>%
filter(coda %in% c("nt", "nd")) %>%
filter(segment == "Vokal") %>%
group_by(rowind) %>%
slice_tail(n=1) %>%
rename(Dialect = language) %>%
mutate(
peakVE = (velumopening_nucleus_on +
velumopening_nucleus_off)/2,
peakTT = (alveolarconstriction_nucleus_on +
alveolarconstriction_nucleus_off)/2,
i1 = alveolarconstriction_maxvel_on - peakVE,
i2 = peakTT - peakVE,
i3 = endv_time - peakVE)Boxplots showing i1 and i2
lwd = 1.4
tt_vel_a = z.df %>%
mutate(i1 = i1 * 1000) %>%
ggplot +
aes(y = i1, col = coda, x = Dialect) +
geom_boxplot(lwd=lwd) +
facet_wrap(~ vowel, ncol = 3) +
theme_michigan2(n=26) +
scale_y_continuous(expression(italic(i[1])~ms),
breaks=c(-100, -50, 0)) +
theme(axis.text.y =
element_text(angle = 90, size=20,
vjust = 1, hjust=1)) +
xlab("") +
coord_cartesian(ylim = c(-175, 50)) +
scale_colour_manual(values = cols.coda)
tt_vel_b = z.df %>%
mutate(i2 = i2 * 1000) %>%
ggplot +
aes(y = i2, col = coda, x = Dialect) +
geom_boxplot(lwd=lwd) +
facet_wrap(~ vowel, ncol = 3) +
theme_michigan3(n=26) +
theme(axis.text.y =
element_text(angle = 90, vjust = 1, hjust=1)) +
scale_y_continuous(expression(italic(i[2])~ms),
breaks=c(0, 100, 200)) +
xlab("") +
coord_cartesian(ylim = c(-50, 200)) +
scale_colour_manual(values = cols.coda)
tt_vel_box =
grid.arrange(tt_vel_a, tt_vel_b, nrow=2)## Warning: Removed 8 rows containing non-finite outside the scale range
## (`stat_boxplot()`).## Warning: Removed 1 row containing non-finite outside the scale range
## (`stat_boxplot()`).
4.3 Statistical test on i1 and i2
i1:
- BRE > USE in BOTH /nt, nd/
- nd > nt for BRE only
z.df %>%
lmer(i1 ~
vowel * coda * Dialect +
(Dialect | onset) +
(vowel + coda| speaker), .) %>%
step()## boundary (singular) fit: see help('isSingular')## Warning: Model failed to converge with 1 negative eigenvalue: -4.7e+00## boundary (singular) fit: see help('isSingular')## Warning: Model failed to converge with 1 negative eigenvalue: -2.6e+00## boundary (singular) fit: see help('isSingular')## Backward reduced random-effect table:
##
## Eliminated npar logLik AIC LRT Df
## <none> 26 1414.6 -2777.3
## vowel in (vowel + coda | speaker) 1 19 1413.1 -2788.3 2.985 7
## Dialect in (Dialect | onset) 2 17 1411.5 -2789.1 3.199 2
## coda in (coda | speaker) 0 15 1393.6 -2757.1 35.955 2
## (1 | onset) 0 16 1398.8 -2765.7 25.418 1
## Pr(>Chisq)
## <none>
## vowel in (vowel + coda | speaker) 0.8864
## Dialect in (Dialect | onset) 0.2020
## coda in (coda | speaker) 1.558e-08 ***
## (1 | onset) 4.616e-07 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Backward reduced fixed-effect table:
## Degrees of freedom method: Satterthwaite
##
## Eliminated Sum Sq Mean Sq NumDF DenDF F value
## vowel:coda:Dialect 1 0.0002291 0.0001145 2 600.52 0.1612
## vowel:Dialect 2 0.0000512 0.0000256 2 600.46 0.0361
## vowel:coda 3 0.0001515 0.0000758 2 607.30 0.1072
## vowel 0 0.0188282 0.0094141 2 492.04 13.3660
## coda:Dialect 0 0.0038479 0.0038479 1 40.89 5.4632
## Pr(>F)
## vowel:coda:Dialect 0.8512
## vowel:Dialect 0.9645
## vowel:coda 0.8983
## vowel 2.225e-06 ***
## coda:Dialect 0.0244 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Model found:
## i1 ~ vowel + coda + Dialect + (coda | speaker) + (1 | onset) + coda:Dialect# model found
z.df %>%
lmer(i1 ~ coda + Dialect + (coda | speaker) +
(1 | CV) + coda:Dialect, .) %>%
anova()## Type III Analysis of Variance Table with Satterthwaite's method
## Sum Sq Mean Sq NumDF DenDF F value Pr(>F)
## coda 0.0295847 0.0295847 1 52.296 42.2563 3.025e-08 ***
## Dialect 0.0140797 0.0140797 1 41.050 20.1103 5.774e-05 ***
## coda:Dialect 0.0038448 0.0038448 1 40.904 5.4916 0.02405 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1z.df %>%
lmer(i1 ~ coda + Dialect + (coda | speaker) +
(1 | CV) + coda:Dialect, .) %>%
emmeans(., ~ Dialect|coda) %>%
pairs(., simple = "each", combine=T) %>%
as.data.frame() %>%
filter(p.value <= 0.05) %>%
as_tibble() %>%
mutate(p.value = round(p.value, 4))## # A tibble: 4 × 8
## coda Dialect contrast estimate SE df t.ratio p.value
## <chr> <chr> <chr> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 nd . BRE - USE -0.0367 0.00762 41.0 -4.81 0.0001
## 2 nt . BRE - USE -0.0189 0.00690 41.0 -2.74 0.0362
## 3 . BRE nd - nt -0.0352 0.00486 48.8 -7.23 0
## 4 . USE nd - nt -0.0174 0.00618 45.2 -2.81 0.0291i2:
- model found is
i2 ~ vowel + coda + (coda | speaker) - thus no dialect differences, only vowel and coda
- for coda, duration from velum peak to TT peak is greater for /nt/ than for /nd/.
## Backward reduced random-effect table:
##
## Eliminated npar logLik AIC LRT Df Pr(>Chisq)
## <none> 11 1341.3 -2660.6
## Dialect in (Dialect | CV) 1 9 1339.1 -2660.2 4.427 2 0.1093
## coda in (coda | speaker) 0 7 1312.3 -2610.5 53.667 2 2.220e-12
## (1 | CV) 0 8 1329.0 -2642.0 20.184 1 7.033e-06
##
## <none>
## Dialect in (Dialect | CV)
## coda in (coda | speaker) ***
## (1 | CV) ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Backward reduced fixed-effect table:
## Degrees of freedom method: Satterthwaite
##
## Eliminated Sum Sq Mean Sq NumDF DenDF F value Pr(>F)
## coda:Dialect 1 0.0007263 0.0007263 1 40.588 0.7535 0.3905
## Dialect 2 0.0003431 0.0003431 1 40.952 0.3560 0.5540
## coda 0 0.0195275 0.0195275 1 49.454 20.2600 4.122e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Model found:
## i2 ~ coda + (coda | speaker) + (1 | CV)## Type III Analysis of Variance Table with Satterthwaite's method
## Sum Sq Mean Sq NumDF DenDF F value Pr(>F)
## coda 0.019527 0.019527 1 49.454 20.26 4.122e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1## coda emmean SE df lower.CL upper.CL
## nd 0.0524 0.00484 45.2 0.0427 0.0622
## nt 0.0753 0.00538 50.0 0.0645 0.0861
##
## Degrees-of-freedom method: kenward-roger
## Confidence level used: 0.955 Nasalization relative to the acoustic VN boundary
5.1 Method
extract the acoustic waveform from the Emu database
temp = speaker == 24 & trial == 63
segment.s = vok.s[temp,]
segment.s = segment.s %>%
mutate(start = start -200,
end = end + 300)
segment.wav = get_trackdata(phys_db, segment.s, "MEDIAFILE_SAMPLES")##
## INFO: parsing 1 wav segments/events
## | | | 0% | |======================================================================| 100%# time of periodic onset of the vowel in Emudatabase: 0.7880938 * 1000
acvowelon.t =
df %>% filter(rowind == "24.63") %>% pull(V2start) * 1000
# Change time scale in segment.wav to make the periodic onset in the
# vowel have a time of zero ms
segment.wav = segment.wav %>%
mutate(times_orig =times_orig -acvowelon.t)Alignment of phys. data relative to the acoustic vowel onset
lwd = 1.5
j = "24.63"
j.df = dt.df %>%
mutate(
zerot = Vperiodiconset,
reltime =
plyr::round_any(1000 *
(time_in_sequence - zerot), 5)) %>%
filter(rowind == j)
j.df = dt.df %>%
mutate(
zerot = Vperiodiconset,
reltime = 1000 * (time_in_sequence - zerot)) %>%
filter(rowind == j)Some time markers
# acoustic vowel offset time
VNbound24.63 = j.df %>%
mutate(endv_time = 1000 * (endv_time - zerot)) %>%
pull(endv_time) %>% unique()
# time of peak velocity of velum lowering
pkvellower24.63 =
j.df %>%
mutate(velumopening_maxvel_on =
1000 * (velumopening_maxvel_on - zerot)) %>%
pull(velumopening_maxvel_on) %>% unique()
# time of velum lowering peak
pkvel24.63 =
j.df %>%
mutate(velumopening_maxcon_on =
1000 * (velumopening_maxcon_on - zerot)) %>%
pull(velumopening_maxcon_on) %>% unique()
# time of peak velocity of velum raising
pkvelraise24.63 =
j.df %>%
mutate(velumopening_maxvel_off =
1000 * (velumopening_maxvel_off - zerot)) %>%
pull(velumopening_maxvel_off) %>% unique()Set the scale on the x-axis
Data frames for drawing the areas
data1 = j.df %>%
filter(reltime >= VNbound24.63) %>%
filter(reltime <= pkvelraise24.63)
data2 = j.df %>%
filter(reltime <= VNbound24.63) %>%
filter(reltime >= pkvellower24.63)ystart = -.1; yend24.63 = .75; yend24.63text = yend24.63 + .02
textsize = 24
nasal_trajectory = j.df %>%
ggplot +
aes(y = velum2US - velum2US_velumopening_gesture_onset,
x = reltime) +
coord_cartesian(xlim = timeaxis, ylim = c(-.05, .77)) +
geom_line() +
xlab("Time (ms)") +
ylab("Size of velum lowering") +
geom_area(
aes(y = velum2US - velum2US_velumopening_gesture_onset,
x = reltime),
data = data1,
fill = 4,
alpha = 0.5,
color = 1,
lwd = 0.5,
linetype = 1) +
geom_area(
aes(y = velum2US -
velum2US_velumopening_gesture_onset, x = reltime),
data = data2,
fill = "orange",
alpha = 0.5,
color = 1,
lwd = 0.5,
linetype = 1) +
theme_michigan1(n = textsize) +
scale_colour_manual(values = cols) +
# acoustic vowel offset
geom_segment(aes(y = velum2US -
velum2US_velumopening_gesture_onset, x = reltime),
x = VNbound24.63, y = ystart, xend = VNbound24.63,
yend = yend24.63, lty=3, linewidth=lwd) +
annotate("text", x=VNbound24.63, y=yend24.63text,
label="italic(t[2])",
parse=TRUE,
size=textsize/.pt) +
# peak velum lowering
geom_segment(aes(y = velum2US -
velum2US_velumopening_gesture_onset, x = reltime),
x = pkvel24.63, y = ystart, xend = pkvel24.63,
yend = yend24.63, lty=2, linewidth=lwd) +
annotate("text", x=pkvel24.63, y=yend24.63text,
label="italic(t[3])",
parse=TRUE,
size=textsize/.pt) +
# pk vel velum lowering
geom_segment(aes(y = velum2US -
velum2US_velumopening_gesture_onset, x = reltime),
x = pkvellower24.63, y = ystart, xend = pkvellower24.63,
yend = yend24.63, lty=2, linewidth=lwd) +
annotate("text", x=pkvellower24.63, y=yend24.63text,
label="italic(t[1])",
parse=TRUE,
size=textsize/.pt) +
# pk vel velum raising
geom_segment(aes(y = velum2US -
velum2US_velumopening_gesture_onset, x = reltime),
x = pkvelraise24.63, y = ystart, xend = pkvelraise24.63,
yend = yend24.63, lty=2, linewidth=lwd) +
annotate("text", x=pkvelraise24.63, y=yend24.63text,
label="italic(t[4])",
parse=TRUE,
size=textsize/.pt) +
# acoustic vowel onset
geom_segment(aes(y = velum2US -
velum2US_velumopening_gesture_onset, x = reltime),
x = 0, y = ystart, xend = 0,
yend = yend24.63, lty=3, linewidth=lwd) +
annotate("text", x=0, y=yend24.63text,
label="italic(t[0])",
parse=TRUE,
size=textsize/.pt)
waveform = segment.wav %>%
ggplot +
aes(y = T1, x = times_orig) +
geom_line() +
coord_cartesian(xlim = timeaxis, ylim=c(-12000, 12000)) +
theme(
axis.text = element_blank(),
axis.title = element_blank(),
legend.title = element_blank(),
legend.position = "none") +
# acoustic vowel onset and offset
geom_vline(xintercept = c(0, VNbound24.63), lty=3, linewidth=lwd)
gA <- ggplotGrob(nasal_trajectory)
gB <- ggplotGrob(waveform)
grid::grid.newpage()
fig1paperntrev = grid.arrange(rbind(gA, gB))
## TableGrob (1 x 1) "arrange": 1 grobs
## z cells name grob
## 1 1 (1-1,1-1) arrange gtable[layout]ggsave(filename = file.path(pfadfigs2, "fig1paperntrev.pdf"),
plot = fig1paperntrev,
device=cairo_pdf,
width = 30,
height = 20,
units = "cm")Sum of nasalisation in coda
propc.df = dt.df %>%
mutate(velum2US =
velum2US - velum2US_velumopening_gesture_onset) %>%
filter(coda %in% c("nd", "nt")) %>%
filter(time_in_sequence >= endv_time) %>%
filter(time_in_sequence <= velumopening_maxvel_off) %>%
#filter(time_in_sequence <= velumopening_nucleus_off) %>%
group_by(rowind, vowel, coda, language, CV, speaker) %>%
summarise(cprop = sum(velum2US)) %>%
ungroup()## `summarise()` has grouped output by 'rowind', 'vowel', 'coda', 'language',
## 'CV'. You can override using the `.groups` argument.Sum of nasalisation between points of maximum velocity.
nasdur.df = dt.df %>%
mutate(velum2US =
velum2US - velum2US_velumopening_gesture_onset) %>%
filter(coda %in% c("nd", "nt")) %>%
filter(time_in_sequence >= velumopening_maxvel_on) %>%
# filter(time_in_sequence >= timeseriesoffset) %>%
filter(time_in_sequence <= velumopening_maxvel_off) %>%
#filter(time_in_sequence <= velumopening_nucleus_off) %>%
group_by(rowind) %>%
summarise(nasalprop = sum(velum2US)) %>%
ungroup()Ratio
5.2 Results
5.2.1 Plot
lwd = 1.4
fig2ant = dt.df %>%
rename(Dialect = language) %>%
filter(coda %in% c("nd", "nt")) %>%
filter(segment == "Vokal") %>%
group_by(rowind) %>%
slice_tail(n=1) %>%
mutate(vn2.num =
velumopening_maxcon_on - Vperiodiconset,
vn2.den = endv_time - Vperiodiconset,
vn2 = vn2.num/vn2.den) %>%
ggplot +
aes(y = log(vn2), col = coda, x = Dialect) +
geom_boxplot(lwd=lwd) +
facet_wrap(~ vowel, ncol = 5) +
theme_michigan2(n=26) +
theme(axis.text.y =
element_text(angle = 90, vjust = 1, hjust=1)) +
scale_y_continuous("Proportional offset", breaks=c(-0.5, 0, 0.5)) +
xlab("") +
# ggtitle("Proportional alignment of peak velum lowering") +
coord_cartesian(ylim = c(-1,1.0)) +
geom_hline(yintercept=0, lty=2) +
scale_colour_manual(values = cols.coda)
fig2bnt = propcnas.df %>%
filter(ratio <1) %>%
rename(Dialect = language) %>%
ggplot +
aes(y = ratio, x = Dialect, col=coda) +
geom_boxplot(lwd=lwd) +
geom_hline(yintercept=0.5, lty=2) +
facet_wrap(~ vowel, ncol = 5) +
ylab("Ratio") +
xlab("") +
theme_michigan3(n = 26) +
theme(axis.text.y =
element_text(angle = 90, vjust = 1, hjust=1)) +
scale_colour_manual(values = cols.coda)
fig2nt =
grid.arrange(fig2ant, fig2bnt, nrow=2)
5.2.2 Statistics row 1 (tprop)
dt.df %>%
filter(coda %in% c("nd", "nt")) %>%
filter(segment == "Vokal") %>%
group_by(rowind) %>%
slice_tail(n=1) %>%
rename(Dialect = language) %>%
mutate(vn2.num =
(velumopening_nucleus_on +
velumopening_nucleus_off)/2 - Vperiodiconset,
vn2.den = endv_time - Vperiodiconset,
vn2 = vn2.num/vn2.den) %>%
lmer(log(vn2) ~ Dialect * coda +
(coda | speaker) + (Dialect | CV), .) %>% step()## Backward reduced random-effect table:
##
## Eliminated npar logLik AIC LRT Df Pr(>Chisq)
## <none> 11 320.83 -619.66
## coda in (coda | speaker) 0 9 303.41 -588.82 34.842 2 2.717e-08
## Dialect in (Dialect | CV) 0 9 313.64 -609.29 14.377 2 0.0007554
##
## <none>
## coda in (coda | speaker) ***
## Dialect in (Dialect | CV) ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Backward reduced fixed-effect table:
## Degrees of freedom method: Satterthwaite
##
## Eliminated Sum Sq Mean Sq NumDF DenDF F value Pr(>F)
## Dialect:coda 1 0.02759 0.02759 1 45.977 1.0413 0.3129
## coda 2 0.00290 0.00290 1 58.227 0.1094 0.7420
## Dialect 0 1.22567 1.22567 1 47.563 46.2538 1.549e-08 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Model found:
## log(vn2) ~ Dialect + (coda | speaker) + (Dialect | CV)# model found
dt.df %>%
filter(coda %in% c("nd", "nt")) %>%
filter(segment == "Vokal") %>%
group_by(rowind) %>%
slice_tail(n=1) %>%
rename(Dialect = language) %>%
mutate(vn2.num =
(velumopening_nucleus_on +
velumopening_nucleus_off)/2 - Vperiodiconset,
vn2.den = endv_time - Vperiodiconset,
vn2 = vn2.num/vn2.den) %>%
lmer(log(vn2) ~ Dialect + (coda | speaker) +
(Dialect | CV), .) %>% anova()## Type III Analysis of Variance Table with Satterthwaite's method
## Sum Sq Mean Sq NumDF DenDF F value Pr(>F)
## Dialect 1.2257 1.2257 1 47.563 46.254 1.549e-08 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# EMMs
dt.df %>%
filter(coda %in% c("nd", "nt")) %>%
filter(segment == "Vokal") %>%
group_by(rowind) %>%
slice_tail(n=1) %>%
rename(Dialect = language) %>%
mutate(vn2.num =
(velumopening_nucleus_on +
velumopening_nucleus_off)/2 - Vperiodiconset,
vn2.den = endv_time - Vperiodiconset,
vn2 = vn2.num/vn2.den) %>%
lmer(log(vn2) ~ Dialect + (coda | speaker) +
(Dialect | CV), .) %>%
emmeans(., ~ Dialect)## Dialect emmean SE df lower.CL upper.CL
## BRE 0.3571 0.0582 23.6 0.2369 0.477
## USE 0.0978 0.0555 29.9 -0.0156 0.211
##
## Degrees-of-freedom method: kenward-roger
## Results are given on the log (not the response) scale.
## Confidence level used: 0.95Dialect sig., not coda
5.2.3 Statistics row 2
m1 =
glmmTMB(ratio ~ Dialect * coda +
(coda|speaker) +
(Dialect|CV),
family=beta_family(),
data = propcnas.df %>%
filter(ratio < 1) %>%
rename(Dialect = language))
summary(m1)## Family: beta ( logit )
## Formula: ratio ~ Dialect * coda + (coda | speaker) + (Dialect | CV)
## Data: propcnas.df %>% filter(ratio < 1) %>% rename(Dialect = language)
##
## AIC BIC logLik -2*log(L) df.resid
## -1574.4 -1519.5 798.2 -1596.4 1076
##
## Random effects:
##
## Conditional model:
## Groups Name Variance Std.Dev. Corr
## speaker (Intercept) 0.16297 0.40370
## codant 0.12888 0.35900 -0.34
## CV (Intercept) 0.61568 0.78465
## DialectUSE 0.00199 0.04461 -0.31
## Number of obs: 1087, groups: speaker, 43; CV, 19
##
## Dispersion parameter for beta family (): 14.6
##
## Conditional model:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 1.03336 0.19847 5.207 1.92e-07 ***
## DialectUSE -0.81357 0.13551 -6.004 1.93e-09 ***
## codant 0.10543 0.08797 1.198 0.231
## DialectUSE:codant -0.16790 0.13500 -1.244 0.214
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1## coda Dialect contrast odds.ratio SE df null z.ratio p.value
## nd . BRE / USE 2.26 0.3060 Inf 1 6.004 <.0001
## nt . BRE / USE 2.67 0.4020 Inf 1 6.509 <.0001
## . BRE nd / nt 0.90 0.0792 Inf 1 -1.198 0.9229
## . USE nd / nt 1.06 0.1150 Inf 1 0.576 1.0000
##
## P value adjustment: bonferroni method for 4 tests
## Tests are performed on the log odds ratio scale6 Intra-gestural tongue tip analysis
The object here is to determine whether the tongue tip gesture is more reduced in /nt/ than in /nd/.
6.1 Method
j = "1.239"
# TT displacement maximum
ttmax = tt.df %>%
filter(rowind == j) %>%
pull(alvUS) %>% max()
# Time of TT nucleus onset
ttnon.t = tt.df %>%
filter(rowind == j) %>%
pull(alveolarconstriction_nucleus_on) %>% max()
# Time of TT nucleus offset
ttnoff.t = tt.df %>%
filter(rowind == j) %>%
pull(alveolarconstriction_nucleus_off) %>% max()
# Time of TT displacement maximum
ttmax.t = tt.df %>%
filter(rowind == j) %>%
pull(alveolarconstriction_maxcon_on) %>% max()
# Time of TT raising pk velocity max
velon.tt = tt.df %>%
filter(rowind == j) %>%
pull(alveolarconstriction_maxvel_on) %>%
unique()
# TT raising pk velocity max
ttvel = tt.df %>%
filter(rowind == j) %>%
mutate(velocity =
500.5 *
c(stats::filter(alvUS, c(.5, 0, -.5)))) %>%
pull(velocity) %>% max(na.rm=T)
# time of TT lowering pk velocity max
veloff.tt = tt.df %>%
filter(rowind == j) %>%
pull(alveolarconstriction_maxvel_off) %>%
unique()
# Time of acoustic vowel offset
offset.vowel = tt.df %>%
filter(rowind == j) %>%
pull(endv_time) %>%
unique()
# Time of VELUM pk. velocity raising
offset.velum = tt.df %>%
filter(rowind == j) %>%
pull(velumopening_maxvel_off) %>%
unique()
xlim.tt = tt.df %>%
filter(rowind == j) %>%
pull(time_in_sequence) %>%
range()tt_dis_paper = tt.df %>%
filter(rowind == j) %>%
ggplot +
aes(y = alvUS, x = time_in_sequence) +
ylab("Displacement") +
geom_line(linewidth = lwd) +
geom_segment(aes(y = alvUS, x = time_in_sequence),
x = (ttnon.t+ttnoff.t)/2, y = 0, lwd=1,
xend = (ttnon.t+ttnoff.t)/2, yend = ttmax,
arrow=arrow(ends="last", type="closed")) +
geom_segment(aes(y = alvUS, x = time_in_sequence),
x = ttnon.t, y = 0, lwd=1, lty=2,
xend = ttnon.t, yend = .9) +
geom_segment(aes(y = alvUS, x = time_in_sequence),
x = ttnoff.t, y = 0, lwd=1, lty=2,
xend = ttnoff.t, yend = .9) +
annotate("text", x = .395, y = .79, label = "1", size=24/.pt) +
geom_vline(xintercept = velon.tt, col="slategray", lwd=1) +
geom_segment(aes(y = alvUS, x = time_in_sequence),
x = velon.tt, y = .3,
xend = (ttnon.t+ttnoff.t)/2, yend = .3,
col="black", lwd=1,
arrow=arrow(ends="both", type="closed")) +
annotate("text", x = .335, y = .35, label = "4", size=24/.pt) +
theme_michigan2apaper(k = 24) +
# geom_vline(xintercept = veloff.tt, col = "slategray", lwd=1) +
scale_colour_manual(values = cols)
tt_vel_paper = tt.df %>%
filter(rowind == j) %>%
mutate(velocity =
500.5 *
c(stats::filter(alvUS, c(.5, 0, -.5)))) %>%
ggplot +
aes(y = velocity, x = time_in_sequence) +
geom_line(linewidth = lwd, col="slategray") +
coord_cartesian(xlim = xlim.tt) +
geom_segment(aes(y = velocity, x = time_in_sequence),
x = velon.tt, y = 0,
xend = velon.tt, yend = .0076 * 500.5,
col = "slategray", lwd=1,
arrow=arrow(ends="last",
type="closed",length = unit(0.13, "inches"))) +
geom_hline(yintercept = 0, col = "slategray") +
geom_segment(aes(y = velocity, x = time_in_sequence),
x = veloff.tt, y = 0,
xend = veloff.tt,
yend = -.006 * 500.5, lwd=1,
col="slategray") +
annotate("text",
x = 0.22,
y = 0.005 * 500.5, label = "2", size=24/.pt, col="slategray") +
annotate("text",
x = 0.4,
y = 0.001 * 500.5, label = "3", size=24/.pt, col="slategray") +
geom_segment(aes(y = velocity, x = time_in_sequence),
x = velon.tt, y = 0,
xend = veloff.tt, yend = 0,
lwd=1, col="slategray",
arrow=arrow(ends="both", type="closed")) +
xlab("Time (s)") +
ylab("Velocity (units/s)") +
theme_michigan2dpaper(k = 24) +
scale_colour_manual(values = cols)
gA.tt <- ggplotGrob(tt_dis_paper)
gB.tt <- ggplotGrob(tt_vel_paper)## Warning: Removed 2 rows containing missing values or values outside the scale range
## (`geom_line()`).
6.2 Two sets of boxplots for the four parameters
6.2.1 Param 1 and 2
lwd = 1.4
ttdisplacement = tt.df %>%
rename(Dialect = language) %>%
# extract values in TT plateau
filter(time_in_sequence <= alveolarconstriction_nucleus_off) %>%
filter(time_in_sequence >= alveolarconstriction_nucleus_on) %>%
group_by(rowind, coda, Dialect, onset, vowel, speaker) %>%
# mean value of plateau
summarise(displ = mean(alvUS - alvUS_Vokal_min)) %>%
ungroup() %>%
filter(coda %in% c("nt", "nd")) %>%
ggplot +
aes(y = displ, x = Dialect, col=coda) +
geom_boxplot(lwd=lwd) +
facet_wrap(~ vowel, ncol = 3) +
scale_colour_manual(values = cols.coda) + scale_y_continuous("Displacement",
breaks = c(0, .5, 1)) +
# coord_cartesian(ylim = c(-3, .5)) +
theme_michigan2(n=26) +
theme(axis.title.y = element_text(size=26)) +
theme(axis.text.y = element_text(size=20)) +
theme(axis.text.y =
element_text(angle = 90, vjust = 1, hjust=1)) +
scale_colour_manual(values = cols.coda) ## `summarise()` has grouped output by 'rowind', 'coda', 'Dialect', 'onset',
## 'vowel'. You can override using the `.groups` argument.
## Scale for colour is already present. Adding another scale for colour, which
## will replace the existing scale.ttvelocity =
tt.df %>%
filter(coda %in% c("nt", "nd")) %>%
filter(segment == "Vokal") %>%
group_by(rowind) %>%
slice_tail(n=1) %>%
filter(!(is.na(alvUSV_alveolarconstriction_maxvel_onset))) %>%
rename(Dialect = language)%>%
ggplot +
aes(y = alvUSV_alveolarconstriction_maxvel_onset,
x = Dialect, col=coda) +
geom_boxplot(lwd=lwd) +
facet_wrap(~ vowel, ncol = 3) +
ylab("Velocity (units/s)") +
xlab("") +
# coord_cartesian(ylim = c(-3, .5)) +
theme_michigan3(n = 26) +
theme(axis.text.y =
element_text(angle = 90, vjust = 1, hjust=1)) +
scale_colour_manual(values = cols.coda)
gA <- ggplotGrob(ttdisplacement)
gB <- ggplotGrob(ttvelocity)
grid::grid.newpage()
figttdisplvel= grid.arrange(rbind(gA, gB))
6.2.2 Params 3 and 4
lwd = 1.4
ttartdur =
tt.df %>%
filter(coda %in% c("nt", "nd")) %>%
filter(segment == "Vokal") %>%
group_by(rowind) %>%
slice_tail(n=1) %>%
rename(Dialect = language)%>%
ggplot +
aes(y = alveolarconstriction_maxvel_dur,
x = Dialect, col=coda) +
geom_boxplot(lwd=lwd) +
facet_wrap(~ vowel, ncol = 3) +
# coord_cartesian(ylim = c(-3, .5)) +
theme_michigan2(n = 26) +
scale_y_continuous("Duration (s)", breaks = c(0.2, .4)) +
theme(axis.text.y =
element_text(angle = 90, vjust = 1, hjust=1)) +
scale_colour_manual(values = cols.coda)
ttraisingdur =
tt.df %>%
filter(coda %in% c("nt", "nd")) %>%
filter(segment == "Vokal") %>%
group_by(rowind) %>%
slice_tail(n=1) %>%
rename(Dialect = language)%>%
mutate(param =
(alveolarconstriction_nucleus_on + alveolarconstriction_nucleus_off)/2 -
alveolarconstriction_maxvel_on) %>%
ggplot +
aes(y = param,
x = Dialect, col=coda) +
geom_boxplot(lwd=lwd) +
facet_wrap(~ vowel, ncol = 3) +
ylab("Duration (s)") +
xlab("") +
# coord_cartesian(ylim = c(-3, .5)) +
theme_michigan3(n = 26) +
theme(axis.text.y =
element_text(angle = 90, vjust = 1, hjust=1)) +
scale_colour_manual(values = cols.coda)
#gA <- ggplotGrob(ttdisplacement)
#gB <- ggplotGrob(ttvelocity)
#grid::grid.newpage()
#figttdisplvel= grid.arrange(rbind(gA, gB))
figttduration =
grid.arrange(ttartdur, ttraisingdur, nrow=2)## Warning: Removed 7 rows containing non-finite outside the scale range
## (`stat_boxplot()`).
## Removed 7 rows containing non-finite outside the scale range
## (`stat_boxplot()`).
6.3 Comparison of /nd, nt/ on peak tongue tip displacement (1)
Displacment:
1 . nd BRE - USE 0.0788 0.0289 46.9 2.72 0.0363
displ.df = tt.df %>%
rename(Dialect = language) %>%
# extract values in TT plateau
filter(time_in_sequence <= alveolarconstriction_nucleus_off) %>%
filter(time_in_sequence >= alveolarconstriction_nucleus_on) %>%
group_by(rowind, coda, Dialect, CV, onset, vowel, speaker) %>%
# mean value of plateau
summarise(displ = mean(alvUS - alvUS_Vokal_min)) %>%
ungroup() %>%
filter(coda %in% c("nt", "nd")) ## `summarise()` has grouped output by 'rowind', 'coda', 'Dialect', 'CV', 'onset',
## 'vowel'. You can override using the `.groups` argument.## Backward reduced random-effect table:
##
## Eliminated npar logLik AIC LRT Df Pr(>Chisq)
## <none> 11 662.44 -1302.88
## coda in (coda | speaker) 1 9 660.16 -1302.33 4.55 2 0.10279
## Dialect in (Dialect | CV) 0 7 656.57 -1299.14 7.19 2 0.02751
## (1 | speaker) 0 8 470.14 -924.29 380.04 1 < 2e-16
##
## <none>
## coda in (coda | speaker)
## Dialect in (Dialect | CV) *
## (1 | speaker) ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Backward reduced fixed-effect table:
## Degrees of freedom method: Satterthwaite
##
## Eliminated Sum Sq Mean Sq NumDF DenDF F value Pr(>F)
## coda:Dialect 0 0.05005 0.05005 1 211 7.5995 0.00635 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Model found:
## displ ~ coda + Dialect + (Dialect | CV) + (1 | speaker) + coda:Dialect# model found
displ.df %>%
lmer(displ ~
coda + Dialect + (Dialect | CV) +
(1 | speaker) + coda:Dialect, .) %>%
anova()## Type III Analysis of Variance Table with Satterthwaite's method
## Sum Sq Mean Sq NumDF DenDF F value Pr(>F)
## coda 0.003298 0.003298 1 647.32 0.5008 0.47941
## Dialect 0.027889 0.027889 1 45.29 4.2346 0.04539 *
## coda:Dialect 0.050050 0.050050 1 211.00 7.5995 0.00635 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1displ.df %>%
lmer(displ ~
coda + Dialect + (Dialect | CV) +
(1 | speaker) + coda:Dialect, .) %>%
emmeans(., ~ coda|Dialect) %>%
pairs(., simple = "each", combine=T) %>%
as.data.frame() %>%
filter(p.value <= 0.05) %>%
as_tibble() %>%
mutate(p.value = round(p.value, 4))## # A tibble: 1 × 8
## Dialect coda contrast estimate SE df t.ratio p.value
## <chr> <chr> <chr> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 . nd BRE - USE 0.0788 0.0289 46.9 2.72 0.03636.4 Comparison of /nd, nt/ on peak tongue tip velocity raising (param 2)
The results shows that /nt/ is faster than /nd/ in USE only
Statistics
tt.df %>%
filter(coda %in% c("nt", "nd")) %>%
filter(segment == "Vokal") %>%
group_by(rowind) %>%
slice_tail(n=1) %>%
filter(!(is.na(alvUSV_alveolarconstriction_maxvel_onset))) %>%
rename(Dialect = language)%>%
lmer(alvUSV_alveolarconstriction_maxvel_onset ~
coda * Dialect +
(Dialect | CV) +
(coda| speaker), .) %>%
step()## boundary (singular) fit: see help('isSingular')## Backward reduced random-effect table:
##
## Eliminated npar logLik AIC LRT Df Pr(>Chisq)
## <none> 11 -1213.2 2448.4
## Dialect in (Dialect | CV) 1 9 -1213.5 2445.1 0.71 2 0.7011
## coda in (coda | speaker) 2 7 -1214.9 2443.8 2.67 2 0.2631
## (1 | CV) 0 6 -1525.8 3063.6 621.87 1 <2e-16
## (1 | speaker) 0 6 -1346.9 2705.8 264.00 1 <2e-16
##
## <none>
## Dialect in (Dialect | CV)
## coda in (coda | speaker)
## (1 | CV) ***
## (1 | speaker) ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Backward reduced fixed-effect table:
## Degrees of freedom method: Satterthwaite
##
## Eliminated Sum Sq Mean Sq NumDF DenDF F value Pr(>F)
## coda:Dialect 0 9.5175 9.5175 1 640.38 6.2638 0.01257 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Model found:
## alvUSV_alveolarconstriction_maxvel_onset ~ coda + Dialect + (1 | CV) + (1 | speaker) + coda:Dialect# simplified model:
tt.df %>%
filter(coda %in% c("nt", "nd")) %>%
filter(segment == "Vokal") %>%
group_by(rowind) %>%
slice_tail(n=1) %>%
# remove 3 NA
filter(!(is.na(alveolarconstriction_maxvel_on))) %>%
rename(Dialect = language)%>%
lmer(alvUSV_alveolarconstriction_maxvel_onset ~
coda + Dialect + (1 | CV) + (1 | speaker) + coda:Dialect, .) %>%
anova()## Type III Analysis of Variance Table with Satterthwaite's method
## Sum Sq Mean Sq NumDF DenDF F value Pr(>F)
## coda 23.8329 23.8329 1 646.33 15.6853 8.312e-05 ***
## Dialect 1.2040 1.2040 1 41.68 0.7924 0.37849
## coda:Dialect 9.5175 9.5175 1 640.38 6.2638 0.01257 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1tt.df %>%
filter(coda %in% c("nt", "nd")) %>%
filter(segment == "Vokal") %>%
group_by(rowind) %>%
slice_tail(n=1) %>%
rename(Dialect = language)%>%
lmer(alvUSV_alveolarconstriction_maxvel_onset ~
coda + Dialect + (1 | CV) + (1 | speaker) + coda:Dialect, .) %>%
emmeans(., ~ coda|Dialect) %>%
pairs(., simple = "each", combine=T) %>%
as.data.frame() %>%
filter(p.value <= 0.05) %>%
as_tibble() %>%
mutate(p.value = round(p.value, 4))## # A tibble: 1 × 8
## Dialect coda contrast estimate SE df t.ratio p.value
## <chr> <chr> <chr> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 USE . nd - nt -0.744 0.175 643. -4.25 0.00016.5 Comparison of /nd, nt/ on tongue tip articulatory duration (param 3)
The results show: BRE > USE
tt.df %>%
filter(coda %in% c("nd", "nt")) %>%
filter(segment == "Vokal") %>%
group_by(rowind) %>%
slice_tail(n=1) %>%
rename(Dialect = language) %>%
ungroup() %>%
lmer(alveolarconstriction_maxvel_dur ~
coda * Dialect +
(Dialect|CV) + (coda|speaker), .) %>%
step()## boundary (singular) fit: see help('isSingular')
## boundary (singular) fit: see help('isSingular')## Backward reduced random-effect table:
##
## Eliminated npar logLik AIC LRT Df Pr(>Chisq)
## <none> 11 884.15 -1746.3
## Dialect in (Dialect | CV) 1 9 884.06 -1750.1 0.1653 2 0.9207
## coda in (coda | speaker) 0 7 873.03 -1732.1 22.0714 2 1.612e-05
## (1 | CV) 0 8 873.58 -1731.2 20.9665 1 4.674e-06
##
## <none>
## Dialect in (Dialect | CV)
## coda in (coda | speaker) ***
## (1 | CV) ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Backward reduced fixed-effect table:
## Degrees of freedom method: Satterthwaite
##
## Eliminated Sum Sq Mean Sq NumDF DenDF F value Pr(>F)
## coda:Dialect 1 0.000295 0.000295 1 40.786 0.0844 0.7728499
## coda 2 0.005882 0.005882 1 53.068 1.6819 0.2002796
## Dialect 0 0.060146 0.060146 1 41.108 17.1973 0.0001645 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Model found:
## alveolarconstriction_maxvel_dur ~ Dialect + (coda | speaker) + (1 | CV)tt.df %>%
filter(coda %in% c("nd", "nt")) %>%
filter(segment == "Vokal") %>%
group_by(rowind) %>%
slice_tail(n=1) %>%
rename(Dialect = language) %>%
ungroup() %>%
lmer(alveolarconstriction_maxvel_dur ~ Dialect +
(coda | speaker) + (1 | CV), .) %>%
anova()## Type III Analysis of Variance Table with Satterthwaite's method
## Sum Sq Mean Sq NumDF DenDF F value Pr(>F)
## Dialect 0.060146 0.060146 1 41.108 17.197 0.0001645 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# get EMMs
tt.df %>%
filter(coda %in% c("nd", "nt")) %>%
filter(segment == "Vokal") %>%
group_by(rowind) %>%
slice_tail(n=1) %>%
rename(Dialect = language) %>%
ungroup() %>%
lmer(alveolarconstriction_maxvel_dur ~ Dialect +
(coda | speaker) + (1 | CV), .) %>%
emmeans(. , ~ Dialect)## Dialect emmean SE df lower.CL upper.CL
## BRE 0.296 0.0116 47.3 0.272 0.319
## USE 0.223 0.0147 46.1 0.193 0.253
##
## Degrees-of-freedom method: kenward-roger
## Confidence level used: 0.956.6 Comparison of /nd, nt/ on duration between TT-maxvel-on and TT peak displacement (param 4)
Statistics shows that only dialect is significant.
tt.df %>%
filter(coda %in% c("nd", "nt")) %>%
filter(segment == "Vokal") %>%
group_by(rowind) %>%
slice_tail(n=1) %>%
rename(Dialect = language) %>%
ungroup() %>%
mutate(d =
(alveolarconstriction_nucleus_on + alveolarconstriction_nucleus_off)/2 -
alveolarconstriction_maxvel_on) %>%
lmer(d ~
coda * Dialect +
(Dialect|CV) + (coda|speaker), .) %>%
step()## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
## Model failed to converge with max|grad| = 0.00456428 (tol = 0.002, component 1)## Backward reduced random-effect table:
##
## Eliminated npar logLik AIC LRT Df Pr(>Chisq)
## <none> 11 1317.2 -2612.4
## Dialect in (Dialect | CV) 1 9 1316.8 -2615.6 0.8609 2 0.6502091
## coda in (coda | speaker) 0 7 1308.2 -2602.3 17.2800 2 0.0001769
## (1 | CV) 0 8 1302.8 -2589.7 27.9206 1 1.264e-07
##
## <none>
## Dialect in (Dialect | CV)
## coda in (coda | speaker) ***
## (1 | CV) ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Backward reduced fixed-effect table:
## Degrees of freedom method: Satterthwaite
##
## Eliminated Sum Sq Mean Sq NumDF DenDF F value Pr(>F)
## coda:Dialect 1 0.0012488 0.0012488 1 40.170 1.2429 0.2715342
## coda 2 0.0019069 0.0019069 1 53.973 1.8978 0.1740158
## Dialect 0 0.0129689 0.0129689 1 40.968 12.9017 0.0008712 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Model found:
## d ~ Dialect + (coda | speaker) + (1 | CV)# model found
tt.df %>%
filter(coda %in% c("nd", "nt")) %>%
filter(segment == "Vokal") %>%
group_by(rowind) %>%
slice_tail(n=1) %>%
rename(Dialect = language) %>%
ungroup() %>%
mutate(d =
(alveolarconstriction_nucleus_on + alveolarconstriction_nucleus_off)/2 -
alveolarconstriction_maxvel_on) %>%
lmer(d ~ Dialect + (coda | speaker) + (1 | CV), .) %>%
anova()## Type III Analysis of Variance Table with Satterthwaite's method
## Sum Sq Mean Sq NumDF DenDF F value Pr(>F)
## Dialect 0.012969 0.012969 1 40.968 12.902 0.0008712 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# EMMs
tt.df %>%
filter(coda %in% c("nd", "nt")) %>%
filter(segment == "Vokal") %>%
group_by(rowind) %>%
slice_tail(n=1) %>%
rename(Dialect = language) %>%
ungroup() %>%
mutate(d =
(alveolarconstriction_nucleus_on + alveolarconstriction_nucleus_off)/2 -
alveolarconstriction_maxvel_on) %>%
lmer(d ~ Dialect + (coda | speaker) + (1 | CV), .) %>%
emmeans(., ~Dialect)## Dialect emmean SE df lower.CL upper.CL
## BRE 0.135 0.00627 47.8 0.1223 0.148
## USE 0.101 0.00792 46.8 0.0854 0.117
##
## Degrees-of-freedom method: kenward-roger
## Confidence level used: 0.957 Compensatory lengthening
/nt, nd/ durations
finals.ntnd = c("nt", "nd")
durations.df = dt.df %>%
group_by(rowind) %>%
filter(segment == "Vokal") %>%
filter(coda %in% finals.ntnd) %>%
slice_tail(n=1) %>%
mutate(alldur = velumopening_maxvel_off - timeseriesoffset,
Vdur = endv_time - timeseriesoffset,
Ndur = velumopening_maxvel_off - endv_time) %>%
rename(Dialect = language) Ndur
## # A tibble: 2 × 2
## coda m
## <chr> <dbl>
## 1 nd 0.155
## 2 nt 0.119durations.theme = function(n=24, m = 20)
{
theme(
axis.text.x = element_blank(),
axis.title.x = element_blank(),
axis.text.y = element_text(size=m,
angle = 90,
vjust = 1,
hjust=1),
axis.title.y = element_text(size=n),
legend.title = element_blank(),
legend.position="top",
text = element_text(size=n))
}plot1 = durations.df %>%
ggplot +
aes(y = alldur, x = coda, col=Dialect) +
geom_boxplot() +
facet_wrap(~ vowel, ncol = 5) +
ylab("VN duration (s)") +
xlab("") +
durations.theme() +
coord_cartesian(ylim = c(0.15, .55)) +
scale_colour_manual(values = cols.dial)
plot2 =
durations.df %>%
ggplot +
aes(y = Vdur, col = Dialect, x = coda) +
geom_boxplot() +
durations.theme() +
theme(
legend.position = "none",
axis.text.x = element_text(size=20)) +
scale_colour_manual(values = cols.dial) +
facet_wrap(~ vowel, ncol = 5) +
ylab("V duration (s)") +
scale_colour_manual(values = cols.dial)## Scale for colour is already present.
## Adding another scale for colour, which will replace the existing scale.## Warning: Removed 1 row containing non-finite outside the scale range
## (`stat_boxplot()`).
ggsave(filename = file.path(pfadfigs, "durplot.pdf"),
plot = durplot,
device=cairo_pdf,
width = 25,
height = 20,
units = "cm")Test on all durations
## boundary (singular) fit: see help('isSingular')## Backward reduced random-effect table:
##
## Eliminated npar logLik AIC LRT Df Pr(>Chisq)
## <none> 11 2002.4 -3982.8
## Dialect in (Dialect | CV) 1 9 2001.5 -3985.1 1.72 2 0.4227
## coda in (coda | speaker) 0 7 1846.7 -3679.4 309.70 2 <2e-16
## (1 | CV) 0 8 1711.8 -3407.7 579.37 1 <2e-16
##
## <none>
## Dialect in (Dialect | CV)
## coda in (coda | speaker) ***
## (1 | CV) ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Backward reduced fixed-effect table:
## Degrees of freedom method: Satterthwaite
##
## Eliminated Sum Sq Mean Sq NumDF DenDF F value Pr(>F)
## coda:Dialect 1 0.000149 0.000149 1 40.785 0.1127 0.7388
## Dialect 2 0.000496 0.000496 1 40.985 0.3747 0.5438
## coda 0 0.134243 0.134243 1 45.274 101.4835 3.853e-13 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Model found:
## alldur ~ coda + (coda | speaker) + (1 | CV)# model found
# alldur ~ coda + (coda | speaker) + (1 | CV)
durations.df %>%
lmer(alldur ~ coda + (coda | speaker) + (1 | CV), .) %>%
anova()## Type III Analysis of Variance Table with Satterthwaite's method
## Sum Sq Mean Sq NumDF DenDF F value Pr(>F)
## coda 0.13424 0.13424 1 45.274 101.48 3.853e-13 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Emmeans
durations.df %>%
lmer(alldur ~ coda + (coda | speaker) + (1 | CV), .) %>%
emmeans(., ~coda)## coda emmean SE df lower.CL upper.CL
## nd 0.358 0.0114 56.0 0.336 0.381
## nt 0.275 0.0113 56.6 0.252 0.297
##
## Degrees-of-freedom method: kenward-roger
## Confidence level used: 0.95Test on vowel duration
## Backward reduced random-effect table:
##
## Eliminated npar logLik AIC LRT Df Pr(>Chisq)
## <none> 11 2337.6 -4653.2
## Dialect in (Dialect | CV) 0 9 2332.0 -4646.0 11.269 2 0.003573
## coda in (coda | speaker) 0 9 2306.4 -4594.9 62.364 2 2.869e-14
##
## <none>
## Dialect in (Dialect | CV) **
## coda in (coda | speaker) ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Backward reduced fixed-effect table:
## Degrees of freedom method: Satterthwaite
##
## Eliminated Sum Sq Mean Sq NumDF DenDF F value Pr(>F)
## coda:Dialect 1 0.00150 0.00150 1 44.768 1.9571 0.16872
## coda 0 0.15397 0.15397 1 55.044 201.0910 < 2e-16 ***
## Dialect 0 0.00572 0.00572 1 45.845 7.4705 0.00888 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Model found:
## Vdur ~ coda + Dialect + (Dialect | CV) + (coda | speaker)Model found
## Type III Analysis of Variance Table with Satterthwaite's method
## Sum Sq Mean Sq NumDF DenDF F value Pr(>F)
## coda 0.15397 0.15397 1 55.044 201.0910 < 2e-16 ***
## Dialect 0.00572 0.00572 1 45.845 7.4705 0.00888 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Emmeans
durations.df %>%
lmer(Vdur ~ coda + Dialect + (Dialect | CV) + (coda | speaker), .) %>%
emmeans(., ~coda)## coda emmean SE df lower.CL upper.CL
## nd 0.207 0.0129 27.2 0.181 0.234
## nt 0.157 0.0124 23.9 0.132 0.183
##
## Results are averaged over the levels of: Dialect
## Degrees-of-freedom method: kenward-roger
## Confidence level used: 0.95# nd 0.207; nt 0.157
durations.df %>%
lmer(Vdur ~ coda + Dialect + (Dialect | CV) + (coda | speaker), .) %>%
emmeans(., ~Dialect)## Dialect emmean SE df lower.CL upper.CL
## BRE 0.169 0.0126 28.2 0.144 0.195
## USE 0.195 0.0142 32.0 0.166 0.224
##
## Results are averaged over the levels of: coda
## Degrees-of-freedom method: kenward-roger
## Confidence level used: 0.958 Schematic outlines
8.1 For voiced NC̬
colscheme = c("black", "red", "blue")
ltyscheme = c(1, 3, 3)
library(emuR)
ablack = cr(p=-pi, type="l",
N=100, axes=F, lwd=2, ylab="", xlab="", values=T)
blue.x = seq(25, 74, length=100)
blue.y = (ablack/2)
red.x = seq(12.5, 86.5, length=100)
red.y = (ablack * .75)
black.x = 1:100
black.y = ablack+2
vel.blue = c(stats::filter((ablack/2)-.5, c(.5, 0, -.5)))
temp = vel.blue == max(vel.blue, na.rm=T)
pktime.blue = (1:100)[temp]
pktime.blue = pktime.blue[!is.na(pktime.blue)]
pktime.blue.time= seq(25, 74, length=100)[pktime.blue]
vel.red = c(stats::filter((ablack*.75)-.25, c(.5, 0, -.5)))
temp = vel.red == max(vel.red, na.rm=T)
pktime.red = (1:100)[temp]
pktime.red = pktime.red[!is.na(pktime.red)]
pktime.red.time = seq(12.5, 86.5, length=100)[pktime.red]
pktime.black.time = 57
# horizontal shifts
ktimes = -18
black.x = black.x + ktimes
times = c(blue.x, red.x, black.x)
# vertical shifts
red.y = red.y + 2
blue.y = blue.y + 1.625
y = c(blue.y, red.y, black.y)
y = y + .5
Dialect = c(rep("USE", length(blue.y)),
rep("BRE", length(red.y)),
rep("Both", length(black.y)))
scheme.df = data.frame(y, times, Dialect)
schematic_paper = scheme.df %>%
ggplot +
aes(y = y, x = times, group=Dialect, col = Dialect,
linetype = Dialect) +
theme_light() +
theme_michigan2hpaper(n = 30, k = 26, position="top") +
geom_line(linewidth = 1.5) +
ylab("Displacement") +
xlab("Time") +
coord_cartesian(xlim = c(-15, 87.5), ylim = c(0.5, 3.7)) +
# double arrow for red N
geom_segment(aes(y = y, x = times),
x = pktime.red.time, y = 1,
xend = pktime.black.time, yend = 1,
arrow=arrow(ends="both", type="closed"),
col = "red", show.legend = FALSE) +
# double arrow for red V
geom_segment(aes(y = y, x = times),
x = -12.5, y = 1,
xend = pktime.red.time, yend = 1,
arrow=arrow(ends="both", type="closed"),
col = "red", show.legend = FALSE) +
# double arrow for blue V
geom_segment(aes(y = y, x = times),
x = -12.5, y = .5,
xend = pktime.blue.time, yend = .5,
arrow=arrow(ends="both", type="closed"),
col = "blue", show.legend = FALSE) +
# double arrow for blue N
geom_segment(aes(y = y, x = times),
x = pktime.blue.time, y = .5,
xend = pktime.black.time, yend = .5,
arrow=arrow(ends="both", type="closed"),
col = "blue", show.legend = FALSE) +
# vertical blue
geom_segment(aes(y = y, x = times),
x = pktime.blue.time, y = 1.25,
xend = pktime.blue.time, yend = 2.125,
col = "blue", show.legend = FALSE) +
geom_segment(aes(y = y, x = times),
x = pktime.blue.time, y = 0.5,
xend = pktime.blue.time, yend = 0.85,
col = "blue", show.legend = FALSE) +
# vertical red
geom_segment(aes(y = y, x = times),
x = pktime.red.time, y = 1,
xend = pktime.red.time, yend = 2.5,
col = "red", show.legend = FALSE) +
# vertical black right
geom_segment(aes(y = y, x = times),
x = pktime.black.time, y = .5,
xend = pktime.black.time, yend = 2.55,
col = "black", show.legend = FALSE) +
# vertical black left
geom_segment(aes(y = y, x = times),
x = -12.5, y = .5,
xend = -12.5, yend = 3.5,
col = "slategray", show.legend = FALSE) +
annotate("text", x=31.25, y=3.6,
label="Velum",
size=28/.pt) +
annotate("text", x=50, y=3.6,
label="TT",
size=28/.pt, col = "red") +
annotate("text", x=50, y=2.45,
label="TT",
size=28/.pt, col = "blue") +
annotate("text", x=44.09343, y=1.1,
label="N",
size=28/.pt, col = "red") +
annotate("text", x=47.18687, y=.6,
label="N",
size=28/.pt, col = "blue") +
annotate("text", x=9.343434, y=1.1,
label="V",
size=28/.pt, col = "red") +
annotate("text", x=12.43687, y=.6,
label="V",
size=28/.pt, col = "blue") +
scale_colour_manual(values = colscheme) +
scale_linetype_manual(values = ltyscheme)
schematic_paper
8.2 For voiceless NCÌ¥
colscheme = c("black", "red", "blue")
ltyscheme = c(1, 3, 3)
library(emuR)
ablack = cr(p=-pi, type="l",
N=100, axes=F, lwd=2, ylab="", xlab="", values=T)
#blue.x = seq(25, 74, length=100)
#blue.y = (ablack/2)
red.x = seq(12.5, 86.5, length=100)
red.y = (ablack * .75)
blue.y = red.y
blue.y.left = blue.y[1:41]
blue.y.right = blue.y[60:100]
blue.y = c(blue.y.left, blue.y.right)
blue.x = red.x[-c(1:9, 92:100)]
black.x = 1:100
black.y = ablack+2
vel.blue = c(stats::filter((ablack/2)-.5, c(.5, 0, -.5)))
temp = vel.blue == max(vel.blue, na.rm=T)
pktime.blue = (1:100)[temp]
pktime.blue = pktime.blue[!is.na(pktime.blue)]
pktime.blue.time= seq(25, 74, length=100)[pktime.blue]
vel.red = c(stats::filter((ablack*.75)-.25, c(.5, 0, -.5)))
temp = vel.red == max(vel.red, na.rm=T)
pktime.red = (1:100)[temp]
pktime.red = pktime.red[!is.na(pktime.red)]
pktime.red.time = seq(12.5, 86.5, length=100)[pktime.red]
pktime.black.time = 57
# horizontal shifts
ktimes = -18
black.x = black.x + ktimes
times = c(blue.x, red.x, black.x)
# vertical shifts
red.y = red.y + 2
blue.y = blue.y + 2
y = c(blue.y, red.y, black.y)
y = y + .5
Dialect = c(rep("USE", length(blue.y)),
rep("BRE", length(red.y)),
rep("Both", length(black.y)))
scheme.df = data.frame(y, times, Dialect)
orange.x = seq(31.25, 56.25, length = 51) + 5
orange.y = black.y[1:51]/4 + .25
orange.dial = rep("Both", length(orange.y))
orange.df = data.frame(y = orange.y,
times = orange.x,
Dialect = orange.dial)
schematic_paper = scheme.df %>%
ggplot +
aes(y = y, x = times, group=Dialect, col = Dialect,
linetype = Dialect) +
theme_light() +
theme_michigan2hpaper(n = 30, k = 26, position="top") +
geom_line(linewidth = 1.5) +
ylab("Displacement") +
xlab("Time") +
coord_cartesian(xlim = c(-15, 87.5), ylim = c(-.5, 4.1)) +
geom_line(aes(y = y, x= times),
data = orange.df, col = "orange", lty=1, linewidth=1.5) +
# horizontal orange right
geom_segment(aes(y = y, x = times),
x = 61.25, y = 1,
xend = 75, yend = 1,
linewidth=1.5,
col = "orange", show.legend = FALSE) +
# horizontal orange left
geom_segment(aes(y = y, x = times),
x = -12.5, y = .5,
xend = 36.25, yend = .5,
linewidth=1.5,
col = "orange", show.legend = FALSE) +
# double arrow for red voiced N
geom_segment(aes(y = y, x = times),
x = pktime.red.time, y = 0,
xend = 43.75+5, yend = 0,
arrow=arrow(ends="both", type="closed"),
col = "red", show.legend = FALSE) +
# double arrow for red voiceless N
geom_segment(aes(y = y, x = times),
x = 43.75+5, y = 0,
xend = pktime.black.time, yend = 0,
arrow=arrow(ends="both", type="closed"),
col = "red", show.legend = FALSE) +
# double arrow for red V
geom_segment(aes(y = y, x = times),
x = -12.5, y = 0,
xend = pktime.red.time, yend = 0,
arrow=arrow(ends="both", type="closed"),
col = "red", show.legend = FALSE) +
# double arrow for blue V
geom_segment(aes(y = y, x = times),
x = -12.5, y = -.5,
xend = pktime.blue.time, yend = -.5,
arrow=arrow(ends="both", type="closed"),
col = "blue", show.legend = FALSE) +
# double arrow for blue voiced N
geom_segment(aes(y = y, x = times),
x = pktime.blue.time, y = -.5,
xend = 43.75+5, yend = -.5,
arrow=arrow(ends="both", type="closed"),
col = "blue", show.legend = FALSE) +
# double arrow for blue voiceless N
geom_segment(aes(y = y, x = times),
x = 43.75+5, y = -.5,
xend = pktime.black.time, yend = -.5,
arrow=arrow(ends="both", type="closed"),
col = "blue", show.legend = FALSE) +
# vertical blue
geom_segment(aes(y = y, x = times),
x = pktime.blue.time, y = .35,
xend = pktime.blue.time, yend = 2.5,
col = "blue", show.legend = FALSE) +
geom_segment(aes(y = y, x = times),
x = pktime.blue.time, y = -.5,
xend = pktime.blue.time, yend = -.1,
col = "blue", show.legend = FALSE) +
# vertical red
geom_segment(aes(y = y, x = times),
x = pktime.red.time, y = 2.5,
xend = pktime.red.time, yend = 0,
col = "red", show.legend = FALSE) +
# vertical black right
geom_segment(aes(y = y, x = times),
x = pktime.black.time, y = -.5,
xend = pktime.black.time, yend = 2.55,
col = "black", show.legend = FALSE) +
# vertical black left
geom_segment(aes(y = y, x = times),
x = -12.5, y = -.5,
xend = -12.5, yend = 3.5,
col = "slategray", show.legend = FALSE) +
# vertical orange
geom_segment(aes(y = y, x = times),
x = 43.75+5, y = 0.75,
xend = 43.75+5, yend = -.5,
col = "orange", show.legend = FALSE) +
# vertical double arrow orange
geom_segment(aes(y = y, x = times),
x = 75, y = 0.5,
xend = 75, yend = 1,
arrow=arrow(ends="both", type="closed"),
col = "orange", show.legend = FALSE) +
annotate("text", x=31.25, y=3.8,
label="Velum",
size=28/.pt) +
annotate("text", x=50, y=3.8,
label="TT",
size=28/.pt, col = "red") +
annotate("text", x=50, y=2.6,
label="TT",
size=28/.pt, col = "blue") +
annotate("text", x=83, y=1,
label="−voice",
size=28/.pt, col = "orange") +
annotate("text", x=83, y=.5,
label="+voice",
size=28/.pt, col = "orange") +
annotate("text", x=40, y=0.19,
label= "N̬",
size=28/.pt, col = "red") +
annotate("text", x=53, y=0.19,
label="NÌ¥",
size=28/.pt, col = "red") +
annotate("text", x=43.06187, y=-.3,
label="N̬",
size=28/.pt, col = "blue") +
annotate("text", x=53, y=-.3,
label="NÌ¥",
size=28/.pt, col = "blue") +
annotate("text", x=9.343434, y=0.19,
label="V",
size=28/.pt, col = "red") +
annotate("text", x=12.43687, y=-.3,
label="V",
size=28/.pt, col = "blue") +
scale_colour_manual(values = colscheme) +
scale_linetype_manual(values = ltyscheme)
schematic_paper
9 Figure in responses to reviewers
The proportional time at which the peak velocity of velum lowering occurs relative to the acoustic vowel onset and offset
onset_norm = dt.df %>%
rename(Dialect = language) %>%
filter(coda %in% c("nd", "nt")) %>%
filter(segment == "Vokal") %>%
group_by(rowind) %>%
slice_tail(n=1) %>%
mutate(vn2.num =
velumopening_maxvel_on - Vowelonset2,
vn2.den =
endv_time - Vowelonset2) %>%
ggplot +
aes(y = vn2.num/vn2.den, col = coda, x = Dialect) +
geom_boxplot(lwd=lwd) +
facet_wrap(~ vowel, ncol = 5) +
theme_michigan3(n=26) +
theme(axis.text.y =
element_text(angle = 90, vjust = 1, hjust=1)) +
scale_y_continuous("Proportional time", breaks=c(0.5, 1)) +
xlab("") +
scale_colour_manual(values = cols.coda)
ggsave(filename = file.path(pfadfigs2, "fig_onset.png"),
plot = onset_norm,
width = 30,
height = 20,
units = "cm")The final figure with the addition of the vertical left boundary at the time of the peak velum velocity lowering
colscheme = c("black", "red", "blue")
ltyscheme = c(1, 3, 3)
library(emuR)
ablack = cr(p=-pi, type="l",
N=100, axes=F, lwd=2, ylab="", xlab="", values=T)
blue.x = seq(25, 74, length=100)
blue.y = (ablack/2)
red.x = seq(12.5, 86.5, length=100)
red.y = (ablack * .75)
black.x = 1:100
black.y = ablack+2
vel.blue = c(stats::filter((ablack/2)-.5, c(.5, 0, -.5)))
temp = vel.blue == max(vel.blue, na.rm=T)
pktime.blue = (1:100)[temp]
pktime.blue = pktime.blue[!is.na(pktime.blue)]
pktime.blue.time= seq(25, 74, length=100)[pktime.blue]
vel.red = c(stats::filter((ablack*.75)-.25, c(.5, 0, -.5)))
temp = vel.red == max(vel.red, na.rm=T)
pktime.red = (1:100)[temp]
pktime.red = pktime.red[!is.na(pktime.red)]
pktime.red.time = seq(12.5, 86.5, length=100)[pktime.red]
pktime.black.time = 57
# horizontal shifts
ktimes = -18
black.x = black.x + ktimes
times = c(blue.x, red.x, black.x)
# vertical shifts
red.y = red.y + 2
blue.y = blue.y + 1.625
y = c(blue.y, red.y, black.y)
y = y + .5
Dialect = c(rep("USE", length(blue.y)),
rep("BRE", length(red.y)),
rep("Both", length(black.y)))
scheme.df = data.frame(y, times, Dialect)
model_paper = scheme.df %>%
ggplot +
aes(y = y, x = times, group=Dialect, col = Dialect,
linetype = Dialect) +
theme_light() +
theme_michigan2xpaper(n = 30, k = 26, position="top") +
geom_line(linewidth = 1.5) +
ylab("Displacement") +
xlab("Time") +
coord_cartesian(xlim = c(-15, 87.5), ylim = c(0.5, 3.7)) +
# double arrow for red N
geom_segment(aes(y = y, x = times),
x = pktime.red.time, y = 1,
xend = pktime.black.time, yend = 1,
arrow=arrow(ends="both", type="closed"),
col = "red", show.legend = FALSE) +
# double arrow for red V
geom_segment(aes(y = y, x = times),
x = -12.5, y = 1,
xend = pktime.red.time, yend = 1,
arrow=arrow(ends="both", type="closed"),
col = "red", show.legend = FALSE) +
# double arrow for blue V
geom_segment(aes(y = y, x = times),
x = -12.5, y = .5,
xend = pktime.blue.time, yend = .5,
arrow=arrow(ends="both", type="closed"),
col = "blue", show.legend = FALSE) +
# double arrow for blue N
geom_segment(aes(y = y, x = times),
x = pktime.blue.time, y = .5,
xend = pktime.black.time, yend = .5,
arrow=arrow(ends="both", type="closed"),
col = "blue", show.legend = FALSE) +
# vertical blue
geom_segment(aes(y = y, x = times),
x = pktime.blue.time, y = 1.25,
xend = pktime.blue.time, yend = 2.125,
col = "blue", show.legend = FALSE) +
geom_segment(aes(y = y, x = times),
x = pktime.blue.time, y = 0.5,
xend = pktime.blue.time, yend = 0.85,
col = "blue", show.legend = FALSE) +
# vertical red
geom_segment(aes(y = y, x = times),
x = pktime.red.time, y = 1,
xend = pktime.red.time, yend = 2.5,
col = "red", show.legend = FALSE) +
# vertical black right
geom_segment(aes(y = y, x = times),
x = pktime.black.time, y = .5,
xend = pktime.black.time, yend = 2.55,
col = "black", show.legend = FALSE) +
# vertical black left
geom_segment(aes(y = y, x = times),
x = 8, y = .5,
xend = 8, yend = 2.5,
col = "black", lty=2, show.legend = FALSE) +
# vertical slategray boundary left
geom_segment(aes(y = y, x = times),
x = -12.5, y = .5,
xend = -12.5, yend = 3.5,
col = "slategray", show.legend = FALSE) +
annotate("text", x=31.25, y=3.6,
label="Velum",
size=28/.pt) +
annotate("text", x=50, y=3.6,
label="TT",
size=28/.pt, col = "red") +
annotate("text", x=50, y=2.45,
label="TT",
size=28/.pt, col = "blue") +
annotate("text", x=44.09343, y=1.1,
label="N",
size=28/.pt, col = "red") +
annotate("text", x=47.18687, y=.6,
label="N",
size=28/.pt, col = "blue") +
annotate("text", x=9.343434, y=1.1,
label="V",
size=28/.pt, col = "red") +
annotate("text", x=12.43687, y=.6,
label="V",
size=28/.pt, col = "blue") +
scale_colour_manual(values = colscheme) +
scale_linetype_manual(values = ltyscheme)
model_paper