SM4. Amplitude and Topic Models

Supplementary Material for ‘The overlooked effect of amplitude on within-speaker vowel variation’

1 Overview

In order to probe the phenomenon picked out by the first PC of our two PCA analyses, we fit a series of models. First, we model F1 on the basis of amplitude to see how changes in amplitude affect each vowel’s F1. This is motivated by the thought that amplitude drives the common movement on F1 found by the first PC in our PCA analysis (developed in corpus_pca.Rmd).

Second, we investigate the sociolinguistic question of whether and to what extent changes in amplitude suggest that a speaker is coming to the end of a discrete topical unit of a monologue.

For both questions we will first apply simple linear and linear mixed models, before turning to more sophisticated GAMM models.

In order for this document to be independently understandable, we briefly run through the phenomenon of interest from the previous supplementary materials.

We first load the required libraries and define global variables.

# Tidyverse and friends
library(tidyverse)
library(broom)
library(glue)
library(patchwork)

# Animations
library(gganimate) 
library(magick)

# Interactive plots
library(plotly)

# File management
library(here)

# Data scaling
library(scales)

# GAMMs
library(mgcv)
library(itsadug)
library(gratia)

# Linear Mixed Models
library(lme4)
library(optimx)
library(car)

# For variance inflation function
library(car)

# parallel computing - only used for `detectCores` function.
library(parallel)


# Global variables for plotting
vowel_colours_with_foot <- c(
  START = "#00B0F6",
  STRUT = "#F8766D",
  LOT = "#00BF7D",
  TRAP = "#FF62BC",
  FOOT = "#966432",
  KIT = "#39B600",
  NURSE = "#00BFC4",
  THOUGHT = "#E76BF3",
  DRESS = "#9590FF",
  FLEECE = "#D89000",
  GOOSE = "#A3A500"
)

# Order = order at which these vowels appear on the right side of the main plot
# of the model of F1 by amplitude which is used in the paper. We don't reorder
# for each plot in these supplementaries.
vowels <- c(
  "START", "STRUT", "LOT", "TRAP", "FOOT", "KIT", "NURSE", "THOUGHT", 
  "DRESS", "FLEECE", "GOOSE"
)

# Sometimes it is useful to split plots between high vowels and others. 
# We define high and low vowels here for this purpose.
high_vowels <- c(
  "DRESS",
  "GOOSE",
  "THOUGHT",
  "FLEECE",
  "NURSE"
)

front_vowels <- c(
  "DRESS",
  "FLEECE",
  "NURSE",
  "GOOSE",
  "TRAP"
)

# Random seed set for reproducibility.
set.seed(5)

knitr::include_graphics(here('plots', 'PCA_with_amplitude_varplot.png'))

Figure 1.1: Variables plots from PCA analysis.

As depicted in Figure 1.1, PC1 of our PCA analysis for both 60 second and 240 second intervals reveals that F1s of each vowel move together with amplitude, and that this effect explains around 7.7% of the variance for the 60 second intervals and around 10.3% of the variance for the 240 second intervals.

In SM2_interval_representation.Rmd, examples of amplitude over the course of a monologue were presented. These seemed to suggest that amplitude systematically drops over time (e.g. the bottom panels of Figure 1.2).

knitr::include_graphics(here('plots', 'QB_NZ_F_369_combined.png'))

Figure 1.2: Amplitude over the course of monologue for 60 and 240 second itnervals.

We will be interested in whether changes in F1 over the course of a monologue are explained by changes in amplitude and whether there is some other effect which might explain systematic shifts in F1 over the course of a monologue.

Connection between SM4 and the paper: The models reported in the paper are developed in Section 2.3 and Section 3.2. The remainder of the document consists of assumption checks and exploration of alternative methods. The fact that alternative methods produce compatible results provides a ‘sanity check’ on the methods which we do report.

2 F1 and Amplitude

2.1 Data exploration and transformation

We load the filtered data.

qb_vowels <- read_rds(
  here('processed_data', 'Quakebox_filtered.rds')
)
qb_vowels

2.1.1 Scaling

We scale the variables so that they are comparable across speakers. Because we are unable to control for different recording environments, we will scale amplitude so we are dealing with relative amplitude within a monologue. We will also scale speaker formant values. In both cases, we are simply z-scoring using the base R scale function. We also scale articulation rate, pitch, and speaker length both within and across speakers. Both forms of scaling will be useful for fitting models. We also scale time so that each monologue has a value running from 0 to 1, where 0 is the first token in the monologue and 1 is the last.

# scale time, collect speaker length.
qb_vowels <- qb_vowels %>%
  group_by(Speaker) %>%
  rename(
    time = Target.segments.start,
    art_rate = utterance.articulation.rate,
    pitch = MeanPitch
  ) %>%
  # Within speaker scaling.
  mutate(
    speaker_scaled_time = rescale(time, to = c(0, 1)),
    speaker_length = max(time),
    speaker_scaled_amp_max = scale(intensity_max),
    speaker_scaled_art_rate = scale(art_rate),
    speaker_scaled_pitch = scale(pitch) 
  ) %>%
  ungroup() %>%
  # Across speaker scaling.
  mutate(
    scaled_art_rate = scale(art_rate),
    scaled_pitch = scale(pitch),
    scaled_length = scale(speaker_length)
    # We don't scale amplitude across speakers as we can't control for recording
    # variation.
  )

# Scale formant data
qb_vowels <- qb_vowels %>%
  group_by(Speaker, Vowel) %>%
  mutate(
    speaker_scaled_F1 = scale(F1_50),
    speaker_scaled_F2 = scale(F2_50)
  ) %>%
  # Remove rows with missing F1
  filter(
    !is.na(speaker_scaled_F1)
  ) %>%
  ungroup() %>%
  # We may use across-speaker scaled F1 as a response.
  mutate(
    scaled_F1 = scale(F1_50),
    scaled_F1 = scale(F2_50)
  )

We now look at the distributions of the key variables.

Our initial models probe the relationship between amplitude and F1. We will use both scaled and unscaled F1 values. We first look at the unscaled values (Figure 2.1). Inspection of the figure suggests that all are roughly normally distributed, although with quite different amounts of variance and moderate differences in their skewness.

qb_vowels %>%
  ggplot(
    aes(
      x = F1_50
    )
  ) +
  geom_histogram(stat="density") +
  facet_wrap(vars(Vowel)) +
  labs(
    title = "Unscaled F1 Distributions by Vowel"
  )

Figure 2.1: Distributions of unscaled F1 values for each vowel.

Figure 2.2 shows the (predictable) consequences of scaling these variables. All are now centred around zero and ranging between -2.5 and 2.5. This is unsurprising because we filtered out tokens with s.d. filtering at -2.5 and 2.5 in preprocessing.Rmd.

qb_vowels %>%
  ggplot(
    aes(
      x = speaker_scaled_F1
    )
  ) +
  geom_histogram( stat="density") +
  facet_wrap(vars(Vowel)) +
  labs(
    title = "Scaled F1 Distributions by Vowel"
  )

Figure 2.2: Distributions of scaled F1 values for each vowel.

Our main variable of interest is the maximum amplitude of the word in which the vowel token originates. Taking our amplitude values at the word level rather than the vowel token level helps us to generate reliable amplitude readings using Praat.¹ Figure 2.3 shows the distribution of maximum amplitude.

(
  qb_vowels %>%
    ggplot(
      aes(
        x = speaker_scaled_amp_max
      )
    ) + 
    geom_histogram(binwidth=0.1) +
    labs(
      title = "Scaled",
      x = "Scaled max amplitude"
    )
) +
(
  qb_vowels %>%
  ggplot(
    aes(
      x = intensity_max
    )
  ) + 
  geom_histogram(binwidth=1)+
  labs(
    title = "Unscaled",
    x = "Unscaled max amplitude"
    )
) +
  plot_annotation(
    title = "Max word amplitude distributions"
  )

Figure 2.3: Maximum amplitude, scaled and unscaled.

The automatically generated scale on the \(x\)-axis in Figure 2.3 suggests that we have a few outliers on the left tail. We look at these values by filtering for scaled maximum amplitude below \(-5\).

qb_vowels %>%
  filter(
    speaker_scaled_amp_max < -5
  ) %>%
  select( # Remove non-informative variables.
    -c("MatchId", "TargetId", "URL")
  )

Interestingly, almost all of these have no pitch information. This suggests a tracking problem in Praat. We look at how common missing pitch information is in the dataframe.

qb_vowels %>%
  filter(
    is.na(pitch)
  ) %>%
  select( # Remove non-informative variables.
    -c("MatchId", "TargetId", "URL")
  )

There are about 100 times more entries with missing pitch than there are entries with scaled amplitude < 0.5. We won’t delete all of these data points.

Instead, given that the arguments for adopting the 2.5 standard deviation cut off for formant values apply to amplitude values just as well. So we will apply the same cut off to the amplitude data.

qb_vowels <- qb_vowels %>%
  filter(
    abs(speaker_scaled_amp_max) <= 2.5
  )

The resulting distribution for amplitude is depicted in Figure 2.4. No surprises here.

qb_vowels %>%
  ggplot(
    aes(
      x = speaker_scaled_amp_max
    )
  ) + 
  geom_histogram(binwidth=0.1) +
  labs(
    title = "Max amplitude distribution",
    subtitle = "Filtered and scaled",
    x = "Scaled max amplitude"
  )

Figure 2.4: Filtered and scaled max amplitude distribution.

Our models will use articulation rate and pitch as control variables. When we use scaled F1 as the response variable, we will also scale these within speaker. We now check the distributions of scaled articulation rate and pitch.

qb_vowels %>%
  ggplot(
    aes(
      x = scaled_pitch,
      colour = participant_gender
    )
  ) + 
  geom_freqpoly(binwidth=0.1, size=1, stat='density') +
  labs(
    title = "Across-speaker scaled mean pitch distribution",
    x = "Scaled mean pitch"
  )

Figure 2.5: Across speaker scaled mean pitch distribution.

Figure 2.5 shows that our across speaker scaling results in a bimodal distribution with modes mostly corresponding to the gender of the speaker. This scaling will only be used to aid the fitting process, so we don’t need to worry about it.

Figure 2.6 shows the distribution as a histogram of raw token counts.

qb_vowels %>%
  ggplot(
    aes(
      x = scaled_pitch
    )
  ) + 
  geom_histogram(binwidth=0.1) +
  labs(
    title = "Across-speaker scaled mean pitch distribution",
    x = "Scaled mean pitch"
  )

Figure 2.6: Histogram of across speaker scaled mean pitch distribution.

Within speaker scaling of pitch does not result in a bimodal distribution (as expected). See Figure 2.7.

qb_vowels %>%
  ggplot(
    aes(
      x = speaker_scaled_pitch
    )
  ) + 
  geom_histogram(binwidth=0.1) +
  labs(
    title = "Within-speaker scaled mean pitch distribution",
    x = "Scaled mean pitch"
  )

Figure 2.7: Within speaker scaled mean pitch distribution.

We also look at articulation rate.

qb_vowels %>%
  ggplot(
    aes(
      x = speaker_scaled_art_rate
    )
  ) + 
  geom_histogram(binwidth=0.1) +
  labs(
    title = "Within speaker scaled articulation rate distribution",
    x = "Scaled utterance articulation rate"
  )

Figure 2.8: Within speaker scaled utterance articulation rate distribution.

Both Figure 2.7, and to a lesser extent, Figure @ref(fig(speaker-scaled-artrate-distribution), show the presence of outliers in the distribution. In both cases, and for consistency, we apply the 2.5 standard deviation rule.

qb_vowels <- qb_vowels %>%
  filter(
    abs(speaker_scaled_art_rate) <= 2.5,
    abs(speaker_scaled_pitch) <= 2.5
  )

Some of our models will use a random effect structure to capture the differences between speakers. Consequently, we look at the distributions by speaker.

We know that different speakers contribute radically different amounts to the dataset (Figure 2.9).

qb_vowels %>%
  ggplot(
    aes(
      x = speaker_length
    )
  ) + 
  geom_histogram(binwidth=100) +
  labs(
    title = "Distribution of speaker monologue lengths",
    x = "Speaker monolgoue length"
  )

Figure 2.9: Distribution of speaker monologue lengths.

We can look at the distribution of F1s by speaker to see if any stick out as having not many tokens and, consequently, extreme looking distributions when scaled.

large_plot <- qb_vowels %>%
  ggplot(
    aes(
      x = speaker_scaled_F1,
      colour = Speaker
    )
  ) +
  facet_wrap(vars(Vowel)) +
  geom_freqpoly(stat="density") +
  theme(legend.position = "None") +
  labs(
    title = "Speaker F1 distributions for each vowel",
    x = "Scaled F1 value"
  )
large_plot

Figure 2.10: Speaker F1 distributions for each vowel.

Figure 2.10 shows some sharp spikes which suggest a lack of data points for certain speakers for certain vowels. We’ll insist on speakers having at least five tokens for each vowel.

qb_vowels <- qb_vowels %>%
  group_by(Speaker, Vowel) %>%
  mutate(
    n_obs = n()
  ) %>%
  ungroup() %>%
  group_by(Speaker) %>%
  mutate(
    min_obs = min(n_obs)
  ) %>%
  filter(
    min_obs >= 5
  )

Figure 2.11 shows the distribution after filtering. start still has a speaker with a strange distribution, but we have no obvious criterion for removing them.

large_plot <- qb_vowels %>%
  ggplot(
    aes(
      x = speaker_scaled_F1,
      colour = Speaker
    )
  ) +
  facet_wrap(vars(Vowel)) +
  geom_freqpoly(stat="density") +
  theme(legend.position = "None") +
  labs(
    title = "Speaker F1 distributions for each vowel",
    subtitle = "After filtering steps",
    x = "Scaled F1 value"
  )
large_plot

Figure 2.11: Speaker F1 distributions for each vowel (filtered).

2.1.2 Amplitude variation

In the paper, we compare the extent of amplitude variation in our data with that in laboratory studies. To get a sense how how much variation there is here, we produce some plots. First we look at the variation at the speaker level.

ranges <- qb_vowels %>%
  group_by(Speaker) %>%
  summarise(
    max_amp = max(intensity_max, na.rm=TRUE),
    min_amp = min(intensity_max, na.rm=TRUE),
    range_amp = max_amp - min_amp
  ) %>%
  ungroup()

summary(ranges$range_amp)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   5.667  15.800  18.070  18.351  20.431  37.256

qb_vowels %>%
  group_by(Speaker) %>%
  mutate(
    intensity_centered = intensity_max - mean(intensity_max, na.rm=TRUE)
  ) %>%
  ungroup() %>%
  ggplot(
    aes(
      x = intensity_centered,
      colour = Speaker,
      after_stat(density)
    )
  ) +
  geom_freqpoly(binwidth=1) +
  labs(
    title = "Amplitude variation of Each Speaker (Db)",
  ) +
  theme(
    legend.position = "none"
  )

qb_vowels %>%
  group_by(Speaker) %>%
  mutate(
    intensity_centered = intensity_max - mean(intensity_max, na.rm=TRUE)
  ) %>%
  ungroup() %>%
  ggplot(
    aes(
      x = intensity_centered,
      after_stat(density)
    )
  ) +
  geom_freqpoly(binwidth=1) +
  labs(
    title = "Amplitude Variation in Data (Db)"
  ) +
  theme(
    legend.position = "none"
  )

And then the amount of variation at the 60 second interval level.

# Now degree of amplitude variation across 60 second intervals.

intervals <-  qb_vowels %>%
    # Divide up the time variable into 60 second and 240 second intervals.
    group_by(Speaker) %>%
    mutate(
      interval_60 = as.numeric(
        as.factor(
          cut(
            time, 
            breaks = seq(0, max(time) + 60, 60))
        )
      )*60
    ) %>%
    # Trim terminal intervals with insufficient data. Replaces bad interval values with NA.
    # note: still grouped by Speaker
    mutate(
      speaker_length = max(time),
      remaining_from_start_60 = speaker_length - (interval_60 - 60),
      interval_60 = if_else(remaining_from_start_60 >= 45, interval_60, NA_real_),
    ) %>%
    ## Create centered intensity
    mutate(
      intensity_centered = intensity_max - mean(intensity_max, na.rm=TRUE)
    ) %>%
    ungroup() %>%
    # Take summary value for formants for 60s intervals.
    group_by(Speaker, interval_60) %>%
    mutate(
      centered_amp_60 = mean(intensity_centered, na.rm=TRUE)
    ) %>%
    ungroup()

intervals %>%
  group_by(Speaker, interval_60) %>%
  summarise(
    centered_amp_60 = first(centered_amp_60)
  ) %>%
  ungroup() %>%
  ggplot(
    aes(
      x = centered_amp_60,
      after_stat(density)
    )
  ) +
  geom_freqpoly(binwidth=1) +
  theme(
    legend.position = "none"
  )

intervals %>%
  group_by(Speaker) %>%
  summarise(
    max_amp = max(centered_amp_60, na.rm=TRUE),
    min_amp = min(centered_amp_60, na.rm=TRUE),
    speaker_range = max_amp-min_amp
  ) %>%
  pull(speaker_range) %>%
  summary()

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##  0.3777  2.8734  4.1153  4.5526  5.6962 21.1940

2.1.3 Initial look at changes in F1 and amplitude over monologues

Before modelling, we want some visual sense of shifts over time in the data.

qb_vowels %>%
  ggplot(
    aes(
      x = speaker_scaled_time,
      y = speaker_scaled_F1
    )
  ) +
  geom_smooth() +
  facet_wrap(vars(Vowel)) +
  labs(
    title = "Changes in F1 over course of monologue",
    x = "Time (scaled)",
    y = "F1 (scaled)"
  )

Figure 2.12: Changes in F1 over course of monologue.

We have some evidence in Figure 2.12 for a decrease in F1 for dress, fleece, foot, lot, nurse, strut, thought, and trap. This may, in turn, be explained by changes in amplitude. Figure 2.13. shows the relationship of amplitude to (scaled) time. We see a small decrease in amplitude over the course of the monologue.

qb_vowels %>%
  ggplot(
    aes(
      x = speaker_scaled_time,
      y = speaker_scaled_amp_max
    )
  ) +
  geom_smooth() +
  labs(
    title = "Change in amplitude over course of monologue",
    x = "Time (scaled)",
    y = "Maximum word amplitude (scaled)"
  )

Figure 2.13: Change in amplitude over course of monologue.

One final thing to look at here is whether this apparent effect is there for speakers of different lengths. We cut speaker lengths in to 0-10m, 10-20m, and 20+m.

qb_vowels <- qb_vowels %>%
  ungroup() %>%
  mutate(
    speaker_length_fact = cut(
      speaker_length,
      breaks = c(0, 600, 1200, max(speaker_length)),
      labels = c("short (-10m)", "medium (10-20m)", "long (20m+)")
    ),
    speaker_length_fact = fct_relevel(
      speaker_length_fact,
      c("short (-10m)", "medium (10-20m)", "long (20m+)")
    )
  )

We look at the number of speakers in each category.

qb_vowels %>%
  group_by(speaker_length_fact) %>%
  summarise(
    n = n_distinct(Speaker)
  )

There are no categories with radically low numbers of speakers.

Figure 2.14

qb_vowels %>%
  ggplot(
    aes(
      x = speaker_scaled_time,
      y = speaker_scaled_amp_max,
      colour = speaker_length_fact
    )
  ) +
  geom_smooth() +
  labs(
    title = "Changes in amplitude over time by speaker length",
    colour = "Speaker length",
    x = "Time (scaled)",
    y = "Max word amplitude (scaled)"
  )

Figure 2.14: Changes in amplitude over time by speaker length.

All seem to be dropping at the end of the monologue. All seem to cross the overall mean amplitude some time after half way and have a quite precipitous drop at the end.

qb_vowels %>%
  ggplot(
    aes(
      x = speaker_scaled_time,
      y = speaker_scaled_pitch
    )
  ) +
  geom_smooth() +
  labs(
    title = "Pitch over the course of monologue.",
    y = "Pitch (scaled)",
    x = "Time (scaled)"
  )

Figure 2.15: Change in pitch over the course of monologue.

We also see a decline in pitch over the course of monologues (Figure 2.15).

2.2 Linear (Mixed) Models

2.2.1 Linear models

We start with some straightforward linear models. First, we use position in the monologue as our predictor.

linear.fit <- lm(speaker_scaled_F1 ~ speaker_scaled_time, data=qb_vowels)

summary(linear.fit)

## 
## Call:
## lm(formula = speaker_scaled_F1 ~ speaker_scaled_time, data = qb_vowels)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -4.2826 -0.6506 -0.0073  0.6419  4.2432 
## 
## Coefficients:
##                      Estimate Std. Error t value Pr(>|t|)    
## (Intercept)          0.041111   0.005884   6.987 2.82e-12 ***
## speaker_scaled_time -0.105060   0.010310 -10.191  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.9784 on 109288 degrees of freedom
## Multiple R-squared:  0.0009493,  Adjusted R-squared:  0.0009402 
## F-statistic: 103.8 on 1 and 109288 DF,  p-value: < 2.2e-16

A simple model with scaled time as predictor strongly indicates a reduction in F1 over time. However, with an adjusted R-squared of 0.00059, this model explains almost none of the variation in F1 in the dataset.

We will get a little bit more sophisticated before engaging in model diagnostics.

linear.fit.2 <- lm(
  speaker_scaled_F1 ~ 
    speaker_scaled_time*scaled_length + 
    speaker_scaled_art_rate + 
    speaker_scaled_amp_max + 
    speaker_scaled_pitch, 
  data=qb_vowels
)
summary(linear.fit.2)

## 
## Call:
## lm(formula = speaker_scaled_F1 ~ speaker_scaled_time * scaled_length + 
##     speaker_scaled_art_rate + speaker_scaled_amp_max + speaker_scaled_pitch, 
##     data = qb_vowels)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -4.1984 -0.6429 -0.0191  0.6247  4.3285 
## 
## Coefficients:
##                                    Estimate Std. Error t value Pr(>|t|)    
## (Intercept)                        0.011641   0.005869   1.984 0.047303 *  
## speaker_scaled_time               -0.057255   0.010271  -5.575 2.49e-08 ***
## scaled_length                      0.018099   0.005746   3.150 0.001633 ** 
## speaker_scaled_art_rate           -0.013431   0.003089  -4.348 1.38e-05 ***
## speaker_scaled_amp_max             0.176602   0.003756  47.017  < 2e-16 ***
## speaker_scaled_pitch              -0.015350   0.004250  -3.611 0.000305 ***
## speaker_scaled_time:scaled_length -0.037523   0.010094  -3.717 0.000201 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.9662 on 109283 degrees of freedom
## Multiple R-squared:  0.02564,    Adjusted R-squared:  0.02559 
## F-statistic: 479.3 on 6 and 109283 DF,  p-value: < 2.2e-16

Our second model includes the across-speaker scaled length of the speaker and interacts it with time scaled. The idea here is that longer speakers may exhibit a more extreme effect of time on their F1, particularly if fatigue is part of the story. We also include articulation rate and amplitude taken at midpoint.

The largest factor here is, by a multiple of 10, amplitude. Scaled time, by itself, is not significant, but the interaction with speaker length does have an effect. This is not surprising, insofar as this is a continuous by continuous interaction where the baseline is a speaker length of 0. The effect of scaled time in reducing F1 seems to increase as speakers increase in length. The articulation rate term suggests that as articulation rate increases, the F1 will decrease, and similar for the pitch.

This model moves us from an R squared of 0.00059 to 0.019. This is a major increase in descriptive power.

We check the diagnostic plots.

plot(linear.fit.2)

There is no extreme departure from normality of residuals and no data points with excessive leverage. In the tails, the error distribution is not entirely normal, but is within acceptable limits.

It is easier to interpret a speaker length factor than the continuous by continuous interaction, so we refit the model.

linear.fit.2.fact <- lm(
  scaled_F1 ~ 
    speaker_scaled_time*speaker_length_fact + 
    speaker_scaled_art_rate + 
    speaker_scaled_amp_max + 
    speaker_scaled_pitch, 
  data=qb_vowels
)
summary(linear.fit.2.fact)

## 
## Call:
## lm(formula = scaled_F1 ~ speaker_scaled_time * speaker_length_fact + 
##     speaker_scaled_art_rate + speaker_scaled_amp_max + speaker_scaled_pitch, 
##     data = qb_vowels)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -2.75881 -0.71923 -0.01481  0.76971  2.95864 
## 
## Coefficients:
##                                                         Estimate Std. Error
## (Intercept)                                            -0.012184   0.011571
## speaker_scaled_time                                     0.042604   0.020269
## speaker_length_factmedium (10-20m)                     -0.005021   0.015138
## speaker_length_factlong (20m+)                          0.013254   0.015616
## speaker_scaled_art_rate                                -0.007798   0.003236
## speaker_scaled_amp_max                                 -0.058781   0.003935
## speaker_scaled_pitch                                    0.060582   0.004453
## speaker_scaled_time:speaker_length_factmedium (10-20m) -0.014235   0.026533
## speaker_scaled_time:speaker_length_factlong (20m+)      0.057177   0.027352
##                                                        t value Pr(>|t|)    
## (Intercept)                                             -1.053   0.2923    
## speaker_scaled_time                                      2.102   0.0356 *  
## speaker_length_factmedium (10-20m)                      -0.332   0.7401    
## speaker_length_factlong (20m+)                           0.849   0.3960    
## speaker_scaled_art_rate                                 -2.410   0.0160 *  
## speaker_scaled_amp_max                                 -14.940   <2e-16 ***
## speaker_scaled_pitch                                    13.606   <2e-16 ***
## speaker_scaled_time:speaker_length_factmedium (10-20m)  -0.537   0.5916    
## speaker_scaled_time:speaker_length_factlong (20m+)       2.090   0.0366 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.012 on 109281 degrees of freedom
## Multiple R-squared:  0.003498,   Adjusted R-squared:  0.003425 
## F-statistic: 47.95 on 8 and 109281 DF,  p-value: < 2.2e-16

We see that longer speakers have a stronger time scaled effect than shorter speakers. We also see that amplitude remains a major factor. There is no evidence here for an effect of F1 drop over time distinct from the drop in amplitude for all but the longest speakers.

Before incorporating by-speaker random effects, it is worth looking at models for each vowel to determine whether the same predictors come out as significant. We do this by using the purrr method of nesting, fitting a model to each nested dataframe, and extracting model summary information.

vowel_linear_models <- qb_vowels %>%
  
  # Group by vowel and nest to create a column of dataframes corresponding
  # to each vowel.
  group_by(Vowel) %>%
  nest() %>%
  
  # Apply the linear model (same structure as linear.fit.2)
  mutate(
    model = map(
      data, 
      ~ lm(speaker_scaled_F1 ~ 
             speaker_scaled_time*scaled_length + 
             speaker_scaled_art_rate + 
             speaker_scaled_amp_max +
             speaker_scaled_pitch, 
           data = .x)
    ),
    
    # Extract the coefficients for each variable
    coefficients = map(model, tidy),
    
    # List the variables with p-values less than or equal to 0.05.
    significant_variables = map(coefficients, ~ .x %>% filter(p.value <= 0.05))
    
  ) %>%
  
  # Select the significant variables and 'unnest' so that each vowel has a row
  # for each significant variable.
  select(
    Vowel, significant_variables
  ) %>%
  unnest(significant_variables)

We then output the models where speaker_scaled_time or the interaction speaker_scaled_time:scaled_length come out as statistically significant at the 0.05 level.

# Output the models where scaled_time or the interaction with speaker
# length is significant.
vowel_linear_models %>%
  filter(
    term %in% c("speaker_scaled_time", "speaker_scaled_time:scaled_length")
  )

The models for kit, trap, and nurse, thought, and lot suggest that something is happening with scaled_time distinct from changes in amplitude. This is particularly interesting given that both kit and start show almost no movement in average F1 over time (Figure 2.12).

We now output all the models where scaled_amp_max appears as a significant predictor.

vowel_linear_models %>%
  filter(term == "speaker_scaled_amp_max")

Amplitude is taken to be a significant predictor by all vowels. Note also, that the effect is in the same direction for each, with lot and strut having the strongest effects by magnitude.

vowel_linear_models %>%
  filter(term == "speaker_scaled_pitch")

The pitch seems to also be associated with F1 for dress, nurse, kit, strut, lot, and foot, with the strongest effect for strut.

Finally, we look at articulation rate:

vowel_linear_models %>%
  filter(term == "speaker_scaled_art_rate")

This predictor is taken to be significant for eight monophthongs. But note that the direction of the effect is different for goose and thought. This is consistent with a decreased vowel space when articulation rate is high (with goose and thought lowering while the other vowels rise.

2.2.2 Linear mixed models

We now move to linear models which incorporate random effects structures. This allows us to capture the fact that our data comes from different speakers who, we may assume, are drawn from a roughly normal distribution of possible speakers.

The linear models suggests that there is variation in the effects of our predictors by each vowel. Vowel levels are repeatable, so we do not include them as random effects. We only include speaker as a random effect.

We model using raw F1 frequency, as this makes the differences between the vowels easier for the model to detect. We will use random intercepts for each speaker-vowel combination.

NB: to refit this model yourself, change eval to TRUE in the following code chunk options.

lmer_fit <- lmer(
  F1_50 ~ 
    Vowel + 
    speaker_scaled_time * scaled_length +
    speaker_scaled_amp_max * Vowel +
    speaker_scaled_art_rate * Vowel +
    speaker_scaled_pitch * Vowel +
    participant_gender + 
    (1 + Vowel|Speaker), 
  data = qb_vowels)

# save model
write_rds(lmer_fit, here('models', 'lmer_fit.rds'))

We load a model we have already fit (or, if the previous cell has been run, the model which has just been saved).

# load model
lmer_fit <- read_rds(here('models', 'lmer_fit.rds'))

The easiest way to look at the model effects is to look at the output of the anova function. This outputs test values for variable terms rather than for each individual level of our Vowel factor.

anova(lmer_fit)

The majority of the variation handled by the model’s fixed effects comes from the different vowels. The F value column suggests that amplitude, scaled by speaker, is significant. It, and the interaction with Vowel explain a very large proportion of the variation in the data which is explained by the model.

We can also look at the detailed output.

summary(lmer_fit)

## Linear mixed model fit by REML ['lmerMod']
## Formula: 
## F1_50 ~ Vowel + speaker_scaled_time * scaled_length + speaker_scaled_amp_max *  
##     Vowel + speaker_scaled_art_rate * Vowel + speaker_scaled_pitch *  
##     Vowel + participant_gender + (1 + Vowel | Speaker)
##    Data: qb_vowels
## 
## REML criterion at convergence: 1246372
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -7.0008 -0.5274 -0.0213  0.5246  7.4909 
## 
## Random effects:
##  Groups   Name         Variance Std.Dev. Corr                               
##  Speaker  (Intercept)  1708.4   41.33                                       
##           VowelFLEECE  1584.2   39.80    -0.55                              
##           VowelFOOT    1324.8   36.40    -0.58  0.81                        
##           VowelGOOSE   1312.4   36.23    -0.62  0.94  0.88                  
##           VowelKIT     2093.2   45.75    -0.43  0.81  0.88  0.77            
##           VowelLOT     1780.4   42.19    -0.33  0.51  0.70  0.49  0.68      
##           VowelNURSE    632.4   25.15     0.00  0.24  0.09  0.18  0.02 -0.03
##           VowelSTART   9020.4   94.98    -0.35  0.57  0.61  0.53  0.73  0.70
##           VowelSTRUT   6377.6   79.86    -0.27  0.55  0.65  0.50  0.76  0.76
##           VowelTHOUGHT  616.1   24.82    -0.48  0.55  0.68  0.64  0.42  0.44
##           VowelTRAP    1204.2   34.70     0.03  0.15  0.05  0.02  0.30  0.43
##  Residual              5052.5   71.08                                       
##                         
##                         
##                         
##                         
##                         
##                         
##                         
##                         
##  -0.04                  
##  -0.02  0.90            
##   0.49  0.24  0.27      
##   0.37  0.50  0.53  0.08
##                         
## Number of obs: 109290, groups:  Speaker, 216
## 
## Fixed effects:
##                                       Estimate Std. Error t value
## (Intercept)                          425.89109    3.45026 123.437
## VowelFLEECE                          -11.22496    2.85791  -3.928
## VowelFOOT                             58.46519    2.90737  20.109
## VowelGOOSE                           -22.88668    2.71729  -8.423
## VowelKIT                              82.40427    3.24741  25.375
## VowelLOT                             157.64450    3.05744  51.561
## VowelNURSE                            12.03593    2.14939   5.600
## VowelSTART                           355.54713    6.59825  53.885
## VowelSTRUT                           252.95629    5.51694  45.851
## VowelTHOUGHT                           9.45437    1.99010   4.751
## VowelTRAP                            145.37415    2.57050  56.555
## speaker_scaled_time                   -3.81558    0.76674  -4.976
## scaled_length                         -4.80946    2.89629  -1.661
## speaker_scaled_amp_max                 3.39388    0.70083   4.843
## speaker_scaled_art_rate               -0.03026    0.53702  -0.056
## speaker_scaled_pitch                   1.88813    0.77756   2.428
## participant_genderM                  -35.47366    4.67112  -7.594
## speaker_scaled_time:scaled_length     -1.26844    0.75160  -1.688
## VowelFLEECE:speaker_scaled_amp_max     2.78553    1.06449   2.617
## VowelFOOT:speaker_scaled_amp_max      13.32234    1.78602   7.459
## VowelGOOSE:speaker_scaled_amp_max      7.95915    1.34868   5.901
## VowelKIT:speaker_scaled_amp_max        7.63532    1.03868   7.351
## VowelLOT:speaker_scaled_amp_max       29.06342    1.14670  25.345
## VowelNURSE:speaker_scaled_amp_max      3.01585    1.58682   1.901
## VowelSTART:speaker_scaled_amp_max      9.68229    1.42407   6.799
## VowelSTRUT:speaker_scaled_amp_max     27.35680    1.06355  25.722
## VowelTHOUGHT:speaker_scaled_amp_max    2.78389    1.27223   2.188
## VowelTRAP:speaker_scaled_amp_max      10.59288    1.17047   9.050
## VowelFLEECE:speaker_scaled_art_rate    1.09302    0.83319   1.312
## VowelFOOT:speaker_scaled_art_rate     -3.53727    1.49593  -2.365
## VowelGOOSE:speaker_scaled_art_rate     4.71872    1.07799   4.377
## VowelKIT:speaker_scaled_art_rate      -3.93612    0.82903  -4.748
## VowelLOT:speaker_scaled_art_rate      -4.05436    0.94284  -4.300
## VowelNURSE:speaker_scaled_art_rate    -0.36178    1.20431  -0.300
## VowelSTART:speaker_scaled_art_rate    -4.00945    1.12143  -3.575
## VowelSTRUT:speaker_scaled_art_rate    -3.31523    0.86261  -3.843
## VowelTHOUGHT:speaker_scaled_art_rate   2.08417    0.99608   2.092
## VowelTRAP:speaker_scaled_art_rate     -2.53745    0.92837  -2.733
## VowelFLEECE:speaker_scaled_pitch      -4.66772    1.19379  -3.910
## VowelFOOT:speaker_scaled_pitch        -9.08192    1.94051  -4.680
## VowelGOOSE:speaker_scaled_pitch       -2.28588    1.57124  -1.455
## VowelKIT:speaker_scaled_pitch         -6.24530    1.14144  -5.471
## VowelLOT:speaker_scaled_pitch        -12.64310    1.31246  -9.633
## VowelNURSE:speaker_scaled_pitch        1.83048    1.68582   1.086
## VowelSTART:speaker_scaled_pitch        0.18231    1.64740   0.111
## VowelSTRUT:speaker_scaled_pitch      -12.56867    1.24817 -10.070
## VowelTHOUGHT:speaker_scaled_pitch     -0.17735    1.42006  -0.125
## VowelTRAP:speaker_scaled_pitch        -0.52139    1.32105  -0.395
## optimizer (nloptwrap) convergence code: 0 (OK)
## Model failed to converge with max|grad| = 0.00498719 (tol = 0.002, component 1)

Note that model’s convergence is somewhat higher (0.0042) than the default tolerance (0.002), but is reasonably close. As this isn’t the main model we will use in the paper, we will not engage in any further attempts to get convergence within the threshold.

Breaking up the results by vowel reveals some important patterns. In particular, we see that lot and strut dominate when we look at the scaled_amp_max effect. The effect of scaled_amp_max on F1 is positive apart from the very low magnitude negative coefficient for START.

We check the diagnostic plots, as above.

qqnorm(resid(lmer_fit))
qqline(resid(lmer_fit))

The model is struggling at the tails. This may be corrected by allowing for non-linear relationships when we turn to GAMMs.

plot(lmer_fit)

We know that amplitude, pitch, and articulation rate have relationships to one another. But are these causing problems for our estimated coefficients. We look at the variance inflation factor.

vif(lmer_fit)

##                                         GVIF Df GVIF^(1/(2*Df))
## Vowel                               1.229098 10        1.010367
## speaker_scaled_time                 1.019796  1        1.009849
## scaled_length                       1.029820  1        1.014801
## speaker_scaled_amp_max              8.120620  1        2.849670
## speaker_scaled_art_rate             5.555067  1        2.356919
## speaker_scaled_pitch                7.751206  1        2.784099
## participant_gender                  1.006729  1        1.003359
## speaker_scaled_time:scaled_length   1.028464  1        1.014132
## Vowel:speaker_scaled_amp_max      105.796199 10        1.262477
## Vowel:speaker_scaled_art_rate       6.272997 10        1.096160
## Vowel:speaker_scaled_pitch        101.228205 10        1.259694

A GVIF above 2.24 represents some multicollinearity, a GVIF above 3.16 indicates high colinearity. The variance inflation here may come from the correlation between amplitude and pitch (0.275815). Since the GVIF is not extreme, we will leave all variable in.

We can now plot the amplitude and F1 relationship for each vowel according for the generalised linear model.

# Define new data to generate model predictions
new_data <- tibble(
  speaker_scaled_pitch = 0,
  speaker_scaled_art_rate = 0,
  scaled_length = 0,
  Vowel = rep(vowels, each = 1000),
  participant_gender = "F",
  # Assuming we are in the middle of the monologue
  speaker_scaled_time = 0.5,
  speaker_scaled_amp_max = rep(seq(-3, 3, length.out = 1000), times=11)
)

new_data <- new_data %>%
  mutate(
    prediction = predict(lmer_fit, newdata=new_data, re.form=NA),
  )

new_data %>%
  ggplot(
    aes(
      x = speaker_scaled_amp_max,
      y = prediction, 
      colour = Vowel
    )
  ) +
  geom_line() +
  labs(
    title = "F1 and Amplitude by Vowel",
    subtitle = glue(
      "Prediction, controlling for speaker gender, length, time, articulation rate,",
      "and pitch"
    ),
    colour = "Speaker length",
    y = "Predicted F1 (hz)",
    x = "Maximum amplitude (scaled)"
  ) +
  scale_colour_manual(
    values = vowel_colours_with_foot
  )

Figure 2.16: Relationship between F1 and amplitude by vowel.

Figure 2.16 shows predicted F1 values for different vowels at different maximum amplitudes. We see that the effect, measured in terms of raw frequency is very large for strut and lot. What is also interesting is that we see some overlap between vowels, so that, for instance, at low amplitude LOT has a lower F1 than trap, but at moderate to high volumes trap has a lower F1 than LOT. It also appears that, at as the amplitude increases, the F1 values of goose and fleece will get closer and closer together. At low amplitude, the F1 value of thought, nurse, fleece and dress coincide, but become distinguished from each other at higher amplitudes. On the other hand, at low amplitudes we find GOOSE more distinguished in height from the other high vowels, but coinciding with fleece at high amplitudes.

2.3 Generalised Additive Mixed Models

We now turn to GAMMs, a more flexible approach to modelling which is particularly effective at capturing non-linear relationships. The failure to handle tails of our error distribution with linear mixed models suggests that we might benefit from allowing non-linearities in to our models.

First, we fix the representation of the data for the mgcv package, which requires factors to be represented as such rather than interpreting character vectors as factors.

qb_vowels <- qb_vowels %>%
  mutate(
    Vowel = as.factor(Vowel),
    Speaker = as.factor(Speaker),
    participant_gender = as.factor(participant_gender)
  )

We begin by exploring structures using fREML to fit our models. We then use ML in order to carry out model-comparison based significance testing. The full model we fit using ML is the model from which we generate the effect plots in the paper.

We are not performing significance tests for distinctions between vowels, so we do not fit difference smooths (as in Sókuthy).

2.3.1 fREML Models

We fit a series of models here using fREML. These can be fit quickly, however, they are not suitable for model comparison-based testing when fixed effects are varied (Sóskuthy 2021, 8). In order to do this, we will fit a series of models with ML. These will take much longer to fit.

Our first structure is used in the main paper for vowel space visualisations in which the effect of amplitude and articulation rate are compared.

Our second structure, which adds random smooths over the time variable for each speaker, is given as part of the process we carried out to explore potential model structures. It is not used in the main paper. We did not find that it significantly improved performance for the added model complexity.

Our third structure explores the possibility of fitting the model using a scaled t-distribution as our error model rather than a Gaussian. This is found to improve the behaviour of our residuals, but it does not significantly affect the interpretation of our results. Moreover, attempts to fit the model with scaled t residuals were unsuccessful with ML due to limitations in computational power.

2.3.1.1 Structure 1: by-speaker and by-speaker-by-vowel, intercepts.

We begin by following the same structure as the previous mixed model.

NB: to refit this model yourself, change eval to TRUE in the following code chunk options.

gamm_fit <- bam(
  F1_50 ~ 
    participant_gender +
    Vowel +
    s(speaker_scaled_time, by=Vowel) + 
    s(speaker_scaled_art_rate, by=Vowel) +
    s(speaker_scaled_amp_max, by=Vowel) +
    s(speaker_scaled_pitch, by=Vowel) + 
    s(Speaker, bs="re") +
    s(Speaker, Vowel, bs="re"),
  data = qb_vowels, 
  method="fREML",
  discrete = TRUE,
  nthreads = 8 
)

write_rds(gamm_fit, here('models', 'gamm_fit_s1.rds'))

# Also takes a long time to calculate summary.
# We calculate it and save it now.
gamm_fit_summary <- summary(gamm_fit)
write_rds(gamm_fit_summary, here('models', 'gamm_fit_s1_summary.rds'))

We load the pre-calculated/fit model and summary.

gamm_fit <- read_rds(here('models', 'gamm_fit_s1.rds'))
gamm_fit_summary <- read_rds(here('models', 'gamm_fit_s1_summary.rds'))
gamm_fit_summary

## 
## Family: gaussian 
## Link function: identity 
## 
## Formula:
## F1_50 ~ participant_gender + Vowel + s(speaker_scaled_time, by = Vowel) + 
##     s(speaker_scaled_art_rate, by = Vowel) + s(speaker_scaled_amp_max, 
##     by = Vowel) + s(speaker_scaled_pitch, by = Vowel) + s(Speaker, 
##     bs = "re") + s(Speaker, Vowel, bs = "re")
## 
## Parametric coefficients:
##                     Estimate Std. Error t value Pr(>|t|)    
## (Intercept)          434.554      4.086 106.360  < 2e-16 ***
## participant_genderM  -55.013      5.620  -9.789  < 2e-16 ***
## VowelFLEECE          -13.305      3.933  -3.383 0.000718 ***
## VowelFOOT             62.709      4.436  14.136  < 2e-16 ***
## VowelGOOSE           -21.129      4.144  -5.099 3.42e-07 ***
## VowelKIT              84.367      3.930  21.466  < 2e-16 ***
## VowelLOT             155.419      4.048  38.398  < 2e-16 ***
## VowelNURSE            13.788      4.147   3.325 0.000886 ***
## VowelSTART           353.802      3.925  90.146  < 2e-16 ***
## VowelSTRUT           251.627      4.056  62.042  < 2e-16 ***
## VowelTHOUGHT          10.584      4.016   2.635 0.008408 ** 
## VowelTRAP            144.038      4.086  35.252  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Approximate significance of smooth terms:
##                                              edf   Ref.df        F  p-value    
## s(speaker_scaled_time):VowelDRESS          1.813    2.263    3.791 0.018336 *  
## s(speaker_scaled_time):VowelFLEECE         1.002    1.004    2.769 0.095805 .  
## s(speaker_scaled_time):VowelFOOT           1.001    1.002    1.017 0.313417    
## s(speaker_scaled_time):VowelGOOSE          1.002    1.003    0.000 0.997547    
## s(speaker_scaled_time):VowelKIT            5.760    6.917    2.664 0.011840 *  
## s(speaker_scaled_time):VowelLOT            2.562    3.193    9.364 3.08e-06 ***
## s(speaker_scaled_time):VowelNURSE          1.001    1.003    0.538 0.463181    
## s(speaker_scaled_time):VowelSTART          1.005    1.010    0.270 0.608260    
## s(speaker_scaled_time):VowelSTRUT          6.766    7.875    4.690 3.32e-05 ***
## s(speaker_scaled_time):VowelTHOUGHT        1.001    1.002    6.162 0.013036 *  
## s(speaker_scaled_time):VowelTRAP           2.495    3.112    6.864 0.000103 ***
## s(speaker_scaled_art_rate):VowelDRESS      1.001    1.002    0.033 0.858243    
## s(speaker_scaled_art_rate):VowelFLEECE     1.175    1.330    1.484 0.172695    
## s(speaker_scaled_art_rate):VowelFOOT       1.001    1.002    6.992 0.008172 ** 
## s(speaker_scaled_art_rate):VowelGOOSE      1.003    1.007   24.106 7.99e-07 ***
## s(speaker_scaled_art_rate):VowelKIT        1.001    1.003   41.117  < 2e-16 ***
## s(speaker_scaled_art_rate):VowelLOT        1.002    1.004   25.698 4.12e-07 ***
## s(speaker_scaled_art_rate):VowelNURSE      1.002    1.004    0.161 0.688967    
## s(speaker_scaled_art_rate):VowelSTART      1.001    1.003   18.148 2.01e-05 ***
## s(speaker_scaled_art_rate):VowelSTRUT      3.921    4.867    6.425 9.77e-06 ***
## s(speaker_scaled_art_rate):VowelTHOUGHT    1.002    1.005    5.933 0.014806 *  
## s(speaker_scaled_art_rate):VowelTRAP       1.003    1.006   11.128 0.000831 ***
## s(speaker_scaled_amp_max):VowelDRESS       1.001    1.002   24.650 6.91e-07 ***
## s(speaker_scaled_amp_max):VowelFLEECE      2.368    3.017   20.601  < 2e-16 ***
## s(speaker_scaled_amp_max):VowelFOOT        1.097    1.186   86.410  < 2e-16 ***
## s(speaker_scaled_amp_max):VowelGOOSE       1.787    2.265   43.789  < 2e-16 ***
## s(speaker_scaled_amp_max):VowelKIT         3.688    4.609   55.485  < 2e-16 ***
## s(speaker_scaled_amp_max):VowelLOT         3.895    4.850  272.056  < 2e-16 ***
## s(speaker_scaled_amp_max):VowelNURSE       1.001    1.002   22.562 2.02e-06 ***
## s(speaker_scaled_amp_max):VowelSTART       1.000    1.001  105.841  < 2e-16 ***
## s(speaker_scaled_amp_max):VowelSTRUT       5.490    6.609  226.567  < 2e-16 ***
## s(speaker_scaled_amp_max):VowelTHOUGHT     1.434    1.759   18.627 2.05e-06 ***
## s(speaker_scaled_amp_max):VowelTRAP        3.680    4.602   46.108  < 2e-16 ***
## s(speaker_scaled_pitch):VowelDRESS         3.870    4.813    5.517 6.86e-05 ***
## s(speaker_scaled_pitch):VowelFLEECE        2.546    3.230    3.915 0.008007 ** 
## s(speaker_scaled_pitch):VowelFOOT          3.255    4.066    8.482 1.18e-07 ***
## s(speaker_scaled_pitch):VowelGOOSE         3.041    3.826    3.628 0.006460 ** 
## s(speaker_scaled_pitch):VowelKIT           5.797    6.914   26.125  < 2e-16 ***
## s(speaker_scaled_pitch):VowelLOT           4.796    5.863   23.346  < 2e-16 ***
## s(speaker_scaled_pitch):VowelNURSE         3.183    3.989    5.196 0.000372 ***
## s(speaker_scaled_pitch):VowelSTART         1.003    1.007    1.728 0.187978    
## s(speaker_scaled_pitch):VowelSTRUT         7.906    8.651   20.555  < 2e-16 ***
## s(speaker_scaled_pitch):VowelTHOUGHT       3.067    3.858    5.055 0.000594 ***
## s(speaker_scaled_pitch):VowelTRAP          3.820    4.754    3.621 0.002836 ** 
## s(Speaker)                               192.620  214.000 2199.605  < 2e-16 ***
## s(Vowel,Speaker)                        1908.639 2361.000   36.354  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## R-sq.(adj) =  0.759   Deviance explained = 76.4%
## fREML = 6.2382e+05  Scale est. = 5025.5    n = 109290

The summary output here has a great deal of detail. We will focus in on specific aspects of the model as we go. At this point, it is worth noting that all of the terms here are significant, at least for one level of our Vowel factor. The model here first a smooth for each of our predictors and then enables a difference from this smooth for each vowel.

We will look at amplitude first, as it is our main variable of interest. The code below can be modified to get and plot predictions for the other variables.

gamm_fit_preds <- get_predictions( 
  gamm_fit,
  cond = list(
    'speaker_scaled_amp_max' = seq(-2.5, 2.5, length.out=200),
    'participant_gender' = 'F',
    'speaker_scaled_pitch' = 0,
    'speaker_scaled_art_rate' = 0,
    'speaker_scaled_time' = 0.5,
    'Vowel' = unique(qb_vowels$Vowel)
  )
)

## Summary:
##  * participant_gender : factor; set to the value(s): F. 
##  * Vowel : factor with 11 values; set to the value(s): DRESS, FLEECE, FOOT, GOOSE, KIT, LOT, NURSE, START, STRUT, THOUGHT, ... (Might be canceled as random effect, check below.) 
##  * speaker_scaled_time : numeric predictor; set to the value(s): 0.5. 
##  * speaker_scaled_art_rate : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_amp_max : numeric predictor; with 200 values ranging from -2.500000 to 2.500000. 
##  * speaker_scaled_pitch : numeric predictor; set to the value(s): 0. 
##  * Speaker : factor; set to the value(s): QB_NZ_M_291. (Might be canceled as random effect, check below.) 
##  * NOTE : The following random effects columns are canceled: s(Speaker),s(Vowel,Speaker)
## 

gamm_fit_preds %>%
  mutate(# Enable plot to distinguish between high and low vowels (for faceting)
    height = if_else(Vowel %in% high_vowels, "high", "low or mid"),
    Vowel = factor(Vowel, levels = vowels)
  ) %>%
  ggplot(
    aes(
      y = fit,
      x = speaker_scaled_amp_max,
      colour = Vowel
    )
  ) + 
  geom_ribbon(
    aes(
      ymin = fit - CI,
      ymax = fit + CI,
      fill = Vowel
    ),
    alpha = 0.3,
    colour = NA
  ) +
  geom_line() +
  scale_colour_manual(
    values = vowel_colours_with_foot
  ) +
  scale_fill_manual(
    values = vowel_colours_with_foot
  ) +
  labs(
    title = "F1 and Amplitude by Vowel",
    x = "Scaled amplitude",
    y = "F1"
  )

Figure 2.17: F1 and amplitude by vowel.

  # facet_wrap(
  #   facets=vars(height), scales = "free"
  # )

Figure 2.17 looks very similar to Figure 2.16. We have the crossing of lot and trap, for instance, and, broadly speaking, increased F1 with increased relative amplitude.

We now run diagnostic checks on the model:

Figure 2.18: GAM model checks.

A few things are worth noting here. First, we don’t have any indication that we have our \(k\) values set too low. The check for this can be found at the bottom of the text output of gam.check above, where we need both an edf value close to k' and a p-value less than 1. This is not the case for any of our variables. NB: \(k\) can be thought of as an upper limit on ‘wiggliness’. If k is too low, then we are not giving the GAM enough freedom to fit the true relationship.

The QQ plot again suggests that we are struggling at the tails of our distribution of residuals. This is not particularly worrying, although we will investigate an alternative model for our residuals below (scaled-t rather than Gaussian). The response vs. fitted variables plot looks fine. As expected, given the QQ plot, the histogram of residuals has quite heavy tails.

An important factor in gamm modelling is to ensure that the model specification enables sufficient ‘wiggliness’. An indication that this is not the case is that estimated degrees of freedom values are close to the ‘k’ value. All of our smooths take the default number of knows (k=10). We look at the text output of gam.check to ensure that the estimated degrees of freedom are lower than our k value. This is indeed the case.

Note the absence of autocorrelation in the model residuals (Figure 2.19).

acf_resid(gamm_fit, split_pred = 'Speaker')

Figure 2.19: Autocorrelation in model residuals.

We will take this to apply to the other models of the data we fit.

2.3.1.2 Structure 2: By-speaker smooths

We can also set up a model with by-speaker random smooths. This takes a very long time to run. By-speaker smooths are preferable in so far as they enable the model to more accurately capture how much independent information we have. Our previous model structure does not understand our datapoints as occurring within an ongoing monologue for a particular speaker.

NB: to refit this model yourself, change eval to TRUE in the following code chunk options.

gamm_fit_by_speaker <- bam(
  F1_50 ~ 
    participant_gender +
    Vowel +
    s(speaker_scaled_time, by = Vowel) + 
    s(speaker_scaled_art_rate, by=Vowel) +
    s(speaker_scaled_amp_max, by=Vowel) +
    s(speaker_scaled_pitch, by=Vowel) + 
    s(speaker_scaled_time, Speaker, bs="fs", k=5, m=1) + #k=5 to reduce load.
    s(Speaker, bs="re") +
    s(Speaker, Vowel, bs="re"),
  data = qb_vowels, 
  method="fREML",
  discrete = TRUE,
  nthreads = 8
)

write_rds(gamm_fit_by_speaker, here('models', 'gamm_fit_by_speaker.rds'))

# We again calculate and save the summary.
gamm_fit_by_speaker_summary <- summary(gamm_fit_by_speaker)
write_rds(
  gamm_fit_by_speaker_summary, 
  here('models', 'gamm_fit_by_speaker_summary.rds')
)

This cell loads a previously generated version of the model.

gamm_fit_by_speaker <- read_rds(here('models', 'gamm_fit_by_speaker.rds'))
gamm_fit_by_speaker_summary <- read_rds(
  here('models', 'gamm_fit_by_speaker_summary.rds')
)
gamm_fit_by_speaker_summary

## 
## Family: gaussian 
## Link function: identity 
## 
## Formula:
## F1_50 ~ participant_gender + Vowel + s(speaker_scaled_time, by = Vowel) + 
##     s(speaker_scaled_art_rate, by = Vowel) + s(speaker_scaled_amp_max, 
##     by = Vowel) + s(speaker_scaled_pitch, by = Vowel) + s(speaker_scaled_time, 
##     Speaker, bs = "fs", k = 5, m = 1) + s(Speaker, bs = "re") + 
##     s(Speaker, Vowel, bs = "re")
## 
## Parametric coefficients:
##                     Estimate Std. Error t value Pr(>|t|)    
## (Intercept)          434.506      4.082 106.440  < 2e-16 ***
## participant_genderM  -54.895      5.616  -9.775  < 2e-16 ***
## VowelFLEECE          -13.203      3.919  -3.369 0.000755 ***
## VowelFOOT             62.294      4.423  14.084  < 2e-16 ***
## VowelGOOSE           -21.260      4.143  -5.131 2.89e-07 ***
## VowelKIT              84.190      3.926  21.442  < 2e-16 ***
## VowelLOT             155.530      4.043  38.469  < 2e-16 ***
## VowelNURSE            13.487      4.141   3.257 0.001126 ** 
## VowelSTART           353.554      3.921  90.164  < 2e-16 ***
## VowelSTRUT           251.729      4.051  62.141  < 2e-16 ***
## VowelTHOUGHT          10.370      4.018   2.581 0.009854 ** 
## VowelTRAP            144.232      4.080  35.353  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Approximate significance of smooth terms:
##                                              edf   Ref.df       F  p-value    
## s(speaker_scaled_time):VowelDRESS          1.602    1.966   2.922 0.073626 .  
## s(speaker_scaled_time):VowelFLEECE         1.003    1.005   1.751 0.184874    
## s(speaker_scaled_time):VowelFOOT           1.002    1.003   1.145 0.285076    
## s(speaker_scaled_time):VowelGOOSE          1.002    1.003   0.006 0.945860    
## s(speaker_scaled_time):VowelKIT            5.887    7.045   2.641 0.010428 *  
## s(speaker_scaled_time):VowelLOT            2.244    2.791   8.138 4.45e-05 ***
## s(speaker_scaled_time):VowelNURSE          1.002    1.003   0.736 0.390788    
## s(speaker_scaled_time):VowelSTART          1.013    1.025   0.264 0.620154    
## s(speaker_scaled_time):VowelSTRUT          6.726    7.838   4.572 5.08e-05 ***
## s(speaker_scaled_time):VowelTHOUGHT        1.001    1.002   5.563 0.018308 *  
## s(speaker_scaled_time):VowelTRAP           2.243    2.791   5.674 0.000889 ***
## s(speaker_scaled_art_rate):VowelDRESS      1.001    1.003   0.082 0.775830    
## s(speaker_scaled_art_rate):VowelFLEECE     1.006    1.012   2.554 0.108260    
## s(speaker_scaled_art_rate):VowelFOOT       1.001    1.003   6.001 0.014274 *  
## s(speaker_scaled_art_rate):VowelGOOSE      1.002    1.004  23.543 1.22e-06 ***
## s(speaker_scaled_art_rate):VowelKIT        1.002    1.005  40.738  < 2e-16 ***
## s(speaker_scaled_art_rate):VowelLOT        1.002    1.003  26.651 1.82e-07 ***
## s(speaker_scaled_art_rate):VowelNURSE      1.001    1.002   0.157 0.692361    
## s(speaker_scaled_art_rate):VowelSTART      1.002    1.003  17.535 2.78e-05 ***
## s(speaker_scaled_art_rate):VowelSTRUT      3.896    4.836   6.707 5.59e-06 ***
## s(speaker_scaled_art_rate):VowelTHOUGHT    1.002    1.005   6.084 0.013599 *  
## s(speaker_scaled_art_rate):VowelTRAP       1.003    1.005  11.001 0.000890 ***
## s(speaker_scaled_amp_max):VowelDRESS       1.001    1.002  25.006 6.06e-07 ***
## s(speaker_scaled_amp_max):VowelFLEECE      2.296    2.926  21.412  < 2e-16 ***
## s(speaker_scaled_amp_max):VowelFOOT        1.030    1.058  95.894  < 2e-16 ***
## s(speaker_scaled_amp_max):VowelGOOSE       1.923    2.444  40.905  < 2e-16 ***
## s(speaker_scaled_amp_max):VowelKIT         3.735    4.663  55.667  < 2e-16 ***
## s(speaker_scaled_amp_max):VowelLOT         3.892    4.845 272.416  < 2e-16 ***
## s(speaker_scaled_amp_max):VowelNURSE       1.001    1.003  21.855 3.04e-06 ***
## s(speaker_scaled_amp_max):VowelSTART       1.001    1.003 105.255  < 2e-16 ***
## s(speaker_scaled_amp_max):VowelSTRUT       5.495    6.613 227.673  < 2e-16 ***
## s(speaker_scaled_amp_max):VowelTHOUGHT     1.579    1.976  15.826 6.02e-07 ***
## s(speaker_scaled_amp_max):VowelTRAP        3.603    4.511  47.062  < 2e-16 ***
## s(speaker_scaled_pitch):VowelDRESS         3.850    4.787   5.372 9.70e-05 ***
## s(speaker_scaled_pitch):VowelFLEECE        2.420    3.071   4.898 0.002086 ** 
## s(speaker_scaled_pitch):VowelFOOT          3.284    4.100   8.706  < 2e-16 ***
## s(speaker_scaled_pitch):VowelGOOSE         3.038    3.822   3.620 0.006564 ** 
## s(speaker_scaled_pitch):VowelKIT           5.820    6.935  26.343  < 2e-16 ***
## s(speaker_scaled_pitch):VowelLOT           4.854    5.925  23.936  < 2e-16 ***
## s(speaker_scaled_pitch):VowelNURSE         3.131    3.924   4.944 0.000692 ***
## s(speaker_scaled_pitch):VowelSTART         1.005    1.009   1.222 0.268043    
## s(speaker_scaled_pitch):VowelSTRUT         7.883    8.636  21.131  < 2e-16 ***
## s(speaker_scaled_pitch):VowelTHOUGHT       3.054    3.841   4.918 0.000756 ***
## s(speaker_scaled_pitch):VowelTRAP          3.868    4.808   3.695 0.002324 ** 
## s(speaker_scaled_time,Speaker)           429.664 1078.000 453.949 0.021549 *  
## s(Speaker)                                96.307  214.000   0.899  < 2e-16 ***
## s(Vowel,Speaker)                        1909.059 2361.000  10.490  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## R-sq.(adj) =  0.761   Deviance explained = 76.7%
## fREML = 6.2358e+05  Scale est. = 4979.1    n = 109290

We again visualise:

gamm_fit_preds_by_speaker <- get_predictions(
  gamm_fit_by_speaker,
  cond = list(
    'speaker_scaled_amp_max' = seq(-2.5, 2.5, length.out=200),
    'Vowel' = unique(qb_vowels$Vowel)
  )
)

## Summary:
##  * participant_gender : factor; set to the value(s): F. 
##  * Vowel : factor with 11 values; set to the value(s): DRESS, FLEECE, FOOT, GOOSE, KIT, LOT, NURSE, START, STRUT, THOUGHT, ... (Might be canceled as random effect, check below.) 
##  * speaker_scaled_time : numeric predictor; set to the value(s): 0.488802711284372. 
##  * speaker_scaled_art_rate : numeric predictor; set to the value(s): -0.023381640359837. 
##  * speaker_scaled_amp_max : numeric predictor; with 200 values ranging from -2.500000 to 2.500000. 
##  * speaker_scaled_pitch : numeric predictor; set to the value(s): -0.0723808600211757. 
##  * Speaker : factor; set to the value(s): QB_NZ_M_291. (Might be canceled as random effect, check below.) 
##  * NOTE : The following random effects columns are canceled: s(speaker_scaled_time,Speaker),s(Speaker),s(Vowel,Speaker)
## 

gamm_fit_preds_by_speaker %>%
  mutate(# Enable plot to distinguish between high and low vowels (for faceting)
    height = if_else(Vowel %in% high_vowels, "high", "low or mid")
  ) %>%
  ggplot(
    aes(
      y = fit,
      x = speaker_scaled_amp_max,
      colour = Vowel
    )
  ) + 
  geom_ribbon(
    aes(
      ymin = fit - CI,
      ymax = fit + CI,
      fill = Vowel
    ),
    alpha = 0.3,
    colour = NA
  ) +
  geom_line() +
  scale_colour_manual(
    values = vowel_colours_with_foot
  ) +
  scale_fill_manual(
    values = vowel_colours_with_foot
  ) +
  labs(
    title = "F1 and Amplitude by Vowel (by Speaker Smooths Over Time)",
    x = "Scaled amplitude",
    y = "F1"
  )

Figure 2.20: F1 and amplitude by vowel with by by-speaker smooths over time.

  # facet_wrap(
  #   facets=vars(height), scales = "free"
  # )

We again run model diagnostics:

gam.check(gamm_fit_by_speaker)

## 
## Method: fREML   Optimizer: perf chol
## $grad
##  [1] -1.901919e-10 -3.296847e-04 -5.389764e-04 -5.507059e-04 -9.507950e-13
##  [6] -6.431744e-12 -6.535152e-04 -3.688858e-04 -1.766143e-12 -4.591929e-04
## [11] -1.397915e-11 -4.615195e-04 -3.002636e-04 -6.061372e-04 -4.200021e-04
## [16] -7.758067e-04 -3.865987e-04 -3.988909e-04 -7.488789e-04 -5.174838e-11
## [21] -7.201934e-04 -3.659678e-04 -3.217623e-04  1.578071e-12 -5.130808e-04
## [26] -9.786616e-14 -5.817569e-14  3.723688e-13 -5.336280e-04 -4.241962e-04
## [31] -1.014744e-12 -1.224665e-11 -1.265654e-13 -3.310685e-13 -3.722800e-12
## [36]  2.206647e-08 -3.146372e-13  3.685940e-13 -3.324674e-12 -2.378986e-12
## [41] -5.096119e-04  1.635136e-12 -4.866996e-12  1.101785e-12  1.024034e-10
## [46]  1.784812e-10  1.819913e-10  6.990831e-09 -5.384936e-08
## 
## $hess
##            [,1]          [,2]          [,3]          [,4]          [,5]
##    1.549460e-01  6.134846e-05 -1.476592e-05  1.570621e-05  1.859996e-03
##    6.134846e-05  3.301635e-04  5.459662e-08 -6.986205e-08 -7.591596e-06
##   -1.476592e-05  5.459662e-08  5.387006e-04  1.394517e-08  1.321416e-06
##    1.570621e-05 -6.986205e-08  1.394517e-08  5.503235e-04 -1.650047e-06
##    1.859996e-03 -7.591596e-06  1.321416e-06 -1.650047e-06  7.645386e-01
##   -1.053697e-02  3.886053e-05 -1.024831e-05  1.051062e-05  2.164652e-04
##    1.451180e-05 -6.462406e-08  1.257542e-08 -1.610360e-08 -1.755055e-06
##   -2.003296e-04  7.438207e-07 -1.744682e-07  1.856583e-07  2.762991e-05
##   -2.031383e-04  1.316047e-06 -7.368151e-08  2.886242e-07  5.731948e-05
##   -6.159471e-06  1.769533e-08 -5.402957e-09  4.599685e-09  6.454442e-07
##   -1.027701e-02  3.791734e-05 -9.922334e-06  1.026863e-05  2.052470e-04
##   -1.633826e-06  1.088678e-09 -2.456029e-10  2.225122e-10  5.898464e-09
##    1.839103e-07 -5.050885e-08  1.266602e-09 -6.497671e-10  6.550196e-07
##    1.149453e-07 -5.434769e-10 -2.774895e-09 -8.119898e-11  1.002477e-08
##   -3.456304e-07  1.710263e-09 -4.395099e-10 -9.810433e-09  5.193150e-08
##   -7.622331e-08  4.294172e-10 -3.844451e-11  8.047456e-11 -4.855640e-07
##   -1.937514e-07  9.007758e-10 -2.596775e-10  2.510463e-10 -7.973269e-08
##   -3.401860e-08 -7.497269e-12 -4.652654e-11 -3.616415e-12  2.351670e-09
##   -7.789180e-08  1.584067e-10 -6.486773e-11  4.684542e-11  6.556094e-09
##   -1.176361e-04  3.297643e-07 -1.499995e-07  2.205960e-07 -4.986456e-05
##   -6.060125e-08 -1.316530e-10 -1.409117e-10 -4.008745e-11 -8.618562e-08
##   -7.136788e-07  2.809674e-09 -6.497978e-10  5.238505e-10  3.894686e-08
##   -1.108801e-06  5.169911e-11  1.023381e-10  3.017567e-12 -1.786108e-09
##    4.520181e-06 -3.269601e-06 -5.448523e-08  7.910191e-08 -3.127190e-05
##    8.015020e-06 -3.177551e-08 -4.840208e-07 -8.485169e-09 -2.081885e-06
##   -1.071032e-04  4.237214e-07 -2.240470e-07 -4.524241e-06 -4.034599e-06
##   -1.173656e-05  1.203030e-08 -1.107898e-07 -5.841019e-08  1.451117e-03
##   -2.739146e-05  3.227875e-08 -3.899704e-08  4.743080e-08 -1.475452e-05
##   -9.624127e-08  3.995574e-10 -2.221429e-10  3.149580e-11  9.948225e-08
##    2.474559e-07 -8.162555e-10  2.050308e-10 -2.888972e-10 -3.874339e-09
##    1.460354e-04 -1.845861e-07  2.674709e-07 -2.128858e-07 -1.106033e-04
##   -2.028785e-04  6.162735e-07 -1.497134e-07  2.116464e-07 -2.406086e-06
##   -1.721951e-04 -1.740359e-08  2.950500e-08  2.437777e-07  1.075772e-04
##    2.177608e-03 -3.662752e-08 -2.503957e-07  1.415387e-07 -8.383267e-06
##   -1.298193e-05 -1.231011e-06 -1.882211e-07  1.485153e-07 -3.217541e-05
##    1.129510e-04 -2.958434e-07 -5.349079e-06 -1.225864e-08  5.110448e-05
##    8.979311e-05 -3.256851e-07  1.243028e-07  2.082671e-06 -3.973419e-05
##   -9.171093e-07  5.200796e-07 -2.585466e-09 -8.957202e-08  2.145483e-03
##    1.013164e-04 -2.345895e-07 -8.098241e-08 -9.178567e-08 -7.559802e-05
##   -3.690242e-04  2.360642e-06 -5.676418e-07  5.274727e-07  1.003833e-05
##    1.525305e-06 -6.330009e-09  1.722531e-09 -2.131079e-09  3.208104e-07
##   -9.301319e-05 -3.636287e-07  5.727258e-08 -1.226310e-07  6.345099e-06
##    7.084708e-05 -4.065220e-08 -1.084609e-07  2.130967e-08  1.325930e-04
##   -6.214903e-05 -2.266138e-07  4.918412e-08  1.231779e-07  1.179062e-04
##    6.600910e-03 -1.560185e-04  9.004162e-06 -8.685461e-05 -3.915179e-02
##    6.851899e-04  1.430484e-06  3.394071e-06  3.101765e-06 -1.771378e-03
##    6.851899e-04  1.430484e-06  3.394071e-06  3.101765e-06 -1.771378e-03
##    4.905528e-03  1.339335e-05 -4.494601e-05 -4.370218e-05 -4.782401e-03
## d -3.007704e-01 -9.605602e-04 -3.197717e-04 -2.022026e-04 -2.443661e+00
##            [,6]          [,7]          [,8]          [,9]         [,10]
##   -1.053697e-02  1.451180e-05 -2.003296e-04 -2.031383e-04 -6.159471e-06
##    3.886053e-05 -6.462406e-08  7.438207e-07  1.316047e-06  1.769533e-08
##   -1.024831e-05  1.257542e-08 -1.744682e-07 -7.368151e-08 -5.402957e-09
##    1.051062e-05 -1.610360e-08  1.856583e-07  2.886242e-07  4.599685e-09
##    2.164652e-04 -1.755055e-06  2.762991e-05  5.731948e-05  6.454442e-07
##    2.996527e-01  9.010204e-06 -1.118605e-04  5.710999e-04 -3.909143e-06
##    9.010204e-06  6.529411e-04  1.731672e-07  4.279987e-07  4.205271e-09
##   -1.118605e-04  1.731672e-07  3.882125e-04 -5.420442e-06 -7.265565e-08
##    5.710999e-04  4.279987e-07 -5.420442e-06  1.098960e+00 -1.611649e-07
##   -3.909143e-06  4.205271e-09 -7.265565e-08 -1.611649e-07  4.588910e-04
##   -9.146742e-03  8.739912e-06 -1.075435e-04 -4.478056e-04 -3.822981e-06
##   -1.747714e-07  1.051115e-10 -3.427851e-09  3.197965e-07 -6.035071e-11
##    5.898391e-07 -2.550894e-11  1.802407e-08 -1.821390e-06  8.468787e-11
##   -1.465363e-08 -1.133725e-10  2.819477e-10  1.024819e-08  3.615989e-11
##   -1.577235e-07  3.412142e-10 -4.173113e-09  2.254916e-07 -1.618102e-10
##    6.464894e-08 -1.099459e-10  6.103082e-10  7.571156e-08 -5.431075e-12
##    2.333427e-06  1.694817e-10 -2.096862e-09  1.381249e-07 -2.993472e-11
##   -2.191826e-11  6.348714e-10  7.675506e-11  2.695778e-09 -2.744818e-13
##   -5.304676e-08  7.733332e-11  1.406861e-08  4.056015e-08 -2.221770e-11
##   -2.298929e-05  7.474894e-08 -4.670659e-07  1.383876e-03 -1.807918e-09
##   -1.604474e-07 -2.259285e-11 -3.541106e-10  2.599360e-07 -2.009366e-09
##   -4.726597e-07  2.005928e-10 -9.225498e-09  7.438624e-07 -1.835049e-10
##    4.121077e-08 -9.484075e-12 -5.863825e-10  1.097878e-07 -2.253681e-12
##   -3.717116e-05 -8.023521e-08  4.173253e-07  2.531642e-05  3.676025e-08
##    2.875123e-06 -8.200513e-09  1.216039e-07  8.283106e-08  2.568668e-09
##   -1.182905e-05  9.665896e-08 -1.059747e-06 -1.238313e-04 -7.373030e-09
##   -1.451855e-06  3.049907e-08  1.086003e-06  1.340094e-04  4.290448e-08
##    1.462782e-03 -5.754893e-09  8.389229e-07 -9.523393e-05 -1.129211e-08
##    4.043512e-09 -7.021046e-09 -1.679695e-09 -4.233292e-10  1.209274e-12
##    1.803819e-07 -2.162807e-10 -1.195017e-07 -2.867606e-08  1.081692e-10
##    1.969076e-04 -2.693022e-08  4.289071e-06 -1.366722e-02  7.906021e-08
##   -6.570289e-05  1.278135e-07 -1.358920e-06 -8.591887e-05  1.643882e-06
##   -1.507197e-04 -8.820661e-09 -9.247712e-07  1.025831e-05 -5.321292e-08
##   -5.176914e-05 -9.037919e-08 -1.855736e-06 -1.981242e-04  3.606395e-09
##   -1.355871e-05  1.035161e-07  1.974837e-07 -1.271481e-04 -2.505909e-08
##    1.005038e-04 -1.940163e-07 -1.352933e-07  1.273523e-05  9.492872e-09
##    4.896961e-05 -8.243276e-08  5.811988e-07  1.046268e-05  2.887756e-08
##   -4.068846e-05 -5.384033e-08  4.514809e-07  8.726160e-05  4.422219e-08
##    4.235620e-04 -1.366046e-07 -7.229999e-07 -9.529170e-05  4.877826e-08
##   -2.031618e-04 -1.120797e-05 -4.927910e-06 -1.801148e-04 -1.497545e-07
##    1.330926e-06 -1.249890e-09 -4.610911e-07  4.686153e-07  5.979100e-10
##   -4.570959e-06 -5.857489e-08 -1.203536e-06  7.773950e-03  7.067331e-09
##    6.210858e-05  1.546737e-08  1.396033e-06 -1.510101e-04 -1.110558e-06
##    3.546234e-05  1.688854e-07 -2.198531e-07  1.045524e-04 -3.647628e-08
##    5.040022e-02 -3.515261e-05  5.742777e-05  1.713168e-02  2.750924e-06
##   -2.427040e-04 -7.679314e-07 -4.175924e-05  2.944993e-03 -2.202006e-07
##   -2.427040e-04 -7.679314e-07 -4.175924e-05  2.944993e-03 -2.202006e-07
##    1.990740e-02  9.110234e-07 -4.491911e-04 -2.406309e-02 -2.455596e-05
## d -6.220648e-01 -1.885164e-04 -6.020621e-03 -2.862952e+00 -3.029585e-05
##           [,11]         [,12]         [,13]         [,14]         [,15]
##   -1.027701e-02 -1.633826e-06  1.839103e-07  1.149453e-07 -3.456304e-07
##    3.791734e-05  1.088678e-09 -5.050885e-08 -5.434769e-10  1.710263e-09
##   -9.922334e-06 -2.456029e-10  1.266602e-09 -2.774895e-09 -4.395099e-10
##    1.026863e-05  2.225122e-10 -6.497671e-10 -8.119898e-11 -9.810433e-09
##    2.052470e-04  5.898464e-09  6.550196e-07  1.002477e-08  5.193150e-08
##   -9.146742e-03 -1.747714e-07  5.898391e-07 -1.465363e-08 -1.577235e-07
##    8.739912e-06  1.051115e-10 -2.550894e-11 -1.133725e-10  3.412142e-10
##   -1.075435e-04 -3.427851e-09  1.802407e-08  2.819477e-10 -4.173113e-09
##   -4.478056e-04  3.197965e-07 -1.821390e-06  1.024819e-08  2.254916e-07
##   -3.822981e-06 -6.035071e-11  8.468787e-11  3.615989e-11 -1.618102e-10
##    3.321686e-01 -1.878656e-07  1.607100e-06  8.776137e-08 -1.586635e-07
##   -1.878656e-07  4.613045e-04  7.914027e-09  3.021978e-10 -6.704530e-10
##    1.607100e-06  7.914027e-09  3.115635e-04 -2.387644e-09  5.594021e-09
##    8.776137e-08  3.021978e-10 -2.387644e-09  6.056377e-04  2.513328e-10
##   -1.586635e-07 -6.704530e-10  5.594021e-09  2.513328e-10  4.193733e-04
##   -7.491553e-08 -1.914180e-11 -2.654300e-10  3.035778e-11 -1.675746e-10
##   -2.585396e-07 -9.160184e-10  7.228106e-09  2.478458e-10 -6.172543e-10
##   -3.108667e-08 -2.473958e-10  1.750858e-09  5.826542e-11 -1.099020e-10
##   -9.458729e-08 -2.692757e-10  2.059836e-09  7.816581e-11 -2.258580e-10
##    5.855788e-06 -2.642714e-07  4.014377e-07  3.481487e-08  1.121664e-07
##   -2.554172e-07 -1.150664e-09  1.074127e-08  2.722478e-10 -5.192402e-10
##    1.138519e-05 -2.357885e-09  1.850798e-08  5.572131e-10 -1.626427e-09
##    3.233115e-08  1.128660e-09  2.946704e-10  6.033667e-12 -1.862856e-11
##   -8.616354e-05 -1.669766e-09  6.362230e-06  2.580710e-08  1.349387e-08
##    4.450603e-06  1.095605e-09 -1.291191e-08 -9.965281e-09  6.511594e-10
##   -3.618888e-05  1.597999e-09 -3.821187e-08  3.788949e-08 -3.988835e-06
##    4.347826e-05  7.605997e-08 -3.626554e-07  1.751092e-08  1.190027e-08
##    1.216826e-05  6.694422e-08 -4.880938e-07 -4.935965e-09  4.918652e-09
##   -1.636417e-08  6.206591e-11 -6.876113e-10 -4.984617e-11 -6.287254e-11
##    2.392282e-07 -1.075116e-10  6.225115e-11  2.154004e-11 -6.096976e-11
##    1.047577e-04  6.584264e-08 -5.409713e-07  1.928251e-08 -3.656530e-08
##   -1.097044e-04  4.833158e-08 -1.329883e-07  4.846704e-09 -6.807816e-08
##    8.359963e-03  4.636811e-08 -3.111315e-07 -5.966064e-08  1.612704e-07
##   -1.038237e-04  3.468392e-06  3.365404e-07  3.049140e-08 -2.563585e-10
##   -3.154194e-05  5.927995e-08  2.098444e-05  9.221593e-08  5.651566e-08
##    1.020299e-04  7.134202e-08  3.074524e-08  1.590902e-06  2.651813e-09
##    7.116749e-05 -5.782618e-08 -5.031510e-08 -1.536551e-08 -2.447919e-06
##    1.174813e-04 -1.956264e-07  6.196470e-07 -1.727197e-08 -4.774750e-08
##    1.945168e-04  1.111417e-09 -2.257126e-07  1.191417e-08 -5.543573e-08
##   -2.519888e-04  6.819169e-08  6.328919e-07  8.233995e-08 -2.614790e-08
##    1.504634e-06  1.272708e-10 -1.454768e-09 -1.209805e-10  2.592103e-10
##   -5.000921e-05 -2.478863e-07  7.288044e-07  1.195262e-07 -1.354972e-07
##    1.786565e-05  1.664869e-08 -4.732411e-08  2.644878e-08  5.673740e-08
##    1.056476e-03  7.984939e-09  1.096339e-06  1.943304e-08  2.465373e-08
##    5.329011e-02 -3.470373e-05  1.121189e-05  3.232266e-06  7.804994e-06
##   -6.745090e-04 -1.536215e-06 -3.669671e-06  3.482890e-06  2.298862e-06
##   -6.745090e-04 -1.536215e-06 -3.669671e-06  3.482890e-06  2.298862e-06
##    2.335240e-02  9.404545e-06  9.118012e-05 -4.423635e-05 -1.357567e-05
## d -6.216786e-01 -1.718192e-04 -2.625317e-03 -9.979154e-05 -4.875273e-04
##           [,16]         [,17]         [,18]         [,19]         [,20]
##   -7.622331e-08 -1.937514e-07 -3.401860e-08 -7.789180e-08 -1.176361e-04
##    4.294172e-10  9.007758e-10 -7.497269e-12  1.584067e-10  3.297643e-07
##   -3.844451e-11 -2.596775e-10 -4.652654e-11 -6.486773e-11 -1.499995e-07
##    8.047456e-11  2.510463e-10 -3.616415e-12  4.684542e-11  2.205960e-07
##   -4.855640e-07 -7.973269e-08  2.351670e-09  6.556094e-09 -4.986456e-05
##    6.464894e-08  2.333427e-06 -2.191826e-11 -5.304676e-08 -2.298929e-05
##   -1.099459e-10  1.694817e-10  6.348714e-10  7.733332e-11  7.474894e-08
##    6.103082e-10 -2.096862e-09  7.675506e-11  1.406861e-08 -4.670659e-07
##    7.571156e-08  1.381249e-07  2.695778e-09  4.056015e-08  1.383876e-03
##   -5.431075e-12 -2.993472e-11 -2.744818e-13 -2.221770e-11 -1.807918e-09
##   -7.491553e-08 -2.585396e-07 -3.108667e-08 -9.458729e-08  5.855788e-06
##   -1.914180e-11 -9.160184e-10 -2.473958e-10 -2.692757e-10 -2.642714e-07
##   -2.654300e-10  7.228106e-09  1.750858e-09  2.059836e-09  4.014377e-07
##    3.035778e-11  2.478458e-10  5.826542e-11  7.816581e-11  3.481487e-08
##   -1.675746e-10 -6.172543e-10 -1.099020e-10 -2.258580e-10  1.121664e-07
##    7.741198e-04  3.458308e-11  1.021239e-11 -2.903288e-11  9.678615e-08
##    3.458308e-11  3.862859e-04 -1.661259e-10 -2.458988e-10  2.475104e-07
##    1.021239e-11 -1.661259e-10  3.986830e-04 -5.622120e-11 -9.304133e-09
##   -2.903288e-11 -2.458988e-10 -5.622120e-11  7.480810e-04  2.426618e-08
##    9.678615e-08  2.475104e-07 -9.304133e-09  2.426618e-08  1.307433e-01
##    2.888885e-10 -1.259567e-09 -2.840245e-10 -3.543025e-10 -7.118289e-08
##    3.056612e-10 -2.182663e-09 -5.549715e-10 -6.018229e-10 -3.327229e-07
##    1.014064e-11 -2.446471e-11 -2.240796e-12  4.418773e-14  3.245143e-08
##   -5.670368e-08  4.540147e-08  2.524720e-09 -2.261222e-08 -6.570654e-05
##    2.389277e-10  5.735837e-10  7.810870e-10 -4.116155e-11 -2.304419e-06
##   -3.792305e-08  7.282594e-08 -1.975819e-10  2.275444e-09 -6.461637e-06
##    5.792394e-07  6.638579e-09  1.259079e-08  5.567787e-09 -7.017321e-06
##   -3.110520e-08 -5.093285e-06 -6.358429e-09 -5.832630e-09  5.283448e-05
##   -4.261703e-11  1.034593e-10 -2.440966e-11  6.789880e-12  4.985078e-08
##    4.766322e-11 -1.907100e-10 -2.792310e-11  1.031141e-09  6.139349e-08
##    8.780421e-09 -1.544764e-07  2.627075e-08  9.024671e-09 -1.037858e-02
##   -4.390494e-08  3.816705e-08  2.676435e-10 -1.143654e-09  1.550872e-05
##   -5.454473e-08  4.906665e-08 -8.654558e-09  4.085030e-08 -2.905892e-05
##   -2.261972e-07  1.193487e-08  8.735961e-09  1.236605e-08 -4.000322e-05
##   -2.826841e-09 -6.308849e-08  1.788686e-08  1.609272e-08 -5.306883e-05
##    1.036215e-08  9.078620e-08  1.621352e-09  5.786208e-10 -7.015369e-05
##   -3.799439e-08 -5.058111e-08 -1.616635e-08 -5.363157e-10  3.460275e-07
##    2.254488e-06 -1.472588e-07 -3.221927e-08 -3.818608e-09 -8.683549e-05
##   -1.561476e-08 -1.250398e-06  1.159567e-08  8.720276e-10  7.163998e-05
##    2.044134e-08 -2.672300e-08 -1.457452e-06  5.174931e-08  2.548837e-05
##   -9.868411e-11  1.562783e-10 -5.297359e-11 -8.698815e-09  2.738973e-07
##   -5.380672e-08 -5.024212e-08 -5.344538e-09 -6.784516e-08 -1.246435e-02
##   -6.368268e-10 -9.825744e-08 -3.035193e-09  6.740523e-09 -4.663117e-06
##    6.019067e-08 -2.363620e-07 -4.780050e-08  1.909214e-08 -4.966332e-05
##   -1.135680e-05  2.496010e-05 -7.323078e-06 -3.125740e-06 -8.772068e-03
##   -1.742951e-07 -6.202621e-07 -6.226449e-07 -1.587221e-06 -1.256975e-03
##   -1.742951e-07 -6.202621e-07 -6.226449e-07 -1.587221e-06 -1.256975e-03
##    6.616761e-06  3.535752e-06 -7.579099e-06 -5.005657e-05 -1.348578e-02
## d -4.439873e-04 -3.911337e-04 -4.118815e-05 -5.985140e-05 -1.448094e+00
##           [,21]         [,22]         [,23]         [,24]         [,25]
##   -6.060125e-08 -7.136788e-07 -1.108801e-06  4.520181e-06  8.015020e-06
##   -1.316530e-10  2.809674e-09  5.169911e-11 -3.269601e-06 -3.177551e-08
##   -1.409117e-10 -6.497978e-10  1.023381e-10 -5.448523e-08 -4.840208e-07
##   -4.008745e-11  5.238505e-10  3.017567e-12  7.910191e-08 -8.485169e-09
##   -8.618562e-08  3.894686e-08 -1.786108e-09 -3.127190e-05 -2.081885e-06
##   -1.604474e-07 -4.726597e-07  4.121077e-08 -3.717116e-05  2.875123e-06
##   -2.259285e-11  2.005928e-10 -9.484075e-12 -8.023521e-08 -8.200513e-09
##   -3.541106e-10 -9.225498e-09 -5.863825e-10  4.173253e-07  1.216039e-07
##    2.599360e-07  7.438624e-07  1.097878e-07  2.531642e-05  8.283106e-08
##   -2.009366e-09 -1.835049e-10 -2.253681e-12  3.676025e-08  2.568668e-09
##   -2.554172e-07  1.138519e-05  3.233115e-08 -8.616354e-05  4.450603e-06
##   -1.150664e-09 -2.357885e-09  1.128660e-09 -1.669766e-09  1.095605e-09
##    1.074127e-08  1.850798e-08  2.946704e-10  6.362230e-06 -1.291191e-08
##    2.722478e-10  5.572131e-10  6.033667e-12  2.580710e-08 -9.965281e-09
##   -5.192402e-10 -1.626427e-09 -1.862856e-11  1.349387e-08  6.511594e-10
##    2.888885e-10  3.056612e-10  1.014064e-11 -5.670368e-08  2.389277e-10
##   -1.259567e-09 -2.182663e-09 -2.446471e-11  4.540147e-08  5.735837e-10
##   -2.840245e-10 -5.549715e-10 -2.240796e-12  2.524720e-09  7.810870e-10
##   -3.543025e-10 -6.018229e-10  4.418773e-14 -2.261222e-08 -4.116155e-11
##   -7.118289e-08 -3.327229e-07  3.245143e-08 -6.570654e-05 -2.304419e-06
##    7.198916e-04 -3.752179e-09 -3.426213e-11 -7.359506e-08  6.450095e-10
##   -3.752179e-09  3.673375e-04 -5.252113e-11 -2.460948e-07  2.454509e-09
##   -3.426213e-11 -5.252113e-11  3.216155e-04  6.225177e-08 -6.086487e-10
##   -7.359506e-08 -2.460948e-07  6.225177e-08  2.379631e-01  1.151517e-06
##    6.450095e-10  2.454509e-09 -6.086487e-10  1.151517e-06  5.239007e-04
##    1.862910e-07 -2.994269e-09  6.421289e-08 -7.190924e-05  4.489614e-07
##    8.478384e-08  8.014191e-08  8.040425e-08 -8.586463e-05  1.941381e-06
##    6.621744e-08  1.115014e-07  5.175561e-08 -4.506258e-05  5.632707e-07
##    1.699320e-10  2.324527e-11  7.095647e-11 -4.963098e-08  3.513472e-09
##    1.401892e-10 -8.625209e-11 -7.220942e-11  8.813584e-08 -8.336903e-10
##    5.543813e-08 -4.519039e-07  3.302015e-08 -6.242692e-05  2.046449e-06
##    9.402724e-07 -5.194201e-08  6.781453e-08 -4.610314e-05  1.674512e-06
##    4.738051e-08 -7.396752e-07 -1.160546e-08 -3.435784e-05  1.348270e-06
##   -2.287488e-07 -5.193186e-08  8.137207e-06  1.732587e-04 -5.905594e-06
##   -1.190550e-07 -9.407104e-09 -1.183391e-08  3.136375e-03 -1.641204e-07
##    5.008545e-08 -2.940466e-08 -2.138725e-08  4.965930e-05  5.807940e-04
##    1.589540e-07  3.750126e-08  1.314785e-08  2.282987e-05  1.432422e-06
##   -1.438012e-07 -6.873766e-07  2.653625e-08 -2.268544e-05 -6.149434e-07
##    2.121266e-07  2.075290e-07 -1.463937e-08  7.468308e-05 -1.530248e-06
##   -2.658302e-08 -1.638078e-07  2.652402e-09  4.994238e-05 -2.214057e-07
##    1.536086e-11 -8.237670e-11 -1.154543e-11  1.429608e-07  5.099790e-09
##    1.171473e-07 -4.147658e-07  5.088965e-08  1.084681e-04 -4.711227e-06
##   -5.908054e-06 -1.936819e-08  2.937349e-08  1.368600e-05 -1.271851e-07
##    2.195164e-07  1.080328e-05  5.505958e-08  2.044994e-05  2.526367e-07
##   -1.144180e-05 -4.815186e-05 -5.726698e-08  1.883446e-03 -2.052258e-05
##    5.323388e-07 -3.163657e-06  1.292535e-07 -6.553913e-04  3.507244e-04
##    5.323388e-07 -3.163657e-06  1.292535e-07 -6.553913e-04  3.507244e-04
##    4.571030e-05  6.635349e-05  1.057184e-06 -7.765862e-04 -4.360780e-03
## d -4.198721e-04 -9.780534e-04 -8.057054e-05 -6.480574e-01 -1.433141e-02
##           [,26]         [,27]         [,28]         [,29]         [,30]
##   -1.071032e-04 -1.173656e-05 -2.739146e-05 -9.624127e-08  2.474559e-07
##    4.237214e-07  1.203030e-08  3.227875e-08  3.995574e-10 -8.162555e-10
##   -2.240470e-07 -1.107898e-07 -3.899704e-08 -2.221429e-10  2.050308e-10
##   -4.524241e-06 -5.841019e-08  4.743080e-08  3.149580e-11 -2.888972e-10
##   -4.034599e-06  1.451117e-03 -1.475452e-05  9.948225e-08 -3.874339e-09
##   -1.182905e-05 -1.451855e-06  1.462782e-03  4.043512e-09  1.803819e-07
##    9.665896e-08  3.049907e-08 -5.754893e-09 -7.021046e-09 -2.162807e-10
##   -1.059747e-06  1.086003e-06  8.389229e-07 -1.679695e-09 -1.195017e-07
##   -1.238313e-04  1.340094e-04 -9.523393e-05 -4.233292e-10 -2.867606e-08
##   -7.373030e-09  4.290448e-08 -1.129211e-08  1.209274e-12  1.081692e-10
##   -3.618888e-05  4.347826e-05  1.216826e-05 -1.636417e-08  2.392282e-07
##    1.597999e-09  7.605997e-08  6.694422e-08  6.206591e-11 -1.075116e-10
##   -3.821187e-08 -3.626554e-07 -4.880938e-07 -6.876113e-10  6.225115e-11
##    3.788949e-08  1.751092e-08 -4.935965e-09 -4.984617e-11  2.154004e-11
##   -3.988835e-06  1.190027e-08  4.918652e-09 -6.287254e-11 -6.096976e-11
##   -3.792305e-08  5.792394e-07 -3.110520e-08 -4.261703e-11  4.766322e-11
##    7.282594e-08  6.638579e-09 -5.093285e-06  1.034593e-10 -1.907100e-10
##   -1.975819e-10  1.259079e-08 -6.358429e-09 -2.440966e-11 -2.792310e-11
##    2.275444e-09  5.567787e-09 -5.832630e-09  6.789880e-12  1.031141e-09
##   -6.461637e-06 -7.017321e-06  5.283448e-05  4.985078e-08  6.139349e-08
##    1.862910e-07  8.478384e-08  6.621744e-08  1.699320e-10  1.401892e-10
##   -2.994269e-09  8.014191e-08  1.115014e-07  2.324527e-11 -8.625209e-11
##    6.421289e-08  8.040425e-08  5.175561e-08  7.095647e-11 -7.220942e-11
##   -7.190924e-05 -8.586463e-05 -4.506258e-05 -4.963098e-08  8.813584e-08
##    4.489614e-07  1.941381e-06  5.632707e-07  3.513472e-09 -8.336903e-10
##    1.500133e-01 -2.796263e-05 -3.354034e-05 -6.013485e-08  4.285242e-08
##   -2.796263e-05  1.363548e+00 -4.182984e-05 -1.038060e-07  7.284639e-08
##   -3.354034e-05 -4.182984e-05  1.675612e+00 -3.854073e-08  1.467723e-07
##   -6.013485e-08 -1.038060e-07 -3.854073e-08  5.332426e-04  6.782147e-11
##    4.285242e-08  7.284639e-08  1.467723e-07  6.782147e-11  4.238489e-04
##    6.495047e-06  1.105178e-05  1.570848e-05 -1.250312e-07 -4.671492e-08
##   -4.534015e-05 -6.002170e-05 -5.252096e-05 -7.441606e-08  6.379462e-08
##    5.774320e-05 -7.814328e-05 -7.597036e-05  3.062044e-08  1.049747e-07
##   -8.002399e-05  5.202539e-05  6.761759e-05  4.822074e-08 -7.287042e-08
##   -2.265251e-05  1.583312e-05  4.697084e-05  2.399730e-08 -6.535968e-08
##    2.047105e-05  2.493847e-06 -2.051550e-05  6.544558e-09 -2.910688e-09
##   -3.098196e-02 -3.923232e-06 -2.088106e-05  4.526124e-08 -1.092661e-09
##   -4.736848e-05 -4.807052e-03  4.182182e-05  2.209599e-08 -5.221002e-08
##    5.831586e-05  6.098411e-05  4.949655e-03  5.062317e-08 -5.998389e-08
##    2.734314e-06 -2.552065e-05  2.929356e-05 -3.293217e-05 -4.534127e-08
##    1.486659e-07 -1.786338e-08  6.748543e-08  1.355763e-11  1.314160e-08
##    1.373707e-04  4.766353e-05 -9.778466e-06 -7.732295e-09 -2.314234e-08
##   -4.119224e-05  2.641315e-05 -5.607452e-05 -1.434576e-08 -3.220726e-08
##   -1.669231e-05  1.081973e-05 -4.394677e-05 -1.565591e-08  1.731706e-08
##   -1.002581e-02 -1.739912e-02 -3.071043e-03 -1.040740e-06 -9.742175e-06
##   -3.150128e-03 -3.697110e-04 -9.204990e-04  4.863981e-08  1.641188e-06
##   -3.150128e-03 -3.697110e-04 -9.204990e-04  4.863981e-08  1.641188e-06
##    3.829560e-02  1.017910e-02 -1.387140e-02  1.397981e-05  1.401081e-04
## d -4.612962e-01 -1.367613e+00 -1.446002e+00 -1.598900e-04 -2.587189e-04
##           [,31]         [,32]         [,33]         [,34]         [,35]
##    1.460354e-04 -2.028785e-04 -1.721951e-04  2.177608e-03 -1.298193e-05
##   -1.845861e-07  6.162735e-07 -1.740359e-08 -3.662752e-08 -1.231011e-06
##    2.674709e-07 -1.497134e-07  2.950500e-08 -2.503957e-07 -1.882211e-07
##   -2.128858e-07  2.116464e-07  2.437777e-07  1.415387e-07  1.485153e-07
##   -1.106033e-04 -2.406086e-06  1.075772e-04 -8.383267e-06 -3.217541e-05
##    1.969076e-04 -6.570289e-05 -1.507197e-04 -5.176914e-05 -1.355871e-05
##   -2.693022e-08  1.278135e-07 -8.820661e-09 -9.037919e-08  1.035161e-07
##    4.289071e-06 -1.358920e-06 -9.247712e-07 -1.855736e-06  1.974837e-07
##   -1.366722e-02 -8.591887e-05  1.025831e-05 -1.981242e-04 -1.271481e-04
##    7.906021e-08  1.643882e-06 -5.321292e-08  3.606395e-09 -2.505909e-08
##    1.047577e-04 -1.097044e-04  8.359963e-03 -1.038237e-04 -3.154194e-05
##    6.584264e-08  4.833158e-08  4.636811e-08  3.468392e-06  5.927995e-08
##   -5.409713e-07 -1.329883e-07 -3.111315e-07  3.365404e-07  2.098444e-05
##    1.928251e-08  4.846704e-09 -5.966064e-08  3.049140e-08  9.221593e-08
##   -3.656530e-08 -6.807816e-08  1.612704e-07 -2.563585e-10  5.651566e-08
##    8.780421e-09 -4.390494e-08 -5.454473e-08 -2.261972e-07 -2.826841e-09
##   -1.544764e-07  3.816705e-08  4.906665e-08  1.193487e-08 -6.308849e-08
##    2.627075e-08  2.676435e-10 -8.654558e-09  8.735961e-09  1.788686e-08
##    9.024671e-09 -1.143654e-09  4.085030e-08  1.236605e-08  1.609272e-08
##   -1.037858e-02  1.550872e-05 -2.905892e-05 -4.000322e-05 -5.306883e-05
##    5.543813e-08  9.402724e-07  4.738051e-08 -2.287488e-07 -1.190550e-07
##   -4.519039e-07 -5.194201e-08 -7.396752e-07 -5.193186e-08 -9.407104e-09
##    3.302015e-08  6.781453e-08 -1.160546e-08  8.137207e-06 -1.183391e-08
##   -6.242692e-05 -4.610314e-05 -3.435784e-05  1.732587e-04  3.136375e-03
##    2.046449e-06  1.674512e-06  1.348270e-06 -5.905594e-06 -1.641204e-07
##    6.495047e-06 -4.534015e-05  5.774320e-05 -8.002399e-05 -2.265251e-05
##    1.105178e-05 -6.002170e-05 -7.814328e-05  5.202539e-05  1.583312e-05
##    1.570848e-05 -5.252096e-05 -7.597036e-05  6.761759e-05  4.697084e-05
##   -1.250312e-07 -7.441606e-08  3.062044e-08  4.822074e-08  2.399730e-08
##   -4.671492e-08  6.379462e-08  1.049747e-07 -7.287042e-08 -6.535968e-08
##    9.070712e-01  4.279669e-06  9.846508e-05  9.953864e-05  6.864225e-05
##    4.279669e-06  9.752858e-02  1.559186e-05  7.555500e-05  6.289225e-05
##    9.846508e-05  1.559186e-05  4.709230e-01  2.573168e-05  1.041560e-04
##    9.953864e-05  7.555500e-05  2.573168e-05  8.765295e-01 -2.777422e-04
##    6.864225e-05  6.289225e-05  1.041560e-04 -2.777422e-04  1.575245e-01
##    1.428696e-06  1.082064e-05  4.878135e-05 -2.168158e-05 -7.936591e-05
##   -6.207195e-05  1.792153e-05 -2.273730e-05 -9.537492e-05 -6.493475e-05
##   -2.833420e-05  6.548153e-06 -7.723083e-07  1.291068e-04 -4.878215e-05
##    1.618715e-04 -3.092046e-06  4.526590e-05 -2.069179e-04 -1.369136e-04
##    2.198578e-05 -2.994558e-05 -1.483604e-05 -2.049811e-04 -2.381109e-04
##    9.066256e-08  1.121696e-08 -1.223349e-07  6.799374e-07  4.109064e-07
##    7.972751e-03 -5.743864e-05 -9.838804e-05 -1.440305e-05 -3.159302e-06
##   -3.015533e-05 -2.955424e-02  1.592823e-05 -4.816584e-05 -3.333123e-05
##   -5.143679e-06 -3.867060e-05 -2.432574e-03  1.984009e-04 -1.597191e-05
##   -1.259664e-02 -1.619457e-02  6.017623e-03  1.923035e-02  2.884401e-02
##    2.653581e-03  8.410805e-04  9.703804e-04 -9.676746e-04  7.834927e-04
##    2.653581e-03  8.410805e-04  9.703804e-04 -9.676746e-04  7.834927e-04
##    1.013444e-02 -5.425215e-03  5.258784e-03  3.173181e-03  1.064305e-02
## d -2.247532e+00 -2.893505e-01 -1.301582e+00 -1.424862e+00 -7.098109e-01
##           [,36]         [,37]         [,38]         [,39]         [,40]
##    1.129510e-04  8.979311e-05 -9.171093e-07  1.013164e-04 -3.690242e-04
##   -2.958434e-07 -3.256851e-07  5.200796e-07 -2.345895e-07  2.360642e-06
##   -5.349079e-06  1.243028e-07 -2.585466e-09 -8.098241e-08 -5.676418e-07
##   -1.225864e-08  2.082671e-06 -8.957202e-08 -9.178567e-08  5.274727e-07
##    5.110448e-05 -3.973419e-05  2.145483e-03 -7.559802e-05  1.003833e-05
##    1.005038e-04  4.896961e-05 -4.068846e-05  4.235620e-04 -2.031618e-04
##   -1.940163e-07 -8.243276e-08 -5.384033e-08 -1.366046e-07 -1.120797e-05
##   -1.352933e-07  5.811988e-07  4.514809e-07 -7.229999e-07 -4.927910e-06
##    1.273523e-05  1.046268e-05  8.726160e-05 -9.529170e-05 -1.801148e-04
##    9.492872e-09  2.887756e-08  4.422219e-08  4.877826e-08 -1.497545e-07
##    1.020299e-04  7.116749e-05  1.174813e-04  1.945168e-04 -2.519888e-04
##    7.134202e-08 -5.782618e-08 -1.956264e-07  1.111417e-09  6.819169e-08
##    3.074524e-08 -5.031510e-08  6.196470e-07 -2.257126e-07  6.328919e-07
##    1.590902e-06 -1.536551e-08 -1.727197e-08  1.191417e-08  8.233995e-08
##    2.651813e-09 -2.447919e-06 -4.774750e-08 -5.543573e-08 -2.614790e-08
##    1.036215e-08 -3.799439e-08  2.254488e-06 -1.561476e-08  2.044134e-08
##    9.078620e-08 -5.058111e-08 -1.472588e-07 -1.250398e-06 -2.672300e-08
##    1.621352e-09 -1.616635e-08 -3.221927e-08  1.159567e-08 -1.457452e-06
##    5.786208e-10 -5.363157e-10 -3.818608e-09  8.720276e-10  5.174931e-08
##   -7.015369e-05  3.460275e-07 -8.683549e-05  7.163998e-05  2.548837e-05
##    5.008545e-08  1.589540e-07 -1.438012e-07  2.121266e-07 -2.658302e-08
##   -2.940466e-08  3.750126e-08 -6.873766e-07  2.075290e-07 -1.638078e-07
##   -2.138725e-08  1.314785e-08  2.653625e-08 -1.463937e-08  2.652402e-09
##    4.965930e-05  2.282987e-05 -2.268544e-05  7.468308e-05  4.994238e-05
##    5.807940e-04  1.432422e-06 -6.149434e-07 -1.530248e-06 -2.214057e-07
##    2.047105e-05 -3.098196e-02 -4.736848e-05  5.831586e-05  2.734314e-06
##    2.493847e-06 -3.923232e-06 -4.807052e-03  6.098411e-05 -2.552065e-05
##   -2.051550e-05 -2.088106e-05  4.182182e-05  4.949655e-03  2.929356e-05
##    6.544558e-09  4.526124e-08  2.209599e-08  5.062317e-08 -3.293217e-05
##   -2.910688e-09 -1.092661e-09 -5.221002e-08 -5.998389e-08 -4.534127e-08
##    1.428696e-06 -6.207195e-05 -2.833420e-05  1.618715e-04  2.198578e-05
##    1.082064e-05  1.792153e-05  6.548153e-06 -3.092046e-06 -2.994558e-05
##    4.878135e-05 -2.273730e-05 -7.723083e-07  4.526590e-05 -1.483604e-05
##   -2.168158e-05 -9.537492e-05  1.291068e-04 -2.069179e-04 -2.049811e-04
##   -7.936591e-05 -6.493475e-05 -4.878215e-05 -1.369136e-04 -2.381109e-04
##    1.012681e+00 -6.206834e-05  7.583630e-05 -1.254422e-04 -7.643406e-05
##   -6.206834e-05  8.632342e-01  4.400743e-05 -5.537707e-05 -1.333794e-04
##    7.583630e-05  4.400743e-05  1.317086e+00  3.185414e-04  3.586533e-05
##   -1.254422e-04 -5.537707e-05  3.185414e-04  1.652777e+00 -1.728385e-04
##   -7.643406e-05 -1.333794e-04  3.586533e-05 -1.728385e-04  8.228685e-01
##    2.520155e-07  4.215160e-07 -8.560307e-07  8.816150e-07  5.896308e-07
##   -6.112021e-05 -2.092002e-05 -2.376748e-04 -2.195340e-04 -1.517425e-04
##   -9.276230e-05 -7.628075e-05  3.670996e-05 -3.521271e-05 -7.061303e-05
##   -1.066108e-04 -1.384044e-04 -1.365476e-05 -2.268003e-05 -6.840073e-05
##   -6.454801e-03  5.601970e-03 -3.154224e-02 -1.774797e-02  1.895135e-02
##   -6.161220e-04 -1.460259e-04  2.867703e-04  2.023155e-03 -6.554137e-05
##   -6.161220e-04 -1.460259e-04  2.867703e-04  2.023155e-03 -6.554137e-05
##    6.771043e-02  3.540031e-03  1.214786e-02  8.335632e-02  6.730418e-02
## d -1.142185e+00 -1.019193e+00 -2.409779e+00 -1.927133e+00 -1.065268e+00
##           [,41]         [,42]         [,43]         [,44]         [,45]
##    1.525305e-06 -9.301319e-05  7.084708e-05 -6.214903e-05  6.600910e-03
##   -6.330009e-09 -3.636287e-07 -4.065220e-08 -2.266138e-07 -1.560185e-04
##    1.722531e-09  5.727258e-08 -1.084609e-07  4.918412e-08  9.004162e-06
##   -2.131079e-09 -1.226310e-07  2.130967e-08  1.231779e-07 -8.685461e-05
##    3.208104e-07  6.345099e-06  1.325930e-04  1.179062e-04 -3.915179e-02
##    1.330926e-06 -4.570959e-06  6.210858e-05  3.546234e-05  5.040022e-02
##   -1.249890e-09 -5.857489e-08  1.546737e-08  1.688854e-07 -3.515261e-05
##   -4.610911e-07 -1.203536e-06  1.396033e-06 -2.198531e-07  5.742777e-05
##    4.686153e-07  7.773950e-03 -1.510101e-04  1.045524e-04  1.713168e-02
##    5.979100e-10  7.067331e-09 -1.110558e-06 -3.647628e-08  2.750924e-06
##    1.504634e-06 -5.000921e-05  1.786565e-05  1.056476e-03  5.329011e-02
##    1.272708e-10 -2.478863e-07  1.664869e-08  7.984939e-09 -3.470373e-05
##   -1.454768e-09  7.288044e-07 -4.732411e-08  1.096339e-06  1.121189e-05
##   -1.209805e-10  1.195262e-07  2.644878e-08  1.943304e-08  3.232266e-06
##    2.592103e-10 -1.354972e-07  5.673740e-08  2.465373e-08  7.804994e-06
##   -9.868411e-11 -5.380672e-08 -6.368268e-10  6.019067e-08 -1.135680e-05
##    1.562783e-10 -5.024212e-08 -9.825744e-08 -2.363620e-07  2.496010e-05
##   -5.297359e-11 -5.344538e-09 -3.035193e-09 -4.780050e-08 -7.323078e-06
##   -8.698815e-09 -6.784516e-08  6.740523e-09  1.909214e-08 -3.125740e-06
##    2.738973e-07 -1.246435e-02 -4.663117e-06 -4.966332e-05 -8.772068e-03
##    1.536086e-11  1.171473e-07 -5.908054e-06  2.195164e-07 -1.144180e-05
##   -8.237670e-11 -4.147658e-07 -1.936819e-08  1.080328e-05 -4.815186e-05
##   -1.154543e-11  5.088965e-08  2.937349e-08  5.505958e-08 -5.726698e-08
##    1.429608e-07  1.084681e-04  1.368600e-05  2.044994e-05  1.883446e-03
##    5.099790e-09 -4.711227e-06 -1.271851e-07  2.526367e-07 -2.052258e-05
##    1.486659e-07  1.373707e-04 -4.119224e-05 -1.669231e-05 -1.002581e-02
##   -1.786338e-08  4.766353e-05  2.641315e-05  1.081973e-05 -1.739912e-02
##    6.748543e-08 -9.778466e-06 -5.607452e-05 -4.394677e-05 -3.071043e-03
##    1.355763e-11 -7.732295e-09 -1.434576e-08 -1.565591e-08 -1.040740e-06
##    1.314160e-08 -2.314234e-08 -3.220726e-08  1.731706e-08 -9.742175e-06
##    9.066256e-08  7.972751e-03 -3.015533e-05 -5.143679e-06 -1.259664e-02
##    1.121696e-08 -5.743864e-05 -2.955424e-02 -3.867060e-05 -1.619457e-02
##   -1.223349e-07 -9.838804e-05  1.592823e-05 -2.432574e-03  6.017623e-03
##    6.799374e-07 -1.440305e-05 -4.816584e-05  1.984009e-04  1.923035e-02
##    4.109064e-07 -3.159302e-06 -3.333123e-05 -1.597191e-05  2.884401e-02
##    2.520155e-07 -6.112021e-05 -9.276230e-05 -1.066108e-04 -6.454801e-03
##    4.215160e-07 -2.092002e-05 -7.628075e-05 -1.384044e-04  5.601970e-03
##   -8.560307e-07 -2.376748e-04  3.670996e-05 -1.365476e-05 -3.154224e-02
##    8.816150e-07 -2.195340e-04 -3.521271e-05 -2.268003e-05 -1.774797e-02
##    5.896308e-07 -1.517425e-04 -7.061303e-05 -6.840073e-05  1.895135e-02
##    5.047849e-04 -2.102263e-07  2.737295e-07  1.366337e-08 -7.301808e-05
##   -2.102263e-07  2.293276e+00  6.058630e-05 -7.049444e-05  1.741677e-02
##    2.737295e-07  6.058630e-05  1.032582e+00 -6.132996e-05  4.108921e-03
##    1.366337e-08 -7.049444e-05 -6.132996e-05  3.688737e-01 -1.031351e-03
##   -7.301808e-05  1.741677e-02  4.108921e-03 -1.031351e-03  7.969412e+01
##   -1.598614e-05 -2.228196e-03  2.057953e-03 -5.794969e-04  6.698987e-02
##   -1.598614e-05 -2.228196e-03  2.057953e-03 -5.794969e-04  6.698987e-02
##    5.987159e-04 -1.588505e-01  2.542721e-02  1.489668e-04  1.133737e+00
## d -1.868674e-03 -3.441276e+00 -1.026936e+00 -1.433950e+00 -1.666783e+02
##           [,46]         [,47]         [,48]         [,49]
##    6.851899e-04  6.851899e-04  4.905528e-03 -3.007704e-01
##    1.430484e-06  1.430484e-06  1.339335e-05 -9.605602e-04
##    3.394071e-06  3.394071e-06 -4.494601e-05 -3.197717e-04
##    3.101765e-06  3.101765e-06 -4.370218e-05 -2.022026e-04
##   -1.771378e-03 -1.771378e-03 -4.782401e-03 -2.443661e+00
##   -2.427040e-04 -2.427040e-04  1.990740e-02 -6.220648e-01
##   -7.679314e-07 -7.679314e-07  9.110234e-07 -1.885164e-04
##   -4.175924e-05 -4.175924e-05 -4.491911e-04 -6.020621e-03
##    2.944993e-03  2.944993e-03 -2.406309e-02 -2.862952e+00
##   -2.202006e-07 -2.202006e-07 -2.455596e-05 -3.029585e-05
##   -6.745090e-04 -6.745090e-04  2.335240e-02 -6.216786e-01
##   -1.536215e-06 -1.536215e-06  9.404545e-06 -1.718192e-04
##   -3.669671e-06 -3.669671e-06  9.118012e-05 -2.625317e-03
##    3.482890e-06  3.482890e-06 -4.423635e-05 -9.979154e-05
##    2.298862e-06  2.298862e-06 -1.357567e-05 -4.875273e-04
##   -1.742951e-07 -1.742951e-07  6.616761e-06 -4.439873e-04
##   -6.202621e-07 -6.202621e-07  3.535752e-06 -3.911337e-04
##   -6.226449e-07 -6.226449e-07 -7.579099e-06 -4.118815e-05
##   -1.587221e-06 -1.587221e-06 -5.005657e-05 -5.985140e-05
##   -1.256975e-03 -1.256975e-03 -1.348578e-02 -1.448094e+00
##    5.323388e-07  5.323388e-07  4.571030e-05 -4.198721e-04
##   -3.163657e-06 -3.163657e-06  6.635349e-05 -9.780534e-04
##    1.292535e-07  1.292535e-07  1.057184e-06 -8.057054e-05
##   -6.553913e-04 -6.553913e-04 -7.765862e-04 -6.480574e-01
##    3.507244e-04  3.507244e-04 -4.360780e-03 -1.433141e-02
##   -3.150128e-03 -3.150128e-03  3.829560e-02 -4.612962e-01
##   -3.697110e-04 -3.697110e-04  1.017910e-02 -1.367613e+00
##   -9.204990e-04 -9.204990e-04 -1.387140e-02 -1.446002e+00
##    4.863981e-08  4.863981e-08  1.397981e-05 -1.598900e-04
##    1.641188e-06  1.641188e-06  1.401081e-04 -2.587189e-04
##    2.653581e-03  2.653581e-03  1.013444e-02 -2.247532e+00
##    8.410805e-04  8.410805e-04 -5.425215e-03 -2.893505e-01
##    9.703804e-04  9.703804e-04  5.258784e-03 -1.301582e+00
##   -9.676746e-04 -9.676746e-04  3.173181e-03 -1.424862e+00
##    7.834927e-04  7.834927e-04  1.064305e-02 -7.098109e-01
##   -6.161220e-04 -6.161220e-04  6.771043e-02 -1.142185e+00
##   -1.460259e-04 -1.460259e-04  3.540031e-03 -1.019193e+00
##    2.867703e-04  2.867703e-04  1.214786e-02 -2.409779e+00
##    2.023155e-03  2.023155e-03  8.335632e-02 -1.927133e+00
##   -6.554137e-05 -6.554137e-05  6.730418e-02 -1.065268e+00
##   -1.598614e-05 -1.598614e-05  5.987159e-04 -1.868674e-03
##   -2.228196e-03 -2.228196e-03 -1.588505e-01 -3.441276e+00
##    2.057953e-03  2.057953e-03  2.542721e-02 -1.026936e+00
##   -5.794969e-04 -5.794969e-04  1.489668e-04 -1.433950e+00
##    6.698987e-02  6.698987e-02  1.133737e+00 -1.666783e+02
##    2.160816e+01  2.160816e+01  4.332329e+00 -4.815373e+01
##    2.160816e+01  2.160816e+01  4.332329e+00 -4.815373e+01
##    4.332329e+00  4.332329e+00  8.307404e+02 -9.545295e+02
## d -4.815373e+01 -4.815373e+01 -9.545295e+02  5.461700e+04
## 
## Model rank =  4080 / 4080 
## 
## Basis dimension (k) checking results. Low p-value (k-index<1) may
## indicate that k is too low, especially if edf is close to k'.
## 
##                                              k'     edf k-index p-value  
## s(speaker_scaled_time):VowelDRESS          9.00    1.60    0.99   0.205  
## s(speaker_scaled_time):VowelFLEECE         9.00    1.00    0.99   0.135  
## s(speaker_scaled_time):VowelFOOT           9.00    1.00    0.99   0.190  
## s(speaker_scaled_time):VowelGOOSE          9.00    1.00    0.99   0.170  
## s(speaker_scaled_time):VowelKIT            9.00    5.89    0.99   0.180  
## s(speaker_scaled_time):VowelLOT            9.00    2.24    0.99   0.185  
## s(speaker_scaled_time):VowelNURSE          9.00    1.00    0.99   0.230  
## s(speaker_scaled_time):VowelSTART          9.00    1.01    0.99   0.185  
## s(speaker_scaled_time):VowelSTRUT          9.00    6.73    0.99   0.180  
## s(speaker_scaled_time):VowelTHOUGHT        9.00    1.00    0.99   0.240  
## s(speaker_scaled_time):VowelTRAP           9.00    2.24    0.99   0.185  
## s(speaker_scaled_art_rate):VowelDRESS      9.00    1.00    0.99   0.310  
## s(speaker_scaled_art_rate):VowelFLEECE     9.00    1.01    0.99   0.250  
## s(speaker_scaled_art_rate):VowelFOOT       9.00    1.00    0.99   0.285  
## s(speaker_scaled_art_rate):VowelGOOSE      9.00    1.00    0.99   0.235  
## s(speaker_scaled_art_rate):VowelKIT        9.00    1.00    0.99   0.275  
## s(speaker_scaled_art_rate):VowelLOT        9.00    1.00    0.99   0.265  
## s(speaker_scaled_art_rate):VowelNURSE      9.00    1.00    0.99   0.255  
## s(speaker_scaled_art_rate):VowelSTART      9.00    1.00    0.99   0.250  
## s(speaker_scaled_art_rate):VowelSTRUT      9.00    3.90    0.99   0.305  
## s(speaker_scaled_art_rate):VowelTHOUGHT    9.00    1.00    0.99   0.220  
## s(speaker_scaled_art_rate):VowelTRAP       9.00    1.00    0.99   0.270  
## s(speaker_scaled_amp_max):VowelDRESS       9.00    1.00    1.01   0.800  
## s(speaker_scaled_amp_max):VowelFLEECE      9.00    2.30    1.01   0.725  
## s(speaker_scaled_amp_max):VowelFOOT        9.00    1.03    1.01   0.720  
## s(speaker_scaled_amp_max):VowelGOOSE       9.00    1.92    1.01   0.785  
## s(speaker_scaled_amp_max):VowelKIT         9.00    3.74    1.01   0.810  
## s(speaker_scaled_amp_max):VowelLOT         9.00    3.89    1.01   0.795  
## s(speaker_scaled_amp_max):VowelNURSE       9.00    1.00    1.01   0.770  
## s(speaker_scaled_amp_max):VowelSTART       9.00    1.00    1.01   0.755  
## s(speaker_scaled_amp_max):VowelSTRUT       9.00    5.50    1.01   0.730  
## s(speaker_scaled_amp_max):VowelTHOUGHT     9.00    1.58    1.01   0.820  
## s(speaker_scaled_amp_max):VowelTRAP        9.00    3.60    1.01   0.800  
## s(speaker_scaled_pitch):VowelDRESS         9.00    3.85    0.98   0.050 *
## s(speaker_scaled_pitch):VowelFLEECE        9.00    2.42    0.98   0.050 *
## s(speaker_scaled_pitch):VowelFOOT          9.00    3.28    0.98   0.040 *
## s(speaker_scaled_pitch):VowelGOOSE         9.00    3.04    0.98   0.060 .
## s(speaker_scaled_pitch):VowelKIT           9.00    5.82    0.98   0.060 .
## s(speaker_scaled_pitch):VowelLOT           9.00    4.85    0.98   0.065 .
## s(speaker_scaled_pitch):VowelNURSE         9.00    3.13    0.98   0.030 *
## s(speaker_scaled_pitch):VowelSTART         9.00    1.00    0.98   0.075 .
## s(speaker_scaled_pitch):VowelSTRUT         9.00    7.88    0.98   0.035 *
## s(speaker_scaled_pitch):VowelTHOUGHT       9.00    3.05    0.98   0.050 *
## s(speaker_scaled_pitch):VowelTRAP          9.00    3.87    0.98   0.055 .
## s(speaker_scaled_time,Speaker)          1080.00  429.66    0.99   0.185  
## s(Speaker)                               216.00   96.31      NA      NA  
## s(Vowel,Speaker)                        2376.00 1909.06      NA      NA  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

No great gain is achieved here. The model output is remarkably similar for our main variable on interest (amplitude). Whatever improvement we might be getting is undermined by the increased computational cost.

2.3.1.3 Structure 3: Scaled-T Residuals

The QQ-plots and residual histograms for the previous two structures show that our residuals do not exactly follow a normal distribution. They have heavy tails. One way to handle heavy tailed distributions of residuals is to fit a model which does not assume the normality of the residuals. One such distribution is the scaled-t distribution (Sóskuthy 2021, 20). However, fitting with a scaled t distribution (using family = scat(link='identity')) increased the computational resource demands of the model.

gamm_fit_scat <- bam(
  F1_50 ~ 
    participant_gender +
    Vowel +
    s(speaker_scaled_time, by=Vowel) + 
    s(speaker_scaled_art_rate, by=Vowel) +
    s(speaker_scaled_amp_max, by=Vowel) +
    s(speaker_scaled_pitch, by=Vowel) + 
    s(Speaker, bs="re") +
    s(Speaker, Vowel, bs="re"),
  data = qb_vowels, 
  method="fREML",
  discrete = TRUE,
  family = scat(link='identity'),
  nthreads = 8 # Change this depending on number of cores available.
)

write_rds(gamm_fit_scat, here('models', 'gamm_fit_scat.rds'))

# calculate summary and save.
gamm_fit_scat_summary <- summary(gamm_fit_scat)
write_rds(gamm_fit_scat_summary, here('models', 'gamm_fit_scat_summary.rds'))

We look at the model summary.

gamm_fit_scat <- read_rds(here('models', 'gamm_fit_scat.rds'))
gamm_fit_scat_summary <- read_rds(here('models', 'gamm_fit_scat_summary.rds'))
gamm_fit_scat_summary

## 
## Family: Scaled t(3.459,48.406) 
## Link function: identity 
## 
## Formula:
## F1_50 ~ participant_gender + Vowel + s(speaker_scaled_time, by = Vowel) + 
##     s(speaker_scaled_art_rate, by = Vowel) + s(speaker_scaled_amp_max, 
##     by = Vowel) + s(speaker_scaled_pitch, by = Vowel) + s(Speaker, 
##     bs = "re") + s(Speaker, Vowel, bs = "re")
## 
## Parametric coefficients:
##                     Estimate Std. Error t value Pr(>|t|)    
## (Intercept)          432.488      4.096 105.586  < 2e-16 ***
## participant_genderM  -55.352      5.602  -9.880  < 2e-16 ***
## VowelFLEECE          -13.649      3.979  -3.430 0.000604 ***
## VowelFOOT             65.149      4.350  14.975  < 2e-16 ***
## VowelGOOSE           -21.272      4.118  -5.166 2.40e-07 ***
## VowelKIT              83.825      3.999  20.962  < 2e-16 ***
## VowelLOT             163.204      4.071  40.092  < 2e-16 ***
## VowelNURSE            16.277      4.057   4.012 6.03e-05 ***
## VowelSTART           361.772      4.187  86.394  < 2e-16 ***
## VowelSTRUT           255.687      4.126  61.967  < 2e-16 ***
## VowelTHOUGHT          11.766      4.007   2.936 0.003324 ** 
## VowelTRAP            146.814      4.084  35.948  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Approximate significance of smooth terms:
##                                              edf   Ref.df        F  p-value    
## s(speaker_scaled_time):VowelDRESS          2.151    2.685    4.064 0.009086 ** 
## s(speaker_scaled_time):VowelFLEECE         1.071    1.138    4.550 0.025470 *  
## s(speaker_scaled_time):VowelFOOT           1.003    1.006    3.744 0.052951 .  
## s(speaker_scaled_time):VowelGOOSE          1.002    1.005    0.567 0.452359    
## s(speaker_scaled_time):VowelKIT            2.262    2.819    1.898 0.103261    
## s(speaker_scaled_time):VowelLOT            2.154    2.689   10.691 5.57e-06 ***
## s(speaker_scaled_time):VowelNURSE          1.003    1.005    0.874 0.348835    
## s(speaker_scaled_time):VowelSTART          2.176    2.717    1.587 0.267643    
## s(speaker_scaled_time):VowelSTRUT          5.781    6.935    3.029 0.002635 ** 
## s(speaker_scaled_time):VowelTHOUGHT        1.001    1.002   10.223 0.001378 ** 
## s(speaker_scaled_time):VowelTRAP           2.472    3.084    7.319 5.49e-05 ***
## s(speaker_scaled_art_rate):VowelDRESS      1.001    1.002    0.024 0.880894    
## s(speaker_scaled_art_rate):VowelFLEECE     1.875    2.377    2.370 0.107736    
## s(speaker_scaled_art_rate):VowelFOOT       1.797    2.270    6.040 0.001043 ** 
## s(speaker_scaled_art_rate):VowelGOOSE      1.005    1.010   31.548  < 2e-16 ***
## s(speaker_scaled_art_rate):VowelKIT        1.003    1.005   47.355  < 2e-16 ***
## s(speaker_scaled_art_rate):VowelLOT        1.003    1.005   38.020  < 2e-16 ***
## s(speaker_scaled_art_rate):VowelNURSE      1.001    1.003    0.055 0.816794    
## s(speaker_scaled_art_rate):VowelSTART      1.003    1.006   29.636  < 2e-16 ***
## s(speaker_scaled_art_rate):VowelSTRUT      1.003    1.007   33.855  < 2e-16 ***
## s(speaker_scaled_art_rate):VowelTHOUGHT    1.003    1.006   10.920 0.000938 ***
## s(speaker_scaled_art_rate):VowelTRAP       1.028    1.056   15.569 5.68e-05 ***
## s(speaker_scaled_amp_max):VowelDRESS       1.013    1.025   43.980  < 2e-16 ***
## s(speaker_scaled_amp_max):VowelFLEECE      2.739    3.480   34.035  < 2e-16 ***
## s(speaker_scaled_amp_max):VowelFOOT        1.002    1.004  142.896  < 2e-16 ***
## s(speaker_scaled_amp_max):VowelGOOSE       1.607    2.017   82.227  < 2e-16 ***
## s(speaker_scaled_amp_max):VowelKIT         4.332    5.353   73.743  < 2e-16 ***
## s(speaker_scaled_amp_max):VowelLOT         4.141    5.134  264.057  < 2e-16 ***
## s(speaker_scaled_amp_max):VowelNURSE       1.003    1.006   41.428  < 2e-16 ***
## s(speaker_scaled_amp_max):VowelSTART       3.233    4.067   28.072  < 2e-16 ***
## s(speaker_scaled_amp_max):VowelSTRUT       3.968    4.928  250.467  < 2e-16 ***
## s(speaker_scaled_amp_max):VowelTHOUGHT     1.820    2.315   23.058  < 2e-16 ***
## s(speaker_scaled_amp_max):VowelTRAP        3.859    4.816   48.744  < 2e-16 ***
## s(speaker_scaled_pitch):VowelDRESS         4.533    5.570    9.120  < 2e-16 ***
## s(speaker_scaled_pitch):VowelFLEECE        3.454    4.333    5.331 0.000170 ***
## s(speaker_scaled_pitch):VowelFOOT          3.673    4.559   11.605  < 2e-16 ***
## s(speaker_scaled_pitch):VowelGOOSE         3.451    4.320    5.566 0.000163 ***
## s(speaker_scaled_pitch):VowelKIT           5.508    6.611   31.200  < 2e-16 ***
## s(speaker_scaled_pitch):VowelLOT           5.145    6.236   22.872  < 2e-16 ***
## s(speaker_scaled_pitch):VowelNURSE         4.064    5.033    8.860  < 2e-16 ***
## s(speaker_scaled_pitch):VowelSTART         1.007    1.014    2.120 0.143184    
## s(speaker_scaled_pitch):VowelSTRUT         6.979    7.980   19.685  < 2e-16 ***
## s(speaker_scaled_pitch):VowelTHOUGHT       3.680    4.593    9.622  < 2e-16 ***
## s(speaker_scaled_pitch):VowelTRAP          4.178    5.166    5.876 1.99e-05 ***
## s(Speaker)                               191.815  214.000 5010.618  < 2e-16 ***
## s(Vowel,Speaker)                        1986.140 2361.000   81.097  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## R-sq.(adj) =  0.755   Deviance explained =   62%
## fREML = 1.8535e+05  Scale est. = 1         n = 109290

There are no obvious systematic differences in the model output. It explains somewhat less deviance, but this is not a cause for concern if the model still carries the main effects we are interested in and fits the data better.

With the t-distribution, quite a bit more is required in terms of degrees of freedom to capture the vowel space of each speaker (see s(Speaker) and s(Vowel, Speaker)).

The same items seem to appear as significant in our list of smooth terms as in Structure 1. If anything, there is a tendency for this model to indicate a higher degree of significance to these terms.

We will look at amplitude first, as it is our main variable of interest.

gamm_fit_preds <- get_predictions(
  gamm_fit_scat,
  cond = list(
    'speaker_scaled_amp_max' = seq(-2.5, 2.5, length.out=200),
    'participant_gender' = 'F',
    'speaker_scaled_pitch' = 0,
    'speaker_scaled_art_rate' = 0,
    'speaker_scaled_time' = 0.5,
    'Vowel' = unique(qb_vowels$Vowel)
  )
)

## Summary:
##  * participant_gender : factor; set to the value(s): F. 
##  * Vowel : factor with 11 values; set to the value(s): DRESS, FLEECE, FOOT, GOOSE, KIT, LOT, NURSE, START, STRUT, THOUGHT, ... (Might be canceled as random effect, check below.) 
##  * speaker_scaled_time : numeric predictor; set to the value(s): 0.5. 
##  * speaker_scaled_art_rate : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_amp_max : numeric predictor; with 200 values ranging from -2.500000 to 2.500000. 
##  * speaker_scaled_pitch : numeric predictor; set to the value(s): 0. 
##  * Speaker : factor; set to the value(s): QB_NZ_M_291. (Might be canceled as random effect, check below.) 
##  * NOTE : The following random effects columns are canceled: s(Speaker),s(Vowel,Speaker)
## 

gamm_fit_preds %>%
  mutate(# Enable plot to distinguish between high and low vowels (for faceting)
    height = if_else(Vowel %in% high_vowels, "high", "low or mid")
  ) %>%
  ggplot(
    aes(
      y = fit,
      x = speaker_scaled_amp_max,
      colour = Vowel
    )
  ) + 
  geom_ribbon(
    aes(
      ymin = fit - CI,
      ymax = fit + CI,
      fill = Vowel
    ),
    alpha = 0.3,
    colour = NA
  ) +
  geom_line() +
  scale_colour_manual(
    values = vowel_colours_with_foot
  ) +
  scale_fill_manual(
    values = vowel_colours_with_foot
  ) +
  labs(
    title = "F1 and Amplitude by Vowel",
    x = "Scaled amplitude",
    y = "F1"
  )

Figure 2.21: F1 and amplitude by vowel, scaled T model.

  # facet_wrap(
  #   facets=vars(height), scales = "free"
  # )

Figure 2.21 Is similar to the previous plots of the same sort. Again, lot and trap, seem to merge rather than cross. We will keep this in mind in interpreting the effect of amplitude on the vowel space as a whole.

We now run diagnostic checks on the model:

Figure 2.22: GAM model checks.

The text output again shows that our choice of k is fine.

The QQ plot and histogram of residuals suggest that the performance of our residuals is superior.

2.3.2 ML models and significance tests by model comparison.

The above models are fit with fREML. The resulting p-values are not necessarily reliable. We use ML and the model comparison based significance test recommended by Sóskuthy (2017).

We refit models using ML to perform significance testing by model comparison. This takes a long time to fit (around 40-50 minutes for each model).

We use structure 1, the model structure with random intercepts by speaker and by speaker, by vowel. The random intercept structure can be thought of as calibrating the model for the overall vowel space of each speaker. While the previous section showed good evidence that a scaled t distribution would be superior for our residuals, attempts to fit scaled t models using ML were unsuccessful due to limitations of both time and memory.

gamm_fit_full <- bam(
  F1_50 ~ 
    participant_gender +
    Vowel +
    s(speaker_scaled_time, by=Vowel) + 
    s(speaker_scaled_art_rate, by=Vowel) +
    s(speaker_scaled_amp_max, by=Vowel) +
    s(speaker_scaled_pitch, by=Vowel) + 
    s(Speaker, bs="re") +
    s(Speaker, Vowel, bs="re"),
  data = qb_vowels, 
  method="ML"
)
write_rds(gamm_fit_full, here('models', 'gamm_fit_full.rds'))

# We will look at the summary for the full model to check that it doesn't
# radically differ from the fREML model Structure 1.
gamm_fit_full_summary <- summary(gamm_fit_full)
write_rds(gamm_fit_full_summary, here('models', 'gamm_fit_full_summary.rds'))

gamm_fit_no_time <- bam(
  F1_50 ~ 
    participant_gender +
    Vowel +
    s(speaker_scaled_art_rate, by=Vowel) +
    s(speaker_scaled_amp_max, by=Vowel) +
    s(speaker_scaled_pitch, by=Vowel) + 
    s(Speaker, bs="re") +
    s(Speaker, Vowel, bs="re"),
  data = qb_vowels, 
  method="ML"
)
write_rds(gamm_fit_no_time, here('models', 'gamm_fit_no_time.rds'))

gamm_fit_no_art <- bam(
  F1_50 ~ 
    participant_gender +
    Vowel +
    s(speaker_scaled_time, by=Vowel) + 
    s(speaker_scaled_amp_max, by=Vowel) +
    s(speaker_scaled_pitch, by=Vowel) + 
    s(Speaker, bs="re") +
    s(Speaker, Vowel, bs="re"),
  data = qb_vowels, 
  method="ML"
)
write_rds(gamm_fit_no_art, here('models', 'gamm_fit_no_art.rds'))

gamm_fit_no_amp <- bam(
  F1_50 ~ 
    participant_gender +
    Vowel +
    s(speaker_scaled_time, by=Vowel) + 
    s(speaker_scaled_art_rate, by=Vowel) +
    s(speaker_scaled_pitch, by=Vowel) + 
    s(Speaker, bs="re") +
    s(Speaker, Vowel, bs="re"),
  data = qb_vowels, 
  method="ML"
)
write_rds(gamm_fit_no_amp, here('models', 'gamm_fit_no_amp.rds'))

gamm_fit_no_pitch <- bam(
  F1_50 ~ 
    participant_gender +
    Vowel +
    s(speaker_scaled_time, by=Vowel) +
    s(speaker_scaled_art_rate, by=Vowel) +
    s(speaker_scaled_amp_max, by=Vowel) +
    s(Speaker, bs="re") +
    s(Speaker, Vowel, bs="re"),
  data = qb_vowels, 
  method="ML"
)
write_rds(gamm_fit_no_pitch, here('models', 'gamm_fit_no_pitch.rds'))

We generate p-values for each of the variables using model comparison.

gamm_fit_full <- read_rds(here('models', 'gamm_fit_full.rds'))
gamm_fit_full_summary <- read_rds(here('models', 'gamm_fit_full_summary.rds'))

# time.
gamm_fit_no_time <- read_rds(here('models', 'gamm_fit_no_time.rds'))
compareML(gamm_fit_full, gamm_fit_no_time)

## gamm_fit_full: F1_50 ~ participant_gender + Vowel + s(speaker_scaled_time, by = Vowel) + 
##     s(speaker_scaled_art_rate, by = Vowel) + s(speaker_scaled_amp_max, 
##     by = Vowel) + s(speaker_scaled_pitch, by = Vowel) + s(Speaker, 
##     bs = "re") + s(Speaker, Vowel, bs = "re")
## 
## gamm_fit_no_time: F1_50 ~ participant_gender + Vowel + s(speaker_scaled_art_rate, 
##     by = Vowel) + s(speaker_scaled_amp_max, by = Vowel) + s(speaker_scaled_pitch, 
##     by = Vowel) + s(Speaker, bs = "re") + s(Speaker, Vowel, bs = "re")
## 
## Chi-square test of ML scores
## -----
##              Model    Score Edf Difference     Df   p.value Sig.
## 1 gamm_fit_no_time 623963.8  80                                 
## 2    gamm_fit_full 623925.1 102     38.698 22.000 4.324e-08  ***
## 
## AIC difference: -74.68, model gamm_fit_full has lower AIC.

# articulation rate.
gamm_fit_no_art <- read_rds(here('models', 'gamm_fit_no_art.rds'))
compareML(gamm_fit_full, gamm_fit_no_art)

## gamm_fit_full: F1_50 ~ participant_gender + Vowel + s(speaker_scaled_time, by = Vowel) + 
##     s(speaker_scaled_art_rate, by = Vowel) + s(speaker_scaled_amp_max, 
##     by = Vowel) + s(speaker_scaled_pitch, by = Vowel) + s(Speaker, 
##     bs = "re") + s(Speaker, Vowel, bs = "re")
## 
## gamm_fit_no_art: F1_50 ~ participant_gender + Vowel + s(speaker_scaled_time, by = Vowel) + 
##     s(speaker_scaled_amp_max, by = Vowel) + s(speaker_scaled_pitch, 
##     by = Vowel) + s(Speaker, bs = "re") + s(Speaker, Vowel, bs = "re")
## 
## Chi-square test of ML scores
## -----
##             Model    Score Edf Difference     Df  p.value Sig.
## 1 gamm_fit_no_art 624005.0  80                                
## 2   gamm_fit_full 623925.1 102     79.950 22.000  < 2e-16  ***
## 
## AIC difference: -142.47, model gamm_fit_full has lower AIC.

# amplitude.
gamm_fit_no_amp <- read_rds(here('models', 'gamm_fit_no_amp.rds'))
compareML(gamm_fit_full, gamm_fit_no_amp)

## gamm_fit_full: F1_50 ~ participant_gender + Vowel + s(speaker_scaled_time, by = Vowel) + 
##     s(speaker_scaled_art_rate, by = Vowel) + s(speaker_scaled_amp_max, 
##     by = Vowel) + s(speaker_scaled_pitch, by = Vowel) + s(Speaker, 
##     bs = "re") + s(Speaker, Vowel, bs = "re")
## 
## gamm_fit_no_amp: F1_50 ~ participant_gender + Vowel + s(speaker_scaled_time, by = Vowel) + 
##     s(speaker_scaled_art_rate, by = Vowel) + s(speaker_scaled_pitch, 
##     by = Vowel) + s(Speaker, bs = "re") + s(Speaker, Vowel, bs = "re")
## 
## Chi-square test of ML scores
## -----
##             Model    Score Edf Difference     Df  p.value Sig.
## 1 gamm_fit_no_amp 625736.3  80                                
## 2   gamm_fit_full 623925.1 102   1811.213 22.000  < 2e-16  ***
## 
## AIC difference: -3659.50, model gamm_fit_full has lower AIC.

# pitch
gamm_fit_no_pitch <- read_rds(here('models', 'gamm_fit_no_pitch.rds'))
compareML(gamm_fit_full, gamm_fit_no_pitch)

## gamm_fit_full: F1_50 ~ participant_gender + Vowel + s(speaker_scaled_time, by = Vowel) + 
##     s(speaker_scaled_art_rate, by = Vowel) + s(speaker_scaled_amp_max, 
##     by = Vowel) + s(speaker_scaled_pitch, by = Vowel) + s(Speaker, 
##     bs = "re") + s(Speaker, Vowel, bs = "re")
## 
## gamm_fit_no_pitch: F1_50 ~ participant_gender + Vowel + s(speaker_scaled_time, by = Vowel) + 
##     s(speaker_scaled_art_rate, by = Vowel) + s(speaker_scaled_amp_max, 
##     by = Vowel) + s(Speaker, bs = "re") + s(Speaker, Vowel, bs = "re")
## 
## Chi-square test of ML scores
## -----
##               Model    Score Edf Difference     Df  p.value Sig.
## 1 gamm_fit_no_pitch 624188.6  80                                
## 2     gamm_fit_full 623925.1 102    263.491 22.000  < 2e-16  ***
## 
## AIC difference: -579.65, model gamm_fit_full has lower AIC.

The four tables above present the contribution of each of our variables to the model. Adding new variables will always result in a better fit to the data. The question is whether the increase in model complexity is worth it for the increase in information about our variable of pseudointerest. For, for instance, our time variable requires, in effect, around 22 additional parameters over the model without time. The information given here is taken by the \(\Chi^2\) test to be significant.

The same is true for our other variable. Note that the Difference column can be used to estimate the respective magnitude of the contribution of each variable, with amplitude providing the most information for the cost in degrees of freedom, and time providing the least.

2.3.2.1 Effect plots from full ML model

We use the model fit with ML to generate plots of our model predictions for each vowel and for each of our main fixed variables.

We first define a function to plot predictions from the models and to thereby reduce repetition of code.

all_vowel_plot <- function(predictions, xvar, xlabel, plot_title) {
  
  xvar <- enquo(xvar)
  
  predictions %>%
    mutate(# Enable plot to distinguish between high and low vowels (for faceting)
      height = if_else(Vowel %in% high_vowels, "high", "low or mid")
    ) %>%
    ggplot(
      aes(
        y = fit,
        x = !!xvar,
        colour = Vowel
      )
    ) + 
    geom_ribbon(
      aes(
        ymin = fit - CI,
        ymax = fit + CI,
        fill = Vowel
      ),
      alpha = 0.3,
      colour = NA
    ) +
    geom_line() +
    scale_colour_manual(
      values = vowel_colours_with_foot
    ) +
    scale_fill_manual(
      values = vowel_colours_with_foot
    ) +
    labs(
      title = plot_title,
      x = xlabel,
      y = "F1"
    )
    # facet_wrap(
    #   facets=vars(height), scales = "free"
    # )
}

The following figure is Figure 3 in the paper.

gamm_fit_preds <- get_predictions(
  gamm_fit_full,
  cond = list(
    'speaker_scaled_amp_max' = seq(-2.5, 2.5, length.out=200),
    'participant_gender' = 'F',
    'speaker_scaled_pitch' = 0,
    'speaker_scaled_art_rate' = 0,
    'speaker_scaled_time' = 0.5,
    'Vowel' = unique(qb_vowels$Vowel)
  )
)

## Summary:
##  * participant_gender : factor; set to the value(s): F. 
##  * Vowel : factor with 11 values; set to the value(s): DRESS, FLEECE, FOOT, GOOSE, KIT, LOT, NURSE, START, STRUT, THOUGHT, ... (Might be canceled as random effect, check below.) 
##  * speaker_scaled_time : numeric predictor; set to the value(s): 0.5. 
##  * speaker_scaled_art_rate : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_amp_max : numeric predictor; with 200 values ranging from -2.500000 to 2.500000. 
##  * speaker_scaled_pitch : numeric predictor; set to the value(s): 0. 
##  * Speaker : factor; set to the value(s): QB_NZ_M_291. (Might be canceled as random effect, check below.) 
##  * NOTE : The following random effects columns are canceled: s(Speaker),s(Speaker,Vowel)
## 

figure_3 <- all_vowel_plot(
  gamm_fit_preds, 
  speaker_scaled_amp_max, 
  "Scaled amplitude", 
  "F1 and Amplitude by Vowel"
)

ggsave(
  here('plots', 'figure_3.png'),
  plot = figure_3,
  dpi = 500,
  units = "cm",
  width = 20,
  height = 12.5
)

figure_3

Figure 2.23: F1 and amplitude by vowel, ML model.

Figure @red(fig:gamm-full-amp-plot) shows strong evidence for increases in F1 accompanying increases in amplitude. This effect is stronger for some vowels than for others. The estimates for lot and trap cross one another as amplitude increases. We also see that some clusters of vowels are distinguishable in F1 at some amplitudes and not at others. These effects are concerning because they would lead an analyst to reach different conclusions about the configuration of the vowel space at higher versus lower amplitudes.

gamm_fit_preds <- get_predictions(
  gamm_fit_full,
  cond = list(
    'speaker_scaled_amp_max' = 0,
    'participant_gender' = 'F',
    'speaker_scaled_pitch' = 0,
    'speaker_scaled_art_rate' = seq(-2.5, 2.5, length.out=200),
    'speaker_scaled_time' = 0.5,
    'Vowel' = unique(qb_vowels$Vowel)
  )
)

## Summary:
##  * participant_gender : factor; set to the value(s): F. 
##  * Vowel : factor with 11 values; set to the value(s): DRESS, FLEECE, FOOT, GOOSE, KIT, LOT, NURSE, START, STRUT, THOUGHT, ... (Might be canceled as random effect, check below.) 
##  * speaker_scaled_time : numeric predictor; set to the value(s): 0.5. 
##  * speaker_scaled_art_rate : numeric predictor; with 200 values ranging from -2.500000 to 2.500000. 
##  * speaker_scaled_amp_max : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_pitch : numeric predictor; set to the value(s): 0. 
##  * Speaker : factor; set to the value(s): QB_NZ_M_291. (Might be canceled as random effect, check below.) 
##  * NOTE : The following random effects columns are canceled: s(Speaker),s(Speaker,Vowel)
## 

all_vowel_plot(gamm_fit_preds, speaker_scaled_art_rate, "Scaled articulation rate", "F1 and Articulation Rate by Vowel")

Figure 2.24: F1 and articulation rate by vowel.

In Figure 2.24 the main thing we are capturing seems to be a reduction in vowel space, with thought and goose moving in the opposite direction to the other vowels. That is, we have contraction occurring at higher rates of speech. Note that the magnitude of this effect is much smaller than that of amplitude (Figure @ref(fig:gamm_full_amp_plot)).

gamm_fit_preds <- get_predictions(
  gamm_fit_full,
  cond = list(
    'speaker_scaled_amp_max' = 0,
    'participant_gender' = 'F',
    'speaker_scaled_pitch' = seq(-2.5, 2.5, length.out=200),
    'speaker_scaled_art_rate' = 0,
    'speaker_scaled_time' = 0.5,
    'Vowel' = unique(qb_vowels$Vowel)
  )
)

## Summary:
##  * participant_gender : factor; set to the value(s): F. 
##  * Vowel : factor with 11 values; set to the value(s): DRESS, FLEECE, FOOT, GOOSE, KIT, LOT, NURSE, START, STRUT, THOUGHT, ... (Might be canceled as random effect, check below.) 
##  * speaker_scaled_time : numeric predictor; set to the value(s): 0.5. 
##  * speaker_scaled_art_rate : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_amp_max : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_pitch : numeric predictor; with 200 values ranging from -2.500000 to 2.500000. 
##  * Speaker : factor; set to the value(s): QB_NZ_M_291. (Might be canceled as random effect, check below.) 
##  * NOTE : The following random effects columns are canceled: s(Speaker),s(Speaker,Vowel)
## 

all_vowel_plot(gamm_fit_preds, speaker_scaled_pitch, "Scaled pitch", "F1 and Pitch by Vowel")

Figure 2.25: F1 and pitch by vowel.

There is an interesting U shaped curve for many vowels when we look at pitch.

gamm_fit_preds <- get_predictions(
  gamm_fit_full,
  cond = list(
    'speaker_scaled_amp_max' = 0,
    'participant_gender' = 'F',
    'speaker_scaled_pitch' = 0,
    'speaker_scaled_art_rate' = 0,
    'speaker_scaled_time' = seq(0, 1, length.out=200),
    'Vowel' = unique(qb_vowels$Vowel)
  )
)

## Summary:
##  * participant_gender : factor; set to the value(s): F. 
##  * Vowel : factor with 11 values; set to the value(s): DRESS, FLEECE, FOOT, GOOSE, KIT, LOT, NURSE, START, STRUT, THOUGHT, ... (Might be canceled as random effect, check below.) 
##  * speaker_scaled_time : numeric predictor; with 200 values ranging from 0.000000 to 1.000000. 
##  * speaker_scaled_art_rate : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_amp_max : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_pitch : numeric predictor; set to the value(s): 0. 
##  * Speaker : factor; set to the value(s): QB_NZ_M_291. (Might be canceled as random effect, check below.) 
##  * NOTE : The following random effects columns are canceled: s(Speaker),s(Speaker,Vowel)
## 

all_vowel_plot(gamm_fit_preds, speaker_scaled_time, "Scaled time", "F1 and Time by Vowel")

Figure 2.26: F1 and time by vowel.

It is very hard to take this plot as presenting any good evidence for an effect of time through a monologue and F1. Certainly, it is the variable our models are least confident about. If anything, there is a small effect where lot and trap reducing over the course of the monologue and kit increasing.

We now look at our GAMM diagnostics.

gam.check(gamm_fit_full)

## 
## Method: ML   Optimizer: outer newton
## full convergence after 9 iterations.
## Gradient range [-0.007653983,0.0391685]
## (score 623925.1 & scale 5027.782).
## Hessian positive definite, eigenvalue range [0.003227284,54662.2].
## Model rank =  3000 / 3000 
## 
## Basis dimension (k) checking results. Low p-value (k-index<1) may
## indicate that k is too low, especially if edf is close to k'.
## 
##                                              k'     edf k-index p-value
## s(speaker_scaled_time):VowelDRESS          9.00    1.00    0.99    0.31
## s(speaker_scaled_time):VowelFLEECE         9.00    1.00    0.99    0.34
## s(speaker_scaled_time):VowelFOOT           9.00    1.00    0.99    0.30
## s(speaker_scaled_time):VowelGOOSE          9.00    1.00    0.99    0.32
## s(speaker_scaled_time):VowelKIT            9.00    1.00    0.99    0.28
## s(speaker_scaled_time):VowelLOT            9.00    1.83    0.99    0.33
## s(speaker_scaled_time):VowelNURSE          9.00    1.00    0.99    0.43
## s(speaker_scaled_time):VowelSTART          9.00    1.00    0.99    0.33
## s(speaker_scaled_time):VowelSTRUT          9.00    6.55    0.99    0.32
## s(speaker_scaled_time):VowelTHOUGHT        9.00    1.00    0.99    0.32
## s(speaker_scaled_time):VowelTRAP           9.00    1.97    0.99    0.32
## s(speaker_scaled_art_rate):VowelDRESS      9.00    1.00    1.01    0.82
## s(speaker_scaled_art_rate):VowelFLEECE     9.00    1.00    1.01    0.82
## s(speaker_scaled_art_rate):VowelFOOT       9.00    1.00    1.01    0.85
## s(speaker_scaled_art_rate):VowelGOOSE      9.00    1.00    1.01    0.83
## s(speaker_scaled_art_rate):VowelKIT        9.00    1.00    1.01    0.82
## s(speaker_scaled_art_rate):VowelLOT        9.00    1.00    1.01    0.83
## s(speaker_scaled_art_rate):VowelNURSE      9.00    1.00    1.01    0.81
## s(speaker_scaled_art_rate):VowelSTART      9.00    1.00    1.01    0.78
## s(speaker_scaled_art_rate):VowelSTRUT      9.00    2.15    1.01    0.81
## s(speaker_scaled_art_rate):VowelTHOUGHT    9.00    1.00    1.01    0.80
## s(speaker_scaled_art_rate):VowelTRAP       9.00    1.00    1.01    0.83
## s(speaker_scaled_amp_max):VowelDRESS       9.00    1.00    1.00    0.28
## s(speaker_scaled_amp_max):VowelFLEECE      9.00    1.00    1.00    0.38
## s(speaker_scaled_amp_max):VowelFOOT        9.00    1.00    1.00    0.36
## s(speaker_scaled_amp_max):VowelGOOSE       9.00    1.01    1.00    0.40
## s(speaker_scaled_amp_max):VowelKIT         9.00    3.50    1.00    0.39
## s(speaker_scaled_amp_max):VowelLOT         9.00    3.75    1.00    0.29
## s(speaker_scaled_amp_max):VowelNURSE       9.00    1.00    1.00    0.38
## s(speaker_scaled_amp_max):VowelSTART       9.00    1.00    1.00    0.42
## s(speaker_scaled_amp_max):VowelSTRUT       9.00    5.06    1.00    0.38
## s(speaker_scaled_amp_max):VowelTHOUGHT     9.00    1.00    1.00    0.32
## s(speaker_scaled_amp_max):VowelTRAP        9.00    2.67    1.00    0.40
## s(speaker_scaled_pitch):VowelDRESS         9.00    3.54    1.00    0.47
## s(speaker_scaled_pitch):VowelFLEECE        9.00    1.00    1.00    0.45
## s(speaker_scaled_pitch):VowelFOOT          9.00    3.01    1.00    0.41
## s(speaker_scaled_pitch):VowelGOOSE         9.00    2.70    1.00    0.48
## s(speaker_scaled_pitch):VowelKIT           9.00    6.07    1.00    0.45
## s(speaker_scaled_pitch):VowelLOT           9.00    4.68    1.00    0.46
## s(speaker_scaled_pitch):VowelNURSE         9.00    2.87    1.00    0.49
## s(speaker_scaled_pitch):VowelSTART         9.00    1.00    1.00    0.49
## s(speaker_scaled_pitch):VowelSTRUT         9.00    7.56    1.00    0.42
## s(speaker_scaled_pitch):VowelTHOUGHT       9.00    2.80    1.00    0.47
## s(speaker_scaled_pitch):VowelTRAP          9.00    3.04    1.00    0.46
## s(Speaker)                               216.00  192.52      NA      NA
## s(Speaker,Vowel)                        2376.00 1907.53      NA      NA

All basically equivalent to our fREML model (Structure 1) as presented above.

gamm_fit_full_summary

## 
## Family: gaussian 
## Link function: identity 
## 
## Formula:
## F1_50 ~ participant_gender + Vowel + s(speaker_scaled_time, by = Vowel) + 
##     s(speaker_scaled_art_rate, by = Vowel) + s(speaker_scaled_amp_max, 
##     by = Vowel) + s(speaker_scaled_pitch, by = Vowel) + s(Speaker, 
##     bs = "re") + s(Speaker, Vowel, bs = "re")
## 
## Parametric coefficients:
##                     Estimate Std. Error t value Pr(>|t|)    
## (Intercept)          432.247      4.008 107.840  < 2e-16 ***
## participant_genderM  -54.987      5.593  -9.831  < 2e-16 ***
## VowelFLEECE          -10.910      3.733  -2.922  0.00347 ** 
## VowelFOOT             59.775      4.000  14.944  < 2e-16 ***
## VowelGOOSE           -22.265      3.821  -5.828 5.64e-09 ***
## VowelKIT              82.551      3.737  22.088  < 2e-16 ***
## VowelLOT             159.537      3.768  42.343  < 2e-16 ***
## VowelNURSE            11.648      3.860   3.018  0.00255 ** 
## VowelSTART           356.610      3.842  92.814  < 2e-16 ***
## VowelSTRUT           254.785      3.739  68.151  < 2e-16 ***
## VowelTHOUGHT           9.266      3.779   2.452  0.01421 *  
## VowelTRAP            145.980      3.759  38.838  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Approximate significance of smooth terms:
##                                              edf   Ref.df        F  p-value    
## s(speaker_scaled_time):VowelDRESS          1.005    1.010    6.701 0.009273 ** 
## s(speaker_scaled_time):VowelFLEECE         1.002    1.005    2.661 0.102463    
## s(speaker_scaled_time):VowelFOOT           1.002    1.003    1.002 0.316438    
## s(speaker_scaled_time):VowelGOOSE          1.002    1.003    0.000 0.999949    
## s(speaker_scaled_time):VowelKIT            1.003    1.006    4.250 0.038688 *  
## s(speaker_scaled_time):VowelLOT            1.830    2.284   12.406 3.45e-06 ***
## s(speaker_scaled_time):VowelNURSE          1.002    1.003    0.548 0.459765    
## s(speaker_scaled_time):VowelSTART          1.004    1.008    0.262 0.608571    
## s(speaker_scaled_time):VowelSTRUT          6.552    7.686    4.683 5.79e-05 ***
## s(speaker_scaled_time):VowelTHOUGHT        1.002    1.004    6.114 0.013307 *  
## s(speaker_scaled_time):VowelTRAP           1.968    2.459    8.427 0.000148 ***
## s(speaker_scaled_art_rate):VowelDRESS      1.002    1.004    0.020 0.893212    
## s(speaker_scaled_art_rate):VowelFLEECE     1.003    1.005    2.311 0.128844    
## s(speaker_scaled_art_rate):VowelFOOT       1.002    1.004    6.993 0.008148 ** 
## s(speaker_scaled_art_rate):VowelGOOSE      1.002    1.004   24.177 7.99e-07 ***
## s(speaker_scaled_art_rate):VowelKIT        1.002    1.004   39.955  < 2e-16 ***
## s(speaker_scaled_art_rate):VowelLOT        1.003    1.006   25.872 3.71e-07 ***
## s(speaker_scaled_art_rate):VowelNURSE      1.002    1.004    0.159 0.692271    
## s(speaker_scaled_art_rate):VowelSTART      1.002    1.004   18.171 1.99e-05 ***
## s(speaker_scaled_art_rate):VowelSTRUT      2.153    2.732    9.839 8.58e-06 ***
## s(speaker_scaled_art_rate):VowelTHOUGHT    1.002    1.004    5.944 0.014656 *  
## s(speaker_scaled_art_rate):VowelTRAP       1.002    1.003   11.237 0.000798 ***
## s(speaker_scaled_amp_max):VowelDRESS       1.003    1.005   24.818 6.39e-07 ***
## s(speaker_scaled_amp_max):VowelFLEECE      1.003    1.005   58.592  < 2e-16 ***
## s(speaker_scaled_amp_max):VowelFOOT        1.005    1.009   99.136  < 2e-16 ***
## s(speaker_scaled_amp_max):VowelGOOSE       1.006    1.011   96.987  < 2e-16 ***
## s(speaker_scaled_amp_max):VowelKIT         3.502    4.405   58.154  < 2e-16 ***
## s(speaker_scaled_amp_max):VowelLOT         3.747    4.697  281.304  < 2e-16 ***
## s(speaker_scaled_amp_max):VowelNURSE       1.002    1.004   22.321 2.28e-06 ***
## s(speaker_scaled_amp_max):VowelSTART       1.002    1.003  105.530  < 2e-16 ***
## s(speaker_scaled_amp_max):VowelSTRUT       5.057    6.205  241.228  < 2e-16 ***
## s(speaker_scaled_amp_max):VowelTHOUGHT     1.004    1.008   29.256  < 2e-16 ***
## s(speaker_scaled_amp_max):VowelTRAP        2.666    3.391   62.238  < 2e-16 ***
## s(speaker_scaled_pitch):VowelDRESS         3.542    4.448    5.731 0.000101 ***
## s(speaker_scaled_pitch):VowelFLEECE        1.004    1.009    9.930 0.001621 ** 
## s(speaker_scaled_pitch):VowelFOOT          3.011    3.787    8.912 5.50e-07 ***
## s(speaker_scaled_pitch):VowelGOOSE         2.704    3.427    3.672 0.009030 ** 
## s(speaker_scaled_pitch):VowelKIT           6.067    7.254   25.106  < 2e-16 ***
## s(speaker_scaled_pitch):VowelLOT           4.682    5.787   23.546  < 2e-16 ***
## s(speaker_scaled_pitch):VowelNURSE         2.870    3.619    5.570 0.000487 ***
## s(speaker_scaled_pitch):VowelSTART         1.003    1.006    1.729 0.188081    
## s(speaker_scaled_pitch):VowelSTRUT         7.560    8.484   19.902  < 2e-16 ***
## s(speaker_scaled_pitch):VowelTHOUGHT       2.799    3.541    5.211 0.000795 ***
## s(speaker_scaled_pitch):VowelTRAP          3.041    3.845    3.706 0.005933 ** 
## s(Speaker)                               192.519  214.000 2201.262  < 2e-16 ***
## s(Speaker,Vowel)                        1907.534 2361.000   36.855 3.00e-07 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## R-sq.(adj) =  0.759   Deviance explained = 76.4%
## -ML = 6.2393e+05  Scale est. = 5027.8    n = 109290

The summary values are also roughly equivalent.

2.3.3 Each vowel models

We now fit GAMM models to the data from each vowel independently to see if this has any effect of our conclusions. For these modules, it is computationally feasible to fit with random smooths for each speaker.

Again, we set this block to not evaluate and load precalculated results in the following cell.

vowel_gam_models <- qb_vowels %>%
  
  # Group by vowel and nest to create a column of dataframes corresponding
  # to each vowel.
  group_by(Vowel) %>%
  nest() %>%
  
  # Apply gam model.
  mutate(
    model = map(
      data, 
      ~ bam(
        F1_50 ~ 
          participant_gender +
          s(speaker_scaled_time) + 
          s(speaker_scaled_art_rate) +
          s(speaker_scaled_amp_max) +
          s(speaker_scaled_pitch) + 
          s(speaker_scaled_time, Speaker, bs="fs", k=5, m=1) + #k=5 to reduce load.
          s(Speaker, bs="re"),
        data = .x, 
        method="fREML",
        discrete = TRUE,
        nthreads = 8 # Change this depending on number of cores available.
      ) 
    )
  )

write_rds(vowel_gam_models, here('models', 'vowel_gam_models.rds'))

vowel_gam_models <- read_rds(here('models', 'vowel_gam_models.rds'))

We first look to see if the residual distribution looks any better.

walk2(
  vowel_gam_models$Vowel, 
  vowel_gam_models$model, 
  ~ qq.gam(.y, main=glue('{.x}: Resids vs. linear pred.'))
)

It is not unexpected that each of these vowels has a distribution which has strange behaviour in the tails. Some vowels do not have much room to move ‘up’ and some do not have much room to move ‘down’. So, for instance, there is more variation possible at low F1 values for start and strut, and the model thus seems to perform more poorly at low values.

If we look at the model for start in more detail we see:

gam.check(
  vowel_gam_models %>%
    filter(
      Vowel == "START"
    ) %>%
    pull(model) %>%
    pluck(1)
)

## 
## Method: fREML   Optimizer: perf chol
## $grad
## [1] -2.159882e-05 -4.026268e-05 -3.654373e-05 -1.157334e-04  4.165265e-06
## [6]  5.100800e-06  5.100800e-06  5.383454e-05
## 
## $hess
##            [,1]          [,2]          [,3]          [,4]          [,5]
##    2.159791e-05  2.604987e-12 -8.551583e-12 -1.326032e-10  9.056256e-07
##    2.604987e-12  4.026040e-05 -2.825608e-12 -1.198277e-11 -1.082652e-06
##   -8.551583e-12 -2.825608e-12  3.654126e-05 -2.268186e-10 -1.473192e-07
##   -1.326032e-10 -1.198277e-11 -2.268186e-10  1.157034e-04 -4.164220e-06
##    9.056256e-07 -1.082652e-06 -1.473192e-07 -4.164220e-06  8.764530e+00
##   -1.180716e-06 -6.177656e-07  7.482589e-07 -5.093367e-06 -1.498569e-01
##   -1.180716e-06 -6.177656e-07  7.482589e-07 -5.093367e-06 -1.498569e-01
## d -2.515245e-05 -3.773499e-06 -8.953022e-06 -5.375294e-05 -4.167004e+01
##            [,6]          [,7]          [,8]
##   -1.180716e-06 -1.180716e-06 -2.515245e-05
##   -6.177656e-07 -6.177656e-07 -3.773499e-06
##    7.482589e-07  7.482589e-07 -8.953022e-06
##   -5.093367e-06 -5.093367e-06 -5.375294e-05
##   -1.498569e-01 -1.498569e-01 -4.167004e+01
##    2.271800e+01  2.271801e+01 -4.970401e+01
##    2.271801e+01  2.271800e+01 -4.970401e+01
## d -4.970401e+01 -4.970401e+01  2.918500e+03
## 
## Model rank =  1334 / 1334 
## 
## Basis dimension (k) checking results. Low p-value (k-index<1) may
## indicate that k is too low, especially if edf is close to k'.
## 
##                                    k'    edf k-index p-value    
## s(speaker_scaled_time)            9.0    1.0    1.00    0.57    
## s(speaker_scaled_art_rate)        9.0    1.0    0.97  <2e-16 ***
## s(speaker_scaled_amp_max)         9.0    1.0    1.00    0.56    
## s(speaker_scaled_pitch)           9.0    1.0    1.00    0.41    
## s(speaker_scaled_time,Speaker) 1080.0  182.8    1.00    0.62    
## s(Speaker)                      216.0   99.4      NA      NA    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

There does seem to be something strange happening for some speakers, where the model predicts low F1 values, but the actual value is even lower. Again, the general pattern looks OK. We are talking about a handful of affected observations.

We check our k values.

vowel_gam_models <- vowel_gam_models %>%
  mutate(
    kcheck = map(model, k.check)
  )

print_kcheck <- function(vowel, kcheck) { # Taken from mgcv gam.check code.
  cat(glue('{vowel}\n'))
  cat("\nBasis dimension (k) checking results. Low p-value (k-index<1) may\n") 
  cat("indicate that k is too low, especially if edf is close to k\'.\n\n")
  printCoefmat(kcheck, digits=3)
  cat('\n')
}

walk2(
  as.character(vowel_gam_models$Vowel), 
  vowel_gam_models$kcheck, 
  print_kcheck
)

## DRESS
## Basis dimension (k) checking results. Low p-value (k-index<1) may
## indicate that k is too low, especially if edf is close to k'.
## 
##                                    k'    edf k-index p-value
## s(speaker_scaled_time)            9.0    1.9    0.99    0.29
## s(speaker_scaled_art_rate)        9.0    1.0    1.00    0.42
## s(speaker_scaled_amp_max)         9.0    1.0    0.98    0.13
## s(speaker_scaled_pitch)           9.0    5.0    1.00    0.54
## s(speaker_scaled_time,Speaker) 1080.0  321.9    0.99    0.32
## s(Speaker)                      216.0  104.4      NA      NA
## 
## NURSE
## Basis dimension (k) checking results. Low p-value (k-index<1) may
## indicate that k is too low, especially if edf is close to k'.
## 
##                                     k'     edf k-index p-value   
## s(speaker_scaled_time)            9.00    1.00    1.00  0.4375   
## s(speaker_scaled_art_rate)        9.00    1.00    1.01  0.7250   
## s(speaker_scaled_amp_max)         9.00    1.00    1.01  0.8225   
## s(speaker_scaled_pitch)           9.00    5.04    0.97  0.0025 **
## s(speaker_scaled_time,Speaker) 1080.00  200.55    1.00  0.4100   
## s(Speaker)                      216.00  103.07      NA      NA   
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## KIT
## Basis dimension (k) checking results. Low p-value (k-index<1) may
## indicate that k is too low, especially if edf is close to k'.
## 
##                                     k'     edf k-index p-value
## s(speaker_scaled_time)            9.00    4.76    0.99    0.23
## s(speaker_scaled_art_rate)        9.00    1.00    1.00    0.46
## s(speaker_scaled_amp_max)         9.00    3.54    1.00    0.60
## s(speaker_scaled_pitch)           9.00    5.49    1.00    0.69
## s(speaker_scaled_time,Speaker) 1080.00  237.59    0.99    0.24
## s(Speaker)                      216.00   99.88      NA      NA
## 
## TRAP
## Basis dimension (k) checking results. Low p-value (k-index<1) may
## indicate that k is too low, especially if edf is close to k'.
## 
##                                     k'     edf k-index p-value  
## s(speaker_scaled_time)            9.00    2.32    1.00   0.470  
## s(speaker_scaled_art_rate)        9.00    1.00    0.98   0.072 .
## s(speaker_scaled_amp_max)         9.00    3.81    1.02   0.875  
## s(speaker_scaled_pitch)           9.00    4.70    0.97   0.040 *
## s(speaker_scaled_time,Speaker) 1080.00  263.15    1.00   0.510  
## s(Speaker)                      216.00  102.56      NA      NA  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## LOT
## Basis dimension (k) checking results. Low p-value (k-index<1) may
## indicate that k is too low, especially if edf is close to k'.
## 
##                                     k'     edf k-index p-value
## s(speaker_scaled_time)            9.00    2.27    1.00    0.65
## s(speaker_scaled_art_rate)        9.00    1.00    0.99    0.23
## s(speaker_scaled_amp_max)         9.00    3.83    1.03    0.95
## s(speaker_scaled_pitch)           9.00    4.75    0.99    0.26
## s(speaker_scaled_time,Speaker) 1080.00  184.00    1.00    0.60
## s(Speaker)                      216.00   99.27      NA      NA
## 
## THOUGHT
## Basis dimension (k) checking results. Low p-value (k-index<1) may
## indicate that k is too low, especially if edf is close to k'.
## 
##                                     k'     edf k-index p-value
## s(speaker_scaled_time)            9.00    1.00    1.01    0.74
## s(speaker_scaled_art_rate)        9.00    1.00    0.99    0.25
## s(speaker_scaled_amp_max)         9.00    2.49    1.00    0.36
## s(speaker_scaled_pitch)           9.00    3.71    1.01    0.79
## s(speaker_scaled_time,Speaker) 1080.00  189.80    1.01    0.71
## s(Speaker)                      216.00  100.01      NA      NA
## 
## FLEECE
## Basis dimension (k) checking results. Low p-value (k-index<1) may
## indicate that k is too low, especially if edf is close to k'.
## 
##                                     k'     edf k-index p-value
## s(speaker_scaled_time)            9.00    1.67    0.99    0.19
## s(speaker_scaled_art_rate)        9.00    1.41    1.01    0.75
## s(speaker_scaled_amp_max)         9.00    3.03    0.99    0.24
## s(speaker_scaled_pitch)           9.00    3.81    0.99    0.29
## s(speaker_scaled_time,Speaker) 1080.00  251.92    0.99    0.18
## s(Speaker)                      216.00  102.28      NA      NA
## 
## STRUT
## Basis dimension (k) checking results. Low p-value (k-index<1) may
## indicate that k is too low, especially if edf is close to k'.
## 
##                                     k'     edf k-index p-value
## s(speaker_scaled_time)            9.00    1.78    1.01    0.70
## s(speaker_scaled_art_rate)        9.00    1.62    1.01    0.74
## s(speaker_scaled_amp_max)         9.00    3.18    1.00    0.56
## s(speaker_scaled_pitch)           9.00    5.60    1.00    0.37
## s(speaker_scaled_time,Speaker) 1080.00  234.02    1.01    0.74
## s(Speaker)                      216.00  100.38      NA      NA
## 
## START
## Basis dimension (k) checking results. Low p-value (k-index<1) may
## indicate that k is too low, especially if edf is close to k'.
## 
##                                    k'    edf k-index p-value   
## s(speaker_scaled_time)            9.0    1.0    1.00  0.6050   
## s(speaker_scaled_art_rate)        9.0    1.0    0.96  0.0025 **
## s(speaker_scaled_amp_max)         9.0    1.0    1.01  0.7250   
## s(speaker_scaled_pitch)           9.0    1.0    0.99  0.3550   
## s(speaker_scaled_time,Speaker) 1080.0  182.8    1.00  0.5850   
## s(Speaker)                      216.0   99.4      NA      NA   
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## GOOSE
## Basis dimension (k) checking results. Low p-value (k-index<1) may
## indicate that k is too low, especially if edf is close to k'.
## 
##                                     k'     edf k-index p-value
## s(speaker_scaled_time)            9.00    1.00    0.99    0.37
## s(speaker_scaled_art_rate)        9.00    2.28    1.02    0.87
## s(speaker_scaled_amp_max)         9.00    3.65    0.98    0.15
## s(speaker_scaled_pitch)           9.00    3.48    1.00    0.52
## s(speaker_scaled_time,Speaker) 1080.00  203.59    0.99    0.32
## s(Speaker)                      216.00   92.97      NA      NA
## 
## FOOT
## Basis dimension (k) checking results. Low p-value (k-index<1) may
## indicate that k is too low, especially if edf is close to k'.
## 
##                                     k'     edf k-index p-value
## s(speaker_scaled_time)            9.00    1.00    1.00    0.38
## s(speaker_scaled_art_rate)        9.00    1.00    0.99    0.33
## s(speaker_scaled_amp_max)         9.00    3.33    1.00    0.60
## s(speaker_scaled_pitch)           9.00    3.59    1.02    0.89
## s(speaker_scaled_time,Speaker) 1065.00  136.06    1.00    0.43
## s(Speaker)                      213.00   84.11      NA      NA

All look OK!

We now plot the results together.

all_vowel_plots <- vowel_gam_models %>% 
  mutate(
    preds = map(
      model, 
      ~ get_predictions(
        .x,
        cond = list(
          'speaker_scaled_amp_max' = seq(-2.5, 2.5, length.out=200),
          'speaker_scaled_pitch' = 0,
          'speaker_scaled_art_rate' = 0,
          'speaker_scaled_time' = 0.5,
          'participant_gender' = 'F'
        )
      )
    )
  ) %>%
  select(Vowel, preds) %>%
  unnest() %>%
  mutate(
    height = if_else(Vowel %in% high_vowels, 'high', 'mid or low')
  ) %>%
  ggplot(
    aes(
      y = fit,
      x = speaker_scaled_amp_max,
      colour = Vowel
    )
  ) + 
  geom_ribbon(
    aes(
      ymin = fit - CI,
      ymax = fit + CI,
      fill = Vowel
    ),
    alpha = 0.25,
    colour = NA
  ) +
  geom_line() +
  scale_colour_manual(
    values = vowel_colours_with_foot
  ) +
  scale_fill_manual(
    values = vowel_colours_with_foot
  ) +
  labs(
    title = "F1 and Amplitude by Vowel",
    x = "Scaled amplitude",
    y = "F1"
  ) +
  facet_wrap(
    facets=vars(height), scales = "free"
  )

## Summary:
##  * participant_gender : factor; set to the value(s): F. 
##  * speaker_scaled_time : numeric predictor; set to the value(s): 0.5. 
##  * speaker_scaled_art_rate : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_amp_max : numeric predictor; with 200 values ranging from -2.500000 to 2.500000. 
##  * speaker_scaled_pitch : numeric predictor; set to the value(s): 0. 
##  * Speaker : factor; set to the value(s): QB_NZ_F_408. (Might be canceled as random effect, check below.) 
##  * NOTE : The following random effects columns are canceled: s(speaker_scaled_time,Speaker),s(Speaker)
##  
## Summary:
##  * participant_gender : factor; set to the value(s): F. 
##  * speaker_scaled_time : numeric predictor; set to the value(s): 0.5. 
##  * speaker_scaled_art_rate : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_amp_max : numeric predictor; with 200 values ranging from -2.500000 to 2.500000. 
##  * speaker_scaled_pitch : numeric predictor; set to the value(s): 0. 
##  * Speaker : factor; set to the value(s): QB_NZ_M_384. (Might be canceled as random effect, check below.) 
##  * NOTE : The following random effects columns are canceled: s(speaker_scaled_time,Speaker),s(Speaker)
##  
## Summary:
##  * participant_gender : factor; set to the value(s): F. 
##  * speaker_scaled_time : numeric predictor; set to the value(s): 0.5. 
##  * speaker_scaled_art_rate : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_amp_max : numeric predictor; with 200 values ranging from -2.500000 to 2.500000. 
##  * speaker_scaled_pitch : numeric predictor; set to the value(s): 0. 
##  * Speaker : factor; set to the value(s): QB_NZ_M_626. (Might be canceled as random effect, check below.) 
##  * NOTE : The following random effects columns are canceled: s(speaker_scaled_time,Speaker),s(Speaker)
##  
## Summary:
##  * participant_gender : factor; set to the value(s): F. 
##  * speaker_scaled_time : numeric predictor; set to the value(s): 0.5. 
##  * speaker_scaled_art_rate : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_amp_max : numeric predictor; with 200 values ranging from -2.500000 to 2.500000. 
##  * speaker_scaled_pitch : numeric predictor; set to the value(s): 0. 
##  * Speaker : factor; set to the value(s): QB_NZ_M_753. (Might be canceled as random effect, check below.) 
##  * NOTE : The following random effects columns are canceled: s(speaker_scaled_time,Speaker),s(Speaker)
##  
## Summary:
##  * participant_gender : factor; set to the value(s): F. 
##  * speaker_scaled_time : numeric predictor; set to the value(s): 0.5. 
##  * speaker_scaled_art_rate : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_amp_max : numeric predictor; with 200 values ranging from -2.500000 to 2.500000. 
##  * speaker_scaled_pitch : numeric predictor; set to the value(s): 0. 
##  * Speaker : factor; set to the value(s): QB_NZ_M_291. (Might be canceled as random effect, check below.) 
##  * NOTE : The following random effects columns are canceled: s(speaker_scaled_time,Speaker),s(Speaker)
##  
## Summary:
##  * participant_gender : factor; set to the value(s): F. 
##  * speaker_scaled_time : numeric predictor; set to the value(s): 0.5. 
##  * speaker_scaled_art_rate : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_amp_max : numeric predictor; with 200 values ranging from -2.500000 to 2.500000. 
##  * speaker_scaled_pitch : numeric predictor; set to the value(s): 0. 
##  * Speaker : factor; set to the value(s): QB_NZ_M_291. (Might be canceled as random effect, check below.) 
##  * NOTE : The following random effects columns are canceled: s(speaker_scaled_time,Speaker),s(Speaker)
##  
## Summary:
##  * participant_gender : factor; set to the value(s): F. 
##  * speaker_scaled_time : numeric predictor; set to the value(s): 0.5. 
##  * speaker_scaled_art_rate : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_amp_max : numeric predictor; with 200 values ranging from -2.500000 to 2.500000. 
##  * speaker_scaled_pitch : numeric predictor; set to the value(s): 0. 
##  * Speaker : factor; set to the value(s): QB_NZ_F_408. (Might be canceled as random effect, check below.) 
##  * NOTE : The following random effects columns are canceled: s(speaker_scaled_time,Speaker),s(Speaker)
##  
## Summary:
##  * participant_gender : factor; set to the value(s): F. 
##  * speaker_scaled_time : numeric predictor; set to the value(s): 0.5. 
##  * speaker_scaled_art_rate : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_amp_max : numeric predictor; with 200 values ranging from -2.500000 to 2.500000. 
##  * speaker_scaled_pitch : numeric predictor; set to the value(s): 0. 
##  * Speaker : factor; set to the value(s): QB_NZ_M_291. (Might be canceled as random effect, check below.) 
##  * NOTE : The following random effects columns are canceled: s(speaker_scaled_time,Speaker),s(Speaker)
##  
## Summary:
##  * participant_gender : factor; set to the value(s): F. 
##  * speaker_scaled_time : numeric predictor; set to the value(s): 0.5. 
##  * speaker_scaled_art_rate : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_amp_max : numeric predictor; with 200 values ranging from -2.500000 to 2.500000. 
##  * speaker_scaled_pitch : numeric predictor; set to the value(s): 0. 
##  * Speaker : factor; set to the value(s): QB_NZ_M_626. (Might be canceled as random effect, check below.) 
##  * NOTE : The following random effects columns are canceled: s(speaker_scaled_time,Speaker),s(Speaker)
##  
## Summary:
##  * participant_gender : factor; set to the value(s): F. 
##  * speaker_scaled_time : numeric predictor; set to the value(s): 0.5. 
##  * speaker_scaled_art_rate : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_amp_max : numeric predictor; with 200 values ranging from -2.500000 to 2.500000. 
##  * speaker_scaled_pitch : numeric predictor; set to the value(s): 0. 
##  * Speaker : factor; set to the value(s): QB_NZ_M_291. (Might be canceled as random effect, check below.) 
##  * NOTE : The following random effects columns are canceled: s(speaker_scaled_time,Speaker),s(Speaker)
##  
## Summary:
##  * participant_gender : factor; set to the value(s): F. 
##  * speaker_scaled_time : numeric predictor; set to the value(s): 0.5. 
##  * speaker_scaled_art_rate : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_amp_max : numeric predictor; with 200 values ranging from -2.500000 to 2.500000. 
##  * speaker_scaled_pitch : numeric predictor; set to the value(s): 0. 
##  * Speaker : factor; set to the value(s): QB_NZ_M_291. (Might be canceled as random effect, check below.) 
##  * NOTE : The following random effects columns are canceled: s(speaker_scaled_time,Speaker),s(Speaker)
## 

all_vowel_plots

Figure 2.27: Amplitude predictions from by-vowel models.

There is a more extreme reduction in F1 values for goose at low values of scaled amplitude. The values of lot and trap get a little closer together at low values as well. However, the overall story is the same. We see increase in F1 with amplitude.

all_vowel_plots <- vowel_gam_models %>% 
  mutate(
    preds = map(
      model, 
      ~ get_predictions(
        .x,
        cond = list(
          'speaker_scaled_pitch' = seq(-2.5, 2.5, length.out=200),
          'speaker_scaled_amp_max' = 0,
          'speaker_scaled_art_rate' = 0,
          'speaker_scaled_time' = 0.5,
          'participant_gender' = 'F'
        )
      )
    )
  ) %>%
  select(Vowel, preds) %>%
  unnest() %>%
  mutate(
    height = if_else(Vowel %in% high_vowels, 'high', 'mid or low')
  ) %>%
  ggplot(
    aes(
      y = fit,
      x = speaker_scaled_pitch,
      colour = Vowel
    )
  ) + 
  geom_ribbon(
    aes(
      ymin = fit - CI,
      ymax = fit + CI,
      fill = Vowel
    ),
    alpha = 0.25,
    colour = NA
  ) +
  geom_line() +
  scale_colour_manual(
    values = vowel_colours_with_foot
  ) +
  scale_fill_manual(
    values = vowel_colours_with_foot
  ) +
  labs(
    title = "F1 and Pitch by Vowel",
    x = "Scaled pitch",
    y = "F1"
  ) 

## Summary:
##  * participant_gender : factor; set to the value(s): F. 
##  * speaker_scaled_time : numeric predictor; set to the value(s): 0.5. 
##  * speaker_scaled_art_rate : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_amp_max : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_pitch : numeric predictor; with 200 values ranging from -2.500000 to 2.500000. 
##  * Speaker : factor; set to the value(s): QB_NZ_F_408. (Might be canceled as random effect, check below.) 
##  * NOTE : The following random effects columns are canceled: s(speaker_scaled_time,Speaker),s(Speaker)
##  
## Summary:
##  * participant_gender : factor; set to the value(s): F. 
##  * speaker_scaled_time : numeric predictor; set to the value(s): 0.5. 
##  * speaker_scaled_art_rate : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_amp_max : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_pitch : numeric predictor; with 200 values ranging from -2.500000 to 2.500000. 
##  * Speaker : factor; set to the value(s): QB_NZ_M_384. (Might be canceled as random effect, check below.) 
##  * NOTE : The following random effects columns are canceled: s(speaker_scaled_time,Speaker),s(Speaker)
##  
## Summary:
##  * participant_gender : factor; set to the value(s): F. 
##  * speaker_scaled_time : numeric predictor; set to the value(s): 0.5. 
##  * speaker_scaled_art_rate : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_amp_max : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_pitch : numeric predictor; with 200 values ranging from -2.500000 to 2.500000. 
##  * Speaker : factor; set to the value(s): QB_NZ_M_626. (Might be canceled as random effect, check below.) 
##  * NOTE : The following random effects columns are canceled: s(speaker_scaled_time,Speaker),s(Speaker)
##  
## Summary:
##  * participant_gender : factor; set to the value(s): F. 
##  * speaker_scaled_time : numeric predictor; set to the value(s): 0.5. 
##  * speaker_scaled_art_rate : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_amp_max : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_pitch : numeric predictor; with 200 values ranging from -2.500000 to 2.500000. 
##  * Speaker : factor; set to the value(s): QB_NZ_M_753. (Might be canceled as random effect, check below.) 
##  * NOTE : The following random effects columns are canceled: s(speaker_scaled_time,Speaker),s(Speaker)
##  
## Summary:
##  * participant_gender : factor; set to the value(s): F. 
##  * speaker_scaled_time : numeric predictor; set to the value(s): 0.5. 
##  * speaker_scaled_art_rate : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_amp_max : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_pitch : numeric predictor; with 200 values ranging from -2.500000 to 2.500000. 
##  * Speaker : factor; set to the value(s): QB_NZ_M_291. (Might be canceled as random effect, check below.) 
##  * NOTE : The following random effects columns are canceled: s(speaker_scaled_time,Speaker),s(Speaker)
##  
## Summary:
##  * participant_gender : factor; set to the value(s): F. 
##  * speaker_scaled_time : numeric predictor; set to the value(s): 0.5. 
##  * speaker_scaled_art_rate : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_amp_max : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_pitch : numeric predictor; with 200 values ranging from -2.500000 to 2.500000. 
##  * Speaker : factor; set to the value(s): QB_NZ_M_291. (Might be canceled as random effect, check below.) 
##  * NOTE : The following random effects columns are canceled: s(speaker_scaled_time,Speaker),s(Speaker)
##  
## Summary:
##  * participant_gender : factor; set to the value(s): F. 
##  * speaker_scaled_time : numeric predictor; set to the value(s): 0.5. 
##  * speaker_scaled_art_rate : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_amp_max : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_pitch : numeric predictor; with 200 values ranging from -2.500000 to 2.500000. 
##  * Speaker : factor; set to the value(s): QB_NZ_F_408. (Might be canceled as random effect, check below.) 
##  * NOTE : The following random effects columns are canceled: s(speaker_scaled_time,Speaker),s(Speaker)
##  
## Summary:
##  * participant_gender : factor; set to the value(s): F. 
##  * speaker_scaled_time : numeric predictor; set to the value(s): 0.5. 
##  * speaker_scaled_art_rate : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_amp_max : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_pitch : numeric predictor; with 200 values ranging from -2.500000 to 2.500000. 
##  * Speaker : factor; set to the value(s): QB_NZ_M_291. (Might be canceled as random effect, check below.) 
##  * NOTE : The following random effects columns are canceled: s(speaker_scaled_time,Speaker),s(Speaker)
##  
## Summary:
##  * participant_gender : factor; set to the value(s): F. 
##  * speaker_scaled_time : numeric predictor; set to the value(s): 0.5. 
##  * speaker_scaled_art_rate : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_amp_max : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_pitch : numeric predictor; with 200 values ranging from -2.500000 to 2.500000. 
##  * Speaker : factor; set to the value(s): QB_NZ_M_626. (Might be canceled as random effect, check below.) 
##  * NOTE : The following random effects columns are canceled: s(speaker_scaled_time,Speaker),s(Speaker)
##  
## Summary:
##  * participant_gender : factor; set to the value(s): F. 
##  * speaker_scaled_time : numeric predictor; set to the value(s): 0.5. 
##  * speaker_scaled_art_rate : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_amp_max : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_pitch : numeric predictor; with 200 values ranging from -2.500000 to 2.500000. 
##  * Speaker : factor; set to the value(s): QB_NZ_M_291. (Might be canceled as random effect, check below.) 
##  * NOTE : The following random effects columns are canceled: s(speaker_scaled_time,Speaker),s(Speaker)
##  
## Summary:
##  * participant_gender : factor; set to the value(s): F. 
##  * speaker_scaled_time : numeric predictor; set to the value(s): 0.5. 
##  * speaker_scaled_art_rate : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_amp_max : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_pitch : numeric predictor; with 200 values ranging from -2.500000 to 2.500000. 
##  * Speaker : factor; set to the value(s): QB_NZ_M_291. (Might be canceled as random effect, check below.) 
##  * NOTE : The following random effects columns are canceled: s(speaker_scaled_time,Speaker),s(Speaker)
## 

  # facet_wrap(
  #   facets=vars(height), scales = "free"
  # )

all_vowel_plots

Figure 2.28: Pitch predictions from by-vowel models.

The U shaped plots again.

all_vowel_plots <- vowel_gam_models %>% 
  mutate(
    preds = map(
      model, 
      ~ get_predictions(
        .x,
        cond = list(
          'speaker_scaled_art_rate' = seq(-2.5, 2.5, length.out=200),
          'speaker_scaled_amp_max' = 0,
          'speaker_scaled_pitch' = 0,
          'speaker_scaled_time' = 0.5,
          'participant_gender' = 'F'
        )
      )
    )
  ) %>%
  select(Vowel, preds) %>%
  unnest() %>%
  mutate(
    height = if_else(Vowel %in% high_vowels, 'high', 'mid or low')
  ) %>%
  ggplot(
    aes(
      y = fit,
      x = speaker_scaled_art_rate,
      colour = Vowel
    )
  ) + 
  geom_ribbon(
    aes(
      ymin = fit - CI,
      ymax = fit + CI,
      fill = Vowel
    ),
    alpha = 0.25,
    colour = NA
  ) +
  geom_line() +
  scale_colour_manual(
    values = vowel_colours_with_foot
  ) +
  scale_fill_manual(
    values = vowel_colours_with_foot
  ) +
  labs(
    title = "F1 and Articulation Rate by Vowel",
    x = "Scaled articulation rate",
    y = "F1"
  )

## Summary:
##  * participant_gender : factor; set to the value(s): F. 
##  * speaker_scaled_time : numeric predictor; set to the value(s): 0.5. 
##  * speaker_scaled_art_rate : numeric predictor; with 200 values ranging from -2.500000 to 2.500000. 
##  * speaker_scaled_amp_max : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_pitch : numeric predictor; set to the value(s): 0. 
##  * Speaker : factor; set to the value(s): QB_NZ_F_408. (Might be canceled as random effect, check below.) 
##  * NOTE : The following random effects columns are canceled: s(speaker_scaled_time,Speaker),s(Speaker)
##  
## Summary:
##  * participant_gender : factor; set to the value(s): F. 
##  * speaker_scaled_time : numeric predictor; set to the value(s): 0.5. 
##  * speaker_scaled_art_rate : numeric predictor; with 200 values ranging from -2.500000 to 2.500000. 
##  * speaker_scaled_amp_max : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_pitch : numeric predictor; set to the value(s): 0. 
##  * Speaker : factor; set to the value(s): QB_NZ_M_384. (Might be canceled as random effect, check below.) 
##  * NOTE : The following random effects columns are canceled: s(speaker_scaled_time,Speaker),s(Speaker)
##  
## Summary:
##  * participant_gender : factor; set to the value(s): F. 
##  * speaker_scaled_time : numeric predictor; set to the value(s): 0.5. 
##  * speaker_scaled_art_rate : numeric predictor; with 200 values ranging from -2.500000 to 2.500000. 
##  * speaker_scaled_amp_max : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_pitch : numeric predictor; set to the value(s): 0. 
##  * Speaker : factor; set to the value(s): QB_NZ_M_626. (Might be canceled as random effect, check below.) 
##  * NOTE : The following random effects columns are canceled: s(speaker_scaled_time,Speaker),s(Speaker)
##  
## Summary:
##  * participant_gender : factor; set to the value(s): F. 
##  * speaker_scaled_time : numeric predictor; set to the value(s): 0.5. 
##  * speaker_scaled_art_rate : numeric predictor; with 200 values ranging from -2.500000 to 2.500000. 
##  * speaker_scaled_amp_max : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_pitch : numeric predictor; set to the value(s): 0. 
##  * Speaker : factor; set to the value(s): QB_NZ_M_753. (Might be canceled as random effect, check below.) 
##  * NOTE : The following random effects columns are canceled: s(speaker_scaled_time,Speaker),s(Speaker)
##  
## Summary:
##  * participant_gender : factor; set to the value(s): F. 
##  * speaker_scaled_time : numeric predictor; set to the value(s): 0.5. 
##  * speaker_scaled_art_rate : numeric predictor; with 200 values ranging from -2.500000 to 2.500000. 
##  * speaker_scaled_amp_max : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_pitch : numeric predictor; set to the value(s): 0. 
##  * Speaker : factor; set to the value(s): QB_NZ_M_291. (Might be canceled as random effect, check below.) 
##  * NOTE : The following random effects columns are canceled: s(speaker_scaled_time,Speaker),s(Speaker)
##  
## Summary:
##  * participant_gender : factor; set to the value(s): F. 
##  * speaker_scaled_time : numeric predictor; set to the value(s): 0.5. 
##  * speaker_scaled_art_rate : numeric predictor; with 200 values ranging from -2.500000 to 2.500000. 
##  * speaker_scaled_amp_max : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_pitch : numeric predictor; set to the value(s): 0. 
##  * Speaker : factor; set to the value(s): QB_NZ_M_291. (Might be canceled as random effect, check below.) 
##  * NOTE : The following random effects columns are canceled: s(speaker_scaled_time,Speaker),s(Speaker)
##  
## Summary:
##  * participant_gender : factor; set to the value(s): F. 
##  * speaker_scaled_time : numeric predictor; set to the value(s): 0.5. 
##  * speaker_scaled_art_rate : numeric predictor; with 200 values ranging from -2.500000 to 2.500000. 
##  * speaker_scaled_amp_max : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_pitch : numeric predictor; set to the value(s): 0. 
##  * Speaker : factor; set to the value(s): QB_NZ_F_408. (Might be canceled as random effect, check below.) 
##  * NOTE : The following random effects columns are canceled: s(speaker_scaled_time,Speaker),s(Speaker)
##  
## Summary:
##  * participant_gender : factor; set to the value(s): F. 
##  * speaker_scaled_time : numeric predictor; set to the value(s): 0.5. 
##  * speaker_scaled_art_rate : numeric predictor; with 200 values ranging from -2.500000 to 2.500000. 
##  * speaker_scaled_amp_max : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_pitch : numeric predictor; set to the value(s): 0. 
##  * Speaker : factor; set to the value(s): QB_NZ_M_291. (Might be canceled as random effect, check below.) 
##  * NOTE : The following random effects columns are canceled: s(speaker_scaled_time,Speaker),s(Speaker)
##  
## Summary:
##  * participant_gender : factor; set to the value(s): F. 
##  * speaker_scaled_time : numeric predictor; set to the value(s): 0.5. 
##  * speaker_scaled_art_rate : numeric predictor; with 200 values ranging from -2.500000 to 2.500000. 
##  * speaker_scaled_amp_max : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_pitch : numeric predictor; set to the value(s): 0. 
##  * Speaker : factor; set to the value(s): QB_NZ_M_626. (Might be canceled as random effect, check below.) 
##  * NOTE : The following random effects columns are canceled: s(speaker_scaled_time,Speaker),s(Speaker)
##  
## Summary:
##  * participant_gender : factor; set to the value(s): F. 
##  * speaker_scaled_time : numeric predictor; set to the value(s): 0.5. 
##  * speaker_scaled_art_rate : numeric predictor; with 200 values ranging from -2.500000 to 2.500000. 
##  * speaker_scaled_amp_max : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_pitch : numeric predictor; set to the value(s): 0. 
##  * Speaker : factor; set to the value(s): QB_NZ_M_291. (Might be canceled as random effect, check below.) 
##  * NOTE : The following random effects columns are canceled: s(speaker_scaled_time,Speaker),s(Speaker)
##  
## Summary:
##  * participant_gender : factor; set to the value(s): F. 
##  * speaker_scaled_time : numeric predictor; set to the value(s): 0.5. 
##  * speaker_scaled_art_rate : numeric predictor; with 200 values ranging from -2.500000 to 2.500000. 
##  * speaker_scaled_amp_max : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_pitch : numeric predictor; set to the value(s): 0. 
##  * Speaker : factor; set to the value(s): QB_NZ_M_291. (Might be canceled as random effect, check below.) 
##  * NOTE : The following random effects columns are canceled: s(speaker_scaled_time,Speaker),s(Speaker)
## 

  # facet_wrap(
  #   facets=vars(height), scales = "free"
  # )

all_vowel_plots

Figure 2.29: Articulation rate predictions from by-vowel models.

Interestingly, if we model the vowels independently, we lose the increase in F1 with articulation rate of thought. However, the rest of the phenoemena explicable by vowel space contraction and expansion with articulation rate remaine (Figure 2.29).

all_vowel_plots <- vowel_gam_models %>% 
  mutate(
    preds = map(
      model, 
      ~ get_predictions(
        .x,
        cond = list(
          'speaker_scaled_time' = seq(0, 1, length.out=200),
          'speaker_scaled_pitch' = 0,
          'speaker_scaled_art_rate' = 0,
          'speaker_scaled_amp_max' = 0,
          'participant_gender' = 'F'
        )
      )
    )
  ) %>%
  select(Vowel, preds) %>%
  unnest() %>%
  mutate(
    height = if_else(Vowel %in% high_vowels, 'high', 'mid or low')
  ) %>%
  ggplot(
    aes(
      y = fit,
      x = speaker_scaled_time,
      colour = Vowel
    )
  ) + 
  geom_ribbon(
    aes(
      ymin = fit - CI,
      ymax = fit + CI,
      fill = Vowel
    ),
    alpha = 0.25,
    colour = NA
  ) +
  geom_line() +
  scale_colour_manual(
    values = vowel_colours_with_foot
  ) +
  scale_fill_manual(
    values = vowel_colours_with_foot
  ) +
  labs(
    title = "F1 and Time by Vowel",
    x = "Scaled time",
    y = "F1"
  )

## Summary:
##  * participant_gender : factor; set to the value(s): F. 
##  * speaker_scaled_time : numeric predictor; with 200 values ranging from 0.000000 to 1.000000. 
##  * speaker_scaled_art_rate : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_amp_max : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_pitch : numeric predictor; set to the value(s): 0. 
##  * Speaker : factor; set to the value(s): QB_NZ_F_408. (Might be canceled as random effect, check below.) 
##  * NOTE : The following random effects columns are canceled: s(speaker_scaled_time,Speaker),s(Speaker)
##  
## Summary:
##  * participant_gender : factor; set to the value(s): F. 
##  * speaker_scaled_time : numeric predictor; with 200 values ranging from 0.000000 to 1.000000. 
##  * speaker_scaled_art_rate : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_amp_max : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_pitch : numeric predictor; set to the value(s): 0. 
##  * Speaker : factor; set to the value(s): QB_NZ_M_384. (Might be canceled as random effect, check below.) 
##  * NOTE : The following random effects columns are canceled: s(speaker_scaled_time,Speaker),s(Speaker)
##  
## Summary:
##  * participant_gender : factor; set to the value(s): F. 
##  * speaker_scaled_time : numeric predictor; with 200 values ranging from 0.000000 to 1.000000. 
##  * speaker_scaled_art_rate : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_amp_max : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_pitch : numeric predictor; set to the value(s): 0. 
##  * Speaker : factor; set to the value(s): QB_NZ_M_626. (Might be canceled as random effect, check below.) 
##  * NOTE : The following random effects columns are canceled: s(speaker_scaled_time,Speaker),s(Speaker)
##  
## Summary:
##  * participant_gender : factor; set to the value(s): F. 
##  * speaker_scaled_time : numeric predictor; with 200 values ranging from 0.000000 to 1.000000. 
##  * speaker_scaled_art_rate : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_amp_max : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_pitch : numeric predictor; set to the value(s): 0. 
##  * Speaker : factor; set to the value(s): QB_NZ_M_753. (Might be canceled as random effect, check below.) 
##  * NOTE : The following random effects columns are canceled: s(speaker_scaled_time,Speaker),s(Speaker)
##  
## Summary:
##  * participant_gender : factor; set to the value(s): F. 
##  * speaker_scaled_time : numeric predictor; with 200 values ranging from 0.000000 to 1.000000. 
##  * speaker_scaled_art_rate : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_amp_max : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_pitch : numeric predictor; set to the value(s): 0. 
##  * Speaker : factor; set to the value(s): QB_NZ_M_291. (Might be canceled as random effect, check below.) 
##  * NOTE : The following random effects columns are canceled: s(speaker_scaled_time,Speaker),s(Speaker)
##  
## Summary:
##  * participant_gender : factor; set to the value(s): F. 
##  * speaker_scaled_time : numeric predictor; with 200 values ranging from 0.000000 to 1.000000. 
##  * speaker_scaled_art_rate : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_amp_max : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_pitch : numeric predictor; set to the value(s): 0. 
##  * Speaker : factor; set to the value(s): QB_NZ_M_291. (Might be canceled as random effect, check below.) 
##  * NOTE : The following random effects columns are canceled: s(speaker_scaled_time,Speaker),s(Speaker)
##  
## Summary:
##  * participant_gender : factor; set to the value(s): F. 
##  * speaker_scaled_time : numeric predictor; with 200 values ranging from 0.000000 to 1.000000. 
##  * speaker_scaled_art_rate : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_amp_max : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_pitch : numeric predictor; set to the value(s): 0. 
##  * Speaker : factor; set to the value(s): QB_NZ_F_408. (Might be canceled as random effect, check below.) 
##  * NOTE : The following random effects columns are canceled: s(speaker_scaled_time,Speaker),s(Speaker)
##  
## Summary:
##  * participant_gender : factor; set to the value(s): F. 
##  * speaker_scaled_time : numeric predictor; with 200 values ranging from 0.000000 to 1.000000. 
##  * speaker_scaled_art_rate : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_amp_max : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_pitch : numeric predictor; set to the value(s): 0. 
##  * Speaker : factor; set to the value(s): QB_NZ_M_291. (Might be canceled as random effect, check below.) 
##  * NOTE : The following random effects columns are canceled: s(speaker_scaled_time,Speaker),s(Speaker)
##  
## Summary:
##  * participant_gender : factor; set to the value(s): F. 
##  * speaker_scaled_time : numeric predictor; with 200 values ranging from 0.000000 to 1.000000. 
##  * speaker_scaled_art_rate : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_amp_max : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_pitch : numeric predictor; set to the value(s): 0. 
##  * Speaker : factor; set to the value(s): QB_NZ_M_626. (Might be canceled as random effect, check below.) 
##  * NOTE : The following random effects columns are canceled: s(speaker_scaled_time,Speaker),s(Speaker)
##  
## Summary:
##  * participant_gender : factor; set to the value(s): F. 
##  * speaker_scaled_time : numeric predictor; with 200 values ranging from 0.000000 to 1.000000. 
##  * speaker_scaled_art_rate : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_amp_max : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_pitch : numeric predictor; set to the value(s): 0. 
##  * Speaker : factor; set to the value(s): QB_NZ_M_291. (Might be canceled as random effect, check below.) 
##  * NOTE : The following random effects columns are canceled: s(speaker_scaled_time,Speaker),s(Speaker)
##  
## Summary:
##  * participant_gender : factor; set to the value(s): F. 
##  * speaker_scaled_time : numeric predictor; with 200 values ranging from 0.000000 to 1.000000. 
##  * speaker_scaled_art_rate : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_amp_max : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_pitch : numeric predictor; set to the value(s): 0. 
##  * Speaker : factor; set to the value(s): QB_NZ_M_291. (Might be canceled as random effect, check below.) 
##  * NOTE : The following random effects columns are canceled: s(speaker_scaled_time,Speaker),s(Speaker)
## 

all_vowel_plots

Figure 2.30: Time predictions from by-vowel models.

There is no great change in our predictions here, with the possible exception of an acceleration of change in kit, trap, and lot at the end of a monologue.

As we did with our simple linear models, we do some simple p-value significance testing to determine how often our various predictors come out as significant. This takes some time as it requires a summary to be generated for each gamm.

vowel_gam_sig_coeffs <- vowel_gam_models %>%
  mutate(
    summary = map(model, summary),
    smooth_coefficients = map(
      summary, 
      ~ as_tibble(.x$s.table, rownames = 'variable'),
    ),
    significant_variables = map(
      smooth_coefficients,
      ~ .x %>% filter(`p-value` <= 0.05)
    )
  ) %>%
  select(
    Vowel, significant_variables
  ) %>%
  unnest(significant_variables)

write_rds(vowel_gam_sig_coeffs, here("models", "vowel_gam_sig_coeffs.rds"))

vowel_gam_sig_coeffs <- read_rds(here("models", "vowel_gam_sig_coeffs.rds"))

Let’s have a look at the values for speaker_scaled_amp_max.

vowel_gam_sig_coeffs %>%
  filter(
    variable == "s(speaker_scaled_amp_max)"
  )

All 11 vowel have significant p-values for amplitude.

We compare these to the values for speaker_scaled_pitch:

vowel_gam_sig_coeffs %>%
  filter(
    variable == "s(speaker_scaled_pitch)"
  )

All but start for pitch.

Now speaker_scaled_art_rate:

vowel_gam_sig_coeffs %>%
  filter(
    variable == "s(speaker_scaled_art_rate)"
  )

All but dress, nurse, and fleece for articulation rate.

Finally, we look at s(speaker_scaled_time) and s(speaker_scaled_time, Speaker).

vowel_gam_sig_coeffs %>%
  filter(
    variable == 's(speaker_scaled_time)'
  )

Only three vowels come out as significant for speaker_scaled_time.

Let’s have a look at these speaker_scaled_time smooths again:

all_vowel_plots <- vowel_gam_models %>% 
  filter(
    Vowel %in% c('KIT', 'TRAP', 'STRUT', 'LOT')
  ) %>%
  mutate(
    preds = map(
      model, 
      ~ get_predictions(
        .x,
        cond = list(
          'speaker_scaled_time' = seq(0, 1, length.out=200),
          'speaker_scaled_pitch' = 0,
          'speaker_scaled_art_rate' = 0,
          'speaker_scaled_amp_max' = 0,
          'participant_gender' = 'F'
        )
      )
    )
  ) %>%
  select(Vowel, preds) %>%
  unnest() %>%
  ggplot(
    aes(
      y = fit,
      x = speaker_scaled_time,
      colour = Vowel
    )
  ) + 
  geom_ribbon(
    aes(
      ymin = fit - CI,
      ymax = fit + CI,
      fill = Vowel
    ),
    alpha = 0.25,
    colour = NA
  ) +
  geom_line() +
  scale_colour_manual(
    values = vowel_colours_with_foot
  ) +
  scale_fill_manual(
    values = vowel_colours_with_foot
  ) +
  labs(
    title = "F1 and Time by Vowel",
    x = "Scaled time",
    y = "F1"
  )

## Summary:
##  * participant_gender : factor; set to the value(s): F. 
##  * speaker_scaled_time : numeric predictor; with 200 values ranging from 0.000000 to 1.000000. 
##  * speaker_scaled_art_rate : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_amp_max : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_pitch : numeric predictor; set to the value(s): 0. 
##  * Speaker : factor; set to the value(s): QB_NZ_M_291. (Might be canceled as random effect, check below.) 
##  * NOTE : The following random effects columns are canceled: s(speaker_scaled_time,Speaker),s(Speaker)
##  
## Summary:
##  * participant_gender : factor; set to the value(s): F. 
##  * speaker_scaled_time : numeric predictor; with 200 values ranging from 0.000000 to 1.000000. 
##  * speaker_scaled_art_rate : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_amp_max : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_pitch : numeric predictor; set to the value(s): 0. 
##  * Speaker : factor; set to the value(s): QB_NZ_M_291. (Might be canceled as random effect, check below.) 
##  * NOTE : The following random effects columns are canceled: s(speaker_scaled_time,Speaker),s(Speaker)
##  
## Summary:
##  * participant_gender : factor; set to the value(s): F. 
##  * speaker_scaled_time : numeric predictor; with 200 values ranging from 0.000000 to 1.000000. 
##  * speaker_scaled_art_rate : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_amp_max : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_pitch : numeric predictor; set to the value(s): 0. 
##  * Speaker : factor; set to the value(s): QB_NZ_M_626. (Might be canceled as random effect, check below.) 
##  * NOTE : The following random effects columns are canceled: s(speaker_scaled_time,Speaker),s(Speaker)
##  
## Summary:
##  * participant_gender : factor; set to the value(s): F. 
##  * speaker_scaled_time : numeric predictor; with 200 values ranging from 0.000000 to 1.000000. 
##  * speaker_scaled_art_rate : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_amp_max : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_pitch : numeric predictor; set to the value(s): 0. 
##  * Speaker : factor; set to the value(s): QB_NZ_M_291. (Might be canceled as random effect, check below.) 
##  * NOTE : The following random effects columns are canceled: s(speaker_scaled_time,Speaker),s(Speaker)
## 

all_vowel_plots

Figure 2.31: Time predictions from by-vowel models.

All of these could have a line at a constant F1 value drawn through their confidence intervals. Whatever this effect is, it is very small compared to the effects of amplitude, pitch, and articulation rate.

2.3.4 An F2 Model

We want to look at the consequences of amplitude change for the whole vowel space. In order to do this, we fit an fREML model for F2. For this purpose, we will match Structure 1.

gamm_fit_f2 <- bam(
  F2_50 ~ 
    participant_gender +
    Vowel +
    s(speaker_scaled_time, by=Vowel) + 
    s(speaker_scaled_art_rate, by=Vowel) +
    s(speaker_scaled_amp_max, by=Vowel) +
    s(speaker_scaled_pitch, by=Vowel) + 
    s(Speaker, bs="re") +
    s(Speaker, Vowel, bs="re"),
  data = qb_vowels, 
  method="fREML",
  discrete = TRUE,
  nthreads = 8 # Change this depending on number of cores available.
)

write_rds(gamm_fit_f2, here('models', 'gamm_fit_f2.rds'))

gamm_fit_f2_summary <- summary(gamm_fit_f2)
write_rds(gamm_fit_f2_summary, here('models', 'gamm_fit_f2_summary.rds'))

We look at the model summary.

gamm_fit_f2 <- read_rds(here('models', 'gamm_fit_f2.rds'))
gamm_fit_f2_summary <- read_rds(here('models', 'gamm_fit_f2_summary.rds'))
gamm_fit_f2_summary

## 
## Family: gaussian 
## Link function: identity 
## 
## Formula:
## F2_50 ~ participant_gender + Vowel + s(speaker_scaled_time, by = Vowel) + 
##     s(speaker_scaled_art_rate, by = Vowel) + s(speaker_scaled_amp_max, 
##     by = Vowel) + s(speaker_scaled_pitch, by = Vowel) + s(Speaker, 
##     bs = "re") + s(Speaker, Vowel, bs = "re")
## 
## Parametric coefficients:
##                      Estimate Std. Error  t value Pr(>|t|)    
## (Intercept)          2244.743      9.515  235.919   <2e-16 ***
## participant_genderM  -249.207     10.616  -23.474   <2e-16 ***
## VowelFLEECE            23.412     10.852    2.157    0.031 *  
## VowelFOOT            -887.995     11.408  -77.841   <2e-16 ***
## VowelGOOSE           -345.265     12.102  -28.530   <2e-16 ***
## VowelKIT             -481.385     10.900  -44.163   <2e-16 ***
## VowelLOT            -1015.990     11.370  -89.361   <2e-16 ***
## VowelNURSE           -344.730     11.281  -30.558   <2e-16 ***
## VowelSTART           -676.354     11.020  -61.376   <2e-16 ***
## VowelSTRUT           -721.753     10.704  -67.429   <2e-16 ***
## VowelTHOUGHT        -1187.357     11.572 -102.603   <2e-16 ***
## VowelTRAP            -157.573     10.773  -14.626   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Approximate significance of smooth terms:
##                                              edf   Ref.df       F  p-value    
## s(speaker_scaled_time):VowelDRESS          4.931    6.020   3.003 0.006146 ** 
## s(speaker_scaled_time):VowelFLEECE         1.615    2.004   2.205 0.110559    
## s(speaker_scaled_time):VowelFOOT           1.002    1.004   0.011 0.922897    
## s(speaker_scaled_time):VowelGOOSE          3.113    3.866   7.403 1.09e-05 ***
## s(speaker_scaled_time):VowelKIT            1.002    1.003   3.365 0.066491 .  
## s(speaker_scaled_time):VowelLOT            1.003    1.005   6.374 0.011514 *  
## s(speaker_scaled_time):VowelNURSE          2.179    2.709   4.220 0.011815 *  
## s(speaker_scaled_time):VowelSTART          1.002    1.004   0.002 0.978537    
## s(speaker_scaled_time):VowelSTRUT          1.005    1.010   0.265 0.612500    
## s(speaker_scaled_time):VowelTHOUGHT        1.002    1.005   0.002 0.985538    
## s(speaker_scaled_time):VowelTRAP           1.001    1.002   3.396 0.065202 .  
## s(speaker_scaled_art_rate):VowelDRESS      1.911    2.419  67.251  < 2e-16 ***
## s(speaker_scaled_art_rate):VowelFLEECE     1.001    1.001  68.682  < 2e-16 ***
## s(speaker_scaled_art_rate):VowelFOOT       1.001    1.002   3.785 0.051678 .  
## s(speaker_scaled_art_rate):VowelGOOSE      2.356    2.981   1.460 0.228916    
## s(speaker_scaled_art_rate):VowelKIT        1.002    1.004   1.343 0.246754    
## s(speaker_scaled_art_rate):VowelLOT        1.001    1.002  13.201 0.000277 ***
## s(speaker_scaled_art_rate):VowelNURSE      1.004    1.007   2.219 0.136354    
## s(speaker_scaled_art_rate):VowelSTART      1.001    1.002   5.123 0.023542 *  
## s(speaker_scaled_art_rate):VowelSTRUT      1.004    1.007   5.424 0.019538 *  
## s(speaker_scaled_art_rate):VowelTHOUGHT    1.001    1.002  49.705  < 2e-16 ***
## s(speaker_scaled_art_rate):VowelTRAP       1.036    1.070   1.542 0.200731    
## s(speaker_scaled_amp_max):VowelDRESS       3.527    4.425   5.974 5.60e-05 ***
## s(speaker_scaled_amp_max):VowelFLEECE      2.588    3.287   3.419 0.013772 *  
## s(speaker_scaled_amp_max):VowelFOOT        1.001    1.002   2.452 0.117245    
## s(speaker_scaled_amp_max):VowelGOOSE       4.210    5.217  36.573  < 2e-16 ***
## s(speaker_scaled_amp_max):VowelKIT         1.211    1.393   2.757 0.058428 .  
## s(speaker_scaled_amp_max):VowelLOT         3.606    4.511  36.175  < 2e-16 ***
## s(speaker_scaled_amp_max):VowelNURSE       1.403    1.710   1.368 0.381295    
## s(speaker_scaled_amp_max):VowelSTART       1.001    1.002   8.944 0.002762 ** 
## s(speaker_scaled_amp_max):VowelSTRUT       1.003    1.005  21.560 3.65e-06 ***
## s(speaker_scaled_amp_max):VowelTHOUGHT     5.418    6.533 100.177  < 2e-16 ***
## s(speaker_scaled_amp_max):VowelTRAP        1.016    1.032  14.151 0.000163 ***
## s(speaker_scaled_pitch):VowelDRESS         5.239    6.341   3.085 0.003968 ** 
## s(speaker_scaled_pitch):VowelFLEECE        1.001    1.002  12.350 0.000437 ***
## s(speaker_scaled_pitch):VowelFOOT          1.001    1.003   2.045 0.152543    
## s(speaker_scaled_pitch):VowelGOOSE         6.613    7.673   4.029 0.000293 ***
## s(speaker_scaled_pitch):VowelKIT           2.778    3.499  21.263  < 2e-16 ***
## s(speaker_scaled_pitch):VowelLOT           4.784    5.849  20.586  < 2e-16 ***
## s(speaker_scaled_pitch):VowelNURSE         1.001    1.002   2.316 0.128058    
## s(speaker_scaled_pitch):VowelSTART         1.001    1.003   9.697 0.001824 ** 
## s(speaker_scaled_pitch):VowelSTRUT         1.006    1.011  44.987  < 2e-16 ***
## s(speaker_scaled_pitch):VowelTHOUGHT       7.045    8.053  35.809  < 2e-16 ***
## s(speaker_scaled_pitch):VowelTRAP          1.003    1.006   9.442 0.002062 ** 
## s(Speaker)                               168.215  214.000 740.667  < 2e-16 ***
## s(Vowel,Speaker)                        1913.869 2361.000  49.703  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## R-sq.(adj) =  0.835   Deviance explained = 83.8%
## fREML = 7.383e+05  Scale est. = 41013     n = 109290

We inspect the plots for amplitude, articulation rate, and pitch.

all_vowel_plot_f2 <- function(predictions, xvar, xlabel, plot_title) {
  
  vowel_colours_reordered <- c(
        FLEECE = "#D89000",
        DRESS = "#9590FF",
        TRAP = "#FF62BC",
        NURSE = "#00BFC4",
        GOOSE = "#A3A500",
        KIT = "#39B600",
        START = "#00B0F6",
        STRUT = "#F8766D",
        FOOT = "#966432",
        LOT = "#00BF7D",
        THOUGHT = "#E76BF3"
      )

  xvar <- enquo(xvar)
  
  predictions %>%
    mutate(# Enable plot to distinguish between high and low vowels (for faceting)
      height = if_else(Vowel %in% front_vowels, "front", "back or mid")
    ) %>%
    ggplot(
      aes(
        y = fit,
        x = !!xvar,
        colour = Vowel
      )
    ) + 
    geom_ribbon(
      aes(
        ymin = fit - CI,
        ymax = fit + CI,
        fill = Vowel
      ),
      alpha = 0.3,
      colour = NA
    ) +
    geom_line() +
    scale_colour_manual(
      values = vowel_colours_reordered
    ) +
    scale_fill_manual(
      values = vowel_colours_reordered
    ) +
    labs(
      title = plot_title,
      x = xlabel,
      y = "F2"
    )
    # facet_wrap(
    #   facets=vars(height), scales = "free"
    # )
}

gamm_preds <- get_predictions(
  gamm_fit_f2,
  cond = list(
    'speaker_scaled_amp_max' = seq(-2.5, 2.5, length.out=200),
    'participant_gender' = 'F',
    'speaker_scaled_pitch' = 0,
    'speaker_scaled_art_rate' = 0,
    'speaker_scaled_time' = 0.5,
    'Vowel' = unique(qb_vowels$Vowel)
  )
)

## Summary:
##  * participant_gender : factor; set to the value(s): F. 
##  * Vowel : factor with 11 values; set to the value(s): DRESS, FLEECE, FOOT, GOOSE, KIT, LOT, NURSE, START, STRUT, THOUGHT, ... (Might be canceled as random effect, check below.) 
##  * speaker_scaled_time : numeric predictor; set to the value(s): 0.5. 
##  * speaker_scaled_art_rate : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_amp_max : numeric predictor; with 200 values ranging from -2.500000 to 2.500000. 
##  * speaker_scaled_pitch : numeric predictor; set to the value(s): 0. 
##  * Speaker : factor; set to the value(s): QB_NZ_M_291. (Might be canceled as random effect, check below.) 
##  * NOTE : The following random effects columns are canceled: s(Speaker),s(Vowel,Speaker)
## 

all_vowel_plot_f2(
  gamm_preds, 
  speaker_scaled_amp_max, 
  'Scaled amplitude', 
  'F2 and Amplitude by Vowel'
)

Figure 2.32: F2 and Amplitude by Vowel

thought (the smooth closest to the bottom of the plot) and goose F2 (the brown smooth third from the top, on the left) stick out. This makes sense given our PCA analysis (that is, they are the vowels whose F2 values most strongly pattern against the F1 values in PC1). In general, we see a reduction in F1, although not as large as in the F1 case.

Let’s look at articulation rate:

gamm_preds <- get_predictions(
  gamm_fit_f2,
  cond = list(
    'speaker_scaled_amp_max' = 0,
    'participant_gender' = 'F',
    'speaker_scaled_pitch' = 0,
    'speaker_scaled_art_rate' = seq(-2.5, 2.5, length.out=200),
    'speaker_scaled_time' = 0.5,
    'Vowel' = unique(qb_vowels$Vowel)
  )
)

## Summary:
##  * participant_gender : factor; set to the value(s): F. 
##  * Vowel : factor with 11 values; set to the value(s): DRESS, FLEECE, FOOT, GOOSE, KIT, LOT, NURSE, START, STRUT, THOUGHT, ... (Might be canceled as random effect, check below.) 
##  * speaker_scaled_time : numeric predictor; set to the value(s): 0.5. 
##  * speaker_scaled_art_rate : numeric predictor; with 200 values ranging from -2.500000 to 2.500000. 
##  * speaker_scaled_amp_max : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_pitch : numeric predictor; set to the value(s): 0. 
##  * Speaker : factor; set to the value(s): QB_NZ_M_291. (Might be canceled as random effect, check below.) 
##  * NOTE : The following random effects columns are canceled: s(Speaker),s(Vowel,Speaker)
## 

all_vowel_plot_f2(
  gamm_preds, 
  speaker_scaled_art_rate, 
  'Scaled articulation rate', 
  'F2 and Articulation Rate by Vowel'
)

Figure 2.33: F2 and Articulation Rate by Vowel

Only dress, fleece, and thought indicated as significant at 0.05. In case of thought, we might have a gradual increase with some surprising ‘wiggles’. dress and fleece F2 seem to decrease as articulation rate increases. This is again consistent with vowel space area reduction.

gamm_preds <- get_predictions(
  gamm_fit_f2,
  cond = list(
    'speaker_scaled_amp_max' = 0,
    'participant_gender' = 'F',
    'speaker_scaled_pitch' = seq(-2.5, 2.5, length.out=200),
    'speaker_scaled_art_rate' = 0,
    'speaker_scaled_time' = 0.5,
    'Vowel' = unique(qb_vowels$Vowel)
  )
)

## Summary:
##  * participant_gender : factor; set to the value(s): F. 
##  * Vowel : factor with 11 values; set to the value(s): DRESS, FLEECE, FOOT, GOOSE, KIT, LOT, NURSE, START, STRUT, THOUGHT, ... (Might be canceled as random effect, check below.) 
##  * speaker_scaled_time : numeric predictor; set to the value(s): 0.5. 
##  * speaker_scaled_art_rate : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_amp_max : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_pitch : numeric predictor; with 200 values ranging from -2.500000 to 2.500000. 
##  * Speaker : factor; set to the value(s): QB_NZ_M_291. (Might be canceled as random effect, check below.) 
##  * NOTE : The following random effects columns are canceled: s(Speaker),s(Vowel,Speaker)
## 

all_vowel_plot_f2(
  gamm_preds, 
  speaker_scaled_pitch, 
  'Scaled pitch', 
  'F2 and Pitch by Vowel'
)

Figure 2.34: F2 and Pitch by Vowel

thought F2 is listed in the model summary as significant at 0.05, the plot shows that the smooth deviates from the null hypothesis by wiggling in the middle. It is hard to be confident that this is a real phenomenon.

2.3.4.1 Vowel Space Plots

We now plot the impact of amplitude and articulation rate within the vowel space as whole. In order to do this, we use the fREML models of F1 and F2 with the same structure as used in the ML model reported in the paper.

We first collect the data for amplitude and articulation rate:

# Extends beyond 2.5 as this seems to help the stability of animations below.
plotting_range = seq(-2.6, 2.6, by = 0.1)

amp_gamm_preds_f1 <- get_predictions(
  gamm_fit,
  cond = list(
    # We go slightly beyond the bounds of the model to fix a problem where
    # text labels disappear in the animation below.
    'speaker_scaled_amp_max' = plotting_range,
    'participant_gender' = 'F',
    'speaker_scaled_pitch' = 0,
    'speaker_scaled_art_rate' = 0,
    'speaker_scaled_time' = 0.5,
    'Vowel' = vowels
  ),
  se = FALSE
)

## Summary:
##  * participant_gender : factor; set to the value(s): F. 
##  * Vowel : factor with 11 values; set to the value(s): DRESS, FLEECE, FOOT, GOOSE, KIT, LOT, NURSE, START, STRUT, THOUGHT, ... (Might be canceled as random effect, check below.) 
##  * speaker_scaled_time : numeric predictor; set to the value(s): 0.5. 
##  * speaker_scaled_art_rate : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_amp_max : numeric predictor; with 53 values ranging from -2.600000 to 2.600000. 
##  * speaker_scaled_pitch : numeric predictor; set to the value(s): 0. 
##  * Speaker : factor; set to the value(s): QB_NZ_M_291. (Might be canceled as random effect, check below.) 
##  * NOTE : The following random effects columns are canceled: s(Speaker),s(Vowel,Speaker)
## 

art_gamm_preds_f1 <- get_predictions(
  gamm_fit,
  cond = list(
    # We go slightly beyond the bounds of the model to fix a problem where
    # text labels disappear in the animation below.
    'speaker_scaled_amp_max' = 0,
    'participant_gender' = 'F',
    'speaker_scaled_pitch' = 0,
    'speaker_scaled_art_rate' = plotting_range,
    'speaker_scaled_time' = 0.5,
    'Vowel' = vowels
  ),
  se = FALSE
)

## Summary:
##  * participant_gender : factor; set to the value(s): F. 
##  * Vowel : factor with 11 values; set to the value(s): DRESS, FLEECE, FOOT, GOOSE, KIT, LOT, NURSE, START, STRUT, THOUGHT, ... (Might be canceled as random effect, check below.) 
##  * speaker_scaled_time : numeric predictor; set to the value(s): 0.5. 
##  * speaker_scaled_art_rate : numeric predictor; with 53 values ranging from -2.600000 to 2.600000. 
##  * speaker_scaled_amp_max : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_pitch : numeric predictor; set to the value(s): 0. 
##  * Speaker : factor; set to the value(s): QB_NZ_M_291. (Might be canceled as random effect, check below.) 
##  * NOTE : The following random effects columns are canceled: s(Speaker),s(Vowel,Speaker)
## 

amp_gamm_preds_f2 <- get_predictions(
  gamm_fit_f2,
  cond = list(
    'speaker_scaled_amp_max' = plotting_range,
    'participant_gender' = 'F',
    'speaker_scaled_pitch' = 0,
    'speaker_scaled_art_rate' = 0,
    'speaker_scaled_time' = 0.5,
    'Vowel' = vowels
  ),
  se = FALSE
)

## Summary:
##  * participant_gender : factor; set to the value(s): F. 
##  * Vowel : factor with 11 values; set to the value(s): DRESS, FLEECE, FOOT, GOOSE, KIT, LOT, NURSE, START, STRUT, THOUGHT, ... (Might be canceled as random effect, check below.) 
##  * speaker_scaled_time : numeric predictor; set to the value(s): 0.5. 
##  * speaker_scaled_art_rate : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_amp_max : numeric predictor; with 53 values ranging from -2.600000 to 2.600000. 
##  * speaker_scaled_pitch : numeric predictor; set to the value(s): 0. 
##  * Speaker : factor; set to the value(s): QB_NZ_M_291. (Might be canceled as random effect, check below.) 
##  * NOTE : The following random effects columns are canceled: s(Speaker),s(Vowel,Speaker)
## 

art_gamm_preds_f2 <- get_predictions(
  gamm_fit_f2,
  cond = list(
    'speaker_scaled_amp_max' = 0,
    'participant_gender' = 'F',
    'speaker_scaled_pitch' = 0,
    'speaker_scaled_art_rate' = plotting_range,
    'speaker_scaled_time' = 0.5,
    'Vowel' = vowels
  ),
  se = FALSE
)

## Summary:
##  * participant_gender : factor; set to the value(s): F. 
##  * Vowel : factor with 11 values; set to the value(s): DRESS, FLEECE, FOOT, GOOSE, KIT, LOT, NURSE, START, STRUT, THOUGHT, ... (Might be canceled as random effect, check below.) 
##  * speaker_scaled_time : numeric predictor; set to the value(s): 0.5. 
##  * speaker_scaled_art_rate : numeric predictor; with 53 values ranging from -2.600000 to 2.600000. 
##  * speaker_scaled_amp_max : numeric predictor; set to the value(s): 0. 
##  * speaker_scaled_pitch : numeric predictor; set to the value(s): 0. 
##  * Speaker : factor; set to the value(s): QB_NZ_M_291. (Might be canceled as random effect, check below.) 
##  * NOTE : The following random effects columns are canceled: s(Speaker),s(Vowel,Speaker)
## 

gamm_preds_f1 <- bind_rows(
  "Articulation Rate" = art_gamm_preds_f1 %>%
    select(
      Vowel, speaker_scaled_art_rate, fit
    ) %>%
    rename(
      scaled_value = speaker_scaled_art_rate
    ),
  "Amplitude" = amp_gamm_preds_f1 %>%
    select(
      Vowel, speaker_scaled_amp_max, fit
    ) %>%
    rename(
      scaled_value = speaker_scaled_amp_max
    ),
  .id = "Variable"
)

gamm_preds_f2 <- bind_rows(
  "Articulation Rate" = art_gamm_preds_f2 %>%
    select(
      Vowel, speaker_scaled_art_rate, fit
    ) %>%
    rename(
      scaled_value = speaker_scaled_art_rate
    ),
  "Amplitude" = amp_gamm_preds_f2 %>%
    select(
      Vowel, speaker_scaled_amp_max, fit
    ) %>%
    rename(
      scaled_value = speaker_scaled_amp_max
    ),
  .id = "Variable"
)

gamm_preds <- bind_rows(
  "F1" = gamm_preds_f1, 
  "F2" = gamm_preds_f2, 
  .id = "Formant"
)

gamm_preds <- gamm_preds %>%
  pivot_wider(
    names_from = Formant,
    values_from = fit
  )

first_obs <- gamm_preds %>%
  group_by(Vowel, Variable) %>%
  slice(which.min(scaled_value))

We now produce a static plot for the paper:

static_plot <- gamm_preds %>%
  filter(
    between(scaled_value, -2.5, 2.5)
  ) %>%
  ggplot(
    aes(
      x = F2,
      y = F1,
      colour = Vowel,
      group = Vowel,
      label = Vowel,
      # frame is introduced here for the interactive plot below. It is 
      # not necessary for the static plot.
      frame = scaled_value
    )
  ) +
  geom_path(
    arrow = arrow(length = unit(1.5, "mm"), type = "closed"), # Make arrows smaller
    show.legend = FALSE
  ) +
  # geom_label(
  #   fontface = 2,
  #   size = 2, 
  #   show.legend = FALSE,
  #   data = first_obs,
  #   alpha = 0.5
  # ) +
  geom_point(data=first_obs) +
  #label the axes
  xlab("F2 (Hz)") +
  ylab("F1 (Hz)") +
  #reverse the axes to follow conventional vowel plotting
  scale_x_reverse(expand = expansion(add=100), position = "top") +
  scale_y_reverse(expand = expansion(add=50), position = "right") +
  #set the colours. Use of 'rev' means the vowels are labelled roughly from top
  #to bottom.
  scale_color_manual(values = rev(vowel_colours_with_foot)) +
  #add a title
  labs(
    title = "Vowel Space Effect of Amplitude and Articulation Rate",
    subtitle = "By-Speaker Z-Scores Between -2.5 and 2.5"
  ) +
  #set the theme
  # theme_bw() +
  #make text more visible
  theme(
    plot.title = element_text(size = 16, hjust = 0, face = "bold"),
    plot.subtitle = element_text(size = 16, hjust = 0),
    panel.spacing.x = unit(6, "mm"),
    strip.text = element_text(size = 10),
    # axis.title = element_text(size = 14, face = "bold"),
    axis.text.x = element_text(size = 8, face = "bold"),
    axis.text.y = element_text(size = 8, face = "bold", angle = 270),
    plot.margin = margin(5, 5, 5, 5, "mm"),
    # axis.ticks = element_blank(),
    # plot.caption = element_text(size = 14, hjust = 0),
    # legend.position = "none"
  ) +
  facet_grid(cols = vars(Variable))

ggsave(
  here('plots', 'amp-art.png'),
  plot = static_plot,
  units = "cm",
  width = 25,
  height = 20
)

static_plot

Figure 2.35: Static plot of effect of amplitude and articulation rate on vowel space as predicted by GAMM models.

We use points rather than labels here because the shifts in articulation rate are so small.

We now produce the same plot as an animation. This will be used in presentations.

animated_plot <- gamm_preds %>%
  ggplot(
    aes(
      x = F2,
      y = F1,
      colour = Vowel,
      group = Vowel,
      label = Vowel
    )
  ) +
  geom_path(
    arrow = arrow(length = unit(1, "mm"), type = "closed"), # Make arrows smaller
    show.legend = FALSE
  ) +
  geom_label(
    fontface = 2,
    size = 2.5,
    show.legend = FALSE,
    alpha = 0.5
  ) +
  #label the axes
  xlab("F2 (Hz)") +
  ylab("F1 (Hz)") +
  #reverse the axes to follow conventional vowel plotting
  scale_x_reverse(expand = expansion(add=200), position = "top") +
  scale_y_reverse(expand = expansion(add=50), position = "right") +
  #set the colours
  scale_color_manual(values = rev(vowel_colours_with_foot)) +
  #add a title
  labs(
    title = "Vowel Space Effect of Amplitude and Articulation Rate",
    subtitle = "By-Speaker Z-Scores Between -2.5 and 2.5",
    caption = 'Z-scored value: {round(frame_along, 1)}'
  ) +
  #set the theme
  # theme_bw() +
  #make text more visible
  theme(
    plot.title = element_text(size = 16, hjust = 0, face = "bold"),
    plot.subtitle = element_text(size = 16, hjust = 0),
    axis.title = element_text(size = 14, face = "bold"),
    axis.text.x = element_text(size = 14, face = "bold"),
    axis.text.y = element_text(size = 14, face = "bold", angle = 270),
    axis.ticks = element_blank(),
    plot.caption = element_text(size = 14, hjust = 0),
    # legend.position = "none"
  ) +
  facet_grid(cols = vars(Variable)) +
  transition_reveal(along = scaled_value, range = c(-2.5, 2.5))

animated_plot <- animate(
  animated_plot, 
  start_pause = 10,
  end_pause = 10
)

animated_plot

Figure 2.36: Animated plot of effect of amplitude and articulation rate on vowel space as predicted by GAMM models.

Finally, we produce an interactive plot using plotly.

interactive_plot <- gamm_preds %>%
  filter(
    between(scaled_value, -2.5, 2.5)
  ) %>%
  ggplot(
    aes(
      x = F2,
      y = F1,
      colour = Vowel,
      group = Vowel,
      label = Vowel,
      # frame is introduced here for the interactive plot below. It is 
      # not necessary for the static plot.
      frame = scaled_value
    )
  ) +
  geom_text(
    fontface = 2,
    size = 3,
    show.legend = FALSE,
    alpha = 1
  ) +
  #label the axes
  xlab("F2 (Hz)") +
  ylab("F1 (Hz)") +
  #reverse the axes to follow conventional vowel plotting
  scale_x_reverse(expand = expansion(add=200), position = "top") +
  scale_y_reverse(expand = expansion(add=50), position = "right") +
  #set the colours. Use of 'rev' means the vowels are labelled roughly from top
  #to bottom.
  scale_color_manual(values = rev(vowel_colours_with_foot)) +
  #add a title
  labs(
    title = "Vowel Space Effect of Amplitude and Articulation Rate",
    subtitle = "By-Speaker Z-Scores Between -2.5 and 2.5"
  ) +
  #set the theme
  # theme_bw() +
  #make text more visible
  theme(
    plot.title = element_text(size = 16, hjust = 0, face = "bold"),
    plot.subtitle = element_text(size = 16, hjust = 0),
    axis.title = element_text(size = 14, face = "bold"),
    axis.text.x = element_text(size = 14, face = "bold"),
    axis.text.y = element_text(size = 14, face = "bold", angle = 270),
    axis.ticks = element_blank(),
    plot.caption = element_text(size = 14, hjust = 0),
    legend.position = "none"
  ) +
  facet_grid(cols = vars(Variable))

ggplotly(interactive_plot)

Figure 2.37: Interactive plot of effect of amplitude and articulation rate on vowel space as predicted by GAMM models.

The takeaway from these plots is simple: the widely controlled for effect of articulation rate on the vowel space is much smaller than the effect of maximum amplitude.

3 Amplitude and Topical Units

We now turn to whether variation in relative amplitude, perhaps through changes to articulatory setting, is being used by speakers to indicate topical structure in the QuakeBox monologues.

3.1 Topic Tags and Filtering

We start with a variety of topic tags which come from the QuakeBox transcription process. For the purposes of this modelling, we are not particularly interested in the specific topic being discussed. That is, for the purpose of this analysis, it doesn’t matter which earthquake is being discussed, or whether the speaker is talking about some other topic. We’re interested in whether there is any amplitude pattern in topics in general.

Even though we are not primarily interested in the specific content of the topics, we will keep track of them at this exploratory stage. The unprocessed topic tags applied to a subset of QB monologues are:

qb_vowels %>% pull(type) %>% unique()

##  [1] "{September earthquake experience}"         
##  [2] "{February earthquake experience}"          
##  [3] "{June earthquakes experience}"             
##  [4] "{aftermath of the earthquakes}"            
##  [5] ""                                          
##  [6] "{housing and insurance}"                   
##  [7] "{June earthquakes experience} "            
##  [8] "{aftermath of the earthquakes} "           
##  [9] "{other earthquake experience}"             
## [10] "{December 23rd earthquakes experience}"    
## [11] "{thoughts for the future}"                 
## [12] "{government response to the earthquakes}"  
## [13] "{personal background to the earthquakes}"  
## [14] "{thoughts for the future} "                
## [15] "{June earthquake experience}"              
## [16] "{February earthquake experience} "         
## [17] "{aftermath of the earthquakes}  "          
## [18] " {February earthquake experience}"         
## [19] "{September earthquake experience} "        
## [20] "{other earthquake experience}  "           
## [21] "{other}"                                   
## [22] "{February earthquake experience}   "       
## [23] "{December 23rd earthquakes experience} "   
## [24] "{personal background to the earthquakes} " 
## [25] "{personal background to the earthquakes}  "
## [26] "{February earthquake experience}  "        
## [27] "{housing and insurance} "                  
## [28] "{housing and insurance}    "

Following Brand (2021), we can simplify these tags:

qb_vowels <- qb_vowels %>%
  mutate(
    topic = str_to_lower(str_trim(type)), # Remove white space and switch to lower case.,
    topic = str_replace(topic, "earthquakes", "earthquake"),
    topic = str_replace_all(topic, " experience| to the earthquake| of the earthquake| earthquake", "")
  )

qb_vowels %>% pull(topic) %>% unique()

##  [1] "{september}"               "{february}"               
##  [3] "{june}"                    "{aftermath}"              
##  [5] ""                          "{housing and insurance}"  
##  [7] "{other}"                   "{december 23rd}"          
##  [9] "{thoughts for the future}" "{government response}"    
## [11] "{personal background}"

We remove the topic “other”.

qb_vowels <- qb_vowels %>%
  mutate(
    topic = str_replace_all(topic, "\\{other\\}", "")
  )

qb_vowels %>% pull(topic) %>% unique()

##  [1] "{september}"               "{february}"               
##  [3] "{june}"                    "{aftermath}"              
##  [5] ""                          "{housing and insurance}"  
##  [7] "{december 23rd}"           "{thoughts for the future}"
##  [9] "{government response}"     "{personal background}"

We are interested in connected spans of monologue which concern the same topic. To do this we create a column for each speaker which increases in value for each change of topic in the speaker’s monologue.

After assessing topic changes, but before creating the new column, we delete those sections which do not have a topic tag.

qb_vowels <- qb_vowels %>%
  group_by(Speaker) %>%
  mutate(
    topic_previous = lag(topic, default = "start"),
    change = if_else(topic_previous != topic, 1, 0)
  ) %>%
  # We now remove untagged sections. Doing this here means we have no risk of
  # missing a gaps between two sections on the same topic.
  filter(
    topic != "" 
  ) %>%
  mutate(
    topic_no = cumsum(change)
  ) %>%
  ungroup()

We look at how many speakers touch on each topic.

qb_vowels %>%
  group_by(topic) %>%
  summarise(n_distinct(Speaker))

Discussions of the February earthquake the aftermath of the February earthquake and the September earthquake are very well represented. Thoughts for the future only represents three speakers.²

We now have all of the distinct single-topic chunks in the corpus. At this stage, we can filter by length of topic chunk. Let’s look at the distribution of topic chunk lengths first (and how many tokens they tend to contain).

qb_vowels <- qb_vowels %>%
  group_by(Speaker, topic_no) %>%
  mutate(
   topic_length = max(time) - min(time),
   n_in_topic = n()
  ) %>%
  ungroup()

We first look at the topic length distribution (Figure 3.1).

qb_vowels %>%
  group_by(Speaker, topic_no) %>%
  summarise(
    topic_length = first(topic_length)
  ) %>%
  ggplot(
    aes(
      x = topic_length
    )
  ) +
  geom_histogram(bins = 100) +
  labs(
    main = "Distribution of topic lengths.",
    x = "Topic length (seconds)",
    y = "Count"
  )

Figure 3.1: Distribution of Topic Lengths

We now look at how many tokens each topic tends to have (Figure 3.2).

qb_vowels %>%
  group_by(Speaker, topic_no) %>%
  summarise(
    n_in_topic = first(n_in_topic)
  ) %>%
  ggplot(
    aes(
      x = n_in_topic
    )
  ) +
  geom_histogram(bins = 100) +
  labs(
    main = "Distribution of Topic Token Counts",
    x = "Count of tokens in topic",
    y = "Count of topic chunks"
  )

Figure 3.2: Distribution of Topic Token Counts

Numerical summaries of topic length of the number of tokens per topic might also help:

qb_vowels %>%
  group_by(Speaker, topic_no) %>%
  summarise(
    topic_length = first(topic_length),
    n_in_topic = first(n_in_topic)
  ) %>%
  ungroup() %>%
  select(topic_length, n_in_topic) %>%
  summary()

##   topic_length       n_in_topic    
##  Min.   :   0.00   Min.   :   1.0  
##  1st Qu.:  49.18   1st Qu.:  35.0  
##  Median : 101.86   Median :  73.0  
##  Mean   : 173.72   Mean   : 122.9  
##  3rd Qu.: 208.72   3rd Qu.: 150.0  
##  Max.   :1797.67   Max.   :1160.0

The median topic length is around 1:40 and contains 57 vowel tokens.

For modelling purposes, we want to know how far through a topic we are for each vowel token. We do this by scaling the segment onset times within the topic to cover the range [0,1]. That is, we scale in the same way we did for overall time in the preprocessing markdown document.

qb_vowels <- qb_vowels %>%
  group_by(Speaker, topic_no) %>%
  mutate(
    topic_time_scaled = rescale(time, to=c(0,1))
  )

We now generate example plots of each topic for an example speaker.

qb_vowels %>%
  filter(
    Speaker == "QB_NZ_F_559"
  ) %>%
  ggplot(
    aes(
      x = time,
      y = intensity_max
    )
  ) +
  geom_point() +
  #geom_smooth() +
  facet_wrap(vars(topic_no), scales="free") +
  labs(
    title = "QB_NZ_F_559 Topics and Amplitudes",
    x = "Time (seconds)",
    y = "Maximum amplitude (db)"
  )

Figure 3.3: Amplitude Changes Across Topic (Example)

Figure 3.3 shows an example of six distinct topical chunks from the same speaker. We see that some are shorter than others and there seem to be different patterns visible in each. Topic 2, in particular, looks to have a downward trajectory. We also see some indication that accounting for changes in variance in amplitude might also be of interest (although we will not do this in this study). Topic 2 seems to have a large expansion in variance in the middle of the topic.

3.2 Linear (Mixed) Model Approach

3.2.1 Part wrangling

We are interested in whether there is a statistically significant effect of coming to the end of a topic and a change in amplitude. The most sophisticated way to investigate this is to consider the trajectory of amplitude over time with a flexible nonlinear model like a GAMM. However, this level of sophistication introduces all sorts of complexities. It is worth starting with a simpler model and seeing what we find. One very simple model assigns an amplitude value to the beginning, middle, and end of each topic chunk. We will then see whether there is any systematic difference between these values in our corpus.

We begin by dividing the topics into three even (by time through the topic) chunks.

qb_vowels <- qb_vowels %>%
  group_by(Speaker, topic_no) %>%
  mutate(
    topic_part = cut(
      topic_time_scaled, 
      breaks = c(-0.1, 0.33, 0.66, 1.1), 
      labels = c("start", "middle", "end")
    )
  ) %>%
  group_by(Speaker, topic_no, topic_part) %>%
  mutate(
    topic_part_n = n()
  ) %>%
  ungroup()

We check that there is an even amount of tokens in the beginning, middle, and end chunks (Figure 3.4). Visually, the boxes look reasonably similar.

qb_vowels %>%
  ggplot(
    aes(
      x = topic_part,
      y = topic_part_n
    )
  ) +
  geom_boxplot() +
  labs(
    title = "Topic Parts by Token Count",
    x = "Topic part",
    y = "Token count"
  )

Figure 3.4: Topic parts by token count.

Given the code above, it is not possible to have a topic_part_n score of 0, but it may be that there are some empty parts. We create a new dataframe which will have a zero value for any topic part without tokens.

qb_parts <- qb_vowels %>%
  group_by(Speaker, topic_no, topic_part, .drop=FALSE) %>%
  summarise(
    topic_part_n = first(topic_part_n),
    topic_part_n = if_else(is.na(topic_part_n), 0L, topic_part_n) # Replace NAs with 0
  )

We now look at a historgram of the number of tokens within topic parts (Figure 3.5).

qb_parts %>%
  ggplot(
    aes(
      x = topic_part_n
    )
  ) +
  geom_histogram(bins = 100) +
  labs(
    title = "Distribution of Token Counts Within Each Topic Part.",
    y = "Count of topic parts.",
    x = "Count of tokens within topic part."
  )

Figure 3.5: Distribution of token counts within each topic part.

There are not many parts without a token.

Our linear model will fit a mean to each of our topic parts for each speaker and topic. A simple way to ensure enough data for this is to insist on 5 tokens, as we did for our initial speaker filtering.

topics_to_filter <- qb_vowels %>%
  filter(
    topic_part_n < 5
  ) %>%
  select(Speaker, topic_no) %>%
  unique()

speaker_topics_to_filter <- topics_to_filter %>%
  mutate(
    speaker_topic = str_c(Speaker, "_", topic_no)
  ) %>%
  pull(speaker_topic)

qb_filtered <- qb_vowels %>%
  mutate(
    speaker_topic = str_c(Speaker, "_", topic_no)
  ) %>%
  filter(
    !speaker_topic %in% speaker_topics_to_filter
  )

We lose 63 topics from the data set with this filtering (from 617).

For convenience, we keep only those variables that we want for modelling.

qb_glmm_data <- qb_filtered %>%
  select(
    Speaker, participant_gender, participant_age_category,
    Vowel, speaker_scaled_art_rate, speaker_topic, topic_part,
    topic_time_scaled, speaker_scaled_time, speaker_scaled_amp_max,
    speaker_scaled_pitch, topic_no, topic, time, speaker_length
  )

3.2.2 Modelling

We now look to see if there is any evidence that the parts of topics are systematically different in terms of amplitude.

Before formally modelling, we produce a boxplot of amplitude at the start middle and end of topics. (Figure 3.6).

qb_glmm_data %>%
  ggplot(
    aes(
      x = topic_part,
      y = speaker_scaled_amp_max
    )
  ) +
  geom_violin(draw_quantiles = c(0.25, 0.5, 0.75), alpha=0.2) +
  geom_jitter(alpha=0.02) +
  labs(
    title = "Start, Middle, and End Mean Amplitudes",
    y = "Scaled maximum amplitude",
    x = "Part of topic"
  )

Figure 3.6: Topic start, middle, and end amplitude

We do seem to have a small amplitude reduction at the end of a topic. Since it is hard to read the precise values off Figure 3.6, we have a look at the means:

qb_glmm_data %>%
  group_by(topic_part) %>%
  summarise(speaker_scaled_amp_max = mean(speaker_scaled_amp_max, na.rm=TRUE))

The start and middle sit slightly above the average amplitude, while the end sits below. However, we know that amplitude tends to be below the mean at the end of monologues and this effect may hide the relative shifts in amplitude within topical chunks of the monologue.

3.2.2.1 Model structure one

We fit a model of amplitude with topic part, scaled time through the speaker’s monologue, and pitch scaled at the speaker level as predictors. We allow each speaker to have their own speaker_scaled_time slope to capture the overall trend in amplitude in their monologue. We do not give each speaker a random intercept, since the data is scaled for each speaker. However, we centre the time values around 0, so that the intercept is in the centre of the monologue and changes in slope can more effectively capture changes over the course of the monologue. We also treat each topical chunk independently, allowing the beginning, middle, and end to be fit separately for each topical section (as a random effect). We could treat topic part as an ordered factor, but I have stuck with a simpler model which allows each part to vary independently.

NB: Change eval=FALSE to eval=FALSE to fit this model yourself.

glmm_fit <- lmer(
  speaker_scaled_amp_max ~ 
    topic_part + 
    speaker_scaled_time + 
    speaker_scaled_pitch +
    (0+speaker_scaled_time|Speaker) +
    (0+topic_part|speaker_topic), 
  data=qb_glmm_data %>%
    mutate(
      speaker_scaled_time = speaker_scaled_time - 0.5
    ))

# This model needs some help converging. We use the strategy of restarting
# from current parameters
pars <- getME(glmm_fit, "theta")
glmm_fit <- update(glmm_fit, start=pars)

write_rds(glmm_fit, here('models', 'glmm_fit_pitch.rds'))

We look at the summary.

glmm_fit <- read_rds(here('models', 'glmm_fit_pitch.rds'))
summary(glmm_fit)

## Linear mixed model fit by REML ['lmerMod']
## Formula: 
## speaker_scaled_amp_max ~ topic_part + speaker_scaled_time + speaker_scaled_pitch +  
##     (0 + speaker_scaled_time | Speaker) + (0 + topic_part | speaker_topic)
##    Data: qb_glmm_data %>% mutate(speaker_scaled_time = speaker_scaled_time -  
##     0.5)
## 
## REML criterion at convergence: 170999.6
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -4.5989 -0.6477 -0.0055  0.6525  4.3801 
## 
## Random effects:
##  Groups        Name                Variance Std.Dev. Corr     
##  speaker_topic topic_partstart     0.04662  0.2159            
##                topic_partmiddle    0.03709  0.1926   0.44     
##                topic_partend       0.04837  0.2199   0.21 0.51
##  Speaker       speaker_scaled_time 0.21673  0.4655            
##  Residual                          0.55658  0.7460            
## Number of obs: 74944, groups:  speaker_topic, 554; Speaker, 153
## 
## Fixed effects:
##                      Estimate Std. Error t value
## (Intercept)           0.05927    0.01139   5.204
## topic_partmiddle     -0.01018    0.01281  -0.795
## topic_partend        -0.07165    0.01537  -4.661
## speaker_scaled_time  -0.20278    0.04482  -4.524
## speaker_scaled_pitch  0.54167    0.00356 152.157
## 
## Correlation of Fixed Effects:
##             (Intr) tpc_prtm tpc_prtn spkr_scld_t
## tpc_prtmddl -0.636                              
## topic_prtnd -0.656  0.626                       
## spkr_scld_t  0.104 -0.103   -0.175              
## spkr_scld_p  0.005  0.006    0.017    0.012

This model provides some evidence for a reduction in amplitude at the end of each topical chunk which is not explained by the reduction in amplitude over the course of the monologue as a whole or by variation in pitch. We don’t get an explicit p-value, but our t values for a higher than average amplitude at the start of the monologue and a lower than average amplitude at the end of a monologue have t-values much greater than two, which we take to be surprising.³

The magnitude of the drop at the end of a topical span is somewhat larger than the increase in amplitude at the start of a topical span. The reduction in amplitude over the course of an entire monologue can be easily read off the speaker_scaled_time coefficient, which says an increase in one in scaled time is associated with a reduction in amplitude of -0.24 (scaled amplitude). Obviously, an increase in monologue length of one represents going through the entire monologue.

We have a look at the QQ-plot:

qqnorm(resid(glmm_fit))
qqline(resid(glmm_fit), col=2)

Figure 3.7: QQ Plot for GLMM model

Figure 3.7 shows that our residuals are behaving (sufficiently) normally.

3.2.2.2 Structure 2

Another way to try to handle the known reduction in amplitude over the course of a monologue would be to remove all end-of-monologue topics. We filter out all monologues which end at the same time that the monologue ends.

start_time_filter <- qb_glmm_data %>%
  group_by(Speaker, topic_no) %>%
  summarise(
    end_time = max(time),
    speaker_length = first(speaker_length)
  ) %>%
  mutate(
    speaker_topic = str_c(Speaker, "_", topic_no)
  ) %>%
  filter(
    end_time == speaker_length
  ) %>%
  pull(speaker_topic)

glmm_fit_trimmed <- lmer(
  speaker_scaled_amp_max ~ 
    topic_part + 
    speaker_scaled_time + 
    speaker_scaled_pitch +
    (0+speaker_scaled_time|Speaker) +
    (0+topic_part|speaker_topic), 
  data=qb_glmm_data %>% 
    filter(!speaker_topic %in% start_time_filter) %>%
    mutate(
      speaker_scaled_time = speaker_scaled_time - 0.5
    ))

write_rds(glmm_fit_trimmed, here('models', 'glmm_fit_trimmed.rds'))

glmm_fit_timmed <- read_rds(here('models', 'glmm_fit_trimmed.rds'))
summary(glmm_fit_timmed)

## Linear mixed model fit by REML ['lmerMod']
## Formula: 
## speaker_scaled_amp_max ~ topic_part + speaker_scaled_time + speaker_scaled_pitch +  
##     (0 + speaker_scaled_time | Speaker) + (0 + topic_part | speaker_topic)
##    Data: qb_glmm_data %>% filter(!speaker_topic %in% start_time_filter) %>%  
##     mutate(speaker_scaled_time = speaker_scaled_time - 0.5)
## 
## REML criterion at convergence: 144349.6
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -4.4849 -0.6458 -0.0060  0.6519  4.4243 
## 
## Random effects:
##  Groups        Name                Variance Std.Dev. Corr     
##  speaker_topic topic_partstart     0.04671  0.2161            
##                topic_partmiddle    0.03761  0.1939   0.41     
##                topic_partend       0.04596  0.2144   0.18 0.47
##  Speaker       speaker_scaled_time 0.21449  0.4631            
##  Residual                          0.55309  0.7437            
## Number of obs: 63429, groups:  speaker_topic, 474; Speaker, 143
## 
## Fixed effects:
##                       Estimate Std. Error t value
## (Intercept)           0.076147   0.012681   6.005
## topic_partmiddle     -0.019963   0.014075  -1.418
## topic_partend        -0.080695   0.016650  -4.847
## speaker_scaled_time  -0.186268   0.047863  -3.892
## speaker_scaled_pitch  0.555741   0.003875 143.408
## 
## Correlation of Fixed Effects:
##             (Intr) tpc_prtm tpc_prtn spkr_scld_t
## tpc_prtmddl -0.641                              
## topic_prtnd -0.684  0.619                       
## spkr_scld_t  0.177 -0.108   -0.185              
## spkr_scld_p  0.007  0.004    0.016    0.012

The results of the two models seem roughly equivalent. Since the difference between the two isn’t great, we’ll just visualise the first model.

3.2.2.3 Visualisations of model (structure 1)

We set up a data frame for the data which we want to draw predictions from. We set speaker_time_scaled to 0, which now represents the middle of the monologue. That is, we are asking the model to assume that the speaker is half way through their monologue.

new_data <- tibble(
  speaker_topic = rep(unique(qb_glmm_data$speaker_topic), times=3),
  topic_part = rep(
    c('start', 'middle', 'end'), 
    each=length(unique(qb_glmm_data$speaker_topic))
  ),
  # Assuming we are in the middle of the monologue
  speaker_scaled_time = 0,
  # and at average pitch
  speaker_scaled_pitch = 0
)

new_data <- new_data %>%
  filter(
    !is.na(speaker_topic)
  ) %>%
  mutate(
    Speaker = str_extract(speaker_topic, 'QB_NZ_[MF]_[0-9]+')
  )

new_data <- new_data %>%
  mutate(
    prediction = predict(glmm_fit, newdata=new_data)
  )

We plot the model estimates for each topic in the dataset in Figure 3.8.

new_data %>%
  mutate(
    topic_part = factor(topic_part, levels = c('start', 'middle', 'end'))
  ) %>%
  ggplot(
    aes(
      x = topic_part,
      y = prediction
    )
  ) + 
  geom_violin(
    draw_quantiles = c(0.25, 0.5, 0.75),
    alpha = 0.5
  ) +
  geom_jitter(
    alpha = 0.2
  ) +
  labs(
    title = "Model Predictions for Each Topic",
    x = "Part",
    y = "Predicted amplutide"
  )

Figure 3.8: Model predictions for each topic at mid point of monologue.

We see a clear difference in the means of the different parts. We will generate confidence intervals for our mean estimates after carrying out a check using simulated topics below.

3.2.3 Side Track: Modelling by Specific Topic

An interesting question which this data can address: do people talk relatively quietly when discussing different topics? As noted above, this is not our main focus, but we can look at relevant data in passing.

qb_glmm_data %>%
  group_by(Speaker) %>%
  ggplot(
    aes(
      x = topic,
      y = speaker_scaled_amp_max
    )
  ) +
  geom_boxplot() +
  theme(axis.text.x = element_text(angle=90)) +
  labs(
    title = "Scaled Amplitude by Topic.",
    x = "Topic", 
    y = "Scaled amplitude"
  )

Figure 3.9: Scaled amplitude by topic.

Figure 3.9 suggests lower amplitude when discussing the December earthquake (only 17 speakers) and the June earthquake (50 speakers), and a higher amplitude when discussing thoughts for the future.

We fit a model to address the same question.

glmm_fit_topic <- lmer(
  speaker_scaled_amp_max ~ 
    topic + 
    speaker_scaled_time + 
    speaker_scaled_pitch +
    (0+speaker_scaled_time|Speaker) +
    (1|speaker_topic), 
  data=qb_glmm_data %>%
    mutate(
      speaker_scaled_time = speaker_scaled_time - 0.5
    )
)

summary(glmm_fit_topic)

## Linear mixed model fit by REML ['lmerMod']
## Formula: 
## speaker_scaled_amp_max ~ topic + speaker_scaled_time + speaker_scaled_pitch +  
##     (0 + speaker_scaled_time | Speaker) + (1 | speaker_topic)
##    Data: qb_glmm_data %>% mutate(speaker_scaled_time = speaker_scaled_time -  
##     0.5)
## 
## REML criterion at convergence: 171936
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -4.8040 -0.6507 -0.0033  0.6569  4.5538 
## 
## Random effects:
##  Groups        Name                Variance Std.Dev.
##  speaker_topic (Intercept)         0.02908  0.1705  
##  Speaker       speaker_scaled_time 0.27475  0.5242  
##  Residual                          0.57035  0.7552  
## Number of obs: 74944, groups:  speaker_topic, 554; Speaker, 153
## 
## Fixed effects:
##                                 Estimate Std. Error t value
## (Intercept)                     0.013838   0.017533   0.789
## topic{december 23rd}            0.015270   0.057432   0.266
## topic{february}                 0.064729   0.023271   2.782
## topic{government response}      0.001605   0.058498   0.027
## topic{housing and insurance}   -0.017011   0.041409  -0.411
## topic{june}                     0.096194   0.032734   2.939
## topic{personal background}     -0.062232   0.044978  -1.384
## topic{september}               -0.028511   0.029073  -0.981
## topic{thoughts for the future}  0.137912   0.090372   1.526
## speaker_scaled_time            -0.263237   0.047209  -5.576
## speaker_scaled_pitch            0.542412   0.003564 152.184
## 
## Correlation of Fixed Effects:
##             (Intr) tp{23} tpc{f} tpc{r} tp{ai} tpc{j} tpc{b} tpc{s} t{ftf}
## tpc{dc23rd} -0.256                                                        
## topc{fbrry} -0.768  0.187                                                 
## tpc{grspns} -0.282  0.078  0.211                                          
## tpc{ainsrn} -0.391  0.112  0.295  0.118                                   
## topic{june} -0.481  0.159  0.363  0.143  0.201                            
## tpc{bckgrn} -0.426  0.103  0.330  0.113  0.152  0.184                     
## tpc{sptmbr} -0.703  0.140  0.547  0.183  0.251  0.281  0.324              
## tpc{tftftr} -0.174  0.052  0.125  0.046  0.069  0.090  0.059  0.098       
## spkr_scld_t -0.132 -0.017  0.117  0.018  0.020 -0.011  0.095  0.207 -0.010
## spkr_scld_p -0.001  0.005  0.008  0.006  0.006 -0.003  0.012  0.013  0.003
##             spkr_scld_t
## tpc{dc23rd}            
## topc{fbrry}            
## tpc{grspns}            
## tpc{ainsrn}            
## topic{june}            
## tpc{bckgrn}            
## tpc{sptmbr}            
## tpc{tftftr}            
## spkr_scld_t            
## spkr_scld_p  0.018

This gives no clear evidence for or against any significant effect here. Exploring whether these different specific topics have any discernible phonetic features is left for future work.

3.3 GAMM models

3.3.1 Data transformation

Another way to proceed is to fit GAMM models over topic windows with a speaker_scaled_time control variable. We’ll continue with the data filtered for the three part GLMM approach as data gaps can lead to poor behaviour from GAMMs.

Let’s look at an uncontrolled version produced using ggplot’s geom_smooth.

qb_filtered %>%
  group_by(Speaker) %>%
  ggplot(
    aes(
      x = topic_time_scaled,
      y = speaker_scaled_amp_max
    )
  ) + 
  geom_smooth() +
  labs(
    title = "Scaled amplitude over course of topic.",
    y = "Scaled amplitude",
    x = "Scaled topic time"
  )

Figure 3.10: Smooth of scaled amp by topic time.

Figure 3.10 shows a very similar pattern to Figure 2.13. That is, we get a similar drop over the course of a topic as we get over the course of the monologue as a whole.

We can, again as a side track, ask if the pattern is different for different topics.

qb_filtered %>%
  group_by(Speaker) %>%
  ggplot(
    aes(
      x = topic_time_scaled,
      y = speaker_scaled_amp_max
    )
  ) + 
  geom_smooth() +
  facet_wrap(vars(topic)) +
  labs(
    title = "Scaled amplitude over course of topic (specific).",
    y = "Scaled amplitude",
    x = "Scaled topic time"
  )

Figure 3.11: Smooth of scaled amp by topic time, by specific topic.

The relative size of the confidence intervals here mostly tracks different amounts of data available for each topic. Those with lots of data seem to have gradual slow declines in amplitude. Certainly, there are none with clear and systematic increases over the course of the topic. The drop off seems to start late, rather than just being a straight line. This is clearest in the case of the Feb and Sept earthquakes. Perhaps {aftermath} is a counterexample to this. Again, this is left open for future research.

It is worth noting that here we are particularly at risk of of misinterpreting the reduction in amplitude over the entire monologue as an effect of topic. Some topics, like the February and September earthquakes, take up large portions of speaker monologues so we are likely to see any overall reduction come through within these topical sections even if the reduction has nothing to do with the topics themselves.

3.3.2 Modelling

We now model using a GAMM approach. We allow random smooths for each topic in the corpus.

We turn speaker_topic into an R factor for the purpose of fitting the GAMM.

qb_gamm_data <- qb_glmm_data %>%
  mutate(
    speaker_topic = as.factor(speaker_topic)
  )

gamm_topic <- bam(
  speaker_scaled_amp_max ~ 
    s(topic_time_scaled) + 
    s(speaker_scaled_time) +
    s(speaker_scaled_pitch) +
    s(topic_time_scaled, speaker_topic, bs = "fs", k=5, m=1) +
    s(speaker_scaled_time, Speaker, bs = 'fs', k=5, m=1),
  data = qb_gamm_data,
  method = 'fREML',
  discrete = TRUE,
  nthreads = 8
)

write_rds(gamm_topic, here('models', 'gamm_topic.rds'))

gamm_topic_summary <- summary(gamm_topic)
write_rds(gamm_topic_summary, here('models', 'gamm_topic_summary.rds'))

gamm_topic <- read_rds(here('models', 'gamm_topic.rds'))
gamm_topic_summary <- read_rds(here('models', 'gamm_topic_summary.rds'))
gamm_topic_summary

## 
## Family: gaussian 
## Link function: identity 
## 
## Formula:
## speaker_scaled_amp_max ~ s(topic_time_scaled) + s(speaker_scaled_time) + 
##     s(speaker_scaled_pitch) + s(topic_time_scaled, speaker_topic, 
##     bs = "fs", k = 5, m = 1) + s(speaker_scaled_time, Speaker, 
##     bs = "fs", k = 5, m = 1)
## 
## Parametric coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 0.084397   0.007148   11.81   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Approximate significance of smooth terms:
##                                         edf   Ref.df        F p-value    
## s(topic_time_scaled)                  6.666    7.765    9.756  <2e-16 ***
## s(speaker_scaled_time)                6.727    7.511   11.321  <2e-16 ***
## s(speaker_scaled_pitch)               8.552    8.932 2922.406  <2e-16 ***
## s(topic_time_scaled,speaker_topic) 1154.880 2769.000    1.102  <2e-16 ***
## s(speaker_scaled_time,Speaker)      259.898  764.000    1.112  <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## R-sq.(adj) =  0.336   Deviance explained = 34.8%
## fREML =  83983  Scale est. = 0.53007   n = 74944

We check the model diagnostics.

gam.check(gamm_topic)

## 
## Method: fREML   Optimizer: perf chol
## $grad
## [1]  1.733395e-07 -6.552448e-07  8.549084e-06 -2.498392e-05 -4.945024e-04
## [6] -4.442184e-05 -5.849127e-04  1.457824e-03
## 
## $hess
##            [,1]          [,2]          [,3]          [,4]          [,5]
##    1.710884e+00  8.448400e-02  2.741221e-04  1.988850e-01  2.571089e-02
##    8.448400e-02  1.961120e+00 -1.851436e-03  1.418473e-01 -2.557187e-01
##    2.741221e-04 -1.851436e-03  3.682246e+00 -1.674164e-02 -1.323073e-01
##    1.988850e-01  1.418473e-01 -1.674164e-02  1.992165e+02  1.281823e+00
##    2.571089e-02 -2.557187e-01 -1.323073e-01  1.281823e+00  5.669020e+01
##    5.707267e-02  7.796396e-02  1.890025e-02  9.986976e+00  1.912134e+01
##   -1.733928e-07  6.559411e-07 -7.899121e-06  2.499857e-05  4.950604e-04
## d -2.833160e+00 -2.863457e+00 -3.775996e+00 -4.533168e+02 -1.241226e+02
##            [,6]          [,7]          [,8]
##    5.707267e-02 -1.733928e-07 -2.833160e+00
##    7.796396e-02  6.559411e-07 -2.863457e+00
##    1.890025e-02 -7.899121e-06 -3.775996e+00
##    9.986976e+00  2.499857e-05 -4.533168e+02
##    1.912134e+01  4.950604e-04 -1.241226e+02
##    7.601470e+01  4.446268e-05 -1.299470e+02
##    4.446268e-05  5.849441e-04 -1.459505e-03
## d -1.299470e+02 -1.459505e-03  3.747000e+04
## 
## Model rank =  3563 / 3563 
## 
## Basis dimension (k) checking results. Low p-value (k-index<1) may
## indicate that k is too low, especially if edf is close to k'.
## 
##                                         k'     edf k-index p-value
## s(topic_time_scaled)                  9.00    6.67    1.01    0.72
## s(speaker_scaled_time)                9.00    6.73    1.01    0.73
## s(speaker_scaled_pitch)               9.00    8.55    0.99    0.29
## s(topic_time_scaled,speaker_topic) 2770.00 1154.88    1.01    0.74
## s(speaker_scaled_time,Speaker)      765.00  259.90    1.01    0.78

It looks like our default k values are OK. All other diagnostics are fine.

Let’s have a look at the smooths:

plot_smooth(gamm_topic, view="topic_time_scaled")

## Summary:
##  * topic_time_scaled : numeric predictor; with 30 values ranging from 0.000000 to 1.000000. 
##  * speaker_scaled_time : numeric predictor; set to the value(s): 0.486120585611586. 
##  * speaker_scaled_pitch : numeric predictor; set to the value(s): -0.0675258296505446. 
##  * speaker_topic : factor; set to the value(s): QB_NZ_F_408_2. (Might be canceled as random effect, check below.) 
##  * Speaker : factor; set to the value(s): QB_NZ_M_291. (Might be canceled as random effect, check below.) 
##  * NOTE : The following random effects columns are canceled: s(topic_time_scaled,speaker_topic),s(speaker_scaled_time,Speaker)
## 

Figure 3.12: Amplitude by time through topic

We see a strong uptick at the start and a strong downward movement at the end of topics. Here the model is assuming that we are in the middle of a monologue.

We now look at amplitude through the monologue as predicted by this model.

plot_smooth(gamm_topic, view="speaker_scaled_time")

## Summary:
##  * topic_time_scaled : numeric predictor; set to the value(s): 0.497827280915662. 
##  * speaker_scaled_time : numeric predictor; with 30 values ranging from 0.000000 to 1.000000. 
##  * speaker_scaled_pitch : numeric predictor; set to the value(s): -0.0675258296505446. 
##  * speaker_topic : factor; set to the value(s): QB_NZ_F_408_2. (Might be canceled as random effect, check below.) 
##  * Speaker : factor; set to the value(s): QB_NZ_M_291. (Might be canceled as random effect, check below.) 
##  * NOTE : The following random effects columns are canceled: s(topic_time_scaled,speaker_topic),s(speaker_scaled_time,Speaker)
## 

Figure 3.13: Amplitude by time through Monologue

Here the model assumes we are midway through a topic, and tells us that we drop below the mean value at around 70% of the way through a monologue and then drop to around -0.2 by the end.

Since behaviour of smooths can be affected by data gaps, we look to see that there is a similar amount of data in each part of our topical chunks.

qb_gamm_data %>%
  mutate(
    topic_parts = cut(topic_time_scaled, breaks=10)
  ) %>%
  group_by(topic_parts) %>%
  summarise(
    n = n()
  )

These values are reasonably consistent with one another.

These results are consistent with those we obtained from our linear mixed models above.

We can see how the different topic smooths look for a particular speaker as follows:

plot_smooth(
  gamm_topic, 
  view="topic_time_scaled", 
  plot_all="speaker_topic", 
  cond=list(
    speaker_topic = c(
      "QB_NZ_F_131_1", "QB_NZ_F_131_2", 
      "QB_NZ_F_131_3", "QB_NZ_F_131_6", 
      "QB_NZ_F_131_7"
    ), 
    Speaker = c("QB_NZ_F_131")
  ), 
  rm.ranef=FALSE)

## Summary:
##  * topic_time_scaled : numeric predictor; with 30 values ranging from 0.000000 to 1.000000. 
##  * speaker_scaled_time : numeric predictor; set to the value(s): 0.486120585611586. 
##  * speaker_scaled_pitch : numeric predictor; set to the value(s): -0.0675258296505446. 
##  * speaker_topic : factor; set to the value(s): QB_NZ_F_131_1, QB_NZ_F_131_2, QB_NZ_F_131_3, QB_NZ_F_131_6, QB_NZ_F_131_7. 
##  * Speaker : factor; set to the value(s): QB_NZ_F_131.

All of these topics start near or above the mean and end below the mean, with varying behaviour in the middle.

3.4 A Test: Fake Topic Generation

One way to test whether the drop in amplitude at the end of topical chunks is a real feature of the data or merely explained by the fact that amplitude has a tendency to drop over the monologue, is to create fake topics. That is, we will cut up the monologue into ‘chunks’ with no regard to what the speaker is talking about.

Let’s look at the lengths for each topic in our dataset. We want our fake topical selections to match the real ones in terms of length.

topic_lengths <- qb_vowels %>%
  group_by(Speaker, topic_no) %>%
  summarise(
    topic_length = first(topic_length)
  ) %>%
  filter(
    !is.na(topic_no)
  )

topic_lengths

Our aim here is to avoid a spurious effect of topic part being generated by the decrease in amplitude over the course of an entire monologue. The extent of this effect might be affected if our fake topics are, on the whole shorter or longer than the real topics. One way to ensure we have the same distribution of speaker topic lengths is to take random chunks from a speaker monologue which match the length of their actual topics. So, in the case of QB_NZ_F_131 we have 7 topic lengths available. Our first fake chunk would take a random continuous section of the monologue of 731.2 seconds, our second would be a random continuous section of the monologue of length 96.4.

To do this, we take the lengths of each speaker’s topics and then replace the real topics from the speaker with a random span of the same length from the speaker’s monologue. In the following code block the chunks dataframe takes information about the speakers full monologue length and the length of each topic, it them sets a random start point for each of the new chunks (ensuring that there is enough time left in the monologue). The function collect_chunk is then used to collect the data for the defined spans.

chunks <- qb_vowels %>%
  group_by(Speaker, topic_no) %>%
  summarise(
    topic_length = first(topic_length),
    speaker_length = first(speaker_length)
  ) %>%
  filter(
    !is.na(topic_no)
  ) %>%
  mutate(
    chunk_start = map2_int(
      topic_length, 
      speaker_length, 
      ~ sample(seq(0, round(.y - .x)), 1)
    ),
    chunk_end = chunk_start + topic_length
)
    
collect_chunk <- function(speaker, chunk_start, chunk_end, vowel_data) {
  out_df <- vowel_data %>%
    filter(
      Speaker == speaker,
      time > chunk_start,
      time < chunk_end
    ) %>%
    select(
      c(
        time, art_rate, Vowel, pitch, speaker_scaled_time, 
        speaker_scaled_amp_max, topic_no, intensity_max, 
        speaker_scaled_art_rate, speaker_scaled_pitch
      )
    )
}


chunks <- chunks %>%
  mutate(
    chunk_df = pmap(
      list(Speaker, chunk_start, chunk_end),
      ~ collect_chunk(..1, ..2, ..3, qb_vowels)  
    )
  ) %>%
  rename(
    chunk = topic_no # We may need to compare overlap of real and fake topics.
  ) %>%
  unnest(chunk_df)

3.4.1 Filtering steps

The following blocks repeat the filtering steps carried out above.

We define the start, middle and end and determine how many tokens are in each.

chunks <- chunks %>%
  group_by(Speaker, chunk) %>%
  mutate(
    chunk_time_scaled = rescale(time, to=c(0,1)),
    chunk_part = cut(
      chunk_time_scaled, 
      breaks = c(-0.1, 0.33, 0.66, 1.1), 
      labels = c("start", "middle", "end")
    )
  ) %>%
  group_by(Speaker, chunk, chunk_part) %>%
  mutate(
    chunk_part_n = n()
  ) %>%
  ungroup()

We have a look at how many tokens we have in each chunk part.

chunk_counts <- chunks %>%
  group_by(Speaker, chunk, chunk_part, .drop=FALSE) %>%
  summarise(
    chunk_part_n = first(chunk_part_n),
    chunk_part_n = if_else(
      is.na(chunk_part_n), 0L, chunk_part_n) # Replace NAs with 0
  )

chunk_counts %>%
  ggplot(
    aes(
      x = chunk_part_n
    )
  ) +
  geom_histogram(bins = 100) +
  labs(
    title = "Distribution of Token Counts Within Each Chunk Part.",
    y = "Count of chunk parts.",
    x = "Count of tokens within chunks part."
  )

Figure 3.14: Number of tokens in each fake topic part.

Looks very similar to 3.5. This should not be surprising!

We now remove any chunk with less than five tokens.

chunks_to_filter <- chunks %>%
  filter(
    chunk_part_n < 5
  ) %>%
  select(Speaker, chunk) %>%
  unique()

speaker_chunks_to_filter <- chunks_to_filter %>%
  mutate(
    speaker_chunk = str_c(Speaker, "_", chunk)
  ) %>%
  pull(speaker_chunk)

chunks_filtered <- chunks %>%
  mutate(
    speaker_chunk = str_c(Speaker, "_", chunk)
  ) %>%
  filter(
    !speaker_chunk %in% speaker_chunks_to_filter
  )

We now look at the difference between the lengths of the real and fake topics again (Figure 3.15).

real_topic_lengths <- qb_filtered %>%
  group_by(Speaker, topic_no) %>%
  summarise(
    topic_length = first(topic_length)
  ) 

fake_topic_lengths <- chunks_filtered %>%
  group_by(Speaker, chunk) %>%
  summarise(
    topic_length = first(topic_length) # chunk_length
  ) %>%
  mutate(
    Speaker = as.factor(Speaker)
  )


bind_rows(
  'Real' = real_topic_lengths, 
  'Fake' = fake_topic_lengths, 
  .id = "Source"
) %>%
  ggplot(
    aes(
      x = topic_length,
      colour = Source
    )
  ) +
  geom_freqpoly(bins=100)

Figure 3.15: Length distribution of real and fake topics.

The only purpose of this plot is to ensure that we have basically the same length distribution. The small differences are because different topics/chunks will be filtered out by our filtering rules (ensuring each part has at least 5 tokens).

3.4.2 GLMM Models

We now copy the GLMM model specification used on the real topic data.

We also save the current ‘chunks’ and reload them at the next stage. If new chunks are generated above, then different speakers may be filtered out and it will be impossible to use the visualisation code later in this document. Saving the ‘chunks’ at the same time we save the model allows us to ensure that the visualisations below will work. This is unfortunate for reproducibility, but setting a seed at the start of the document does not ensure that the same ‘chunks’ will be generated in interactive use of this code.

glmm_fit_2 <- lmer(
  speaker_scaled_amp_max ~ 
    chunk_part + 
    speaker_scaled_time + 
    speaker_scaled_pitch +
    (0+speaker_scaled_time|Speaker) +
    (0+chunk_part|speaker_chunk), 
  data=chunks_filtered %>%
    mutate(
      speaker_scaled_time = speaker_scaled_time - 0.5
    ))

# This model needs some help converging. We use the strategy of restarting
# from current parameters
pars <- getME(glmm_fit_2, "theta")
glmm_fit_2 <- update(glmm_fit_2, start=pars)

write_rds(glmm_fit_2, here('models', 'glmm_pitch_fit_chunks.rds'))
write_rds(chunks_filtered, here('processed_data', 'chunks_filtered.rds'))

glmm_fit_2 <- read_rds(here('models', 'glmm_pitch_fit_chunks.rds'))
chunks_filtered <- read_rds(here('processed_data', 'chunks_filtered.rds'))
summary(glmm_fit_2)

## Linear mixed model fit by REML ['lmerMod']
## Formula: 
## speaker_scaled_amp_max ~ chunk_part + speaker_scaled_time + speaker_scaled_pitch +  
##     (0 + speaker_scaled_time | Speaker) + (0 + chunk_part | speaker_chunk)
##    Data: 
## chunks_filtered %>% mutate(speaker_scaled_time = speaker_scaled_time -  
##     0.5)
## 
## REML criterion at convergence: 166716.8
## 
## Scaled residuals: 
##    Min     1Q Median     3Q    Max 
## -4.370 -0.653 -0.001  0.654  4.319 
## 
## Random effects:
##  Groups        Name                Variance Std.Dev. Corr       
##  speaker_chunk chunk_partstart     0.03173  0.1781              
##                chunk_partmiddle    0.03223  0.1795    0.32      
##                chunk_partend       0.03757  0.1938   -0.01  0.31
##  Speaker       speaker_scaled_time 0.34750  0.5895              
##  Residual                          0.55912  0.7477              
## Number of obs: 72996, groups:  speaker_chunk, 541; Speaker, 153
## 
## Fixed effects:
##                       Estimate Std. Error t value
## (Intercept)           0.067174   0.010652   6.306
## chunk_partmiddle      0.001097   0.012782   0.086
## chunk_partend        -0.007383   0.015560  -0.474
## speaker_scaled_time  -0.169780   0.055654  -3.051
## speaker_scaled_pitch  0.550407   0.003602 152.799
## 
## Correlation of Fixed Effects:
##             (Intr) chnk_prtm chnk_prtn spkr_scld_t
## chnk_prtmdd -0.627                                
## chunk_prtnd -0.707  0.584                         
## spkr_scld_t  0.160 -0.120    -0.195               
## spkr_scld_p  0.014  0.003     0.000     0.006

The ‘chunks’ certainly provide weaker evidence of a reduction in amplitude with fake topics. This may simply be due to the reduction in amount of data going in to the model (our chunking process is, in some ways, a filtering process). The t-value for the intercept is surprisingly high! Perhaps the model is capturing the pattern of reduction in amplitude by pushing the ‘start’ of the chunks up in amplitude rather than pushing the ‘end’ down. This is not great for our claim that speakers drop amplitude at the end of topical sections. It is not direct counter evidence though. We will find a way to a more principled test below.

We now produce a plot equivalent to Figure 3.8.

new_data_fake <- tibble(
  speaker_chunk = rep(unique(chunks_filtered$speaker_chunk), times=3),
  chunk_part = rep(
    c('start', 'middle', 'end'), 
    each=length(unique(chunks_filtered$speaker_chunk))
  ),
  # Assuming we are in the middle of the monologue
  speaker_scaled_time = 0,
  speaker_scaled_pitch = 0
)

new_data_fake <- new_data_fake %>%
  filter(
    !is.na(speaker_chunk)
  ) %>%
  mutate(
    Speaker = str_extract(speaker_chunk, 'QB_NZ_[MF]_[0-9]+')
  )

new_data_fake <- new_data_fake %>%
  mutate(
    prediction = predict(glmm_fit_2, newdata=new_data_fake)
  )

new_data_fake %>%
  mutate(
    # Make sure chunks are in correct order in plot.
    chunk_part = factor(chunk_part, levels = c('start', 'middle', 'end'))
  ) %>%
  ggplot(
    aes(
      x = chunk_part,
      y = prediction
    )
  ) + 
  geom_violin(
    draw_quantiles = c(0.25, 0.5, 0.75),
    alpha = 0.5
  ) +
  geom_jitter(
    alpha = 0.1
  ) +
  labs(
    title = "Model Predictions for Each Chunk (Fake Topic) with Position in Monologue Controlled.",
    x = "Part",
    y = "Predicted amplutide"
  )

Figure 3.16: Model predictions for each topic at mid point of monologue.

All are assumed to be above 0 in scaled amplitude in this model, with a slightly increased value for the start.

To make this even clearer, we plot the two together using violin plots.

bind_rows(
    "Real topics" = new_data,
    "Fake topics" = new_data_fake %>%
      rename(
        topic_part = chunk_part,
        speaker_topic = speaker_chunk
      ),
    .id = "source"
  ) %>%
  mutate(
    # Make sure chunks are in correct order in plot.
    topic_part = factor(topic_part, levels = c('start', 'middle', 'end'))
  ) %>%
  ggplot(
    aes(
      x = topic_part,
      y = prediction,
      colour = source
    )
  ) +
  geom_violin(
    draw_quantiles = c(0.25, 0.5, 0.75),
    alpha = 0.2
  ) + 
  labs(
    title = "Predicted Values for Real and Fake Topics at Midpoint of Monologue",
    y = "Predicted (scaled) amplitude",
    x = "Part"
  )

Figure 3.17: Predicted values of real and fake topics at mid point of monologue.

While the violin plots in Figure 3.17 might not look very different from one another, we see the increase over the mean amplitude at the start of the real topics and a greater drop at the end of the monologue. The fake topics, by contrast, stay much closer to the mean value for amplitude. The reduction from start to end in the real topics is great than the reduction in the fake topics.

We can make this more rigourous by estimating standard errors for both models using the confint.merMod function. This takes quite a while to compute. So we save the results and load them in the next cell. To run this yourself, change eval to TRUE, as above.

boot_real <- confint.merMod(
  glmm_fit, 
  method = "profile",
  parm=c(
    '(Intercept)', 
    'topic_partmiddle', 
    'topic_partend', 
    'speaker_scaled_time',
    'speaker_scaled_pitch'
  )
)
boot_fake <- confint.merMod(
  glmm_fit_2,
  method='profile',
  parm=c(
    '(Intercept)', 
    'chunk_partmiddle', 
    'chunk_partend', 
    'speaker_scaled_time',
    'speaker_scaled_pitch'
  )
)

write_rds(boot_real, here('models', 'real_topic_boot.rds'))
write_rds(boot_fake, here('models', 'fake_topic_boot.rds'))

boot_real <- read_rds(here('models', 'real_topic_boot.rds'))
boot_fake <- read_rds(here('models', 'fake_topic_boot.rds'))
print('Real topics')

## [1] "Real topics"

boot_real

##                            2.5 %      97.5 %
## (Intercept)           0.03685263  0.08160754
## topic_partmiddle     -0.03542500  0.01498957
## topic_partend        -0.10188171 -0.04149036
## speaker_scaled_time  -0.29098488 -0.11461480
## speaker_scaled_pitch  0.53469454  0.54865182

print('Fake topics')

## [1] "Fake topics"

boot_fake

##                            2.5 %      97.5 %
## (Intercept)           0.04625693  0.08805515
## chunk_partmiddle     -0.02395840  0.02622840
## chunk_partend        -0.03789525  0.02315459
## speaker_scaled_time  -0.27928524 -0.06048265
## speaker_scaled_pitch  0.54334950  0.55747312

Let’s plot these:

real_coefs <- coef(summary(glmm_fit))[, 'Estimate'] %>%
  as_tibble(rownames = "variable") %>%
  mutate(
    ll = boot_real[,'2.5 %'],
    ul = boot_real[, '97.5 %']
  )

fake_coefs <- coef(summary(glmm_fit_2))[, 'Estimate'] %>%
  as_tibble(rownames = "variable") %>%
  mutate(
    ll = boot_fake[,'2.5 %'],
    ul = boot_fake[, '97.5 %'],
    variable = str_replace(variable, 'chunk', 'topic')
  )

glmm_coefs <- bind_rows(
  "Real" = real_coefs,
  "Fake" = fake_coefs,
  .id = "Source"
)

pd = position_dodge(width=0.5)

glmm_coefs %>%
  filter(
    !variable %in% c('speaker_scaled_time', 'speaker_scaled_pitch')
  ) %>%
  mutate(
    variable = factor(
      variable, 
      levels = c(
        '(Intercept)', 'topic_partmiddle', 'topic_partend'
      )
    )
  ) %>%
  ggplot(
    aes(
      x = variable,
      y = value,
      colour = Source,
      group = Source
    )
  ) + 
  geom_line(position=pd, alpha = 0.5) +
  geom_point(position=pd) +
  geom_errorbar(
    aes(
      ymin = ll, ymax = ul
    ),
    width = 0.25,
    position=pd,
    alpha = 0.5
  ) +
  labs(
    title = "Bootstrap 95% Confidence Intervals of Coefficients for Real and Fake Topics",
    x = "Topic part",
    y = "Scaled amplitude"
  )

Figure 3.18: Bootstrap coefficients for real and fake topics.

The middle and end of the fake topics have 0 within their 95% confidence intervals. The reduction at the end in the real topics is outside the range to be expected from the fake topics.

3.4.3 GAMM Models

We now preform the same analysis with GAMM models.

qb_gamm_fake_data <- chunks_filtered %>%
  mutate(
    speaker_chunk = str_c(Speaker, '_', chunk),
    speaker_chunk = as.factor(speaker_chunk),
    Speaker = as.factor(Speaker)
  )

gam_fake_fit <- bam(
  speaker_scaled_amp_max ~ 
    s(chunk_time_scaled) + 
    s(speaker_scaled_time) +
    s(speaker_scaled_pitch) +
    s(chunk_time_scaled, speaker_chunk, bs = "fs", k=5, m=1) +
    s(speaker_scaled_time, Speaker, bs = 'fs', k=5, m=1),
  data = qb_gamm_fake_data,
  method = 'fREML',
  discrete = TRUE,
  nthreads = 8
)

write_rds(gam_fake_fit, here('models', 'gam_fake_fit.rds'))

gam_fake_fit_summary <- summary(gam_fake_fit)
write_rds(gam_fake_fit_summary, here('models', 'gam_fake_fit_summary.rds'))

gam_fake_fit <- read_rds(here('models', 'gam_fake_fit.rds'))
gam_fake_fit_summary <- read_rds(here('models', 'gam_fake_fit_summary.rds'))
gam_fake_fit_summary

## 
## Family: gaussian 
## Link function: identity 
## 
## Formula:
## speaker_scaled_amp_max ~ s(chunk_time_scaled) + s(speaker_scaled_time) + 
##     s(speaker_scaled_pitch) + s(chunk_time_scaled, speaker_chunk, 
##     bs = "fs", k = 5, m = 1) + s(speaker_scaled_time, Speaker, 
##     bs = "fs", k = 5, m = 1)
## 
## Parametric coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 0.093566   0.008276   11.31   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Approximate significance of smooth terms:
##                                        edf   Ref.df        F p-value    
## s(chunk_time_scaled)                 1.224    1.338    0.101   0.764    
## s(speaker_scaled_time)               5.712    6.609    5.884  <2e-16 ***
## s(speaker_scaled_pitch)              8.564    8.936 2959.456  <2e-16 ***
## s(chunk_time_scaled,speaker_chunk) 803.351 2704.000    0.602  <2e-16 ***
## s(speaker_scaled_time,Speaker)     400.088  764.000    3.861  <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## R-sq.(adj) =   0.33   Deviance explained = 34.1%
## fREML =  81876  Scale est. = 0.53385   n = 72996

Let’s have a look at the main effect smooths:

plot_smooth(gam_fake_fit, view="chunk_time_scaled")

## Summary:
##  * chunk_time_scaled : numeric predictor; with 30 values ranging from 0.000000 to 1.000000. 
##  * speaker_scaled_time : numeric predictor; set to the value(s): 0.482337379935042. 
##  * speaker_scaled_pitch : numeric predictor; set to the value(s): -0.0639228026959656. 
##  * speaker_chunk : factor; set to the value(s): QB_NZ_F_408_2. (Might be canceled as random effect, check below.) 
##  * Speaker : factor; set to the value(s): QB_NZ_M_626. (Might be canceled as random effect, check below.) 
##  * NOTE : The following random effects columns are canceled: s(chunk_time_scaled,speaker_chunk),s(speaker_scaled_time,Speaker)
## 

Figure 3.19: Smooth over fake topics

The effect here is less clear than that in Figure 3.12. We could, for instance, draw a straight line through these confidence intervals at around a scaled amplitude of 0.055. Note that we are asking the model to assume that we are roughly half way through the monologue, so we should not be surprised to be slightly above 0 throughout ( see Figure 3.20).

plot_smooth(gam_fake_fit, view="speaker_scaled_time")

## Summary:
##  * chunk_time_scaled : numeric predictor; set to the value(s): 0.492928569203452. 
##  * speaker_scaled_time : numeric predictor; with 30 values ranging from 0.000000 to 0.996103. 
##  * speaker_scaled_pitch : numeric predictor; set to the value(s): -0.0639228026959656. 
##  * speaker_chunk : factor; set to the value(s): QB_NZ_F_408_2. (Might be canceled as random effect, check below.) 
##  * Speaker : factor; set to the value(s): QB_NZ_M_626. (Might be canceled as random effect, check below.) 
##  * NOTE : The following random effects columns are canceled: s(chunk_time_scaled,speaker_chunk),s(speaker_scaled_time,Speaker)
## 

Figure 3.20: Smooth over speaker scaled time.

This is, in general, quite similar to (Figure 3.13). This is good, as we have not removed the temporal order of the data. All we have done is select random places at which to start and end topics.

3.4.4 A Final Permutation Test

Further experimentation with these models reveals that the process of randomly assigning ‘chunks’ has a big effect on the results of the models here. One way to get a sense of things which does not depend on the specific ‘chunks’ is to rerun the analysis multiple times as we did in our permutation tests in corpus_pca.Rmd.

The script which performs this analysis is available at scripts/permutation_topics.R. It reruns the chunking process and then fits the linear mixed model structure above. It then extracts the coefficients, t values, and errors from each model. 1000 iterations of the process were carried out.

We load in the results here:

coefs <- read_rds(here('processed_data', 'glmm_pitch_coeffs_perm.rds'))
ses <- read_rds(here('processed_data', 'glmm_pitch_ses_perm.rds'))
t_vals <- read_rds(here('processed_data', 'glmm_pitch_tvals_perm.rds'))

We will visualise the distribution of coefficient results, errors, and t values.

We first define a general function:

violin_three_way <- function(plot_data, comparison_data = list()) {
  out_plot <- plot_data %>%
    as_tibble() %>%
    pivot_longer(
      cols = everything(),
      values_to = "value"
    ) %>%
    mutate(
      name = factor(
        name, 
        levels = c(
          '(Intercept)', 'chunk_partmiddle', 'chunk_partend', 
          'speaker_scaled_time', 'speaker_scaled_pitch'
        )
      )
    ) %>%
    filter(
      !name %in% c('speaker_scaled_pitch')
    ) %>%
    ggplot(
      aes(
        x = name,
        y = value
      )
    ) +
    geom_violin(draw_quantiles = c(0.05, 0.5, 0.95))
  
  if (length(comparison_data) > 1) {
    out_plot <- out_plot +
      geom_point(colour = "red", data = comparison_data)
  }
  
  out_plot
}

We then extract the coefficients, t-values, and ses from our model fit on the real data.

var_names <- c(
  '(Intercept)', 'chunk_partmiddle', 'chunk_partend', 'speaker_scaled_time',
  'speaker_scaled_pitch'
)

summ_glmm_fit <- summary(glmm_fit)

real_model <- summ_glmm_fit$coefficients[,1] %>%
  as.tibble() %>%
  mutate(
    name = var_names
  ) %>% 
  filter(
    !name %in% c('speaker_scaled_pitch')
  )
  
real_model_s <- summ_glmm_fit$coefficients[,2] %>%
  as.tibble() %>%
  mutate(
    name = var_names
  ) %>%
  filter(
    !name %in% c('speaker_scaled_pitch')
  )

real_model_t <- summ_glmm_fit$coefficients[,3] %>%
  as.tibble() %>%
  mutate(
    name = var_names
  ) %>%
  filter(
    !name %in% c('speaker_scaled_pitch')
  )

We visualise the coefficients:

violin_three_way(coefs, real_model) +
  labs(
    title = "Distribution of Coefficient Estimates for Random and Topical Segments",
    caption = "Red points indicate values for topical segments",
    y = "Speaker scaled max amplitude",
    x = "Coefficient"
  )

Figure 3.21: Distribution of Coefficient Estimates for Random and Topical Segments.

The coefficient estimates for our real model are easily within the range estimated in the ‘chunks’. Interestingly, on the whole, estimates for chunk_partmiddle are lower than 0, and lower than the initial and final segments of chunks. This the average model of our faked chunks will have a ‘u’ shape rather than a steady decline.

violin_three_way(t_vals, comparison_data = real_model_t) +
  labs(
    title = "Distribution of t-values for Random and Topical Segments",
    caption = "Red points indicate values for topical segments",
    y = "t-value",
    x = "Coefficient"
  )

Figure 3.22: Distribution of t-values for Random and Topical Segments.

Figure 3.22 that our real data sits towards the tails of the significance achieved by the models fit on fake topics. We should be particularly surprised by the values for chunk_partend and (Intercept), that is the first third of the chunk. We see that the vast majority of the models we fit will have t-values less than 2 for their various coefficients.

violin_three_way(ses, comparison_data = real_model_s) +
  labs(
    title = "Distribution of Standard Errors for Random and Topical Segments",
    caption = "Red points indicate values for topical segments",
    y = "ses value",
    x = "Coefficient"
  )

Figure 3.23: Distribution of standard errors for random and topical segments.

In all cases, we see the standard errors for the real topics sitting below the distribution for the fake topics. There are two phenomena which might be behind this:

1. There is a real pattern in amplitude over the course of topical segments of monologues and this commonality enables the model to fit to this pattern with more confidence than is possible when we ta(4)ke random sections of the monologue as our topics.
2. The creation of fake topics (‘chunks’) involves data loss, so that there is more data available and thus the model can achieve fit estimates within tighter confidence intervals.

We take it that the above provides at least some evidence that amplitude indicates position within a topical subsection of a monologue. The difficulty in pinning this down with increased confidence is the difficulty of distinguishing between the reduction in amplitude across the monologue as a whole and the reduction in amplitude which might be explained by position in a topical subsection. Straight-forwardly, the end of a topical section is later in the monologue than the start and so would be expected to be of somewhat lower amplitude.

---

1. See preprocessing.Rmd.↩︎

2. Wikipedia has detailed accounts of the September, 2010 and February, 2011 earthquakes.↩︎

3. Given that this is exploratory research, surprisingness is all we can get out of statistical test values (see Baayen et al. 2017, 227).↩︎