library(dplyr)
library(tidyverse)
library(jsonlite)
library(xtable)
library(data.table)Experiment 1C: SONA participants
Abstract
This is a reproducible analysis script for Experiment 1C.
Data collected 10/19/23 Brooklyn College SONA participants
Masters, US, 95% hit approval, more than 200 hits
Load libraries
Import Data
# Read the text file from JATOS ...
read_file('data/E1C_self_reference_deID.JSON') %>%
# ... split it into lines ...
str_split('\n') %>% first() %>%
# ... filter empty rows ...
discard(function(x) x == '') %>%
# ... parse JSON into a data.frame
map_dfr(fromJSON, flatten=T) -> all_dataDemographics
library(tidyr)
demographics <- all_data %>%
filter(trial_type == "survey-html-form") %>%
select(ID,response) %>%
unnest_wider(response) %>%
mutate(age = as.numeric(age)) %>%
filter(is.na(age) == FALSE)
age_demographics <- demographics %>%
summarize(mean_age = mean(age),
sd_age = sd(age),
min_age = min(age),
max_age = max(age))
factor_demographics <- apply(demographics[-1], 2, table)A total of 65 participants were recruited from Amazon’s Mechanical Turk. Mean age was 21.6 (range = 18 to 49 ). There were 48 females, and 16 males. There were 56 right-handed participants, and 8 left or both handed participants. 30 participants reported normal vision, and 28 participants reported corrected-to-normal vision. 42 participants reported English as a first language, and 22 participants reported English as a second language.
Pre-processing
50 workers from Amazon’s Mechanical Turk were paid $2.00 to complete this task. The only restriction was to limit workers to the US locale. Typewritten responses during the recall portion indicated that some of the participants were not completing the task as intended. For example, some of the responses appeared to be written by a chatbot, and did not contain words from the experiment.
We were were interested in analyzing data from participants who appeared to engage with the task as intended. To identify participants for inclusion we used accuracy data from the case judgment task. We included participants if their accuracy was 70% or greater.
Case judgment accuracy
Get case judgment accuracy for all participants.
case_judgment <- all_data %>%
filter(encoding_trial_type == "study_word",
study_instruction == "case") %>%
mutate(response = as.character(unlist(response))) %>%
mutate(accuracy = case_when(
response == "0" & letter_case == "upper" ~ 1,
response == "1" & letter_case == "upper" ~ 0,
response == "0" & letter_case == "lower" ~ 0,
response == "1" & letter_case == "lower" ~ 1
)) %>%
group_by(ID) %>%
summarise(percent_correct = mean(accuracy))
ggplot(case_judgment, aes(x=percent_correct))+
geom_histogram() +
geom_vline(xintercept=.7)
Response bias
Check to see whether participants pressed one button all of the time. Not used for exclusion.
# get response bias
response_bias <- all_data %>%
filter(encoding_trial_type == "study_word") %>%
mutate(response = as.character(unlist(response))) %>%
group_by(ID,study_instruction) %>%
count(response)post-task questions
post_questions <- all_data %>%
filter(trial_type == "survey-text") %>%
select(ID,response) %>%
unnest_wider(response)All exclusions
no exclusions
all_excluded <- case_judgment %>%
filter(percent_correct < .7) %>%
select(ID) %>%
pull()
length(all_excluded)[1] 1filtered_data <- all_data %>%
filter(ID %in% all_excluded == FALSE) Accuracy analysis
Define Helper functions
To do, consider moving the functions into the R package for this project
# attempt general solution
## Declare helper functions
################
# get_mean_sem
# data = a data frame
# grouping_vars = a character vector of factors for analysis contained in data
# dv = a string indicated the dependent variable colunmn name in data
# returns data frame with grouping variables, and mean_{dv}, sem_{dv}
# note: dv in mean_{dv} and sem_{dv} is renamed to the string in dv
get_mean_sem <- function(data, grouping_vars, dv, digits=3){
a <- data %>%
group_by_at(grouping_vars) %>%
summarize("mean_{ dv }" := round(mean(.data[[dv]]), digits),
"sem_{ dv }" := round(sd(.data[[dv]])/sqrt(length(.data[[dv]])),digits),
.groups="drop")
return(a)
}
################
# get_effect_names
# grouping_vars = a character vector of factors for analysis
# returns a named list
# list contains all main effects and interaction terms
# useful for iterating the computation means across design effects and interactions
get_effect_names <- function(grouping_vars){
effect_names <- grouping_vars
if( length(grouping_vars > 1) ){
for( i in 2:length(grouping_vars) ){
effect_names <- c(effect_names,apply(combn(grouping_vars,i),2,paste0,collapse=":"))
}
}
effects <- strsplit(effect_names, split=":")
names(effects) <- effect_names
return(effects)
}
################
# print_list_of_tables
# table_list = a list of named tables
# each table is printed
# names are header level 3
print_list_of_tables <- function(table_list){
for(i in 1:length(table_list)){
cat("###",names(table_list[i]))
cat("\n")
print(knitr::kable(table_list[[i]]))
cat("\n")
}
}Conduct Analysis
Study phase immediate recall
# get recall proportion correct for each participant
study_phase_recall <- filtered_data %>%
filter(phase == "study_recall",
encoding_recall == "recall") %>%
separate(col = paragraph,
into = c("first_word","second_word"),
sep = " ",
remove = FALSE,
extra = "merge") %>%
mutate(accuracy = tolower(target_word) == tolower(first_word),
study_instruction = factor(study_instruction, levels= c("case","semantic","self"))) %>%
group_by(ID,study_instruction) %>%
summarize(percent_correct = mean(accuracy))
# get means in each question condition
study_phase_recall_means <- get_mean_sem(study_phase_recall,
grouping_vars = c("study_instruction"),
dv = "percent_correct")
# run ANOVA
study_phase_recall <- study_phase_recall %>%
ungroup() %>%
mutate(ID = as.factor(ID),
study_instruction = as.factor(study_instruction))
study_phase_recall_aov <- aov(percent_correct ~ study_instruction + Error(ID/study_instruction),
study_phase_recall)
# save printable summaries
study_phase_recall_apa_print <- papaja::apa_print(study_phase_recall_aov)
knitr::kable(study_phase_recall_means)| study_instruction | mean_percent_correct | sem_percent_correct |
|---|---|---|
| case | 0.849 | 0.026 |
| semantic | 0.892 | 0.017 |
| self | 0.872 | 0.023 |
During the encoding phase participants attempted to immediately recall half of the words following the primary judgment. We computed proportion of correctly recalled words for each participant separately in each encoding question condition. These means were submitted to a one-way repeated measures ANOVA, with question type as the sole factor. Mean proportion correctly recalled was 0.849 in the case judgment, 0.892 in the semantic judgment, and 0.872 in the self-reference condition; \(F(2, 128) = 1.50\), \(\mathit{MSE} = 0.02\), \(p = .228\), \(\hat{\eta}^2_G = .010\).
Study phase word judgment
# get recall proportion correct for each participant
study_phase_judgment <- filtered_data %>%
filter(phase == "main_study",
encoding_trial_type == "study_word") %>%
mutate(accuracy = case_when(study_instruction == "case" &
letter_case == "lower" &
response == 1 ~ TRUE,
study_instruction == "case" &
letter_case == "lower" &
response == 0 ~ FALSE,
study_instruction == "case" &
letter_case == "upper" &
response == 0 ~ TRUE,
study_instruction == "case" &
letter_case == "upper" &
response == 1 ~ TRUE,
study_instruction == "semantic" &
likeable == "low" &
response == 0 ~ FALSE,
study_instruction == "semantic" &
likeable == "low" &
response == 1 ~ TRUE,
study_instruction == "semantic" &
likeable == "high" &
response == 0 ~ TRUE,
study_instruction == "semantic" &
likeable == "high" &
response == 1 ~ FALSE,
study_instruction == "self" &
likeable == "low" &
response == 0 ~ FALSE,
study_instruction == "self" &
likeable == "low" &
response == 1 ~ TRUE,
study_instruction == "self" &
likeable == "high" &
response == 0 ~ TRUE,
study_instruction == "self" &
likeable == "high" &
response == 1 ~ FALSE
),
study_instruction = factor(study_instruction,
levels= c("case","semantic","self"))) %>%
group_by(ID,study_instruction) %>%
summarize(percent_correct = mean(accuracy)) %>%
ungroup()
# get means in each question condition
study_phase_judgment_means <- get_mean_sem(study_phase_judgment,
grouping_vars = c("study_instruction"),
dv = "percent_correct")
knitr::kable(study_phase_judgment_means)| study_instruction | mean_percent_correct | sem_percent_correct |
|---|---|---|
| case | 0.999 | 0.001 |
| semantic | 0.951 | 0.009 |
| self | 0.783 | 0.018 |
For completeness we report mean performance in the encoding phase for each of the word judgment condition. See above table.
Recall Test
# obtain recall data from typed answers
recall_data <- filtered_data %>%
filter(phase %in% c("recall_1","recall_2") == TRUE ) %>%
select(ID,phase,paragraph) %>%
pivot_wider(names_from = phase,
values_from = paragraph) %>%
mutate(recall_1 = paste(recall_1,recall_2,sep = " ")) %>%
select(ID,recall_1) %>%
# separate_longer_delim(cols = recall_1,
# delim = " ") %>%
mutate(recall_1 = tolower(recall_1)) %>%
mutate(recall_1 = gsub("[^[:alnum:][:space:]]","",recall_1))
encoding_words_per_subject <- filtered_data %>%
filter(encoding_trial_type == "study_word",
phase == "main_study")
recall_data <- left_join(encoding_words_per_subject,recall_data,by = 'ID') %>%
mutate(recall_1 = strsplit(recall_1," "))
# implement a spell-checking method
recall_success <- c()
min_string_distance <- c()
for(i in 1:dim(recall_data)[1]){
recalled_words <- unlist(recall_data$recall_1[i])
recalled_words <- recalled_words[recalled_words != ""]
if (length(recalled_words) == 0 ) recalled_words <- "nonerecalled"
recall_success[i] <- tolower(recall_data$target_word[i]) %in% recalled_words
min_string_distance[i] <- min(sapply(recalled_words,FUN = function(x) {
stringdist::stringdist(a=x,b = tolower(recall_data$target_word[i]), method = "lv")
}))
}
# recall proportion correct by subject
# correct for unequal conditions. 4 words in recall, 8 words in no recall
recall_data_subject <- recall_data %>%
mutate(recall_success = recall_success,
min_string_distance = min_string_distance) %>%
mutate(close_recall = min_string_distance <= 2) %>%
group_by(ID,study_instruction,encoding_recall,block_type) %>%
summarise(number_recalled = sum(recall_success),
number_close_recalled = sum(close_recall)) %>%
ungroup() %>%
mutate(proportion_recalled = case_when(encoding_recall == "no_recall" ~ number_close_recalled/6,
encoding_recall == "recall" ~ number_close_recalled/6)) %>%
mutate(ID = as.factor(ID),
study_instruction = as.factor(study_instruction),
encoding_recall = as.factor(encoding_recall),
block_type = as.factor(block_type))
# Condition means
mean_recall_data <- get_mean_sem(recall_data_subject,
c("study_instruction","encoding_recall", "block_type"),
"proportion_recalled") %>%
ungroup() %>%
mutate(study_instruction = factor(study_instruction,levels = c("case","semantic","self")),
`Retrieval Practice` = case_when(
encoding_recall == "no_recall" ~ "No Retrieval Practice \n during study \n",
encoding_recall == "recall" ~ "Retrieval Practice \n during study \n",
))
recall_plot <- ggplot(mean_recall_data,
aes(x = study_instruction,
y = mean_proportion_recalled,
fill= `Retrieval Practice`))+
geom_bar(stat="identity",position="dodge",color="black") +
geom_errorbar(aes(ymin = mean_proportion_recalled - sem_proportion_recalled,
ymax = mean_proportion_recalled + sem_proportion_recalled),
width=.9, position=position_dodge2(width = 0.2, padding = 0.8)) +
ylab("Proportion words recalled")+
xlab("Study Instruction") +
theme_classic(base_size = 15)+
theme(legend.position = "top")+
facet_wrap(~block_type)
recall_plot
Recall test ANOVA
## Condition-level means
# get all possible main effects and interactions
recall_effect_names <- get_effect_names(c("block_type","encoding_recall", "study_instruction"))
recall_effect_means <- lapply(recall_effect_names, FUN = function(x) {
get_mean_sem(data=recall_data_subject,
grouping_vars = x,
dv = "proportion_recalled") %>%
as.data.table()
})
# run ANOVA
recall_aov <- aov(proportion_recalled ~ block_type*encoding_recall*study_instruction + Error(ID/(study_instruction*encoding_recall)), data = recall_data_subject)
# save printable summaries
recall_apa_print <- papaja::apa_print(recall_aov)
knitr::kable(xtable(summary(recall_aov)))| Df | Sum Sq | Mean Sq | F value | Pr(>F) | |
|---|---|---|---|---|---|
| block_type | 1 | 0.5548501 | 0.5548501 | 5.4095555 | 0.0232590 |
| Residuals | 63 | 6.4618166 | 0.1025685 | NA | NA |
| study_instruction | 2 | 0.9988604 | 0.4994302 | 12.7054125 | 0.0000094 |
| block_type:study_instruction | 2 | 0.0112366 | 0.0056183 | 0.1429286 | 0.8669563 |
| Residuals | 126 | 4.9528660 | 0.0393085 | NA | NA |
| encoding_recall | 1 | 0.6293447 | 0.6293447 | 26.5401370 | 0.0000028 |
| block_type:encoding_recall | 1 | 0.0156288 | 0.0156288 | 0.6590838 | 0.4199405 |
| Residuals | 63 | 1.4939153 | 0.0237129 | NA | NA |
| encoding_recall:study_instruction | 2 | 0.0689459 | 0.0344729 | 1.3843235 | 0.2542764 |
| block_type:encoding_recall:study_instruction | 2 | 0.0711335 | 0.0355667 | 1.4282476 | 0.2435827 |
| Residuals | 126 | 3.1376984 | 0.0249024 | NA | NA |
Write-up
# use data.table
#t <- as.data.table(Accuracy$means$`encoding_stimulus_time:encoding_instruction`)
#t[encoding_stimulus_time==500 & encoding_instruction == "F"]$mean_correctResults
We computed proportion correct recalled for each participant in each condition of the design. The proportions were submitted to a 3 (Encoding Question: Case, Semantic, Self) x 2 (Retrieval Practice: Yes, No) x 2 (Question Order: Blocked, Mixed) mixed factorial design with Encoding Question, and Retrieval Practice as within-subject factors, and Question Order as the sole between-subject factor. Mean proportions of correctly recalled words in each condition is shown in Figure X. We adopted an alpha criterion of .05 for all statistical tests.
There was a main effect of encoding question, \(F(2, 126) = 12.71\), \(\mathit{MSE} = 0.04\), \(p < .001\), \(\hat{\eta}^2_G = .059\). Mean proportion recall was lowest in the case condition (M = 0.154, SEM = 0.017),higher for the semantic condition (M = 0.203, SEM = 0.019), and highest for the self condition (M = 0.277, SEM = 0.02).
The retrieval practice effect was also significant, \(F(1, 63) = 26.54\), \(\mathit{MSE} = 0.02\), \(p < .001\), \(\hat{\eta}^2_G = .038\). Mean proportion recall was lower for items that did not receive retrieval practice (M = 0.171, SEM = 0.015), compared to items that did receive retrieval practice (M = 0.251, SEM = 0.016).
Finally, there was a main effect of block type, \(F(1, 63) = 5.41\), \(\mathit{MSE} = 0.10\), \(p = .023\), \(\hat{\eta}^2_G = .033\). Mean proportion recall was lower for the blocked (M = 0.176, SEM = 0.014), than mixed conditions (M = 0.252, SEM = 0.017).
No other main effects or interactions reached significance.
save data
save.image("data/E1_C.RData")