Bayesian | Reality Bending Lab

How to Assess Task Reliability using Bayesian Mixed Models

Mon, 18 Mar 2024 00:00:00 +0000

Using reliable tasks when assessing inter-individual differences is a key issue for differential psychology and neuropsychology, and many research areas are clouded with mixed evidence stemming out of the suboptimal computation of individual scores (e.g., tasks with not enough trials, scores consisting in computing the difference, aka the contrast between two conditions; see Rouder et al., 2024). As such, measuring and reporting the reliability of the paradigms used could be an important step for increasing results replicability.

Recently, a new approach has emerged, suggesting to assess task sensitivity to inter-individual differences by leveraging mixed models (Rouder et al., 2024). In essence, the idea is to fit a statistical model that tests for the general population level effect of a manipulation in a given task/experiment (e.g., the impact of a variable Difficulty on another variable RT), and incorporates a random effect for each participant. This “full” mixed model essentially models the general population level by taking into account all the inter-individual effects and - as a side effect - estimates the effects of interest for each participant separately.

When fitting these models under a Bayesian framework, one can easily estimate the “variability” (or certainty) of the effect in each participant. This is great, because it allows us to assess a “signal-to-noise” ratio, an index of how much the interindividual variability (how participants vary) is larger than the intraindividual variability (e.g., how much participants vary across trial, or how precisely participants’ effects are estimated).

In this “Signal-To-Noise Ratio as Effect Reliability” framework, an ideal task/manipulation would have a strong inter-individual variability (i.e., participants would on average vary a lot) and a low intra-individual variability (each participant would have very consistent effects), which leads to a reliable measure of interindividual effects.

Let’s see how we can do that in R using the brms package for fitting Bayesian mixed model. First, let’s start to generate 4 datasets with different levels of inter-individual and intra-individual variability.

Show code

library(easystats)
library(tidyverse)
library(brms)
library(patchwork)

# Make function to generate data
generate_data <- function(n_trials=25, effect_sd = 0.4, intercept_sd=0.4, noise=0.8, name="df") {
  df <- data.frame()
  for(participant in 1:20) {
    x <- rnorm(n_trials, 0, 1)
    y <- (1 + rnorm(1, 0, effect_sd)) * x + rnorm(1, 0, intercept_sd)
    y <- y + rnorm(n_trials, 0, noise)
    df <- rbind(df, data.frame(Difficulty=x, RT=y,
                               Participant=paste0("S", participant)))
  }
  df$Name <- name
  df
}

# Generate 4 datasets
df1 <- generate_data(n_trials=20, effect_sd = 0.5, intercept_sd=0.5, name="1. Intercept and Effect")
df2 <- generate_data(n_trials=20, effect_sd = 0.1, intercept_sd=0.5, name="2. Intercept Only")
df3 <- generate_data(n_trials=20, effect_sd = 0.5, intercept_sd=0.1, name="3. Effect Only")
df4 <- generate_data(n_trials=200, effect_sd = 0.5, intercept_sd=0.5, name="4. More trials")

# Plot data
rbind(df1, df2, df3, df4) |>
  ggplot(aes(x=Difficulty, y=RT, color=Participant, fill=Participant)) +
  geom_point2(alpha=0.5) +
  geom_smooth(method="lm", se=TRUE, alpha=0.2) +
  theme_minimal() +
  scale_fill_material_d() +
  scale_color_material_d() +
  facet_wrap(~Name, scales="free")

In each of the dataset, we simulated the data of 20 participants undergoing a task with n trials varying in difficulty, and we recorded their reaction time (RT). Note that while in our example difficulty is a continuous variable, it would work the same if it was categorical variable (e.g., effect of condition B over A, intervention vs. baseline, incongruent vs. congruent, etc.).

When we fit a linear regression of the form RT ~ difficulty, we are estimating two parameters; the intercept (which can be seen as the “baseline” RT, i.e., participants’ baseline processing speed when the difficulty is 0) and the slope (how much participants are impacted by this variable). These two parameters are in principle independent (a participant can be very fast regardless of the difficulty, and another one could be equally fast at baseline - same intercept - but very slow when the task is difficult - strong slope).

We simulated 4 datasets with different participant characteristics:

Dataset 1: Both the RT intercept (the “baseline” RT) and the effect of the manipulation (the effect of difficulty) vary across participants.
Dataset 2: Not much interindividual variability in the effect (only the baseline RT varies).
Dataset 3: Not much interindividual variability in the baseline RT (only the effect of difficulty varies from participant to participant).
Dataset 4: Same as dataset 1, but with more trials (200 instead of 20). As you can see, the “precision” ribbon around the regression line is much narrower, indicating that the effect is more precisely estimated.

We expect that reliability of the paradigm to measure 1) the sensitivity to difficulty and 2) the baseline RT will be higher in dataset 4 (because more trials) than in dataset 1. Moreover, the sensitivity to difficulty will be particularly low in dataset 2 (where only the baseline RT is set to varies), and similarly for baseline RT in dataset 3 mutatis mutandis.

Now, let’s fit a Bayesian linear mixed model to each of these datasets (note that we specify the effect of Difficulty as a random slope in addition to estimating the random intercept).

Show code

model1 <- brms::brm(RT ~ Difficulty + (1+Difficulty|Participant), data=df1, iter=600)
model2 <- brms::brm(RT ~ Difficulty + (1+Difficulty|Participant), data=df2, iter=600)
model3 <- brms::brm(RT ~ Difficulty + (1+Difficulty|Participant), data=df3, iter=600)
model4 <- brms::brm(RT ~ Difficulty + (1+Difficulty|Participant), data=df4, iter=600)

This model basically computes the overall relationship (Intercept + Slope) between difficulty and RT, as well as for each participant. We can then extract the posterior distribution of these individual effects (i.e., the value of the Intercept and the Slope for each participant).

Show code

# Random effects extraction
extract_individual <- function(model, name="df") {
  coefs <- coef(model, summary=FALSE)$Participant
  data <- rbind(
    as.data.frame(coefs[, , "Intercept"]) |>
      pivot_longer(everything(), names_to="Participant", values_to="Value") |>
      mutate(Parameter="Intercept", Name=name),
    as.data.frame(coefs[, , "Difficulty"]) |>
      pivot_longer(everything(), names_to="Participant", values_to="Value") |>
      mutate(Parameter="Difficulty", Name=name)
  )
  data
}

re1 <- extract_individual(model1, "1. Intercept and Effect")
re2 <- extract_individual(model2, "2. Intercept Only")
re3 <- extract_individual(model3, "3. Effect Only")
re4 <- extract_individual(model4, "4. More trials")


# Plot Random effects
rbind(re1, re2, re3, re4) |>
  ggplot(aes(x=Value, y=Participant, fill=Participant)) +
  ggdist::stat_slabinterval(adjust=2, linewidth=0.5, size=0.5) +
  scale_fill_material_d() +
  theme_minimal() +
  facet_grid(Name~Parameter, scales="free")

Each participant’s “score” (for the baseline RT score, i.e., the intercept; and the effect of difficulty, i.e., the slope) is represented by a distribution. This distribution is wider when there is less trials, which can be interpreted as more uncertainty about the exact estimate. Some datasets have a low interindividual variability for some parameters (e.g., dataset 2 has not much interindividual variability in the effect of difficulty).

We can now compute, for each participant, the “mean” of its effects (for the intercept and the slope), as well as its own effect SD (intra-individual variability).

Show code

scores <- rbind(re1, re2, re3, re4) |>
  summarize(
    Mean = mean(Value),
    SD = sd(Value),
    .by = c("Name", "Parameter", "Participant")
  )
head(scores)

Name	Parameter	Participant	Mean	SD
1. Intercept and Effect	Intercept	S1	0.37	0.20
1. Intercept and Effect	Intercept	S10	-1.05	0.20
1. Intercept and Effect	Intercept	S11	0.88	0.19
1. Intercept and Effect	Intercept	S12	-0.30	0.18
1. Intercept and Effect	Intercept	S13	0.16	0.19
1. Intercept and Effect	Intercept	S14	0.57	0.19

Finally, we can compute the Signal-to-Noise Ratio for each parameter for each dataset, which is the ratio of the interindividual variability (the SD of the individual mean scores) over the average intraindividual variability (the average of the individual SDs).

Show code

summarize(scores,
          SNR = sd(Mean) / mean(SD),
          .by=c("Name", "Parameter"))

Name	Parameter	SNR
1. Intercept and Effect	Intercept	2.87
1. Intercept and Effect	Difficulty	3.00
2. Intercept Only	Intercept	2.57
2. Intercept Only	Difficulty	0.55
3. Effect Only	Intercept	0.88
3. Effect Only	Difficulty	2.59
4. More trials	Intercept	8.88
4. More trials	Difficulty	7.97

As predicted, the “reliability” of the paradigm to measure the interindividual effect of difficulty on RT is low in dataset 2 (where only the baseline RT varies), moderate in dataset 1 and 3, and high in dataset 4 where there are more trials.

How to extract individual scores from repeated measures

Mon, 14 Sep 2020 00:00:00 +0000

Introduction

Many psychology fields require to extract individual scores, i.e., point-estimates (i.e., a single value) for a participant/patient, to be used as an index of something and later interpreted or re-used in further statistical analyses. This single index is often derived from several “trials”. For instance, the reaction times in the condition A (let’s say, the baseline) will be averaged together, and the same will be done with the condition B. Finally, the difference between these two means will be used an the individual score for a given participant.

However, we can intuitively feel that we lose a lot of information when averaging these scores. Do we deal appropriately with the variability related to individuals, conditions, or the noise aggravated by potential outliers? This is especially important when working with a limited amount of trials.

With the advent of recent computational advances, new easy-to-implement alternatives emerge. For instance, one can “model” the effects at an individual level (e.g., the simplest case, for the two conditions paradigm described above, would be a linear regression with the condition as a unique predictor), and use the parameters of each model as individual scores (e.g., the “slope” coefficient of the effect of the manipulation), rather than the raw mean. This opens up the possibility of including covariates and take into account other sources of known variability, which could lead to better estimates.

However, individual models are also sensitive to outliers and noise. Thus, another possibility is to model the effects at the population level and, at the same time, at the individual level. This can be achieved by modelling the participants as a random factor in a mixed model. In this case, the individual estimates might benefit from the population estimates. In other words, the effects at the population level will “constrain” or “guide” the estimation at an individual level to potentially limit extreme parameters.

Unfortunately, the above method requires to have all the data at hand, to be able to fit the population model. This is often not the case in on-going acquisition, or in neuropsychological contexts, in which the practitioners simply acquire data for one patient, and have to compute individual scores, without having access to the detailed population data. Thus, an in-between alternative could make use of Bayesian models, in which the population effects (for instance, the mean effect of the condition) could be entered as an informative prior in the individual models to, again, “guide” the estimation at an individual level and hopefully limit the impact of noise or outliers observations.

In this post, the aim is to compare these 4 methods (basic individual model - equivalent to using the raw mean, population model, individual model with informative priors) in recovering the “true” effects using a simulated dataset.

Results

Generate Data

We generate several datasets in which we manipulate the number of participants, in which the score of interest is the effect of a manipulation as compared to a baseline condition. 20 trials per condition will be generated with a known “true” effect (the centre of the distribution from which the data is generated). Gaussian noise of varying standard deviation will be added to create a natural variability (See the functions’ definition below).

library(tidyverse)
library(easystats)

data <- get_data(n_participants=1000, n_trials=20)
results <- get_results(data)

Figure 1: *Example of a dataset containing 20 participants (shown with different colors). As can be seen, we introduced modulations in the inter- and intra- individual variability.*

We will then compare the scores obtained by each method to the “true” score of each participant by substracting them from one another. As such, for each method, we obtain the absolute “distance” from the true score.

Fit model

Contrast analysis will be applied to compare the different methods together.

model <- lm(Diff_Abs ~ Method, data=results)

modelbased::estimate_contrasts(model) %>%
  arrange(Difference) %>%
  mutate(Level1 = stringr::str_remove(Level1, "Diff_"),
         Level2 = stringr::str_remove(Level2, "Diff_")) %>% 
  select(Level1, Level2, Difference, CI_low, CI_high, p)

## Level1                 | Level2                 | Difference |            CI |      p
## -------------------------------------------------------------------------------------
## IndividualModel_Priors | PopulationModel        |  -1.85e-03 | [-0.01, 0.01] | > .999
## IndividualModel_Freq   | PopulationModel        |   1.70e-03 | [-0.01, 0.01] | > .999
## IndividualModel_Freq   | IndividualModel_Priors |   3.55e-03 | [-0.01, 0.01] | > .999

Visualize the results

Figure 2: *Average accuracy of the different methods (the closest to 0 the better).*

Figure 3: *Accuracy depending on the number of total participants in the dataset.*

Conclusion

Though not significantly different, it seems that raw basic estimates (that rely only on the individual data) perform consistently worse than the population model or individual models informed by priors, especially for small datasets (between 10 and 100 participants) - though again, the difference is tiny in our simulated dataset. In the absence of the whole population dataset, it seems that using individual Bayesian model with informative priors (derived from the population model) is a safe alternative.

Functions

library(tidyverse)
library(easystats)
library(rstanarm)
library(ggdist)


# Get data ----------------------------------------------------------------

get_data <- function(n_participants = 10, n_trials = 20, d = 1.5, var = 3, noise = 0.1) {
  scores_baseline <- rnorm(n_participants, 0, 1)
  scores_condition <- rnorm(n_participants, d, 1)
  variances <- rbeta(n_participants, 2, 8)
  variances <- 0.1 + variances * (var / max(variances)) # Rescale
  noise_sd <- abs(rnorm(n_participants, 0, noise))

  data <- data.frame()
  for (i in 1:n_participants) {
    a <- rnorm(n_trials, scores_baseline[i], variances[i])
    b <- rnorm(n_trials, scores_condition[i], variances[i])
    a <- a + rnorm(n_trials, 0, noise_sd[i]) # Add noise
    b <- b + rnorm(n_trials, 0, noise_sd[i]) # Add noise
    data <- rbind(data, data.frame(
      "Participant" = sprintf("S%02d", i),
      "Y" = c(a, b),
      "Score_True" = rep(c(scores_baseline[i], scores_condition[i]), each = n_trials),
      "Condition" = rep(c("Baseline", "Manipulation"), each = n_trials)
    ))
  }
  data
}



# Visualize data -----------------------------------------------------------

p <- get_data(n_participants = 20) %>%
  group_by(Participant, Condition) %>%
  mutate(mean = mean(Y)) %>%
  ggplot(aes(y = Y, x = Condition, fill = Participant, color = Participant, group = Participant)) +
  geom_line(aes(y = mean), position = position_dodge(width = 0.66)) +
  ggdist::stat_eye(point_interval = ggdist::mean_hdi, alpha = 0.66, position = position_dodge(width = 0.66), .width = c(0.95)) +
  ylab("Score") +
  theme_modern() +
  theme(legend.position = "none")
ggsave("individual.png", p, width = 7, height = 7, dpi = 450)


# Get results -------------------------------------------------------------


get_results <- function(data) {

  # Raw method ----

  results <- data %>%
    group_by(Participant, Condition) %>%
    summarise_all(mean) %>%
    rename("Score_Raw" = "Y") %>%
    arrange(Condition, Participant) %>%
    ungroup()


  # Population model ----

  model <- lme4::lmer(Y ~ Condition + (1 + Condition | Participant), data = data)

  fixed <- insight::get_parameters(model, effects = "fixed")$Estimate
  random <- insight::get_parameters(model, effects = "random")$Participant

  # Transform coefs into scores
  pop_baseline <- random[, 1] + fixed[1]
  pop_manipulation <- pop_baseline + random[, 2] + fixed[2]

  results$Score_PopulationModel <- c(pop_baseline, pop_manipulation)


  # Individual model ----

  individual_model_data <- data.frame()
  for (participant in unique(data$Participant)) {
    cat(".") # Print progress

    dat <- data[data$Participant == participant, ]

    # Frequentist
    model1 <- lm(Y ~ Condition, data = dat)
    nopriors <- parameters::parameters(model1)$Coefficient

    # Bayesian without priors
    # model2 <- stan_glm(Y ~ Condition, data = dat, refresh = 0)
    # bayes <- parameters::parameters(model2)$Median

    # Bayesian with Priors
    model3 <- stan_glm(Y ~ Condition,
      data = dat,
      refresh = 0,
      prior = normal(fixed[1]),
      prior_intercept = normal(fixed[2])
    )
    priors <- parameters::parameters(model3)$Median

    individual_model_data <- rbind(
      individual_model_data,
      data.frame(
        "Participant" = c(participant, participant),
        "Condition" = c("Baseline", "Manipulation"),
        "Score_IndividualModel" = c(nopriors[1], nopriors[1] + nopriors[2]),
        # "Score_IndividualModel_Bayes" = c(bayes[1], bayes[1] + bayes[2]),
        "Score_IndividualModel_Priors" = c(priors[1], priors[1] + priors[2])
      )
    )
  }

  results <- merge(results, individual_model_data)


  # Clean output ----

  diff <- results %>%
    mutate(
      # Diff_Raw = Score_True - Score_Raw,
      Diff_PopulationModel = Score_True - Score_PopulationModel,
      Diff_IndividualModel = Score_True - Score_IndividualModel,
      # Diff_IndividualModel_Bayes = Score_True - Score_IndividualModel_Bayes,
      Diff_IndividualModel_Priors = Score_True - Score_IndividualModel_Priors
    ) %>%
    select(Participant, Condition, starts_with("Diff")) %>%
    pivot_longer(starts_with("Diff"), names_to = "Method", values_to = "Diff") %>%
    mutate(Diff_Abs = abs(Diff))

  diff
}



# Analysis ----------------------------------------------------------------
results <- data.frame()
for(n in seq.int(10, 300, length.out = 10)){
  data <- get_data(n_participants = round(n), n_trials = 20)
  rez <- get_results(data) %>%
    select(-Participant) %>%
    group_by(Condition, Method) %>%
    summarise_all(mean) %>%
    mutate(n_Participants = n,
           Method = as.factor(Method),
           Dataset=paste0("Dataset", round(n, 2)))
  results <- rbind(results, rez)

  print(n) # Print progress
}

# model <- mgcv::gam(Diff_Abs ~ Method + s(n_Participants, by = Method), data = results)
model <- lm(Diff_Abs ~ Method * poly(n_Participants, 3), data = results)

parameters::parameters(model)


contrasts <- modelbased::estimate_contrasts(model) %>%
  arrange(Difference) %>%
  mutate(
    Level1 = stringr::str_remove(Level1, "Diff_"),
    Level2 = stringr::str_remove(Level2, "Diff_")
  ) %>%
  select(Level1, Level2, Difference, CI_low, CI_high, p)




# Visualize results ---------------------------------------------------------
p <- modelbased::estimate_means(model) %>%
  arrange(Mean) %>%
  mutate(
    Method = stringr::str_remove(Method, "Diff_"),
    Method = factor(Method, levels = Method)
  )  %>%
  ggplot(aes(x = Method, y = Mean, color = Method)) +
  geom_line(aes(group = 1)) +
  geom_pointrange(aes(ymin = CI_low, ymax = CI_high), size = 1) +
  theme_modern() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
  scale_color_material()
ggsave("featured.png", p, width = 10, height = 6, dpi = 450)



p <- modelbased::estimate_relation(model) %>%
  mutate(Method = stringr::str_remove(Method, "Diff_"))  %>%
  ggplot(aes(x = n_Participants, y = Predicted)) +
  geom_point(data=mutate(results, Method = stringr::str_remove(Method, "Diff_")),
             aes(y=Diff_Abs, color = Method)) +
  geom_ribbon(aes(ymin=CI_low, ymax=CI_high, fill=Method), alpha=0.1) +
  geom_line(aes(color = Method), size=1) +
  theme_modern() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
  scale_color_material() +
  scale_fill_material()
ggsave("n_participants.png", p, width = 10, height = 6, dpi = 450)


# Save results ------------------------------------------------------------


d <- list("results" = results, "model" = model, "contrasts" = contrasts)
save(d, file = "data.Rdata")

References

_{You can reference this post as follows:}

_{- Makowski, D. (2020, September 14). How to extract individual scores from repeated measures. Retrieved from https://dominiquemakowski.github.io/post/individual_scores/}

Thanks for reading! Do not hesitate to share this post, and leave a comment below 🤗

🐦 And don’t forget to join me on X @Dom_Makowski