Code

pacman::p_load(
    tidyverse,
    brms,
    emmeans,
    broom,
    bayestestR,
    tidybayes,
    here,
    glue,
    gt,
    purrr,
    scales,
    ggdist,
    gghalves,
    priorsense,
    patchwork,
    grateful,
    ggrepel,
    extras,
    qrcode
)

options(width = 10000)

source(here("scripts", "theme.R"))

Very often when we look at experimental data, we are interested in the question whether two conditions are different from each other.

Code

set.seed(1234)
d <- tibble(
    group = rep(c("sd = 0.45", "sd = 0.90"), each = 500),
    x = c(rnorm(500, mean = 0, sd = .45), rnorm(500, mean = 0, sd = .9))
)

p_dist <- ggplot(d, aes(x = x, fill = group, color = group)) +
    geom_area(
        stat = "density",
        alpha = .3,
        position = "identity",
        color = "transparent",
        adjust = 2
    ) +
    guides(fill = "none", color = "none") +
    theme_void()
p_dist

While we normally focus on the location of the distribution, i.e., the mean, we often ignore the scale of the distribution, i.e., the standard deviation. In this talk, I want to argue that the scale of the distribution can be just as informative as its location.

Needless to say, for the plot above, the means of the two distributions are the same, but the standard deviations are different. Yet, our standard statistical tests would not be able to detect this difference, because they are designed to test for differences in location, not scale, because these models tend to assume homoscedasticity, i.e., equal variances across conditions.¹

The empirical domain for this claim is the domain of presuppositions. In particular, I want to argue that intuitions of presupposition failure are associated with increased variability in judgments, which can be measured through larger standard deviations. That is, presuppositions make themselves known not only through their location but also through their scale.

Background: Presuppositions and truth-value intuitions

Natural language has expressions that trigger so-called presuppositions. These are prerequisites that must hold in order for the sentence to be meaningful to begin with. Compare believe and know below. The two sentences appear to differ with respect to whether the sentence conveys that Aditi actually owns a pet cockroach. The believe sentence comes with no such commitment, the know sentence however does. If we explicitly negate this commitment, only the sentence with believe remains coherent. The minimal variant with know suffers from what is typically called presupposition failure and is felt to be degraded.

1. Aditi does not own a pet cockroach but Skye believes that Aditi owns a pet cockroach.
2. #Aditi does not own a pet cockroach but Skye knows that Aditi owns a pet cockroach.

So know seems to be a presupposition trigger. There are other presupposition triggers, though:

1. Skye stopped smoking.
2. #Skye never smoked and they stopped smoking.
1. Skye smoked again.
2. #Skye never smoked and they smoked again.

Negation generally has no effect of the presuppositional requirement of an utterance. That is the negated and unnegated version of the same sentence involving a presupposition trigger have the same presuppositional requirement.

1. Skye stopped smoking.
  \(\rightsquigarrow\) Skye used to smoke.
2. Skye did not stop smoking.
  \(\rightsquigarrow\) Skye used to smoke.

By extension, a sentence suffering from presupposition failure without negation will generally still suffer from it when negated:

1. #Skye never smoked and they stopped smoking.
2. #Skye never smoked and they didn’t stop smoking.

The variance hypothesis

Different from sentences that are truth-evaluable, encountering presupposition failure leads to a breakdown of communication and may leave interlocutors unable to respond without taking the time to highlight the occurrence of this breakdown. This core intuition is perhaps best described with the term squeamishness in Strawson (1964) and others, and it is meant to capture the uneasiness that speakers display when confronted with (certain kinds of) utterances suffering from presupposition failure.

Strawsonian squeamishness
An utterance suffering from presupposition failure and thereby lacking a classical truth value will cause interlocutors to experience a sense of conversational unease or breakdown—manifested as hesitation, uncertainty, or reluctance to evaluate the utterance for truth.

Semantically, we may say that presupposition failure leads to undefinedness. This is a technical term that is often formalized in either of two ways: (i) as the failure of functional application in a partial function logic or (ii) as a dedicated third truth value in a three-valued logic. In either case, the key point is that presupposition failure leads to a deficient semantic output, either a literal compositional failure or a truth-value that, via mechanisms like Stalnaker’s Bridge, does not result in an assertable utterance:

Stalnaker’s Bridge (Fintel 2008; Fox 2013)
A truth-denoting sentence \(S\) is assertable given a context set \(C\) only if \(\forall\! w \in C [⟦S⟧(w) = 1 \lor ⟦S⟧(w) = 0]\)

We expect that a sentence that receives a non-classical truth value (or none at all) is deemed not assertable. This, in turn, gives us a handle on squeamishness: a non-assertable utterance that nonetheless is asserted is reasonably expected to put interlocutors in a position of conversational confusion, and thus, I argue, as displaying squeamishness. This gives us a linking hypothesis both for systems where presuppositions are partial and those where presuppositions represent total functions via the route of failed conversational turns.

I take it that if squeamishness is induced by presupposition failure, it should lead to rating behaviors plagued by uncertainty. That is, over the course of the experiment, intuitions of squeamishness should elicit response patterns that are highly variable relative to sets of trials where no catastrophic presupposition failure obtains. I want to pursue the hypothesis that it should be detectable in offline measures like ratings as well.

On this view, one way to detect (intuitions of) presupposition failure experimentally is to look at the standard deviations associated with the condition means: all else being equal, undefinedness, or rather the squeamishness triggered by it, should elicit larger uncertainty, which can be measured through larger standard deviations. More precisely, this hypothesis predicts that conditions without presupposition failure should show a more strongly clustered rating distribution around the mean, i.e., lower standard deviations. Conversely, a more widely spread-out pattern, as measured by larger standard deviations, is expected for conditions where there is a presupposition that is not entailed by the context set and, to the extent that this is possible, which is not subject to mechanisms that nevertheless yield a binary truth value. I call this the variance hypothesis.

Variance hypothesis
Experimental conditions involving presupposition failure will exhibit greater response variability, i.e., higher standard deviations, than conditions that are evaluable for truth, due to Strawsonian squeamishness.

If we translate our distributional image from the beginning into something that more closely aligns with the data visualization preferences for experimental results, we get something like this, which shows two conditions with the same mean but different standard deviations. Of course, only the condition in red with the larger standard deviation should be associated with presupposition failure and thus squeamishness.

Code

p_violin <- ggplot(d, aes(x = group, y = x, fill = group, color = group)) +
    geom_violin(trim = FALSE, alpha = .3, color = "transparent", width = .8) +
    stat_summary(fun = mean, geom = "point", size = 3) +
    stat_summary(fun.data = mean_cl_normal, geom = "errorbar", width = .03) +
    scale_fill_manual(values = c(colors[1], colors[2])) +
    coord_cartesian(expand = FALSE, clip = "off") +
    guides(fill = "none", group = "none", color = "none") +
    theme_void()
p_dist + p_violin

Squeamishness in action: Projection and definite descriptions

For both experiments, I made use of a slider-based truth-value judgment task with three labels completely false, neither nor, and completely true. This is a method that should closely mimic the well-known truth-value judgment task, allow for judgments indicating intuitions of presupposition failure via the “neither nor” option (Križ and Chemla 2015), and crucially, allow for the measurement of variability in judgments via the standard deviations associated with the condition means (see Sun et al. 2025 for discussion).

We will go through the two case studies in turn, starting with presupposition projection from attitude predicates and then moving on to the presuppositional properties of definite descriptions.

Presupposition projection from attitude predicates

First, we will look at presupposition projection from attitude predicates, which is a domain that has not been explored experimentally. Normally presupposition projection from quantified environments focuses on quantifiers over individuals like every, (9), but here we look at attitude predicates like be certain, (10), which are quantifiers over worlds. We will have to set aside the important discussion of previous theoretical and experimental work on presupposition projection, but the interested reader is referred to Thalmann and Matticchio (2024);Thalmann and Matticchio (in progress) and the references therein.

Every man canoed again.
Maybe presupposes: Every man canoed before.
Peter is certain that Jan canoed again.
Maybe presupposes: Peter is certain that Jan canoed before.

Here, we will only focus on the control conditions, one of which featured uncontroversial presupposition failure, no matter which theoretical framework is adopted.

The experiment was set up as follows:

\(2 \times 4\) design
1. negation: without vs. with matrix negation (within items and participants)
2. scenario: true vs. false vs. undefined vs. critical (within items and participants)
3. Presupposition trigger as a pseudo-factor: again vs. stop (between items, 24 each)

Below is a sample item translated from the original German with the hard trigger again, plus the verbal context that instantiates the scenario manipulation. The visual context was informationally redundant and shown alongside the verbal context.

Peter is (not) certain that Jan canoed again.
1. true Peter: “I’m certain that Jan canoed last time, and I’m certain that Jan canoed this time.”
2. false Peter: “I’m certain that Jan canoed last time, but I have no idea if this time, Jan canoed or not.”
3. undefined Peter: “I have no idea if last time, Jan canoed or not, but I am certain that Jan canoed this time.”
4. critical Peter: “I have no idea if last time, Jan canoed or not, and I have no idea if this time, Jan canoed or not.”

The experimental procedure is illustrated in Figure 2.

Figure 2: Screenshot of the experimental procedure for an item featuring the soft trigger *stop* in the `critical` scenario: “Markus is certain that Sonja stopped drinking wine”.

The inclusion of the pseudo-factor was motivated by examples such as these. Arguably, these show that some presupposition triggers are less sensitive to presupposition failure contexts than others. Though opinions on all of this are various, we will say here that this is due to local accommodation, which turns presupposition failure into mere falsity and which only applies to certain triggers like discover and stop (but not to others like regret and again).

1. I don’t know if Skye got Aditi a present, but if Aditi discovers that Skye did, she’ll give them a hug.
2. #I don’t know if Skye got Aditi a present, but if Aditi is happy that Skye did, she’ll give them a hug.
1. What did Skye buy? — Aditi discovered that they bought a guitar.
2. What did Skye buy? — #Aditi is happy that they bought a guitar.

As I said before, I will not go into the theoretical details behind the hypotheses we’re testing here; see Thalmann and Matticchio (2024);Thalmann and Matticchio (in progress) for a full discussion. The key point is that the two theories come apart in their predictions for the critical scenario. People in the universal projection camp expect that this scenario should elicit intuitions of presupposition failure (i.e., judgments near “neither nor”) regardless of negation. By contrast, the strong Kleene theorist expects that negation should flip the judgment from “completely false” to “completely true” in this scenario.

Code

preds <- tribble(
    ~"Scenario", ~"Negation", ~"Judgment", ~"who",
    "true", "without", 2, "*again*<br>Strong Kleene",
    "true", "without", 2, "*again*<br>Universal Projection",
    "true", "without", 2, "*stop*<br>Local Accommodation",
    "true", "with", -2, "*again*<br>Strong Kleene",
    "true", "with", -2, "*again*<br>Universal Projection",
    "true", "with", -2, "*stop*<br>Local Accommodation",
    "false", "without", -2, "*again*<br>Strong Kleene",
    "false", "without", -2, "*again*<br>Universal Projection",
    "false", "without", -2, "*stop*<br>Local Accommodation",
    "false", "with", 2, "*again*<br>Strong Kleene",
    "false", "with", 2, "*again*<br>Universal Projection",
    "false", "with", 2, "*stop*<br>Local Accommodation",
    "undef.", "without", 0, "*again*<br>Strong Kleene",
    "undef.", "without", 0, "*again*<br>Universal Projection",
    "undef.", "without", -2, "*stop*<br>Local Accommodation",
    "undef.", "with", 0, "*again*<br>Strong Kleene",
    "undef.", "with", 0, "*again*<br>Universal Projection",
    "undef.", "with", 2, "*stop*<br>Local Accommodation",
    "crit.", "without", -2, "*again*<br>Strong Kleene",
    "crit.", "with", 2, "*again*<br>Strong Kleene",
    "crit.", "without", 0, "*again*<br>Universal Projection",
    "crit.", "without", -2, "*stop*<br>Local Accommodation",
    "crit.", "with", 0, "*again*<br>Universal Projection",
    "crit.", "with", 2, "*stop*<br>Local Accommodation",
)

preds %>%
    mutate(Negation = fct_relevel(Negation, "without")) %>%
    ggplot(aes(
        x = fct_inorder(Scenario),
        y = Judgment,
        color = Negation,
        shape = Negation,
        group = Negation
    )) +
    geom_line() +
    geom_point(size = 3) +
    scale_y_continuous(
        breaks = c(-2, 0, 2),
        labels = c("Compl. false", "Neither nor", "Compl. true")
    ) +
    labs(
        x = "Scenario",
        y = "Judgment"
    ) +
    coord_cartesian(clip = "off") +
    facet_wrap(~who) +
    theme(
        axis.text.y = element_markdown(hjust = 1),
        axis.text.x = element_markdown(family = "Cascadia Code", size = 8)
    )

Here we have the actual results:

Code

named.contr.sum <- function(x, ...) {
    if (is.factor(x)) {
        x <- levels(x)
    } else if (is.numeric(x) & length(x) == 1L) {
        stop("cannot create names with integer value. Pass factor levels")
    }
    x <- contr.sum(x, ...)
    colnames(x) <- paste0(rownames(x)[1:(nrow(x) - 1)], "_v_GM")
    return(x)
}

d <- read_csv(
    here("data", "believe-projection.csv"),
    show_col_types = FALSE
) %>%
    filter(sub_exp == 1) %>%
    mutate(
        scenario = gsub("undef", "undefined", scenario),
        scenario = forcats::fct_relevel(
            scenario,
            "false",
            "undefined",
            "critical",
            "true"
        ),
        negation = forcats::fct_relevel(negation, "neg"),
        negation = forcats::fct_recode(negation, without = "pos", with = "neg"),
        trigger = paste0("*", trigger, "*"),
        trigger = fct_relevel(trigger, "*stop*", "*again*"),
        judgment = judgment - 50,
        judgment = judgment / 25
    )

contrasts(d$negation) <- named.contr.sum(levels(d$negation))
contrasts(d$scenario) <- named.contr.sum(levels(d$scenario))
contrasts(d$trigger) <- named.contr.sum(levels(d$trigger))

d %>%
    mutate(
        scenario = fct_relevel(scenario, "true", "false", "undefined"),
        negation = fct_relevel(negation, "without", "with"),
    ) %>%
    ggplot(aes(
        x = scenario,
        y = judgment,
        color = negation,
        pch = negation,
        group = negation
    )) +
    geom_half_violin(
        data = . %>% filter(negation == "without"),
        mapping = aes(group = scenario),
        adjust = .7,
        alpha = .2,
        fill = colors[1],
        bw = .4,
        color = "transparent",
        trim = FALSE,
        scale = "count"
    ) +
    geom_half_violin(
        data = . %>% filter(negation == "with"),
        mapping = aes(group = scenario),
        adjust = .7,
        alpha = .2,
        fill = colors[2],
        bw = .4,
        color = "transparent",
        trim = FALSE,
        scale = "count",
        side = "R"
    ) +
    stat_summary(fun = mean, geom = "line") +
    stat_summary(
        fun.data = mean_cl_normal,
        width = .15,
        alpha = .7,
        geom = "errorbar"
    ) +
    stat_summary(fun = mean, geom = "point", size = 4) +
    guides(group = "none") +
    labs(
        x = "Scenario",
        y = "Judgment \u00B1CI<sub>95</sub>",
        color = "Negation",
        pch = "Negation"
    ) +
    scale_y_continuous(limits = c(-2, 2)) +
    facet_wrap(~trigger) +
    theme(axis.text.x = element_markdown(family = "Cascadia Code"))

All the models here are Bayesian mixed models, fit with the brms package (Bürkner 2018; Bürkner 2021), that allow for the parallel estimation of the location and scale parameters of the judgment distributions. In other words, these models are so-called distributional models (Kneib et al. 2023). This kind of architecture allows us to directly test the variance hypothesis by looking at the effects of our experimental manipulations on the scale parameter estimates, which reflect the standard deviations (on the log scale). The priors are all weakly informative, biasing the estimation towards smaller effects, but not ruling out larger ones.

Code

mod_belproj <- brm(
    bf(
        judgment ~ scenario *
            negation *
            trigger +
            (1 + scenario * negation * trigger | id) +
            (1 + scenario * negation | item),
        sigma ~ scenario * negation * trigger,
        alpha ~ scenario *
            negation *
            trigger +
            (1 + scenario * negation * trigger | id) +
            (1 + scenario * negation | item)
    ),
    family = skew_normal(),
    data = d,
    prior = c(
        prior(normal(0, .5), class = Intercept),
        prior(normal(0, .5), class = Intercept, dpar = sigma),
        prior(normal(0, 1), class = b),
        prior(normal(0, .25), class = b, dpar = sigma),
        prior(normal(0, .5), class = sd),
        prior(normal(0, .5), class = sd, dpar = alpha),
        prior(normal(0, 3), dpar = alpha),
        prior(lkj(2), class = cor)
    ),
    iter = 8000,
    init = 0, # initialization errors otherwise
    seed = 1234,
    file = here("models", "belproj_skew_big"),
    cores = 4
)

Below, we show the estimated distributions for the conditions in the experiment, based on the estimated marginal means associated with the model parameter (emmeans package, Lenth 2024). Note that the undefined scenario patterns exactly as predicted regarding the two diagnostics, with judgments near “neither nor” and increased standard deviations. The skew parameter was not associated with any prediction.

Code

spreads_curves <- map(
    c("mu", "sigma", "alpha"),
    ~ emmeans(
        mod_belproj,
        specs = c("scenario", "negation", "trigger"),
        dpar = .x,
        type = "response"
    ) %>%
        as_tibble() %>%
        # if type = "response" had an effect, col is "response", else "emmean"
        rename(!!.x := any_of(c("emmean", "response"))) %>%
        select(scenario, negation, trigger, !!.x)
) %>%
    reduce(left_join, by = c("scenario", "negation", "trigger")) %>%
    mutate(label = paste0(scenario, "-", negation)) %>%
    group_by(label, trigger) %>%
    reframe({
        x <- seq(-2.3, 2.3, length.out = 2000)
        tibble(
            x = x,
            y = dskewnorm(x, mean = mu, sd = sigma, shape = alpha)
        )
    })

spreads_peaks <- spreads_curves %>%
    slice_max(y, n = 1, by = c(label, trigger)) %>%
    mutate(label = fct_reorder(label, x))

p_dists <- spreads_curves %>%
    mutate(label = fct_relevel(label, levels(spreads_peaks$label))) %>%
    ggplot(aes(x = x, y = y, fill = label)) +
    geom_area(
        alpha = 0.3,
        color = alpha("white", .1),
        position = "identity"
    ) +
    geom_text_repel(
        data = spreads_peaks,
        aes(x = x, y = y, label = label, color = label),
        inherit.aes = FALSE,
        family = "Cascadia Code"
    ) +
    guides(fill = "none", color = "none") +
    scale_color_manual(values = colorRampPalette(c(colors[2], colors[1]))(8)) +
    scale_fill_manual(values = colorRampPalette(c(colors[2], colors[1]))(8)) +
    scale_x_continuous(
        limits = c(-2.3, 2.3),
        breaks = (-2:2),
        labels = c(
            "-2\ncompletely false",
            "-1",
            "0\nneither nor",
            "1",
            "2\ncompletely true"
        )
    ) +
    coord_cartesian(clip = "off", expand = FALSE) +
    theme(
        axis.line.y = element_blank(),
        axis.text.y = element_blank(),
        panel.grid.major.y = element_blank(),
        panel.grid.minor.y = element_blank()
    ) +
    facet_grid(rows = vars(trigger)) +
    labs(x = "Estimated judgment distributions", y = NULL) +
    labs(
        caption = "Here, we illustrate only the (estimated marginal) means of the posterior distributions, which do not reflect any of the uncertainty."
    )
p_dists

Because the distrutions above do not take into account the uncertainty associated with the estimates, below we plot the posterior marginal means for the location and scale parameters.

Code

spreads_crit <- mod_belproj %>%
    emmeans(specs = c("scenario", "negation", "trigger")) %>%
    gather_emmeans_draws() %>%
    ungroup() %>%
    mutate(
        cond = paste0(
            scenario,
            "-",
            negation
        ),
        .before = scenario
    )


plot_base <- function(which_scenario) {
    spreads_crit %>%
        mutate(trigger = fct_relevel(trigger, "*again*", "*stop*")) %>%
        filter(scenario %in% which_scenario) %>%
        ggplot(aes(
            x = fct_reorder(cond, .value, .desc = TRUE),
            y = .value,
            color = colors[1],
            fill = colors[1]
        )) +
        geom_hline(
            yintercept = 0,
            color = colors[2],
            lty = "dashed",
            alpha = .5
        ) +
        stat_slab(
            aes(fill = after_stat(level)),
            position = "dodgejust",
            point_interval = mean_hdi,
            .width = c(.95, .999),
            limits = c(.15, .85),
            color = "white",
            scale = 1,
            n = 5000,
            linewidth = .1
        ) +
        stat_pointinterval(
            position = position_dodge(width = .4, preserve = "single"),
            .width = c(.5, .9, .95),
            limits = c(.15, .85),
            point_size = 1.5,
            fill = "white",
            pch = 22,
            stroke = .1,
            point_interval = mean_qi
        ) +
        guides(
            fill_ramp = "none",
            fill = "none",
            pch = "none",
            color = "none"
        ) +
        scale_x_discrete(expand = c(0, 0)) +
        scale_y_continuous(
            limits = c(-2.05, 2.05),
            breaks = c(-2, -1, 0, 1, 2),
            labels = c(
                "-2\ncompletely false",
                "-1",
                "0\nneither nor",
                "1",
                "2\ncompletely true"
            )
        ) +
        scale_fill_manual(
            values = c(alpha(colors[2], .7), alpha(colors[1], .7))
        ) +
        coord_flip(clip = "off") +
        theme(
            # panel.grid.major.y = element_blank(),
            panel.grid.minor.y = element_blank(),
            axis.text.y = element_markdown(hjust = 1),
            axis.title.x = element_markdown(),
            axis.text.x = element_markdown()
        ) +
        labs(
            x = "Parameter",
            y = "Posterior Marginal Means \u00B1HDI<sub>95</sub> \u00B1ETI<sub>50;90;95</sub>"
        ) +
        facet_wrap(vars(trigger), nrow = 2, scales = "fixed")
}

p_mod_all <- plot_base(c("false", "critical", "undef", "true"))
p_mod_all

And here are the posterior marginal means for the scale parameter. Note in particular the increased standard deviations for the undefined scenario, regardless of the trigger or the negation condition, which is consistent with the variance hypothesis.

Code

spreads_sigma <- mod_belproj %>%
    emmeans(specs = c("scenario", "negation", "trigger"), dpar = "sigma") %>%
    gather_emmeans_draws() %>%
    ungroup() %>%
    mutate(
        cond = paste0(
            scenario,
            "-",
            negation
        ),
        .before = scenario
    )

p_mod_sigma <- spreads_sigma %>%
    mutate(trigger = fct_relevel(trigger, "*again*", "*stop*")) %>%
    ggplot(aes(
        x = fct_reorder(cond, .value, .desc = FALSE),
        y = exp(.value),
        color = colors[1],
        fill = colors[1]
    )) +
    stat_slab(
        aes(fill = after_stat(level)),
        position = "dodgejust",
        point_interval = mean_hdi,
        .width = c(.95, .999),
        limits = c(.15, .85),
        color = "white",
        scale = 1,
        n = 5000,
        linewidth = .1
    ) +
    stat_pointinterval(
        position = position_dodge(width = .4, preserve = "single"),
        .width = c(.5, .9, .95),
        limits = c(.15, .85),
        point_size = 1.5,
        fill = "white",
        pch = 22,
        stroke = .1,
        point_interval = mean_qi
    ) +
    guides(
        fill_ramp = "none",
        fill = "none",
        pch = "none",
        color = "none"
    ) +
    scale_x_discrete(expand = c(0, 0)) +
    scale_fill_manual(
        values = c(alpha(colors[2], .7), alpha(colors[1], .7))
    ) +
    scale_y_continuous(expand = c(0, 0)) +
    coord_flip(clip = "off") +
    theme(
        # panel.grid.major.y = element_blank(),
        panel.grid.minor.y = element_blank(),
        axis.text.y = element_markdown(hjust = 1),
        axis.title.x = element_markdown(),
        axis.text.x = element_markdown()
    ) +
    labs(
        x = "Parameter",
        y = "Posterior Marginal Standard Deviations \u00B1HDI<sub>95</sub> \u00B1ETI<sub>50;90;95</sub>"
    ) +
    facet_wrap(vars(trigger), nrow = 2, scales = "fixed")
p_mod_sigma

As we can see, the undefined scenario, which is the only one that should be associated with presupposition failure in terms of its location estimate, is also the one associated with the largest scale estimate. This is consistent with the variance hypothesis, which predicts that intuitions of presupposition failure should be associated with increased variability in judgments due to Strawsonian squeamishness.

In the next case study, we will look at the presuppositional properties of definite descriptions, which may be considered a much more classical testing ground for the variance hypothesis.

What’s so unique about definite descriptions?

Definite descriptions are (nowadays) often taken to be the prototypical presupposition trigger, licensing two separate presuppositions: existence and uniqueness. While today this is rarely considered controversial in the literature on linguistic semantics (but see Coppock and Beaver 2015), it is worth noting that this was not always the case, with the most famous example for the semantics of definite descriptions being from Russell (1905), who famously argued that definite descriptions do not come with any presuppositions at all. Frege (1997), on the other hand, is a famous precursor to the modern view.

The king of France is bald.
Maybe presupposes existence: There is a king of France.
Maybe presupposes uniqueness: There is at most one king of France.

In the second case study, I looked at the presuppositional properties of definite descriptions. The experiment was set up as follows:

\(2 \times 2 \times 2\) design
1. number: singular vs. with plural (within items and participants)
2. scenario: true vs. false vs. undefined (within items and participants)
3. position: sentence-initial vs. sentence-final trigger (within items and participants)

While the core experiment focused on the existence presupposition of definite descriptions, uniqueness was also manipulated in a separate set of items, together with various controls.

I will not have time to discuss the position manipulation today, but whoever’s interested in that can look at Thalmann (in progress) (available on my website).

Much like before, participants were presented with verbal stimuli that were accompanied by visual contexts instantiating the scenario manipulation. Participants were then asked to rate the truth of the sentence in the scenario on a slider with the same three labels as before. Below are sample items for the singular and plural critical conditions, which form the basis for testing the existence and homogeneity violations, respectively. The true and false controls are omitted. Alongside the two undefined conditions, we show the uniqueness violation condition.

Existence violation
The triangle is above the square.

Homogeneity violation
The triangles are above the square.

Uniqueness violation
The shield is above the anchor.

The plot below shows the descriptive results for the critical conditions of the experiment: the existence conditions on the left and the homogeneity conditions on the right. Only in the homogeneity violation condition do we see the characteristic presupposition failure patterns: neither-nor judgments combined with increased standard deviations.

Code

d_modund <- read_csv(
    here("data", "modund-exp1a.csv"),
    show_col_types = FALSE
) %>%
    mutate(
        id = as.numeric(as.factor(id)),
        reaction_time = judgment_t - image_started_t,
        scenario = case_when(
            scenario == "f" ~ "false",
            scenario == "t" ~ "true",
            TRUE ~ "undefined"
        ),
        judgment = judgment - 3,
        trigger = if_else(
            trigger == "dp_pl",
            "DP<sub>PL</sub>",
            "DP<sub>SG</sub>"
        )
    ) %>%
    mutate(
        scenario = fct_relevel(scenario, "false", "undefined", "true"),
        word_order = fct_relevel(word_order, "subject_final"),
        trigger = fct_relevel(trigger, "DP<sub>SG</sub>")
    ) %>%
    # remove trials that took too long
    filter(reaction_time < mean(reaction_time) + 3 * sd(reaction_time))

p_crit <- d_modund %>%
    filter(filler_cond == "n_a") %>%
    mutate(
        scenario = fct_relevel(scenario, "true", "false"),
        scenario = glue(
            "<span style=\"font-family:'Cascadia Code'\">{scenario}</span>"
        )
    ) %>%
    ggplot(aes(
        x = scenario,
        y = judgment,
        color = word_order,
        fill = word_order,
        group = word_order,
        pch = word_order
    )) +
    stat_summary(
        fun.data = mean_cl_normal,
        width = .15,
        alpha = .7,
        geom = "errorbar"
    ) +
    geom_half_violin(
        data = . %>% filter(word_order == "subject_initial"),
        mapping = aes(group = scenario),
        adjust = .7,
        alpha = .2,
        fill = colors[2],
        bw = .4,
        color = "transparent",
        trim = TRUE,
        scale = "count",
        side = "R"
    ) +
    geom_half_violin(
        data = . %>% filter(word_order == "subject_final"),
        mapping = aes(group = scenario),
        adjust = .7,
        alpha = .2,
        fill = colors[1],
        bw = .4,
        color = "transparent",
        trim = TRUE,
        scale = "count"
    ) +
    stat_summary(fun = mean, geom = "line") +
    stat_summary(fun = mean, geom = "point", size = 4) +
    facet_wrap(~trigger) +
    scale_color_discrete() +
    labs(
        x = "Scenario",
        y = "Judgment \u00B1CI<sub>95</sub>",
        color = "Word Order",
        fill = "Word Order",
        group = "Word Order",
        pch = "Word Order"
    )

And here are the other conditions, including the uniqueness violation condition. As with the homogeneity violation, we appear to find the double signature of presupposition failure.

Code

p_control <- d_modund %>%
    filter(filler_cond != "n_a") %>%
    mutate(
        filler_cond = glue(
            "<span style=\"font-family:'Cascadia Code'\">{filler_cond}</span>"
        )
    ) %>%
    ggplot(aes(
        x = fct_reorder(filler_cond, judgment),
        y = judgment,
        color = word_order,
        fill = word_order,
        group = word_order,
        pch = word_order
    )) +
    stat_summary(
        fun.data = mean_cl_normal,
        width = .15,
        alpha = .7,
        geom = "errorbar"
    ) +
    geom_half_violin(
        data = . %>% filter(word_order == "subject_initial"),
        mapping = aes(group = filler_cond),
        adjust = .7,
        alpha = .2,
        fill = colors[2],
        bw = .4,
        color = "transparent",
        trim = TRUE,
        scale = "count",
        side = "R"
    ) +
    geom_half_violin(
        data = . %>% filter(word_order == "subject_final"),
        mapping = aes(group = filler_cond),
        adjust = .7,
        alpha = .2,
        fill = colors[1],
        bw = .4,
        color = "transparent",
        trim = TRUE,
        scale = "count"
    ) +
    stat_summary(fun = mean, geom = "point", size = 4) +
    scale_y_continuous(limits = c(-2, 2)) +
    coord_flip() +
    theme(axis.title.x = element_markdown()) +
    scale_color_discrete() +
    labs(
        x = "Filler condition",
        y = "Judgment \u00B1CI<sub>95</sub>",
        color = "Word Order",
        fill = "Word Order",
        group = "Word Order",
        pch = "Word Order"
    )

The models are described in the two code chunks below. Just like with the believe projection case study, we model both the location and the scale of the judgments, which allows us to test the variance hypothesis directly.

Code

mod_critical <- brm(
    bf(
        judgment ~ scenario *
            trigger *
            word_order +
            (1 + scenario * trigger * word_order | id) +
            (1 + scenario * trigger * word_order | item),
        sigma ~ scenario * trigger * word_order
    ),
    data = d_crit,
    family = gaussian(),
    cores = 4,
    prior = c(
        prior(normal(0, .5), class = Intercept, lb = -2, ub = 2),
        prior(normal(0, .5), class = Intercept, dpar = sigma),
        prior(normal(0, 1), class = b, lb = -4, ub = 4),
        prior(normal(0, .25), class = b, dpar = sigma),
        prior(normal(0, .5), class = sd)
    ),
    iter = 10000,
    seed = 1234,
    file = here("models", "modund_1a_crit"),
    chains = 8
)
mod_control <- brm(
    bf(
        judgment ~ filler_cond *
            word_order +
            (1 + filler_cond * word_order | id) +
            (1 + filler_cond * word_order | item),
        sigma ~ filler_cond * word_order
    ),
    data = d_control,
    family = gaussian(),
    cores = 4,
    prior = c(
        prior(normal(0, .5), class = Intercept, lb = -2, ub = 2),
        prior(normal(0, .5), class = Intercept, dpar = sigma),
        prior(normal(0, 1), class = b, lb = -4, ub = 4),
        prior(normal(0, .25), class = b, dpar = sigma),
        prior(normal(0, .5), class = sd)
    ),
    iter = 10000,
    seed = 1234,
    file = here("models", "modund_1a_control"),
    chains = 8
)

Looking at the location estimates, we see that the undefined scenario is only associated with scale-medial estimates for definite plurals, not with definite singulars. This is consistent with the idea that homogeneity violations pattern like presupposition failures. Existence, on the other hand, does not appear to be associated with presupposition failure, as the false and undefined scenarios are indistinguishable in terms of their location estimates.

Code

spreads_crit <- mod_critical %>%
    emmeans(specs = c("scenario", "trigger")) %>%
    gather_emmeans_draws() %>%
    mutate(
        cond = paste0(
            "<span style=\"font-family:'Cascadia Code'\">",
            scenario,
            "</span>",
            "-",
            trigger
        )
    )
spreads_crit_sigma <- mod_critical %>%
    emmeans(specs = c("scenario", "trigger"), dpar = "sigma") %>%
    gather_emmeans_draws() %>%
    mutate(
        cond = paste0(
            "<span style=\"font-family:'Cascadia Code'\">",
            scenario,
            "</span>",
            "-",
            trigger
        ),
        .value = exp(.value)
    )
# controls
spreads_control <- mod_control %>%
    emmeans(specs = c("filler_cond")) %>%
    gather_emmeans_draws() %>%
    mutate(
        cond = glue(
            "<span style=\"font-family:'Cascadia Code'\">{filler_cond}</span>"
        )
    )
spreads_control_sigma <- mod_control %>%
    emmeans(specs = c("filler_cond"), dpar = "sigma") %>%
    gather_emmeans_draws() %>%
    mutate(
        cond = glue(
            "<span style=\"font-family:'Cascadia Code'\">{filler_cond}</span>"
        ),
        .value = exp(.value)
    )


p_spreads_base <- function(data, sigma = FALSE) {
    if (sigma) {
        label <- "Posterior Marginal Standard Deviations"
    } else {
        label <- "Posterior Marginal Means"
    }
    p <- data %>%
        ggplot(aes(
            x = fct_reorder(cond, .value, .desc = sigma),
            y = .value,
            color = colors[1],
            fill = colors[1]
        )) +
        stat_slab(
            aes(fill = after_stat(level)),
            position = "dodgejust",
            point_interval = mean_hdi,
            .width = c(.95, .999),
            limits = c(.15, .85),
            color = "white",
            scale = .8,
            n = 5000,
            linewidth = .1
        ) +
        stat_pointinterval(
            position = position_dodge(width = .2, preserve = "single"),
            .width = c(.5, .9, .95),
            limits = c(.15, .85),
            point_size = 1.5,
            fill = "white",
            pch = 22,
            stroke = .1,
            point_interval = mean_qi
        ) +
        guides(
            fill_ramp = "none",
            fill = "none",
            pch = "none",
            color = "none"
        ) +
        scale_x_discrete(expand = c(0, 0)) +
        scale_fill_manual(
            values = c(alpha(colors[2], .7), alpha(colors[1], .7))
        ) +
        coord_flip(clip = "off") +
        theme(
            # panel.grid.major.y = element_blank(),
            panel.grid.minor.y = element_blank(),
            axis.text.y = element_markdown(hjust = 1),
            axis.title.x = element_markdown(),
            axis.text.x = element_markdown()
        ) +
        labs(
            x = "Parameter",
            y = paste(
                label,
                "\u00B1HDI<sub>95</sub> \u00B1ETI<sub>50;90;95</sub>"
            )
        )

    if (sigma) {
        p +
            scale_y_continuous(
                limits = c(0, 1),
                breaks = scales::pretty_breaks()
            )
    } else {
        p +
            geom_hline(
                yintercept = 0,
                color = colors[2],
                lty = "dashed",
                alpha = .5
            ) +
            scale_y_continuous(
                limits = c(-2.05, 2.05),
                breaks = c(-2, -1, 0, 1, 2)
            )
    }
}

And here are the results for the scale estimates, which show the same pattern as the location estimates and confirm the variance hypothesis: the undefined scenario for definite plurals is associated with larger standard deviations, as is the uniqueness violation condition in the control items. Violating existence, however, does not appear to be associated with increased variability in judgments, mirroring the location-based diagnostic.

Conclusion

Across two case studies, I have argued that intuitions of presupposition failure manifest themselves in two ways: (i) as judgments that cluster around the “neither nor” option in a slider-based truth-value judgment task and (ii) as increased variability in judgments, which can be measured through larger standard deviations. That is, presuppositions make themselves known not only through their location but also through their scale.

I have argued that this latter property is a consequence of the Strawsonian squeamishness that speakers display when confronted with utterances suffering from presupposition failure, which I connected to the experimental data via the variance hypothesis, namely the assumption that intuitions of presupposition failure should elicit more variable judgments than conditions without.

1. Strawsonian squeamishness
  An utterance suffering from presupposition failure and thereby lacking a classical truth value will cause interlocutors to experience a sense of conversational unease or breakdown—manifested as hesitation, uncertainty, or reluctance to evaluate the utterance for truth.
2. Variance hypothesis
  Experimental conditions involving presupposition failure will exhibit greater response variability, i.e., higher standard deviations, than conditions that are evaluable for truth, due to Strawsonian squeamishness.

In this way, the variance hypothesis provides a novel way to detect intuitions of presupposition failure experimentally, and it also provides us with a new perspective on what is often used a mere nuisance variable in statistics: the standard deviation. Properly understood and modelled theoretically, standard deviation estimates cease to be mere noise in the data. Instead, they can be used as a discriminative property that helps us answer the question whether two condition means come from the same distribution or not.

In this way, in experimental semantics and in presupposition research in particular, standard deviations are more than just noise: they are a characteristic property of truth-value gaps, and thus diagnostic of presuppositions and their failure.

Of course, there are some open questions that I have not been able to address in this talk, such as whether there are cases where we find just a scale difference without a location difference, as in the initial visualization from the beginning of the talk, repeated below. In fact, there are some conditions in the definite descriptions case study that show this pattern, like the scalar implicature condition in the controls as well as the true scenario for the definite plurals. In Thalmann (in progress), I discuss these cases against the background of the variance hypothesis and proposals in the literature for how homogeneity inferences and scalar implicatures come about (and may be related to presuppositions).

Code

p_dist

You can find this handout here:

References

Bürkner, Paul-Christian. 2018. Advanced bayesian multilevel modeling with the R package brms. The R Journal 10: 395–411. https://doi.org/10.32614/RJ-2018-017.

Bürkner, Paul-Christian. 2021. Bayesian item response modeling in R with brms and stan. Journal of Statistical Software 100: 1–54. https://doi.org/10.18637/jss.v100.i05.

Coppock, Elizabeth, and David I. Beaver. 2015. Definiteness and determinacy. Linguistics & Philosophy 38. Springer: 377–435. https://doi.org/10.1007/s10988-015-9178-8.

Fintel, Kai von. 2008. What is presupposition accommodation, again? Philosophical Perspectives 22. Wiley Online Library: 137–170. https://doi.org/10.1111/j.1520-8583.2008.00144.x.

Fox, Danny. 2013. Presupposition projection from quantificational sentences: Trivalence, local accommodation, and presupposition strengthening. In From grammar to meaning, ed. Ivano Caponigro and Carlo Cecchetto, 201–232. Cambridge University Press. https://doi.org/10.1017/cbo9781139519328.011.

Frege, Gottlob. 1997. Über Sinn und Bedeutung (1892). In The Frege reader, ed. Michael Beaney, 151–171. Malden, MA: Blackwell Publishers.

Kneib, Thomas, Alexander Silbersdorff, and Benjamin Säfken. 2023. Rage against the mean: A review of distributional regression approaches. Econometrics and Statistics 26. Elsevier BV: 99–123. https://doi.org/10.1016/j.ecosta.2021.07.006.

Križ, Manuel, and Emmanuel Chemla. 2015. Two methods to find truth-value gaps and their application to the projection problem of homogeneity. Natural Language Semantics 23. Springer: 205–248. https://doi.org/10.1007/s11050-015-9114-z.

Lenth, Russell V. 2024. Emmeans: Estimated marginal means, aka least-squares means.

Russell, Bertrand. 1905. On denoting. Mind 14. [Oxford University Press, Mind Association]: 479–493. https://doi.org/10.5040/9781474216166.0007.

Strawson, P. F. 1964. Identifying reference and truth-values. Theoria 30. Wiley: 96–118. https://doi.org/10.1111/j.1755-2567.1964.tb00404.x.

Sun, Siqi, Karen M. Schmidt, and Teague R. Henry. 2025. Don’t let your Likert scales grow up to be visual analog scales: Understanding the relationship between number of response categories and measurement error. Ms; arXiv. https://doi.org/10.48550/ARXIV.2502.02846.

Thalmann, Maik. in progress. Not so squeamish, Your majesty: The presuppositions of singular definites between existence and uniqueness.

Thalmann, Maik, and Andrea Matticchio. in progress. Kleene’ing up your attitude: Against universal presupposition projection.

Thalmann, Maik, and Andrea Matticchio. 2024. On being certain that presuppositions don’t project universally. In Proceedings of the Amsterdam Colloquium, 378–385.

Appendix

The homoscedasticity assumption

The code below illustrates the difference between models that assume homoscedasticity (i.e., constant variance across conditions) and models that allow for heteroscedasticity (i.e., different variances across conditions). Note that the homoscedastic model is not able to capture the increased variability in the x_2 condition (or, in turn, the low amount of variance for the x_1 condition), while the heteroscedastic model is able to do so by allowing for different standard deviations for the two conditions.

If the standard deviation estimates from inappropriate homoscedastic models are used to test hypotheses about the location of the data, this can lead to incorrect conclusions, as the denominator of the test statistic, which is typically some residual variance measure, is incorrect.

Code

set.seed(1234)
d_hom <- tibble(x_1 = rnorm(1000, -1, .25), x_2 = rnorm(1000, 1, .25)) %>%
    pivot_longer(values_to = "y", names_to = "x", cols = c(x_1, x_2)) %>%
    mutate(which = "Homoscedastic") %>%
    bind_rows(
        tibble(x_1 = rnorm(1000, -1, .125), x_2 = rnorm(1000, 1, .328)) %>%
            pivot_longer(
                values_to = "y",
                names_to = "x",
                cols = c(x_1, x_2)
            ) %>%
            mutate(which = "Heteroscedastic")
    ) %>%
    mutate(which = fct_relevel(which, "Homoscedastic"))

p_hom <- d_hom %>%
    ggplot(aes(x = x, y = y, color = x, pch = x, group = x, fill = x)) +
    geom_violin(color = "transparent", alpha = .4) +
    stat_summary(fun = mean, geom = "line", group = 1, color = "grey50") +
    facet_wrap(~which) +
    stat_summary(fun.data = mean_cl_normal, geom = "errorbar", width = .1) +
    stat_summary(fun = mean, geom = "point", size = 3) +
    guides(color = "none", pch = "none", fill = "none") +
    scale_y_continuous(breaks = seq(-2, 2, 1), limits = c(-2, 2)) +
    coord_cartesian(clip = "off") +
    labs(
        x = "*x*",
        y = "*y* \u00B1CI<sub>95</sub>"
    )

mod_hom <- brm(
    bf(y ~ x),
    data = subset(d_hom, which == "Homoscedastic"),
    cores = 4,
    silent = 2,
    refresh = 0,
    seed = 1234
)
mod_het <- update(
    mod_hom,
    newdata = subset(d_hom, which == "Heteroscedastic"),
    cores = 4
)
mod_hom_dist <- update(mod_hom, formula = bf(y ~ x, sigma ~ x), cores = 4)
mod_het_dist <- update(
    mod_hom_dist,
    newdata = subset(d_hom, which == "Heteroscedastic"),
    cores = 4
)

posterior_effects_sigma <- function(model) {
    model %>%
        tidybayes::gather_draws(
            b_Intercept,
            b_xx_2,
            b_sigma_Intercept,
            b_sigma_xx_2
        ) %>%
        pivot_wider(names_from = .variable, values_from = .value) %>%
        mutate(
            Sigma_x_2 = exp(b_sigma_Intercept + b_sigma_xx_2),
            Sigma_x_1 = exp(b_sigma_Intercept),
            Intercept = b_Intercept,
            x_2 = b_Intercept + b_xx_2
        ) %>%
        select(Sigma_x_2, Sigma_x_1, Intercept, x_2) %>%
        pivot_longer(
            values_to = "estimate",
            names_to = "Parameter",
            cols = c("Sigma_x_2", "Sigma_x_1", "Intercept", "x_2")
        ) %>%
        group_by(Parameter) %>%
        summarise(estimate = tidybayes::mean_hdi(estimate)) %>%
        unnest(cols = c(estimate)) %>%
        select(-.width, -.point, -.interval) %>%
        arrange(desc(y)) %>%
        arrange(fct_relevel(fct_inorder(Parameter), "Intercept")) %>%
        rename(Estimate = y, HDI_low = ymin, HDI_high = ymax)
}
posterior_effects <- function(model) {
    model %>%
        tidybayes::gather_draws(b_Intercept, b_xx_2, sigma) %>%
        pivot_wider(names_from = .variable, values_from = .value) %>%
        mutate(
            Intercept = b_Intercept,
            x_2 = b_Intercept + b_xx_2
        ) %>%
        select(Intercept, x_2, Sigma = sigma) %>%
        pivot_longer(
            values_to = "estimate",
            names_to = "Parameter",
            cols = c("Sigma", "Intercept", "x_2")
        ) %>%
        group_by(Parameter) %>%
        summarise(estimate = tidybayes::mean_hdi(estimate)) %>%
        unnest(cols = c(estimate)) %>%
        select(-.width, -.point, -.interval) %>%
        arrange(desc(y)) %>%
        arrange(fct_relevel(fct_inorder(Parameter), "Intercept")) %>%
        rename(Estimate = y, HDI_low = ymin, HDI_high = ymax)
}

format_table <- function(left, right, dist = TRUE) {
    left_join(left, right, by = join_by(Parameter)) %>%
        gt() %>%
        tab_header(
            title = if_else(
                dist,
                md("*Distributional models*"),
                md("*Standard models*")
            )
        ) %>%
        tab_spanner(label = "Homoscedastic data", columns = ends_with(".x")) %>%
        tab_spanner(
            label = "Heteroscedastic data",
            columns = ends_with(".y")
        ) %>%
        tab_style(
            style = cell_borders(sides = c("top"), weight = px(1)),
            locations = cells_column_labels()
        ) %>%
        tab_style(
            style = cell_borders(sides = c("bottom"), weight = px(1)),
            locations = cells_body(
                columns = everything(),
                rows = length(everything())
            )
        ) %>%
        tab_style(
            style = cell_borders(sides = c("top"), weight = px(.6)),
            locations = cells_body(columns = everything(), rows = 1)
        ) %>%
        tab_style(
            style = "padding-right:20px",
            locations = cells_column_labels(columns = Parameter)
        ) %>%
        tab_style(
            style = "padding-right:80px",
            locations = list(
                cells_body(columns = HDI_high.x),
                cells_column_labels(columns = HDI_high.x)
            )
        ) %>%
        cols_label_with(fn = ~ gsub("\\.x$|\\.y$", "", .)) %>%
        fmt_number(decimals = 4) %>%
        tab_options(
            column_labels.padding = px(12),
            heading.title.font.size = 14,
            table.font.names = "Roboto Condensed",
            table.font.size = 13
        ) %>%
        opt_align_table_header(align = "left") %>%
        opt_horizontal_padding(scale = 3) %>%
        opt_vertical_padding(scale = .7) %>%
        opt_table_lines(extent = "none")
}

p_hom /
    format_table(
        posterior_effects(mod_hom),
        posterior_effects(mod_het),
        dist = FALSE
    ) /
    format_table(
        posterior_effects_sigma(mod_hom_dist),
        posterior_effects_sigma(mod_het_dist)
    ) +
    plot_layout(heights = c(4, 1.8, 2.2))

Believe projection

Skew plots

Code

spreads_alpha <- mod_belproj %>%
    emmeans(specs = c("scenario", "negation", "trigger"), dpar = "alpha") %>%
    gather_emmeans_draws() %>%
    ungroup() %>%
    mutate(
        cond = paste0(
            scenario,
            "-",
            negation
        ),
        .before = scenario
    )

p_mod_alpha <- spreads_alpha %>%
    mutate(trigger = fct_relevel(trigger, "*again*", "*stop*")) %>%
    ggplot(aes(
        x = fct_reorder(cond, .value, .desc = FALSE),
        y = .value,
        color = colors[1],
        fill = colors[1]
    )) +
    stat_slab(
        aes(fill = after_stat(level)),
        position = "dodgejust",
        point_interval = mean_hdi,
        .width = c(.95, .999),
        limits = c(.15, .85),
        color = "white",
        scale = 1,
        n = 5000,
        linewidth = .1
    ) +
    stat_pointinterval(
        position = position_dodge(width = .4, preserve = "single"),
        .width = c(.5, .9, .95),
        limits = c(.15, .85),
        point_size = 1.5,
        fill = "white",
        pch = 22,
        stroke = .1,
        point_interval = mean_qi
    ) +
    guides(
        fill_ramp = "none",
        fill = "none",
        pch = "none",
        color = "none"
    ) +
    scale_x_discrete(expand = c(0, 0)) +
    scale_y_continuous(expand = c(0, 0)) +
    scale_fill_manual(
        values = c(alpha(colors[2], .7), alpha(colors[1], .7))
    ) +
    coord_flip(clip = "off") +
    theme(
        panel.grid.minor.y = element_blank(),
        axis.text.y = element_markdown(hjust = 1),
        axis.title.x = element_markdown(),
        axis.text.x = element_markdown()
    ) +
    labs(
        x = "Parameter",
        y = "Posterior Marginal Skew Parameters \u00B1HDI<sub>95</sub> \u00B1ETI<sub>50;90;95</sub>"
    ) +
    facet_wrap(vars(trigger), nrow = 2, scales = "fixed")
p_mod_alpha

Skew- and hyperparameters

Code

mod_belproj_noskew <- update(
    mod_belproj,
    bf(
        judgment ~ scenario *
            negation *
            trigger +
            (1 + scenario * negation * trigger | id) +
            (1 + scenario * negation | item),
        sigma ~ scenario * negation * trigger,
        alpha = 0
    ),
    save_pars = save_pars(all = TRUE),
    file = here("models", "belproj_noskew"),
    cores = 4
)

prep_data <- function(model, model_string) {
    as.data.frame(VarCorr(model, summary = TRUE)) %>%
        select(contains("sd"), -contains("error")) %>%
        rownames_to_column("parameter") %>%
        janitor::clean_names() %>%
        pivot_longer(
            cols = starts_with(c("id", "item")),
            names_to = "which",
            values_to = "stat"
        ) %>%
        separate(
            which,
            into = c("ranef", "stat_type"),
            sep = "_",
            extra = "merge"
        ) %>%
        pivot_wider(
            id_cols = c("parameter", "ranef"),
            names_from = "stat_type",
            values_from = "stat"
        ) %>%
        mutate(
            sub = if_else(str_starts(parameter, "alpha"), "alpha", "mu"),
            parameter = str_remove(parameter, "^alpha_"),
            model = model_string,
            parameter = str_to_title(
                str_remove_all(parameter, "_v_GM|without|MUstopMU|scenario")
            ),
            parameter = fct_rev(fct_inorder(parameter)),
            ranef = if_else(ranef == "id", "By-Participants", "By-Items"),
            ranef = fct_relevel(ranef, "By-Participants")
        ) %>%
        filter(sub != "alpha")
}
d_hyper <- bind_rows(
    prep_data(mod_belproj, "Skew"),
    prep_data(mod_belproj_noskew, "No skew")
)

# compute by how much the skew model outperforms the no skew one
# mod_belproj_bf <- bayes_factor(mod_belproj, mod_belproj_noskew, log = TRUE)
mod_belproj_bf <- 327

p_hyper <- d_hyper %>%
    mutate(
        model = fct_relevel(model, "Skew")
    ) %>%
    ggplot(aes(y = parameter, x = sd_estimate, color = model, shape = model)) +
    geom_vline(
        data = d_hyper %>%
            group_by(ranef, model) %>%
            summarise(mean_sd = mean(sd_estimate), .groups = "drop"),
        aes(xintercept = mean_sd, color = model),
        linetype = "dashed",
        linewidth = .3,
        show.legend = FALSE
    ) +
    geom_errorbar(aes(xmin = sd_q2_5, xmax = sd_q97_5), width = .3) +
    geom_point(size = 3) +
    facet_grid(cols = vars(ranef), scales = "free") +
    labs(
        x = "Location hyperparameter estimate \u00B1HDI<sub>95</sub>",
        y = "Random effect component",
        color = "Model",
        shape = "Model",
        subtitle = glue::glue(
            "In the 'No skew' model, the by-participant effects soak up all kinds of<br>residual structure (true subject effects, asymmetry, item heterogeneity).<br>What previously looked like participant-level variability was in part due to<br>distributional skewness, which is better modeled now (log BF {round(mod_belproj_bf, 0)})."
        ),
        caption = "NB: (1 + scenario * negation | item) means random effects for the columns in the design matrix of scenario * negation.<br>When multiplying these contrasts, the interaction columns can include terms involving trigger due to the coding,<br>even if it wasn't specified since trigger is a fixed effect of the model, so the global model matrix includes it."
    ) +
    theme(
        axis.text.y = element_markdown(hjust = 0),
        plot.caption = element_markdown(hjust = 0),
        plot.subtitle = element_markdown(size = 12),
        panel.grid.major = element_blank()
    )
p_hyper

Code

# compare fixed effects to the ranef hyperparameters
mods_fixef_sample <- map2(
    .x = list(mod_belproj, mod_belproj_noskew),
    .y = list("Skew", "No skew"),
    ~ as_tibble(fixef(.x), rownames = "parameter") %>%
        janitor::clean_names() %>%
        select(-contains("error")) %>%
        filter(!grepl("^alpha|^sigma", parameter)) %>%
        mutate(
            model = .y,
            parameter = str_to_title(
                str_remove_all(parameter, "_v_GM|without|MUstopMU|scenario")
            )
        )
) %>%
    bind_rows()

p_hyper_fix <- mods_fixef_sample %>%
    left_join(
        d_hyper %>%
            filter(ranef == "By-Participants") %>%
            select(-sub, -ranef),
        by = c("parameter", "model")
    ) %>%
    mutate(
        ranef_fixef_ratio = sd_estimate / estimate,
        model = fct_rev(paste("Model:", model)),
        label = if_else(sd_estimate > .25, parameter, NA)
    ) %>%
    ggplot(aes(
        x = estimate,
        y = sd_estimate,
        color = model,
        fill = model
    )) +
    geom_rect(
        aes(xmin = q2_5, xmax = q97_5, ymin = sd_q2_5, ymax = sd_q97_5),
        color = "transparent",
        alpha = .8
    ) +
    geom_point(color = alpha("white", .3), shape = 15) +
    geom_text(
        aes(label = label),
        na.rm = TRUE,
        angle = 270,
        color = "white",
        size = 2.5
    ) +
    facet_grid(cols = vars(model)) +
    guides(color = "none", fill = "none", label = "none") +
    scale_x_continuous(limits = c(-1.5, 1.5), breaks = seq(-1.5, 1.5, .5)) +
    labs(
        subtitle = "In the 'No skew' model, random effect hyperparameter estimates approach the scale of the<br>fixed effects. Relaxing the symmetry assumption achieves much smaller by-participant slopes<br>compared to the fixed effect estimates. One wonders how much of the remaining participant-<br>level variance is simply removed via shrinkage in the better 'Skew' model.",
        x = "Fixed location effects (sum-coded) \u00B1HDI<sub>95</sub>",
        y = "Participant hyperparameter \u00B1HDI<sub>95</sub>"
    ) +
    theme(plot.subtitle = element_markdown(size = 12))
p_hyper_fix

Footnotes

Violations of homoscedasticity can have serious consequences for the validity of statistical tests, leading to increased Type I error rates and reduced statistical power. I will not have time to go into this.↩︎