Measuring naturalistic speech comprehension in real time.

Code ↔ Paper

16 matches between paragraphs of the paper and lines of its authors' code, computed by the harvester (lexical-v1). Click a colored paragraph or line to see its counterpart.

The 16 matches · 2 of them tie a paragraph to a whole file without given lines: weak matches, whose lines are not tinted

[1] § Experiment 1 › Results › Characterizing the comprehension decline ↔ experiment_1/analysis/linear_vs_categorical.ipynb, lines 128 to 220 · score 0.73 · curve_fit, sigmoid curve, Sigmoidal model, Linear model, speech rate, predicted · Report a mismatch
[2] § Experiment 1 › Results › Characterizing the comprehension decline ↔ experiment_1/analysis/linear_vs_categorical.ipynb, lines 222 to 268 · score 0.71 · Pearson correlation, sigmoidal model, linear model, Wilcoxon, fold, predicted · Report a mismatch
[3] § Experiment 1 › Results ↔ experiment_1/supplamentary/analysis/supplamentary_analysis.Rmd, lines 659 to 733 · score 0.59 · random slopes, digit span score, noise scores, comprehension score, regression, model · Report a mismatch
[4] § Experiment 3 › Results ↔ experiment_1/supplamentary/analysis/supplamentary_analysis.Rmd, lines 659 to 733 · score 0.59 · random slopes, digit span score, noise scores, comprehension score, regression, model · Report a mismatch
[5] § Experiment 1 › Results ↔ experiment_1/analysis/data_analysis.Rmd, lines 1359 to 1429 · score 0.59 · random slopes, digit span score, noise scores, comprehension score, regression, model · Report a mismatch
[6] § Experiment 3 › Results ↔ experiment_1/analysis/data_analysis.Rmd, lines 1359 to 1429 · score 0.59 · random slopes, digit span score, noise scores, comprehension score, regression, model · Report a mismatch
[7] § Experiment 1 › Results › Quantifying summary performance ↔ experiment_1/analysis/semantic_similarity.ipynb, lines 482 to 550 · score 0.58 · GloVe Heard Segment, summary word, dictionary, embedding, cosine, semantic · Report a mismatch
[8] § Experiment 1 › Results › Characterizing the comprehension decline ↔ experiment_1/analysis/linear_vs_categorical.ipynb, lines 128 to 220 · score 0.58 · sigmoidal models predicting, linear model, Folds, fit, speech rate · Report a mismatch
[9] § Experiment 1 › Speech comprehension measures › Real-time speech comprehension measure ↔ experiment_1/experiment_files/lib/psychojs-2023.2.3.iife.js, the whole file · a weak match · score 0.55 · minimizing, compatibility, head, tools, max, segments · Report a mismatch
[10] § Experiment 1 › Speech comprehension measures › Real-time speech comprehension measure ↔ experiment_1/experiment_files/lib/psychojs-2023.2.3.js, the whole file · a weak match · score 0.55 · minimizing, compatibility, head, tools, max, segments · Report a mismatch
[11] § Experiment 1 › Speech comprehension measures › Post-hoc comprehension measures › Summary task ↔ experiment_1/analysis/semantic_similarity.ipynb, lines 368 to 444 · score 0.55 · summary word, GLoVe, Written Summary, embedding, cosine, summed · Report a mismatch
[12] § Experiment 2 › Methods › Participants ↔ experiment_2/analysis/exp2_data_analysis.Rmd, lines 506 to 539 · score 0.55 · standard deviations, slider movements, outliers · Report a mismatch
[13] § Experiment 2 › Methods › Participants ↔ experiment_1/analysis/data_analysis.Rmd, lines 552 to 583 · score 0.54 · standard deviations, slider movements, outliers · Report a mismatch
[14] § Experiment 2 › Results › Slider scores ↔ experiment_2/analysis/exp2_data_analysis.Rmd, lines 555 to 571 · score 0.51 · pairwise comparisons, Tukey, intercepts, slider responses, fit, digit · Report a mismatch
[15] § Experiment 1 › Results › Validating the slider measure ↔ experiment_1/supplamentary/analysis/supplamentary_analysis.Rmd, lines 1892 to 1953 · score 0.50 · confidence intervals, Regression coefficient, speech rate, slider · Report a mismatch
[16] § Experiment 1 › Results › Validating the slider measure ↔ experiment_1/analysis/data_analysis.Rmd, lines 1556 to 1614 · score 0.50 · confidence intervals, Regression coefficient, speech rate · Report a mismatch

Paper

Loaded from Europe PMC by your browser; OSCR does not store it: doi.org · Europe PMC

The paper is loaded when this pane is shown.

The paper is loaded by your browser, with JavaScript: read it at doi.org or on Europe PMC.

The authors' code

R Markdown · 1,686 lines · 59 KB · no license · 4 matches

---
title: "Measuring Naturalistic Speech Comprehension in Real Time"
output: html_document
---
# DATA WRANGLING
```{r setup, echo=FALSE, message=FALSE, warning=FALSE}
# Load libraries
library(stringi)
library(lme4)
library(MuMIn)
library(stringr)
library(fs)
library(readxl)
library(readr)
library(simr)
library(lmerTest)
library(patchwork)
library(RColorBrewer)
library(cowplot)
library(scales)
library(gridExtra)
library(PerformanceAnalytics)
library(corrplot)
library(Hmisc)
library(GGally)
library(visreg)
library(broom.mixed)
library(sjPlot)
library(gridExtra)
library(grid)
library(rempsyc)
library(flextable)
library(officer)
library(ggsignif)
library(MuMIn)
library(rstatix)
library(caret)
library(modelr)
library(tidyr)
library(purrr)
library(broom)
library(dplyr)
library(ggplot2)
library(rsample)
library(corrplot)
# set the default ggplot theme
theme_set(theme_classic())
```
```{r}
# Set path and participant ids
# Change the folder path to data folder relative to the wd
folder_path <- '/Users/irmakergin/Desktop/measuring_naturalistic_speech_comprehension_2024/data/raw_data'
# Define the list of participant IDs
participant_ids <- c("p_1","p_2","p_3","p_4","p_5", "p_6", "p_7", "p_8", "p_9","p_10",
"p_11", "p_12", "p_13", "p_14","p_15","p_16","p_17","p_18","p_19","p_20",
"p_21", "p_22", "p_23", "p_24","p_25","p_26","p_27","p_28","p_29","p_30")
```
```{r, echo=FALSE, message=FALSE, warning=FALSE}
# Organize the data csv files
# Get a list of all files in the folder
files <- dir(folder_path, full.names = TRUE)
# Set a path to save the organized files
organized_data_path<-"/Users/irmakergin/Desktop/measuring_naturalistic_speech_comprehension_2024/data/organized_data"
# Find files by participant ID
for(part_id in participant_ids) {
# Match the slider files that involve the participant ID
slider_pattern <- paste0("slider_", part_id, ".*\\.csv$")
# Match data (csv) files that start with the participant ID
additional_csv_pattern <- paste0("^", part_id, "_.*\\.csv$")
# Find slider files that match the pattern
slider_matched_files <- files[str_detect(basename(files), slider_pattern)]
# Find data CSV files that match the pattern
additional_csv_matched_files <- files[str_detect(basename(files),
additional_csv_pattern)]
# Create a directory for the current participant on the organized data path
participant_folder <- file.path(organized_data_path, part_id)
if(!dir.exists(participant_folder)) {
dir.create(participant_folder, recursive = TRUE, showWarnings = TRUE)
}
# Create a subdirectory for slider files within the participant folder
slider_folder <- file.path(participant_folder, paste0("slider_", part_id))
if(!dir.exists(slider_folder)) {
dir.create(slider_folder, recursive = TRUE, showWarnings = TRUE)
}
# Move slider matched files to the slider subfolder
if(length(slider_matched_files) > 0) {
for(file in slider_matched_files) {
file_copy(file, file.path(slider_folder, basename(file)), overwrite = TRUE)
}
}
# Move additional CSV matched files (experiment data) to the main participant folder
# and rename the participant folders
if(length(additional_csv_matched_files) > 0) {
# Loop to rename the file during the copy process
for(file in additional_csv_matched_files) {
# New filename with '_raw_data'
new_name <- paste0(part_id, "_raw_data.csv")
# Copy and rename the file to the new name in the participant folder
file_copy(file, file.path(participant_folder, new_name), overwrite = TRUE)
}
}
# check
if(length(slider_matched_files) > 0 || length(additional_csv_matched_files) > 0) {
cat("Files for participant ID '", part_id,
"' have been organized successfully. Slider files in: ", slider_folder,
", other CSVs in: ", participant_folder, "\n")
} else {
cat("No files found for participant ID '", part_id, "'.\n")
}
}
# Commented out because they are already there
# # Put excel files (of digit in noise and digit span) in the organized data folder
#
#source_folder<-"/Users/irmakergin/Desktop/measuring_naturalistic_speech_comprehension_2024/data"
# destination_folder<-"/Users/irmakergin/Desktop/measuring_naturalistic_speech_comprehension_2024/data/organized_data"
#
# List all Excel files in the source folder
#excel_files <- dir_ls(path = source_folder, glob = "*.xlsx")
# Copy each Excel file to the destination folder- commented out to re-run
#for (file_path in excel_files) {
#dest_file_path <- file.path(destination_folder)
#file_copy(file_path, dest_file_path)
# # Check
# cat("Copied:", file_path, "to", dest_file_path, "\n")
#}
# Loop through each participant ID
for (part_id in participant_ids) {
# Define the path to the participant's raw data CSV
raw_data_path <- file.path(organized_data_path,
part_id,
paste0(part_id, "_raw_data.csv"))
# Read the CSV for each participant
if (file.exists(raw_data_path)) {
df.raw <- read_csv(raw_data_path) %>%
filter(!wav_file %in% c("Someday_trial_condition.wav",
"Someday_trial_condition-5x.wav")) %>%
mutate(index = row_number()) %>%
select(index, participant, wav_file, old_name, segment_text, question,
C1, C2, C3, C4, C_correct, duration,
A.numClicks, B.numClicks, C.numClicks, D.numClicks, slider.response,
summary, `textbox.text`) %>%
group_by(wav_file) %>%
summarise(
index = first(index),
participant = first(participant),
old_name = first(old_name),
segment_text = first(segment_text),
question = first(question),
C1 = first(C1),
C2 = first(C2),
C3 = first(C3),
C4 = first(C4),
C_correct = first(C_correct),
duration = first(duration),
summary = first(summary),
textbox.text = first(textbox.text),
A.numClicks = max(A.numClicks, na.rm = TRUE),
B.numClicks = max(B.numClicks, na.rm = TRUE),
C.numClicks = max(C.numClicks, na.rm = TRUE),
D.numClicks = max(D.numClicks, na.rm = TRUE),
likert_response = max(slider.response, na.rm = TRUE),
.groups = 'drop'
) %>%
arrange(index) %>%
mutate(index = row_number())
# Fill NA values in participant_id column with part_id for participant p_3
if (part_id == "p_3") {
df.raw <- df.raw %>%
mutate(participant = replace_na(participant, part_id))
}
if (part_id == "p_1") {
df.raw <- df.raw %>%
mutate(participant = replace_na(participant, part_id))
}
if (part_id == "p_2") {
df.raw <- df.raw %>%
mutate(participant = replace_na(participant, part_id))
}
if (part_id == "p_14") {
df.raw <- df.raw %>%
mutate(participant = replace_na(participant, part_id))
}
if (part_id == "p_13") {
df.raw <- df.raw %>%
mutate(participant = replace_na(participant, part_id))
}
if (part_id == "p_26") {
df.raw <- df.raw %>%
mutate(participant = replace_na(participant, part_id))
}
# Remove the extra last row from df.raw
df.raw <- head(df.raw, n = -1)
#Assign processed data of each participant to a new df
assign(paste0("df.raw.merged_", part_id), df.raw, envir = .GlobalEnv)
}
}
```
```{r}
# Merge all participant dfs into one df
# Create an empty data frame to store merged data
df.raw <- data.frame()
# Loop through each participant ID and merge their df
for (part_id in participant_ids) {
# Construct the name of the data frame variable
df_name <- paste0("df.raw.merged_", part_id)
# Check if the data frame exists in the global environment
if (exists(df_name, envir = .GlobalEnv)) {
# Get the data frame from its name
df_participant <- get(df_name, envir = .GlobalEnv)
# Merge the data frame with the main merged data frame
df.raw <- rbind(df.raw, df_participant)
}
}
```
```{r}
# Add accuracy columns for multiple choice questions
# Calculate the multiple choice accuracy
df.raw<- df.raw %>%
mutate(
multiple_choice_accuracy = apply(., 1, function(row) {
# Extract the first character from C_correct - it is the correct letter to click on
correct_answer <- substr(row[["C_correct"]], 1, 1)
# Determine which of the click columns matches the correct answer
clicked_column <- ifelse(row[["A.numClicks"]] == 1, "A",
ifelse(row[["B.numClicks"]] == 1, "B",
ifelse(row[["C.numClicks"]] == 1, "C",
ifelse(row[["D.numClicks"]] == 1, "D", NA))))
# Return 1 if the clicked column matches the correct answer, 0 otherwise
if (!is.na(clicked_column) && clicked_column == correct_answer) {
return(1)
} else {
return(0)
}
})
)
# Change the column the order
df.raw<- df.raw[c("index", "participant", "wav_file", "old_name",
"duration","segment_text",
"question", "C1", "C2", "C3", "C4", "C_correct",
"A.numClicks", "B.numClicks", "C.numClicks",
"D.numClicks", "multiple_choice_accuracy",
"likert_response", "summary","textbox.text")]
```
```{r}
# Extract the speech rate information from the trial name and create a speech_rate column
df.raw<- df.raw %>%
mutate(speech_rate = case_when(
str_detect(wav_file, "2x") ~ 2,
str_detect(wav_file, "3x") ~ 3,
str_detect(wav_file, "4x") ~ 4,
str_detect(wav_file, "5x") ~ 5,
TRUE ~ 1 # not sped up if there are no numbers + x in the name
))
```
```{r}
# Add the Digit Span (working memory) scores of each participant
# Create an empty digit_span_score column
df.raw$digit_span_score <- NA
for (part_id in unique(df.raw$participant)) {
# Construct the filename based on the participant ID
filename <- paste0(organized_data_path, "/digit_span_", part_id, ".xlsx")
# Check if the file exists
if (file.exists(filename)) {
# Correctly read the file using read_excel
digit_span_data <- read_excel(filename)
# The score is located in the first row of the 'score' column
score <- digit_span_data$score[1]
df.raw<- df.raw%>%
mutate(digit_span_score = ifelse(participant == part_id, score, digit_span_score))
} else {
cat("File not found for participant", part_id, "\n")
}
}
```
```{r}
# Add the hearWHO (digit-in-noise task for hearing in noise) scores of each participants
hearwho_pilot_data <- read_excel(paste0(organized_data_path,
"/hearwho_experiment.xlsx"))
# Excel file has columns named 'participant' and 'score'
# Merge the scores into df.raw based on participant ID
df.raw <- merge(df.raw, hearwho_pilot_data[, c("participant", "score")],
by.x = "participant", by.y = "participant", all.x = TRUE)
# Rename the 'score' column to 'digit_in_noise_score'
names(df.raw)[names(df.raw) == "score"] <- "digit_in_noise_score"
```
```{r}
# Add slider values and time points
# Check if the 'slider_values' column exists, if not, create it
if (!"slider_values" %in% names(df.raw)) {
df.raw$slider_values <- NA
}
# Check if the 'slider_time' column exists, if not, create it
if (!"slider_time" %in% names(df.raw)) {
df.raw$slider_time <- NA
}
# Define a function to extract and return slider values and time as strings
get_slider_values_and_time <- function(wav_file_name, part_id) {
# Extract the trial number from wav_file name
matches <- regmatches(wav_file_name, regexec("Someday_([0-9]+)", wav_file_name))
if (length(matches[[1]]) < 2) { # If no match or match does not have a capture group
return(list(values = NA, time = NA))
}
trial_number <- matches[[1]][2]
# Construct the path to the slider file
slider_file_path <- sprintf("%s/%s/slider_%s/slider_%s_001_Someday_%s_condition*.csv",
organized_data_path,
part_id, part_id, part_id,
trial_number)
# Find slider files matching the pattern
slider_files <- Sys.glob(slider_file_path)
if (length(slider_files) == 0) {
return(list(values = NA, time = NA)) # if no matching file found
}
slider_data <- read.csv(slider_files[1], skip = 1)
# Prepare output for values
slider_values_str <- if ("value" %in% colnames(slider_data)) {
paste(slider_data$value, collapse = ",")
} else {
NA
}
# Prepare output for time
slider_time_str <- if ("time" %in% colnames(slider_data)) {
rounded_times <- round(slider_data$time, 2)
paste(rounded_times, collapse = ",")
} else {
NA
}
return(list(values = slider_values_str, time = slider_time_str))
}
# Apply the function to each row of df.raw and extract results into separate columns
slider_info <- mapply(get_slider_values_and_time,
df.raw$wav_file,
df.raw$participant,
SIMPLIFY = FALSE) # Ensure output is a list
# Assign values and time from the list output to respective columns
df.raw$slider_values <- sapply(slider_info, '[[', "values")
df.raw$slider_time <- sapply(slider_info, '[[', "time")
```
```{r}
# Re-scale slider values to be between 0-1
# Convert slider_values from string to numeric lists
df.raw$slider_values <- strsplit(as.character(df.raw$slider_values),
",\\s*")
df.raw$slider_values <- lapply(df.raw$slider_values,
function(x) as.numeric(x))
rescale_values <- function(values) {
sapply(values, function(x) x / 255)
}
# Apply the rescaling function to each row's slider_values
df.raw$slider_values_rescaled <- lapply(df.raw$slider_values,
rescale_values)
```
```{r}
# Create a column showing number of slider values
df.raw <- df.raw %>%
mutate(slider_values_number = lengths(slider_values_rescaled))
```
```{r}
# Rescale the 10-point-scale values to be between 0-1
df.raw <- df.raw %>%
mutate(likert_rescaled = likert_response / 10)
```
## Calculations for the data exclusion criteria
For the post-hoc comprehension measures, to ensure that we are validating the novel measure against actual comprehension, following exclusion criteria will be applied:
### 1. Absolute threshold for comprehension
75% correctness on the multiple choice questions for the slowest (easiest to comprehend) speech rate.
```{r}
# Find trials that do not have a number right before .wav in the wav_file column
# (slowest condition)
attention_check_trials <- df.raw %>%
filter(!grepl("x\\.wav$", wav_file))
# Calculate the accuracy
accuracy_results <- attention_check_trials %>%
group_by(participant) %>%
summarise(
accuracy = mean(multiple_choice_accuracy == 1, na.rm = TRUE),
n = n()
) %>%
mutate(passed = if_else(accuracy >= 0.75, TRUE, FALSE))
# Print out participants who passed or failed
passed_participants <- accuracy_results %>%
filter(passed) %>%
pull(participant)
failed_participants <- accuracy_results %>%
filter(!passed) %>%
select(participant, accuracy)
if(length(passed_participants) > 0) {
cat(paste(passed_participants, collapse = ", "),
"passed the question accuracy criterion\n")
}
if(nrow(failed_participants) > 0) {
cat(paste(failed_participants$participant, "with accuracy:", failed_participants$accuracy, collapse = ", "),
"failed the question accuracy criterion\n")
}
```
#### Figure: failed vs accepted participants
```{r figure-size, fig.width=6, fig.height=4}
# Histogram with all participants accuracies for speech rate 1
p_mult <- ggplot(accuracy_results, aes(x = accuracy)) +
geom_histogram(binwidth = 0.04, fill = "violetred", alpha = 0.7, color = "black") +
labs(title = "All Participants' Multiple Choice Question Accuracy for Speech Rate x1",
x = "Accuracy",
y = "Number of Participants")
# Failed vs passed
p_mult +
geom_histogram(data = failed_participants, aes(x = accuracy),
binwidth = 0.04, fill = "pink", alpha = 0.7, color = "black") +
labs(title = "",
x = "Accuracy",
y = "Number of Participants") +
scale_x_continuous(breaks = c(0.6, 0.8, 1), labels= c('0.6', '0.8', '1')) +
theme(axis.title.x = element_text(size = 14),
axis.title.y = element_text(size = 14),
plot.title = element_text(hjust = 0.5, size = 15, margin = margin(b = 40)), =
axis.text = element_text(size = 12))
```
### 2. Ratings on the 10-point scale
They should be significantly different for the slowest and fastest speech rates.
```{r}
# t-test
participants <- unique(df.raw$participant)
# Create a vector to store results
rating_criteria_results <- character(length(participants))
# Loop through each participant
for (i in seq_along(participants)) {
part_id <- participants[i]
# Subset data for the current participant for slowest and fastest speech rates
subset_data <- df.raw %>%
filter(participant == part_id & (speech_rate == 1 | speech_rate == 4)) %>%
select(likert_response, speech_rate)
# Perform a t-test comparing likert_response for speech_rate 1 vs 4
test_result <- t.test(likert_response ~ speech_rate, data = subset_data)
# Check if the difference is significant (p-value < 0.05)
if (test_result$p.value < 0.05) {
rating_criteria_results[i] <- paste(part_id, "passed the rating criterion")
} else {
rating_criteria_results[i] <- paste(part_id, "failed the rating criterion")
}
}
# Print the results
cat(rating_criteria_results, sep = "\n")
```
### 3. Summaries
Participants shouldn't leave all summaries empty
```{r}
# If all rows under textbox.tex are empty
# Check if all 'textbox.text' entries are empty or NA for each participant
summary_criterion <- df.raw %>%
group_by(participant) %>%
summarise(all_empty = all(textbox.text == "" | is.na(textbox.text))) %>%
ungroup()
# Print the results for participants where all textbox.text are empty
summary_criterion %>%
filter(all_empty) %>%
pull(participant) %>%
walk(~ cat(.x, "failed summary criterion\n"))
# Print the results for participants where not all textbox.text are empty
summary_criterion %>%
filter(!all_empty) %>%
pull(participant) %>%
walk(~ cat(.x, "passed summary criterion\n"))
```
### 4. Slider movements
For the physical slider to ensure that participants actually used it actively: Distribution of the amount of slider movements across trials and participants- If a participant's slider movements exceeds ±3.5 standard deviations from the mean, we will remove those participants' data.
```{r}
# Calculate movement score with magnitude for each trial
df.raw <- df.raw %>%
rowwise() %>%
mutate(trial_movement_score_magnitude =
ifelse(slider_values[[1]][1] == 0, sum(abs(diff(unlist(slider_values)))), NA))
# Aggregate these scores for each participant
participant_movement_scores <- df.raw %>%
group_by(participant) %>%
summarise(movement_score_all = sum(trial_movement_score_magnitude, na.rm = TRUE))
# Add the movement scores back to the df
df.raw <- left_join(df.raw, participant_movement_scores, by = "participant")
# Calculate mean and standard deviation for movement scores, identify outliers
mean_movement_score <- mean(participant_movement_scores$movement_score_all, na.rm = TRUE)
sd_movement_score <- sd(participant_movement_scores$movement_score_all, na.rm = TRUE)
cutoff_upper <- mean_movement_score + 3.5 * sd_movement_score
cutoff_lower <- mean_movement_score - 3.5 * sd_movement_score
outliers <- participant_movement_scores %>%
filter(movement_score_all < cutoff_lower | movement_score_all > cutoff_upper) %>%
pull(participant)
# Print participant IDs for those outside the ±3.5 SD range
cat("Participants outside the ±3.5 SD range:", paste(outliers, collapse = ", "), "\n")
```
### Remove the participants that failed the criteria.
p_12, p_16, p_2, p_20, p_23, p_26, p_27, p_6 failed the question accuracy criterion.
```{r}
# Remove failed participants
df.raw_success <- df.raw %>%
filter(participant != "p_12")
df.raw_success <- df.raw_success %>%
filter(participant != "p_16")
df.raw_success <- df.raw_success %>%
filter(participant != "p_2")
df.raw_success <- df.raw_success %>%
filter(participant != "p_20")
df.raw_success <- df.raw_success %>%
filter(participant != "p_23")
df.raw_success <- df.raw_success %>%
filter(participant != "p_26")
df.raw_success <- df.raw_success %>%
filter(participant != "p_27")
df.raw_success <- df.raw_success %>%
filter(participant != "p_6")
# check
count(df.raw_success, participant)
```
## Save the df
```{r}
# Convert list to string for slider values
df.raw_success$slider_values <- sapply(df.raw_success$slider_values,
function(x) paste(x, collapse = ","))
output_file_path <- file.path(organized_data_path, "organized_data.csv")
write.csv(df.raw_success, output_file_path, row.names = FALSE)
```
# ANALYSIS
Typos in the summaries participants wrote are corrected first using this code and then manually: *analysis/correct_typos.ipynb*
Semantic similarity between the summaries participants wrote and segments they heard in each trial are calculated using the code in: *analysis/semantic_similarity.ipynb*
data file with semantic similarity scores are in: *data/organized_data/df_semantic.csv*
```{r}
# upload data after semantic similarity calculations
df.data <- read.csv(file.path(organized_data_path, "df_semantic.csv"))
```
```{r}
# Calculate median trial movements for each trial
df.data <- df.data %>%
mutate(
slider_values_numeric = str_split(slider_values_rescaled, ",") %>%
map(~ as.numeric(.x))
)
# Mean and median slider values for each trial
df.data <- df.data %>%
rowwise() %>%
mutate(trial_mean_rescaled = mean(unlist(slider_values_numeric), na.rm = TRUE),
trial_median_rescaled = median(unlist(slider_values_numeric), na.rm = TRUE)) %>%
ungroup()
```
## I. Semantic Similarity
### Average word cound per second for each speech rate
```{r}
# per-trial word counts and words/min
df_wpm <- df.data %>%
mutate(
text_chr = as.character(segment_text),
word_count = if_else(
is.na(text_chr) | stri_trim_both(text_chr) == "",
0L,
lengths(stri_extract_all_words(text_chr))
),
wpm = if_else(duration > 0, 60 * word_count / duration, NA_real_) # words per minute
)
# summaries by speech_rate (both unweighted and duration-weighted)
wpm_by_rate <- df_wpm %>%
group_by(speech_rate) %>%
summarise(
mean_wpm_unweighted = mean(wpm, na.rm = TRUE),
sd_wpm_unweighted = sd(wpm, na.rm = TRUE),
mean_wpm_weighted = 60 * sum(word_count, na.rm = TRUE) / sum(duration, na.rm = TRUE),
n_trials = sum(!is.na(wpm)),
.groups = "drop"
) %>%
mutate(across(c(mean_wpm_unweighted, sd_wpm_unweighted, mean_wpm_weighted), ~ round(., 2)))
wpm_by_rate
```
Which semantic similarity analysis explains comprehension better?
### Visualization
First, let's visualize all 3 to see if they show the same pattern:
```{r figure-size, fig.width=9, fig.height=5}
# GloVe - Written Summary
average_similarity_summary <- df.data %>%
group_by(speech_rate) %>%
summarise(
average_similarity = mean(glove_sum_max_similarity_rescaled, na.rm = TRUE),
sd = sd(glove_sum_max_similarity_rescaled, na.rm = TRUE),
n = n(),
se = sd / sqrt(n) # standard error
)
# GloVe - Heard Segment
average_similarity_text <- df.data %>%
group_by(speech_rate) %>%
summarise(
average_similarity = mean(glove_text_average_max_similarity, na.rm = TRUE),
sd = sd(glove_text_average_max_similarity, na.rm = TRUE),
n = n(),
se = sd / sqrt(n) # standard error
)
# BERT
average_similarity_bert <- df.data %>%
group_by(speech_rate) %>%
summarise(
average_similarity = mean(bert_cosine_similarity, na.rm = TRUE),
sd = sd(bert_cosine_similarity, na.rm = TRUE),
n = n(),
se = sd / sqrt(n) # standard error
)
# Create the plots without x and y labels
plot_glove_summary <- ggplot(average_similarity_summary, aes(x = factor(speech_rate),
y = average_similarity,
fill = as.factor(speech_rate))) +
geom_bar(stat = "identity", position = "dodge", width = 0.7, fill = "green3") +
scale_x_discrete(labels = function(x) paste0("x ", x)) +
labs(x = NULL, y= NULL,
title = "GloVe- Written Summary") +
geom_text(aes(label = round(average_similarity, 2)),
vjust = -1, position = position_dodge(width = 0.7), size = 3) +
geom_errorbar(aes(ymin = average_similarity - se, ymax = average_similarity + se),
width = 0, position = position_dodge(width = 0.7)) +
theme(axis.title.x = element_text(size = 14),
axis.title.y = element_text(size = 14),
plot.title = element_text(size = 13, hjust = 0.5))
plot_glove_text <- ggplot(average_similarity_text, aes(x = factor(speech_rate),
y = average_similarity,
fill = as.factor(speech_rate))) +
geom_bar(stat = "identity", position = "dodge", width = 0.7, fill = "darkseagreen2") +
scale_x_discrete(labels = function(x) paste0("x ", x)) +
labs(x = NULL, y = NULL,
title = "GloVe - Heard Segment") +
geom_text(aes(label = round(average_similarity, 2)),
vjust = -1, position = position_dodge(width = 0.7), size = 3) +
geom_errorbar(aes(ymin = average_similarity - se, ymax = average_similarity + se),
width = 0,position = position_dodge(width = 0.7)) +
theme(plot.title = element_text(size = 13, hjust = 0.5))
# Adjust the plot for BERT without individual axis labels
plot_bert <- ggplot(average_similarity_bert, aes(x = factor(speech_rate),
y = average_similarity,
fill = as.factor(speech_rate))) +
geom_bar(stat = "identity", position = "dodge", width = 0.7, fill = "darkseagreen3") +
scale_x_discrete(labels = function(x) paste0("x ", x)) +
labs(x = NULL, y = NULL,
title = "BERT") +
geom_text(aes(label = round(average_similarity, 2)),
vjust = -1.2, position = position_dodge(width = 0.7), size = 3) +
geom_errorbar(aes(ymin = average_similarity - se, ymax = average_similarity + se),
width = 0, position = position_dodge(width = 0.7)) +
theme(plot.title = element_text(size = 13, hjust = 0.5))
#put them in a grid
grid.arrange(
arrangeGrob(
plot_glove_summary,plot_glove_text, plot_bert,
ncol = 3,
left = textGrob("Average Normalized Cosine Similarity Value",
rot = 90, vjust = 0.5),
bottom = textGrob("Speech Rate",
rot = 0, vjust = 0.5)
)
)
```
### Correlation
Do 3 different semantic similarity measures correlate with each other?
```{r}
# Subset the relevant columns
semantic_columns <- df.data[, c("bert_cosine_similarity",
"glove_text_average_max_similarity",
"glove_sum_max_similarity_rescaled")]
# Calculate the correlation matrix
correlation_matrix <- cor(semantic_columns, use = "complete.obs")
# Print
print(correlation_matrix)
```
Test if any of these correlations are statistically significant:
```{r}
# Correlation test between BERT and GloVe- Heard Segment
test1 <- cor.test(df.data$bert_cosine_similarity,
df.data$glove_text_average_max_similarity)
# Correlation test between BERT and GloVe- Written Summary
test2 <- cor.test(df.data$bert_cosine_similarity,
df.data$glove_sum_max_similarity_rescaled)
# Correlation test between GloVe- Heard Segment & GloVe- Written Summary
test3 <- cor.test(df.data$glove_text_average_max_similarity,
df.data$glove_sum_max_similarity_rescaled)
print(test1)
print(test2)
print(test3)
```
### Comparison
Which semantic similarity analysis method explains the most varience in comprehension?
To see which if semantic similarity scores explains variance in comprehension better than the others,we conducted a linear mixed model was conducted to predict the 10-Point Scale responses based on BERT, GloVe- Written Summary, and GloVe- Heard Segment. Random effects for digit span score and digit in noise score were included in the model.
```{r}
model_all<- lmer(likert_rescaled ~
bert_cosine_similarity + glove_text_average_max_similarity +
glove_sum_max_similarity_rescaled +
(1 | digit_span_score) +
(1 | digit_in_noise_score), data = df.data)
#model_compare <- anova(model_g1, model_all)
summary(model_all)
```
All fixed effects (different sem similarity scores) are significant, they are finding independent variance, interestingly. Glove- Written Summary has the highest t value and estimate. Therefore, I will use/ report the GLoVe- written summary Segment for the rest of the analyses.
### Speech Rate
Are semantic similarity scores btw speech rates sig different from each other?
#### Glove- Written Summary
```{r}
semantic.anova <- aov(glove_sum_max_similarity_rescaled ~ speech_rate, data = df.data)
summary(semantic.anova)
pairwise_results <- df.data %>% pairwise_t_test(
glove_sum_max_similarity_rescaled ~ speech_rate, pool.sd = FALSE,
p.adjust.method = "bonferroni"
)
pairwise_results
```
All significant except x1-x2
#### Glove- Heard Segment
```{r}
semantic.anova2 <- aov(glove_text_average_max_similarity ~ speech_rate, data = df.data)
summary(semantic.anova2)
pairwise_results2 <- df.data %>% pairwise_t_test(
glove_text_average_max_similarity ~ speech_rate, pool.sd = FALSE,
p.adjust.method = "bonferroni"
)
pairwise_results2
```
All significant except x1-x2 & x2-x3
#### BERT
```{r}
semantic.anova3 <- aov(bert_cosine_similarity ~ speech_rate, data = df.data)
summary(semantic.anova3)
pairwise_results3 <- df.data %>% pairwise_t_test(
bert_cosine_similarity ~ speech_rate, pool.sd = FALSE,
p.adjust.method = "bonferroni"
)
pairwise_results3
```
All significant except except x2-x3
### Recency Effect
Is there a recency effect in summaries that participants wrote?
#### Glove- Written Summary
```{r}
# First, make sure that the right ones are NA, right now NAs are also 0
df.data <- df.data %>%
mutate(
rescaled_glove_bin1 = ifelse(textbox.text_corrected_manual == "",
NA, rescaled_glove_bin1),
rescaled_glove_bin2 = ifelse(textbox.text_corrected_manual == "",
NA, rescaled_glove_bin2),
rescaled_glove_bin3 = ifelse(textbox.text_corrected_manual == "",
NA, rescaled_glove_bin3),
rescaled_glove_bin4 = ifelse(textbox.text_corrected_manual == "",
NA, rescaled_glove_bin4),
rescaled_glove_bin5 = ifelse(textbox.text_corrected_manual == "",
NA, rescaled_glove_bin5)
)
# Create a long dataset for bins and scores
df.bin <- df.data %>%
select(participant, index, speech_rate, segment_text, textbox.text_corrected_manual,
glove_bin1, glove_bin2, glove_bin3, glove_bin4, glove_bin5) %>%
pivot_longer(cols = starts_with("glove_bin"),
names_to = "bin",
names_prefix = "glove_bin",
values_to = "semantic_score") %>%
mutate(bin = as.integer(bin)) %>%
arrange(participant, index, bin)
# If a recency effect -> latter bins should be recalled better than earlier ones
binned.anova <- aov(semantic_score ~ speech_rate * bin, data = df.bin)
summary(binned.anova)
df.bin_factor = df.bin %>%
mutate(speech_bin = factor(paste(speech_rate, bin, sep="_")))
# pairwise comparison
df.bin_factor %>% pairwise_t_test(
semantic_score ~ speech_bin, pool.sd = FALSE,
p.adjust.method = "bonferroni"
)
```
#### Glove- Heard Segment
```{r}
# First, make sure that the right ones are NA, right now NAs are also 0
df.data <- df.data %>%
mutate(
glove2_bin1 = ifelse(textbox.text_corrected_manual == "", NA, glove2_bin1),
glove2_bin2 = ifelse(textbox.text_corrected_manual == "", NA, glove2_bin2),
glove2_bin3 = ifelse(textbox.text_corrected_manual == "", NA, glove2_bin3),
glove2_bin4 = ifelse(textbox.text_corrected_manual == "", NA, glove2_bin4),
glove2_bin5 = ifelse(textbox.text_corrected_manual == "", NA, glove2_bin5)
)
# Create a long dataset for bins and scores
df.bin_glove2 <- df.data %>%
select(participant, index, speech_rate, segment_text, textbox.text_corrected_manual,
glove2_bin1, glove2_bin2, glove2_bin3, glove2_bin4, glove2_bin5) %>%
pivot_longer(cols = starts_with("glove2_bin"),
names_to = "bin",
names_prefix = "glove2_bin",
values_to = "glove2_score") %>%
mutate(bin = as.integer(bin)) %>%
arrange(participant, index, bin)
# If a recency effect -> latter bins should be recalled better than earlier ones
binned.anova2 <- aov(glove2_score ~ speech_rate * bin, data = df.bin_glove2)
summary(binned.anova2)
df.bin_factor = df.bin_glove2 %>%
mutate(speech_bin = factor(paste(speech_rate, bin, sep="_")))
# pairwise comparison
df.bin_factor %>% pairwise_t_test(
glove2_score ~ speech_bin, pool.sd = FALSE,
p.adjust.method = "bonferroni"
)
```
#### BERT
```{r}
# Create a long dataset for bins and scores for BERT
df.bin_bert <- df.data %>%
select(participant, index, speech_rate, segment_text, textbox.text_corrected_manual,
cosine_similarity_bin1,
cosine_similarity_bin2,
cosine_similarity_bin3,
cosine_similarity_bin4,
cosine_similarity_bin5) %>%
pivot_longer(cols = starts_with("cosine_similarity_bin"),
names_to = "bin",
names_prefix = "cosine_similarity_bin",
values_to = "bert_score") %>%
mutate(bin = as.integer(bin)) %>%
arrange(participant, index, bin)
binned.anova_bert <- aov(bert_score ~ speech_rate * bin, data = df.bin_bert)
summary(binned.anova_bert)
df.bin_bert_factor = df.bin_bert %>%
mutate(speech_bin = factor(paste(speech_rate, bin, sep="_")))
# pairwise comparison
df.bin_bert_factor %>% pairwise_t_test(
bert_score ~ speech_bin, pool.sd = FALSE,
p.adjust.method = "bonferroni"
)
```
There is a main effect of Speech Rate for all 3, main effect of binning (recency) only for GloVe- Heard Summary & BERT.
## II. Validation
Can we predict the scores of our novel comprehension measure from the existing post-hoc comprehension measures?
### Correlation between comprehension measures
```{r}
vars <- c("trial_median_rescaled",
"glove_sum_max_similarity_rescaled",
"likert_rescaled",
"multiple_choice_accuracy")
# <-- rename map to match your visreg wording
labs <- c(
trial_median_rescaled = "Real-Time Comprehension",
glove_sum_max_similarity_rescaled = "Semantic Similarity",
likert_rescaled = "10-Point Scale",
multiple_choice_accuracy = "Multiple Choice"
)
X <- df.data[, vars]
rc_p <- rcorr(as.matrix(X), type = "pearson")
# apply pretty labels to matrices
R <- rc_p$r; P <- rc_p$P
dimnames(R) <- lapply(dimnames(R), function(nm) unname(labs[nm]))
dimnames(P) <- lapply(dimnames(P), function(nm) unname(labs[nm]))
# tidy pairwise table with pretty names
pairs_tbl <- (\(R, P) {
nm <- colnames(R)
out <- do.call(rbind, lapply(1:(ncol(R)-1), function(i)
do.call(rbind, lapply((i+1):ncol(R), function(j)
data.frame(var1 = nm[i], var2 = nm[j], r = R[i,j], p = P[i,j])
))
))
out[order(abs(out$r), decreasing = TRUE), ]
})(R, P) %>%
mutate(r = round(r, 2),
p = signif(p,4))
pairs_tbl
```
```{r}
# palette: purple (-1) → white (0) → green (+1)
pal_pg <- colorRampPalette(c("#6A00A8", "#F7F7F7", "#10B981"))(200)
corrplot(R,
method = "circle",
type = "upper",
col = pal_pg,
tl.col = "black",
tl.srt = 45,
cl.lim = c(-1, 1),
p.mat = P,
sig.level = c(0.001, 0.01, 0.05),
insig = "label_sig", # prints ***, **, *
pch.cex = 1.2,
pch.col = "black")
```
### Each measure as a fixed effect in seperate models
#### 10-Point Scale Ratings
```{r}
model_likert<- lmer(trial_median_rescaled ~
likert_rescaled +
(1 | digit_span_score) +
(1 | digit_in_noise_score), data = df.data)
summary(model_likert)
```
##### Visualize 10-Point Scale Ratings per Sepeech Speed
```{r figure-size, fig.width=6, fig.height=6 }
# Calculate the average 10-point scale scores per speech_rate category
average_score_likert <- df.data %>%
group_by(speech_rate) %>%
summarise(average_likert = mean(likert_rescaled, na.rm = TRUE),
sd = sd(likert_rescaled, na.rm = TRUE),
n = n(),
se = sd / sqrt(n) # standard error
)
# Plot
likert_plot <- ggplot(average_score_likert, aes(x = factor(speech_rate),
y = average_likert)) +
geom_bar(stat = "identity", width = 0.7, fill = "royalblue") +
labs(x = "Speech Rate", y = "10-Point Scale Response") +
geom_text(aes(label = round(average_likert, 2)), vjust = -0.2, size = 6) +
scale_x_discrete(labels = function(x) paste0("x ", x)) +
geom_errorbar(aes(ymin = average_likert - se, ymax = average_likert + se),
width = 0, position = position_dodge(width = 0.5)) +
scale_y_continuous(breaks = c(0, 0.25, 0.50)) +
theme(axis.title.x = element_text(size = 24),
axis.title.y = element_text(size = 24),
axis.text.x = element_text(size = 20),
axis.text.y = element_text(size = 20))
print(likert_plot)
```
##### variance explained by the fixed effect (partial r2)
The proportion of variance explain uniquely by the predictor relative to total
variance
```{r}
res_likert <- partR2(model_likert,
partvars = "likert_rescaled",
data = df.data,
R2_type = "marginal")
res_likert
res_likert_round <- as.data.frame(res_likert$R2) %>%
mutate(across(where(is.numeric), ~ round(., 2)))
res_likert_round
```
Cohen's f2
```{r}
r2 <- r.squaredGLMM(model_likert)
R2_m <- as.numeric(r2[1])
# Cohen's f^2 for a single fixed effect
f2 <- if (is.finite(R2_m) && R2_m < 1) R2_m / (1 - R2_m) else NA_real_
# Partial R^2 equals Marginal R^2 when there's only one fixed effect
PR2_likert <- R2_m
# Pretty print (2 decimals)
cat(sprintf("Marginal R^2 (fixed effects): %.2f\n", R2_m))
cat(sprintf("Cohen's f^2: %.2f\n", f2))
cat(sprintf("Partial R^2 for likert_rescaled: %.2f\n", PR2_likert))
```
#### Multiple Choice Quesitons
```{r}
model_multiple_choice<- lmer(trial_median_rescaled ~
multiple_choice_accuracy +
(1 | digit_span_score) +
(1 | digit_in_noise_score), data = df.data)
summary(model_multiple_choice)
```
##### Visualize Multiple Choice Quesitons per Speech Rate
```{r figure-size, fig.width=6, fig.height=6 }
# Calculate the average multiple_choice_accuracy scores per speech_rate category
average_scores <- df.data %>%
group_by(speech_rate) %>%
summarise(average_accuracy = mean(multiple_choice_accuracy, na.rm = TRUE),
sd = sd(multiple_choice_accuracy, na.rm = TRUE),
n = n(),
se = sd / sqrt(n) # standard error
)
question_plot <- ggplot(average_scores, aes(x = factor(speech_rate), y = average_accuracy)) +
geom_bar(stat = "identity", width = 0.7, fill = "violetred") +
labs(x = "Speech Rate", y = "Multiple Choice Accuracy") +
geom_text(aes(label = round(average_accuracy, 2)), vjust = -0.5, size = 6) +
scale_x_discrete(labels = function(x) paste0("x ", x)) +
geom_errorbar(aes(ymin = average_accuracy - se, ymax = average_accuracy + se),
width = 0, position = position_dodge(width = 0.5)) +
# Add dashed line at chance level:
geom_hline(yintercept = 0.25, linetype = "dashed", color = "black", size=1.5) +
scale_y_continuous(breaks = c(0, 0.25, 0.5)) +
theme(axis.title.x = element_text(size = 24),
axis.title.y = element_text(size = 24),
axis.text.x = element_text(size = 20),
axis.text.y = element_text(size = 20))
print(question_plot)
```
##### variance explained by the fixed effect (partial r2)
The proportion of variance explain uniquely by the predictor relative to total
variance
```{r}
res_mcq <- partR2(model_multiple_choice,
partvars = "multiple_choice_accuracy",
data = df.data,
R2_type = "marginal")
res_mcq
res_mcq_round <- as.data.frame(res_mcq$R2) %>%
mutate(across(where(is.numeric), ~ round(., 2)))
res_mcq_round
```
Cohen's f2
```{r}
## 1) Marginal R^2 (fixed effects) + Cohen's f^2
r2 <- r.squaredGLMM(model_multiple_choice)
R2_m <- as.numeric(r2[1]) # marginal R^2
f2 <- R2_m / (1 - R2_m) # Cohen's f^2
## 2) Partial R^2 for the single fixed effect (equals marginal R^2)
PR2_mcq <- R2_m
## 3) Standardized beta (ΔSD_y per 1 SD_x)
df.data$y_z <- scale(df.data$trial_median_rescaled)
df.data$x_z <- scale(df.data$multiple_choice_accuracy)
mod_std <- lmer(y_z ~ x_z +
(1 | digit_span_score) +
(1 | digit_in_noise_score),
data = df.data)
beta_std <- fixef(mod_std)["x_z"]
## 4) (Optional) Semi-standardized beta: SD(y) per 1 raw-unit of x
mod_semistd <- lmer(y_z ~ multiple_choice_accuracy +
(1 | digit_span_score) +
(1 | digit_in_noise_score),
data = df.data)
beta_semistd <- fixef(mod_semistd)["multiple_choice_accuracy"]
## Pretty print
cat(sprintf(
"Marginal R^2: %.2f\nCohen's f^2: %.2f\nPartial R^2: %.2f",
R2_m, f2, PR2_mcq
))
```
#### Summary
```{r}
# Summary- GloVe- Written Summary
model_glove1<- lmer(trial_median_rescaled ~
glove_sum_max_similarity_rescaled +
(1 | digit_span_score) +
(1 | digit_in_noise_score), data = df.data)
summary(model_glove1)
```
##### Visualize Semantic Simlarity Scores of Summaries per Speech Rate
```{r figure-size, fig.width=6, fig.height=6}
plot_glove_summary <- ggplot(average_similarity_summary, aes(x = factor(speech_rate),
y = average_similarity,
fill = as.factor(speech_rate))) +
geom_bar(stat = "identity", position = "dodge", width = 0.7, fill = "green3") +
scale_x_discrete(labels = function(x) paste0("x ", x)) +
labs(x = "Speech Rate", y= "Semantic Similarity\nScore") +
geom_text(aes(label = round(average_similarity, 2)),
vjust = -0.5, position = position_dodge(width = 0.7), size = 6) +
geom_errorbar(aes(ymin = average_similarity - se, ymax = average_similarity + se),
width = 0, position = position_dodge(width = 0.7)) +
scale_y_continuous(breaks = c(0, 0.25, 0.5), limits = c(0, 0.5)) +
theme(axis.title.x = element_text(size = 24),
axis.title.y = element_text(size = 24),
axis.text.x = element_text(size = 20),
axis.text.y = element_text(size = 20),
plot.title = element_text(size = 20, hjust = 0.5))
plot_glove_summary
```
##### variance explained by the fixed effect (partial r2)
The proportion of variance explain uniquely by the predictor relative to total
variance
```{r}
res_sem <- partR2(model_glove1,
partvars = "glove_sum_max_similarity_rescaled",
data = df.data,
R2_type = "marginal")
res_sem
res_sem_round <- as.data.frame(res_sem$R2) %>%
mutate(across(where(is.numeric), ~ round(., 2)))
res_sem_round
```
Cohen's f2
```{r}
## 1) Marginal R^2 (fixed effects) + Cohen's f^2
r2 <- r.squaredGLMM(model_glove1)
R2_m <- as.numeric(r2[1]) # marginal R^2
f2 <- R2_m / (1 - R2_m) # Cohen's f^2
## 2) Partial R^2 (same as marginal R^2 with one fixed effect)
PR2_glove <- R2_m
## 3) Standardized beta (ΔSD_y per 1 SD_x)
df.data$y_glove_z <- scale(df.data$trial_median_rescaled)
df.data$x_glove_z <- scale(df.data$glove_sum_max_similarity_rescaled)
mod_std_glove <- lmer(y_glove_z ~ x_glove_z +
(1 | digit_span_score) +
(1 | digit_in_noise_score),
data = df.data)
## print
cat(sprintf(
"Marginal R^2: %.3f\nCohen's f^2: %.3f\nPartial R^2: %.3f",
R2_m, f2, PR2_glove
))
```
### Visualize single fixed effect regression models
```{r figure-size, fig.width=6, fig.height=6 }
visreg_summary <- visreg(model_glove1, "glove_sum_max_similarity_rescaled", gg=TRUE,
line=list(col="green3", size=1.7), points=list(alpha=0.5),
xlab= "Semantic Similarity Score",
ylab= "Predicted Real-Time\nComprehension Score") +
theme(axis.title.x = element_text(size = 24),
axis.title.y = element_text(size = 24),
axis.text.x = element_text(size = 20), # Adjust X-axis tick label size
axis.text.y = element_text(size = 20)) + # Adjust Y-axis tick label size
scale_x_continuous(breaks = c(0, 0.5, 1)) + # Set x-axis ticks at 0, 0.5, 1
scale_y_continuous(breaks = c(0, 0.5, 1))
visreg_likert <- visreg(model_likert, "likert_rescaled", gg=TRUE,
line=list(col="royalblue",size=1.7), points=list(alpha=0.5),
xlab= "10-point Scale Response",
ylab= "") +
theme(axis.title.x = element_text(size = 24),
axis.title.y = element_text(size = 24),
axis.text.x = element_text(size = 20), # Adjust X-axis tick label size
axis.text.y = element_text(size = 20)) + # Adjust Y-axis tick label size
scale_x_continuous(breaks = c(0, 0.5, 1)) + # Force x-axis to include 0, 0.5, 1
scale_y_continuous(breaks = c(0, 0.5, 1))
visreg_multiple <- visreg(model_multiple_choice, "multiple_choice_accuracy", gg=TRUE,
line=list(col="violetred", size=1.7), points=list(alpha=0.5),
xlab= "Multiple Choice Accuracy",
ylab= "") +
theme(axis.title.x = element_text(size = 24),
axis.title.y = element_text(size = 24),
axis.text.x = element_text(size = 20), # Adjust X-axis tick label size
axis.text.y = element_text(size = 20)) + # Adjust Y-axis tick label size
scale_x_continuous(breaks = c(0, 0.5, 1)) + # Set x-axis ticks at 0, 0.5, 1
scale_y_continuous(breaks = c(0, 0.5, 1))
visreg_summary
visreg_likert
visreg_multiple
```
### Visualize regression models + Bar plots
```{r figure-size, fig.width=18, fig.height=14}
# Create a multi-panel plot for
# Create title groups
title1 <- textGrob("Summary", gp=gpar(fontsize=28, color='green3',fontface="bold"))
title2 <- textGrob("10-Point Scale", gp=gpar(fontsize=28, color='royalblue', fontface="bold"))
title3 <- textGrob("Multiple Choice Question", gp=gpar(fontsize=28,color='violetred', fontface="bold"))
combined_plot_effects <- grid.arrange(
title1, title2, title3,
visreg_summary, visreg_likert, visreg_multiple,
plot_glove_summary, likert_plot, question_plot,
ncol = 3,
nrow = 4,
heights = unit.c(unit(4, "null"), unit(8, "null"), unit(2, "null"), unit(8, "null")), # Adjust heights
layout_matrix = rbind(c(1, 2, 3), c(4, 5, 6), c(NA, NA, NA), c(7, 8, 9))
)
print(combined_plot_effects)
```
## All post-hoc measures as fixed effects in one regression model
Now predict the novel measure's scores from all post-hoc comprehension measures to see if they can explain independent variance.
```{r}
model_all_glove1 <- lmer(trial_median_rescaled ~
glove_sum_max_similarity_rescaled +
likert_rescaled +
multiple_choice_accuracy +
(1 | digit_span_score) +
(1 | digit_in_noise_score), data = df.data)
summary(model_all_glove1)
```
### Visualize the multiple fixed effects regression
```{r figure-size, fig.width=15, fig.height=5 }
visreg_summary_all <- visreg(model_all_glove1, "glove_sum_max_similarity_rescaled",
gg=TRUE,
line=list(col="green3", size = 1.7), points=list(alpha=0.5),
xlab= "Semantic Similarity Score",
ylab= "Predicted Real-Time\nComprehension Score") +
theme(axis.title.x = element_text(size = 24),
axis.title.y = element_text(size = 24),
axis.text.x = element_text(size = 20),
axis.text.y = element_text(size = 20)) +
scale_x_continuous(breaks = c(0, 0.5, 1)) +
scale_y_continuous(breaks = c(0, 0.5, 1))
# Update for visreg_likert
visreg_likert_all <- visreg(model_all_glove1, "likert_rescaled", gg=TRUE,
line=list(col="royalblue",size=1.7), points=list(alpha=0.5),
xlab= "10-point Scale Response",
ylab= NULL)+
theme(axis.title.x = element_text(size = 24),
axis.title.y = element_text(size = 24),
axis.text.x = element_text(size = 20),
axis.text.y = element_text(size = 20)) +
scale_x_continuous(breaks = c(0, 0.5, 1)) +
scale_y_continuous(breaks = c(0, 0.5, 1))
# Update for visreg_multiple
visreg_multiple_all <- visreg(model_all_glove1, "multiple_choice_accuracy", gg=TRUE,
line=list(col="violetred", size=1.7), points=list(alpha=0.5),
xlab= "Multiple Choice Accuracy",
ylab= NULL) +
theme(axis.title.x = element_text(size = 24),
axis.title.y = element_text(size = 24),
axis.text.x = element_text(size = 20),
axis.text.y = element_text(size = 20)) +
scale_x_continuous(breaks = c(0, 0.5, 1)) +
scale_y_continuous(breaks = c(0, 0.5, 1))
# Arrange plots in a grid
grid.arrange(
arrangeGrob(
visreg_summary_all, visreg_likert_all, visreg_multiple_all,
ncol = 3
)
)
# For random slopes
visreg_wm <- visreg(model_all_glove1, "digit_span_score", gg=TRUE,
xlab= "Working Memory Scores",
ylab= NULL)
#scale_y_continuous(breaks = c(1, 2, 3, 4, 5), limits = c(1, 5))
visreg_hearing <- visreg(model_all_glove1, "digit_in_noise_score", gg=TRUE,
xlab= "Hearing In Noise",
ylab= NULL)
#scale_y_continuous(breaks = c(1, 2, 3, 4, 5), limits = c(1, 5))
# put them in a grid
grid.arrange(
arrangeGrob(
visreg_wm, visreg_hearing,
ncol = 2,
left = textGrob(" Predicted real-time comprehension scores
given the post-hoc measures",
rot = 90, vjust = 1.5)
)
)
```
0.00##### variance explained
```{r}
cohens_f2_lmer <- function(mod, digits = 3) {
stopifnot(inherits(mod, "lmerMod"))
# Use the exact rows the model used (avoid NA mismatches)
mf <- model.frame(mod, na.action = na.omit)
mod_clean <- lmer(formula(mod), data = mf, REML = lme4::isREML(mod))
# Pieces
resp <- as.character(formula(mod_clean))[2]
fixed_terms <- attr(terms(mod_clean), "term.labels") # fixed-only labels
rand_terms <- lme4::findbars(formula(mod_clean)) # random terms
# Keep random effects in all reduced models
rand_str <- if (length(rand_terms)) {
vapply(rand_terms, function(x) paste0("(", deparse(x), ")"), character(1))
} else character(0)
# Model-level R^2 (marginal for fixed effects)
r2_full_vec <- r.squaredGLMM(mod_clean)
r2_full_m <- as.numeric(r2_full_vec[1]) # Marginal R^2 (fixed effects)
r2_full_c <- as.numeric(r2_full_vec[2]) # Conditional R^2 (fixed + random), FYI
# Build reduced models dropping ONE fixed term at a time
rows <- lapply(fixed_terms, function(trm) {
keep_fixed <- setdiff(fixed_terms, trm)
fixed_rhs <- if (length(keep_fixed)) paste(keep_fixed, collapse = " + ") else "1"
rhs <- paste(c(fixed_rhs, rand_str), collapse = " + ")
f_reduced <- as.formula(paste(resp, "~", rhs))
m_red <- lmer(f_reduced, data = mf, REML = lme4::isREML(mod_clean))
r2_red <- as.numeric(r.squaredGLMM(m_red)[1]) # marginal R^2 of reduced
dR2 <- r2_full_m - r2_red # unique/semi-partial R^2
f2 <- if (is.finite(r2_full_m) && r2_full_m < 1) dR2 / (1 - r2_full_m) else NA_real_
data.frame(
Predictor = trm,
Marginal_R2 = r2_full_m, # same for all rows (model-level)
Partial_R2 = dR2, # unique/semi-partial R^2 for this predictor
R2_reduced = r2_red, # for transparency
Cohen_f2 = f2,
stringsAsFactors = FALSE
)
})
out <- bind_rows(rows) |>
arrange(desc(Partial_R2)) |>
mutate(across(c(Marginal_R2, Partial_R2, R2_reduced, Cohen_f2),
~ round(., digits)))
# (optional) attach conditional R^2 as an attribute for reference
attr(out, "R2_conditional_model") <- round(r2_full_c, digits)
out
}
# ----- Use it -----
f2_tbl <- cohens_f2_lmer(model_all_glove1, digits = 3)
f2_tbl
# View the model Conditional R^2 (optional):
attr(f2_tbl, "R2_conditional_model")
# Cohen (1988) benchmarks: small ~0.02, medium ~0.15, large ~0.35
```
## Figure: Single fixed-effect regressions + bar plots + multiple fixed-effect regression
```{r figure-size, fig.width=18, fig.height=22}
# all 3 plots in the same grid
# Create title groups
title1 <- textGrob("Summary", gp=gpar(fontsize=28,
color='green3',
fontface="bold"))
title2 <- textGrob("10-Point Scale", gp=gpar(fontsize=28,
color='royalblue',
fontface="bold"))
title3 <- textGrob("Multiple Choice Question", gp=gpar(fontsize=28,
color='violetred',
fontface="bold"))
combined_plot_effects <- grid.arrange(
title1, title2, title3,
visreg_summary, visreg_likert, visreg_multiple,
plot_glove_summary, likert_plot, question_plot,
visreg_summary_all, visreg_likert_all, visreg_multiple_all,
ncol = 3,
nrow = 6,
heights = unit.c(
unit(4, "null"), # Title row
unit(8, "null"), # First row of plots
unit(2, "null"), # Spacer row
unit(8, "null"), # Second row of plots
unit(2, "null"), # Spacer row (optional)
unit(8, "null") # Third row of plots
),
layout_matrix = rbind(
c(1, 2, 3),
c(4, 5, 6),
c(NA, NA, NA),
c(7, 8, 9),
c(NA, NA, NA),
c(10, 11, 12)
)
)
print(combined_plot_effects)
```
## Predicting speech rate from comprehension
Does comprehension change with Speech Rate?
```{r}
model_rate <- lmer(speech_rate ~
trial_median_rescaled +
glove_sum_max_similarity_rescaled +
likert_rescaled +
multiple_choice_accuracy +
(1 | digit_span_score) +
(1 | digit_in_noise_score), data = df.data)
summary(model_rate)
```
### Figure: Estimates of fixed effects (comprehension measures) on Speech Rate
```{r}
# Extract the fixed effects from the model (including confidence intervals)
fixed_effects <- tidy(model_rate, effects = "fixed", conf.int = TRUE)
# Filter out the intercept term
fixed_effects <- fixed_effects %>%
filter(term != "(Intercept)")
# Map the actual terms to custom axis labels
term_mapping <- c(
"multiple_choice_accuracy" = "Multiple Choice Question Accuracy",
"glove_sum_max_similarity_rescaled" = "Summary Semantic Similarity",
"likert_rescaled" = "10-Point Scale",
"trial_median_rescaled" = "Median Real-Time Comprehension"
)
# Replace the term names with custom labels
fixed_effects <- fixed_effects %>%
mutate(term = recode(term, !!!term_mapping))
# Reorder the terms based on the estimate values in descending order
fixed_effects <- fixed_effects %>%
mutate(term = reorder(term, -estimate))
# Add a column for significance stars based on p-values
fixed_effects <- fixed_effects %>%
mutate(sig_stars = case_when(
p.value < 0.001 ~ "***",
p.value < 0.01 ~ "**",
p.value < 0.05 ~ "*",
TRUE ~ ""
))
# Plot with ggplot2 - swapped x and y axes
ggplot(fixed_effects, aes(y = term, x = estimate)) + # Swapped axes
geom_point(aes(color = term), size = 3) + # Add color to the points
geom_errorbarh(aes(xmin = conf.low, xmax = conf.high, color = term),
height = 0,
width = 0) +
geom_text(aes(label = paste0(round(estimate, 2), sig_stars)), vjust = -1, size = 4) +
scale_color_manual(values = c(
"Multiple Choice Question Accuracy" = "violetred",
"10-Point Scale" = "royalblue",
"Summary Semantic Similarity" = "green3",
"Median Real-Time Comprehension" = "purple"
)) +
labs(title = " ",
x = "Regression Coefficient Estimates",
y = NULL) +
theme(
plot.title = element_text(hjust = 0.5, size = 18),
axis.title.x = element_text(size = 13),
axis.text.y = element_text(size = 13, color = "black"),
axis.text.x = element_text(size = 12)
) +
guides(color = "none")
```
## III. Multiple Choice Questions Diagnosis
Are questions comparable in difficulty?
Take all stories presented at 1x. (divide by questions and average across participants for that item)
```{r figure-size, fig.width=6, fig.height=6}
pid <- "participant"
# 1) per-participant accuracy for each QUESTION at 1×
by_pp_1x <- df.data %>%
filter(speech_rate == 1,
!is.na(question), !is.na(.data[[pid]]),
!is.na(multiple_choice_accuracy)) %>%
group_by(.data[[pid]], question) %>%
summarise(acc = mean(multiple_choice_accuracy, na.rm = TRUE), .groups = "drop")
# 2) per-question mean accuracy + n participants
q_summary_1x <- by_pp_1x %>%
group_by(question) %>%
summarise(
mean_acc = mean(acc, na.rm = TRUE),
n_participants = n(),
.groups = "drop"
)
# quick stats (optional)
summary_1x <- q_summary_1x %>%
summarise(
n_questions = n(),
mean = mean(mean_acc), median = median(mean_acc),
sd = sd(mean_acc), iqr = IQR(mean_acc)
)
print(round(summary_1x, 3))
# histogram
# counts of per-question means rounded to 2 decimals
counts_2dp <- q_summary_1x %>%
mutate(mean_acc_2dp = round(mean_acc, 1)) %>%
count(mean_acc_2dp) %>%
arrange(mean_acc_2dp)
ggplot(counts_2dp,
aes(x = factor(mean_acc_2dp, levels = sort(unique(mean_acc_2dp))), y = n)) +
scale_x_discrete(expand = c(0,0)) +
scale_y_continuous(expand = c(0,0), limits = c(0, NA))+
geom_col(width = 0.75, color = "white") +
labs(x = "Accuracy", y = "Number of questions", title = "") +
theme_classic(base_size = 20)
tbl_1x <- df.data %>%
filter(speech_rate == 1,
!is.na(question), !is.na(.data[[pid]]),
!is.na(multiple_choice_accuracy)) %>%
# per-participant accuracy per question (in case of multiple trials)
group_by(.data[[pid]], question) %>%
summarise(acc = mean(multiple_choice_accuracy, na.rm = TRUE), .groups = "drop") %>%
# average across participants
group_by(question) %>%
summarise(
n_participants = n(),
mean_accuracy = mean(acc, na.rm = TRUE),
.groups = "drop"
) %>%
mutate(mean_accuracy = round(mean_accuracy, 2)) %>% # 2 decimals
arrange(desc(mean_accuracy))
tbl_1x
```
Distribution of per-question accuracy averaged across participants for speech rate x1

data_analysis.Rmd at commit b741b80, no license · at the source

Overview

Authors: Irmak Ergin^1,2,3, Jill Kries^1,2, Shiven Gupta², Maria Papworth Burrel^1,2, Laura Gwilliams^1,2,3

ORCID iDs: Irmak Ergin, Jill Kries, Maria Papworth Burrel, Laura Gwilliams

Department of Psychology, Stanford University,Stanford, CA USA
Wu Tsai Neurosciences Institute, Stanford University,Stanford, CA USA
Stanford Data Science, Stanford University,Stanford, CA USA

Institutions: Stanford University (United States)

Journal: Behavior research methods, volume 58, issue 4, article 93

Dates: received 3 May 2025; accepted 19 December 2025; published online 27 March 2026; in print 2026

Type: Research article · Language: English

License: CC BY

Identifiers: DOI 10.3758/s13428-026-02941-1 · PMID 41896392 · PMCID PMC13031255 · OpenAlex W7141543328

Open access: hybrid, a free copy (OpenAlex)

Status: code verified (how the code is found and verified)

Categories: human (organism), cognitive (subfield)

Keywords: Speech comprehension, Naturalistic, Real-time measurement, Language

MeSH: Comprehension*, Speech*, Speech Perception*, Adult, Female, Humans, Male, Young Adult (* major topic)

Journal subjects: Original Manuscript

Topic: Neuroscience and Music Perception (Cognitive Neuroscience, Neuroscience), according to OpenAlex

Funding: LG: BRAIN Foundation (A-0741551370); Whitehall Foundation (2024-08-04); Esther A. and Joseph Klingenstein Fund (Esther A. & Joseph Klingenstein Fund, Inc.)

Citations: not cited yet (Europe PMC); 81 references in the paper

Abstract

Speech comprehension has been described as an effortless and robust process; yet, in real-world contexts, it is common for a listener to misunderstand what was said or fail to derive meaning entirely. Typically, methods of measuring speech comprehension are applied ‘post hoc’ - that is, after the comprehension has happened. This approach fails to capture comprehension as it occurs, limiting the field’s understanding of the cognitive processes involved in real-time comprehension. To overcome these challenges, we designed and tested a novel method of measuring real-time speech comprehension during naturalistic listening. We built a slider device that synchronizes with experimental software and provides millisecond read-out. In three experiments, participants listened to audiobook segments while providing continuous comprehension ratings using the slider. To vary comprehension success, we presented speech segments at speed factors of 1–5 times faster than normal. We validated the time-resolved slider data against established speech comprehension assessment methods. Overall, our findings validate our novel time-resolved comprehension measure and demonstrate that it is possible to derive an online behavioral measure of real-time speech comprehension. We also confirmed numerous limitations of static post hoc assessments, including challenges with multiple-choice question design and the confounding of potential effects due to recency bias and comprehension for summarization. The measure proposed here overcomes the constraints of static post hoc assessments and can be effectively integrated with neuroimaging techniques, offering a valuable tool for future research on dynamic processes during naturalistic listening.

Supplementary Information: The online version contains supplementary material available at 10.3758/s13428-026-02941-1.

Reproduced under the paper's license (CC BY), from the paper cited above.

Repository

Its files are read in the Code ↔ Paper reader above, with 16 matches between paragraphs and lines of code.

irmak-ergin/measuring_naturalistic_speech_comprehension_2024

License: none: the authors keep all their rights

State: the link answers, verified on 30 September 2026

Evidence: files inventoried

Commit: b741b80d2cf99b80484da4fdb781af702bb04092, 3 May 2026

Languages: Jupyter (7), R (4), Python (4), JavaScript (2)

Size: 529 files, 17 scripts

Software Heritage: not archived

Found in: “Data and Code Availability”

Holds: README, 11 notebooks

Not found: license file, CITATION.cff, environment file, tests, continuous integration, documentation

Tools: NumPy (7 files), Matplotlib (6 files), pandas (6 files), scikit-learn (5 files), seaborn (5 files), SciPy (4 files), broom (3 files), caret (3 files), cowplot (3 files), ggplot2 (3 files), lmerTest (3 files), patchwork (3 files), rstatix (3 files), statsmodels (3 files), tidyverse (3 files), emmeans (2 files), lme4 (2 files), multcomp (1 file), PsychoPy (1 file)

Availability: 1 check, the latest on 30 September 2026: the link answers

30 September 2026: the link answers

14 files

experiment_1/analysis/binned_real-time_comprehension.ipynb, Jupyter, 490 lines
experiment_1/analysis/correct_typos.ipynb, Jupyter, 139 lines
experiment_1/analysis/data_analysis.Rmd, R, 1,686 lines, 4 matches
experiment_1/analysis/linear_vs_categorical.ipynb, Jupyter, 293 lines, 3 matches
experiment_1/analysis/semantic_similarity.ipynb, Jupyter, 726 lines, 2 matches
experiment_1/analysis/visualise_slider_position.ipynb, Jupyter, 820 lines
experiment_1/experiment_files/lib/psychojs-2023.2.3.iife.js, JavaScript, 8 lines, 1 match
experiment_1/experiment_files/lib/psychojs-2023.2.3.js, JavaScript, 8 lines, 1 match
experiment_1/experiment_files/speech_rate.py, Python, 3,577 lines
experiment_1/experiment_files/v2.py, Python, 98 lines
experiment_1/supplamentary/analysis/supplamentary_analysis.Rmd, R, 1,973 lines, 3 matches
experiment_2/analysis/exp2_data_analysis.Rmd, R, 724 lines, 2 matches
experiment_2/analysis/exp2_visualise_slider_position.ipynb, Jupyter, 797 lines
repository limit reached (2,000 files or 30 MB): the rest is at the source (4 files)
README.md, Text, 79 lines

At the source: github.com/irmak-ergin/measuring_naturalistic_speech_comprehension_2024

The paper's code and data availability statement is in the Data section.

Tracing map

Proposed by the machine: these links were found in the paper and verified at the source, without human review. The map will receive a Zenodo DOI once one of the paper's authors has validated it with their ORCID.

What the map holds:

1 repository of the authors' code, each at its verified commit, with its license and how the link was found in the paper;
13 scripts, each with its path and the digest of its content;
16 matches between paragraphs of the paper and lines of the code (method lexical-v1);
neither the text of the paper nor the code itself.

Its JSON (tracing-map.json) is deposited on Zenodo with its DOI once the map is validated.

Data

Datasets cited

osf:zk3c5, at OSF; found in “Data and Code Availability”

Data and Code Availability

Data is available at https://osf.io/zk3c5/files/osfstorage, and code and experiment files are publicly available at https://github.com/irmak-ergin/measuring_naturalistic_speech_comprehension_2024. You can find the preregistration and link to the GitHub repository on doi.org/10.17605/OSF.IO/F5UZ8 as well. The design, analyses, and participant-exclusion criteria for Experiment 1 were preregistered. The only exploratory analyses not preregistered were the recency analysis and the investigation of the nature of decline in comprehension (linear vs categorical decline). Experiments 2 and 3 were conducted after preregistration, during the review process.

Reproduced under the paper's license (CC BY), from the paper cited above.

Versions

The history of this record: each version stored by the harvester or made by a correction of its authors or of the maintainers of its code, and what changed in its facts. The texts of the paper (its abstract, its availability statements) are not part of it; versions that changed only those are not listed.

Version 1, 30 September 2026: the first record

Recorded: type, language, journal, volume, issue, pages, dates, 5 authors, 4 keywords, 8 MeSH terms, 3 funders, 56 references.

Cite

This paper

Ergin, I., Kries, J., Gupta, S., Papworth Burrel, M., & Gwilliams, L. (2026). Measuring naturalistic speech comprehension in real time. Behavior research methods, 58(4), 93. https://doi.org/10.3758/s13428-026-02941-1

BibTeX

@article{ergin2026measuring, author = {Ergin, Irmak and Kries, Jill and Gupta, Shiven and Papworth Burrel, Maria and Gwilliams, Laura}, title = {{Measuring naturalistic speech comprehension in real time}}, journal = {Behavior research methods}, year = {2026}, month = mar, volume = {58}, number = {4}, pages = {93}, publisher = {Springer Science+Business Media}, issn = {1554-351X}, doi = {10.3758/s13428-026-02941-1}, url = {https://doi.org/10.3758/s13428-026-02941-1}, pmid = {41896392}, pmcid = {PMC13031255} }

RIS

TY - JOUR AU - Ergin, Irmak AU - Kries, Jill AU - Gupta, Shiven AU - Papworth Burrel, Maria AU - Gwilliams, Laura TI - Measuring naturalistic speech comprehension in real time T2 - Behavior research methods J2 - Behav Res Methods PY - 2026 DA - 2026/03/27 VL - 58 IS - 4 SP - 93 SN - 1554-351X PB - Springer Science+Business Media DO - 10.3758/s13428-026-02941-1 UR - https://doi.org/10.3758/s13428-026-02941-1 LA - en ER -

CSL-JSON

{ "id": "10.3758/s13428-026-02941-1", "type": "article-journal", "title": "Measuring naturalistic speech comprehension in real time", "container-title": "Behavior research methods", "author": [ { "family": "Ergin", "given": "Irmak" }, { "family": "Kries", "given": "Jill" }, { "family": "Gupta", "given": "Shiven" }, { "family": "Papworth Burrel", "given": "Maria" }, { "family": "Gwilliams", "given": "Laura" } ], "container-title-short": "Behav Res Methods", "volume": "58", "issue": "4", "page": "93", "DOI": "10.3758/s13428-026-02941-1", "PMID": "41896392", "PMCID": "PMC13031255", "ISSN": "1554-351X", "publisher": "Springer Science+Business Media", "URL": "https://doi.org/10.3758/s13428-026-02941-1", "language": "en", "issued": { "date-parts": [ [ 2026, 3, 27 ] ] } }

The tracing map gets a citation of its own once an author has validated it and it has a DOI.

Similar papers

The papers with a page that share the most with this one: the tools found in their code, their categories, datasets, cited references and authors, the rarest counting most.

[1] doi:10.1523/jneurosci.1001-25.2025 [code]: The Spatio-Temporal Dynamics of Phoneme Encoding in Aging and Aphasia.
Journal: The Journal of neuroscience : the official journal of the Society for Neuroscience
In common: seaborn, scikit-learn, pandas, 3 other tools, cognitive, 5 references, 2 authors
[2] doi:10.1371/journal.pbio.3003588 [code]: Sensory sharpening and semantic prediction errors unify competing models of predictive processing in human speech comprehension.
Journal: PLoS biology
In common: PsychoPy, emmeans, lmerTest, 8 other tools, cognitive, 8 references
[3] doi:10.1126/sciadv.ado8915 [code]: The human auditory cortex concurrently tracks syllabic and phonemic timescales via acoustic spectral flux.
Journal: Science advances
In common: multcomp, emmeans, lmerTest, 8 other tools, 6 references
[4] doi:10.1523/jneurosci.0657-25.2025 [code]: Attentional Engagement with Target and Distractor Streams Predicts Speech Comprehension in Multitalker Environments.
Journal: The Journal of neuroscience : the official journal of the Society for Neuroscience
In common: rstatix, emmeans, lmerTest, 9 other tools, cognitive, 5 references
[5] doi:10.1162/nol_a_00081 [code]: Causal Contributions of the Domain-General (Multiple Demand) and the Language-Selective Brain Networks to Perceptual and Semantic Challenges in Speech Comprehension.
Journal: Neurobiology of language (Cambridge, Mass.)
In common: rstatix, emmeans, lmerTest, 4 other tools, cognitive, 6 references
[6] doi:10.1002/hbm.26305 [code]: Cortical haemodynamic responses predict individual ability to recognise vocal emotions with uninformative pitch cues but do not distinguish different emotions.
Journal: Human brain mapping
In common: multcomp, caret, broom, 9 other tools, cognitive, 2 references
[7] doi:10.1523/eneuro.0069-26.2026 [code]: Electrophysiological Indices of Hierarchical Speech Processing Differentially Reflect the Comprehension of Speech in Noise.
Journal: eNeuro
In common: emmeans, lmerTest, cognitive, 10 references
[8] doi:10.1038/s41598-024-69602-1 [code]: Neural encoding of linguistic speech cues is unaffected by cognitive decline, but decreases with increasing hearing impairment.
Journal: Scientific reports
In common: emmeans, lmerTest, lme4, 8 other tools, cognitive, 5 references
[9] doi:10.1093/bioinformatics/btag592 [code]: Network-based stratification of allele-specific expression reveals patient subgroups in Huntington's disease.
Journal: Bioinformatics (Oxford, England)
In common: multcomp, broom, rstatix, 12 other tools
[10] doi:10.1016/j.dcn.2023.101251 [code]: Age and vocabulary knowledge differentially influence the N400 and theta responses during semantic retrieval.
Journal: Developmental cognitive neuroscience
In common: multcomp, broom, rstatix, 9 other tools, 2 references

Contribute

The authors of this paper can claim it, correct its record and validate its tracing map, and the maintainers of its code (its owner, or a public member of its organization) correct what it says of their repository; anyone signed in can ask for its removal. Every request goes to OSCR's own machine, which answers it; your account page follows them.

Sign in with ORCID to claim this paper as one of its authors, correct its record or validate its tracing map: when the paper's metadata lists your ORCID iD, you are recognized at once. Maintainers of its code: sign in with GitHub, then claim the repository on your account page.

Add the badge to the code's README

If you are an author or a maintainer of this paper's code, you can add this badge. It says what OSCR knows of the paper (its code, its validated tracing map) and links the code to this page. Paste one of these snippets under the README's title. Keep the two marks around it, so that the badge can be replaced in place and is never added twice. OSCR changes nothing in your repository.

Markdown

<!-- oscr-badge:start -->
[![OSCR](https://openscicode.org/badge/doi/10.3758/s13428-026-02941-1.svg)](https://openscicode.org/badge/doi/10.3758/s13428-026-02941-1)
<!-- oscr-badge:end -->

reStructuredText

.. oscr-badge:start

.. image:: https://openscicode.org/badge/doi/10.3758/s13428-026-02941-1.svg
   :target: https://openscicode.org/badge/doi/10.3758/s13428-026-02941-1
   :alt: OSCR

.. oscr-badge:end

HTML

<!-- oscr-badge:start -->
<a href="https://openscicode.org/badge/doi/10.3758/s13428-026-02941-1"><img src="https://openscicode.org/badge/doi/10.3758/s13428-026-02941-1.svg" alt="OSCR"></a>
<!-- oscr-badge:end -->

On GitHub, open the README, choose Edit (the pencil), paste the snippet under the title, then "Commit changes".

irmak-ergin/measuring_naturalistic_speech_comprehension_2024: README.md on GitHub

If you choose to, you can have the badge kept up to date for you, with oscr badge --write from the command line or with the GitHub Action in your repository's workflows. Every other form and option (a card, AsciiDoc, LaTeX, shields.io) is on the badge page.

Request its removal

To ask OSCR to remove this record, the copies of its authors' scripts or its tracing map, use the removal request page: signed in, you say who you are, what to remove and why, then review and confirm the request. Published rules decide every request (how).

Discussion, reproductions, activity

Discussion: code errors and mismatches between the code and the paper about this paper and its code, from readers and its authors, beside the paper and its tracing map.

Report a mismatch between the code and the paper · Report a code error (signed in)

Reproductions: reports from readers who ran the authors' code and did not get the paper's result, what they ran, with which environment, commit and data.

Report a reproduction failure (signed in)

Versions of its code: the releases of its code tied to a version of this paper (the preprint, the accepted manuscript, the version of record…), each with the tracing map versioned with it.

Activity: what happens around this paper: new versions of its record, its map's validation, discussions and reproductions. It opens with sign-in.