1: As cost increases, children will attempt to encode more items in memory. We expect that, as cost increases, children will be incentivized to make fewer trips. This can be accomplished by selecting more correct items per trip. To accomplish this, children will have to spend more time encoding list items. We predict, then, that study time will be the lowest in the No-delay condition, longer in the Long-delay condition, and longest in the One-shot condition.
2: Relatedly, we predict that children will succeed at encoding more items when they attempt to do so, leading to more correct responses as costs increase. We predict, then, that MU(total) will be the lowest in the No-delay condition, higher in the Long-delay condition, and highest in the One-shot condition.
3: When allowed to choose how many attempts to make, children will tend to be overly conservative and therefore underperform. Given this, then if children are obliged to respond despite their risk aversion, memory usage will increase. We predict then that, across all conditions, MU(total) (as measured in total-response trials) will be higher than MU(free) (as measured in free-response trials).
4: Relatedly, as cost increases, children will be encouraged to act on the contents of their memory (so that they may get more correct, and reduce the trips required to accomplish the task); their response bias will become less conservative. We predict then that MU(free) will be the lowest in the No-delay condition, greater in the Long-delay condition, and greatest in the One-shot condition.
5: Older children will have greater cognitive control that will benefit them in the present paradigm. We will test this by including age as an additional variable in our mixed models. Here we predict that there will be a significant main effect of Age on study time and MU(total) with older children (closer to 7 years of age) spending more study time on the shopping list and having a higher MU(total) than younger children (closer to 4.5 years of age).
6: Relatedly, we expect older children to show a greater ability to adjust their behavior in response to changing costs. Given that, we predict that there will be a significant interaction between Age and Condition on study time and MU(total).
Preregistered plan
Unless specified otherwise, hypotheses will be tested using Generalized Linear Mixed-Effect Models (Lo & Andrews, 2015) with Condition and Age as fixed effects and participant as a random effect, and with appropriate linking functions. If there are substantive violations of the assumptions of these analyses, we will corroborate results with non-parametric tests.
Process data
# Load libraries & general setup -----------------------library(tidyverse)
Warning: package 'tidyverse' was built under R version 4.2.3
Warning: package 'ggplot2' was built under R version 4.2.3
Warning: package 'readr' was built under R version 4.2.3
Warning: package 'stringr' was built under R version 4.2.3
Warning: package 'forcats' was built under R version 4.2.3
Warning: package 'lubridate' was built under R version 4.2.3
── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
✔ dplyr 1.0.10 ✔ readr 2.1.4
✔ forcats 1.0.0 ✔ stringr 1.5.0
✔ ggplot2 3.5.1 ✔ tibble 3.1.8
✔ lubridate 1.9.2 ✔ tidyr 1.2.1
✔ purrr 0.3.4
── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter() masks stats::filter()
✖ dplyr::lag() masks stats::lag()
ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(ggpubr)library(ggforce)
Warning: package 'ggforce' was built under R version 4.2.3
library(effectsize)library(lme4)
Warning: package 'lme4' was built under R version 4.2.3
Loading required package: Matrix
Attaching package: 'Matrix'
The following objects are masked from 'package:tidyr':
expand, pack, unpack
library(lmerTest)
Warning: package 'lmerTest' was built under R version 4.2.3
Attaching package: 'lmerTest'
The following object is masked from 'package:lme4':
lmer
The following object is masked from 'package:stats':
step
library(emmeans)
Warning: package 'emmeans' was built under R version 4.2.3
library(MuMIn)
Warning: package 'MuMIn' was built under R version 4.2.3
library(MCMCglmm)
Warning: package 'MCMCglmm' was built under R version 4.2.3
Loading required package: coda
Warning: package 'coda' was built under R version 4.2.3
Loading required package: ape
Warning: package 'ape' was built under R version 4.2.3
Attaching package: 'ape'
The following object is masked from 'package:ggpubr':
rotate
library(mixedpower)library(DHARMa)
Warning: package 'DHARMa' was built under R version 4.2.3
This is DHARMa 0.4.6. For overview type '?DHARMa'. For recent changes, type news(package = 'DHARMa')
# Disable scientific notationoptions(scipen =999)# Set the correct working directory (only when running locally)setwd("D:/Canna_d/EM5_stuff/EM5_data/Indivivual_participant_data/placeholder")# Load filemultiDataTrialSum <-read.csv("multiDataTrialSum1Trip.csv", header =TRUE)# Remove the old One-shotno1shot <- multiDataTrialSum %>%filter(!condsFile =="oneShot3.2") %>%filter(!condsFile =="oneShotClosing")# Rename Closing trials as Total-responsedata <- no1shot %>%mutate(condsFile =case_when( condsFile %in%c("noDelayClosing", "longDelayClosing") ~"totalResponse",TRUE~ condsFile # Keep the original value for all other cases ))# Make output more interpretableoptions(contrasts =c("contr.sum","contr.poly"))
Study time (H1/H5/H6)
# Average over all trials for each condition, for each child, as per preregistrationstudy_time <- data %>%group_by(participant, condsFile) %>%summarize(mean_MU =mean(meanMU, na.rm =TRUE),mean_StudyTime =mean(meanListTime, na.rm =TRUE), age =first(age), .groups ='drop')# Center agestudy_time$age.ct <- study_time$age -mean(study_time$age)# make sure condition is a factorstudy_time$condsFile <-as.factor(study_time$condsFile)# Run modelstudyTimeGlmm <-glmer(mean_StudyTime ~ condsFile + age.ct + age.ct*condsFile + (1|participant), data = study_time, family =inverse.gaussian(link ="identity"), nAGQ =0)# Looks great 9/16/24 5:15 PMplot(density(study_time$mean_StudyTime), xlim=c(0, 160), ylim=c(0, 1), main='M_1 y_hat')lines(density(predict(studyTimeGlmm, type='response')), col='red')
# Looks great 9/16/24 5:15 PMplot(studyTimeGlmm)
# OK 9/16/24 5:15 PMresiduals <-residuals(studyTimeGlmm)qqnorm(residuals)qqline(residuals, col ="red")
# Below we will compare model with one that has no fixed effects# To see if the fixed effects (condsFile) is important at explaining the datamixConTime_GLMM_null <-glmer(mean_StudyTime ~1+ (1|participant), data = study_time, family =inverse.gaussian(link ="identity"), nAGQ =0)mixTimeConAov <-cbind(car::Anova(studyTimeGlmm),r.squaredGLMM(studyTimeGlmm,mixConTime_GLMM_null))
Warning: 'r.squaredGLMM' now calculates a revised statistic. See the help page.
# Compare the modelsanova(mixConTime_GLMM_null,studyTimeGlmm)
NOTE: Results may be misleading due to involvement in interactions
$emmeans
condsFile emmean SE df asymp.LCL asymp.UCL
longDelay 6.85 0.364 Inf 6.13 7.56
noDelay 6.05 0.329 Inf 5.40 6.69
totalResponse 6.55 0.357 Inf 5.85 7.25
Confidence level used: 0.95
$contrasts
contrast estimate SE df z.ratio p.value
longDelay - noDelay 0.801 0.346 Inf 2.312 0.0541
longDelay - totalResponse 0.300 0.376 Inf 0.798 0.7045
noDelay - totalResponse -0.500 0.336 Inf -1.491 0.2950
P value adjustment: tukey method for comparing a family of 3 estimates
Memory Use (H2?/H5/H6)
# Average over participant and conditionMU_data <- data %>%group_by(participant, condsFile) %>%summarize(mean_MU =mean(meanMU, na.rm =TRUE), age =first(age), .groups ='drop')# Center ageMU_data$age.ct <- MU_data$age -mean(MU_data$age)# Run the modelMU_GLMM <-glmer(mean_MU ~ condsFile + age.ct + age.ct*condsFile + (1|participant), data = MU_data, family =gaussian(link ="identity"))
Warning in glmer(mean_MU ~ condsFile + age.ct + age.ct * condsFile + (1 | :
calling glmer() with family=gaussian (identity link) as a shortcut to lmer() is
deprecated; please call lmer() directly
# Predicted vs observed density plotplot(density(MU_data$mean_MU), xlim=c(-50, 50), ylim=c(0, 0.6), main='M_1 y_hat')lines(density(predict(MU_GLMM, type='response') ), col='red')
# This plot has more values concentrated to the leftplot(MU_GLMM)
# The qq plot is quite wiggly in the tailsresiduals <-residuals(MU_GLMM)qqnorm(residuals)qqline(residuals, col ="red")
# Summarysummary(MU_GLMM)
Linear mixed model fit by REML ['lmerMod']
Formula: mean_MU ~ condsFile + age.ct + age.ct * condsFile + (1 | participant)
Data: MU_data
REML criterion at convergence: 974.7
Scaled residuals:
Min 1Q Median 3Q Max
-3.8939 -0.4581 0.0386 0.4729 3.3342
Random effects:
Groups Name Variance Std.Dev.
participant (Intercept) 0.5515 0.7426
Residual 2.6985 1.6427
Number of obs: 243, groups: participant, 82
Fixed effects:
Estimate Std. Error t value
(Intercept) 1.91184 0.13362 14.308
condsFile1 -0.05823 0.14865 -0.392
condsFile2 -0.34078 0.15025 -2.268
age.ct 0.75940 0.18022 4.214
condsFile1:age.ct -0.19096 0.20049 -0.952
condsFile2:age.ct -0.46903 0.20287 -2.312
Correlation of Fixed Effects:
(Intr) cndsF1 cndsF2 age.ct cnF1:.
condsFile1 -0.008
condsFile2 0.016 -0.505
age.ct 0.000 0.000 0.000
cndsFl1:g.c 0.000 0.000 0.000 -0.009
cndsFl2:g.c 0.000 0.000 0.000 0.018 -0.506
# Get the p value, and R squaredMUfree_null <-glmer(mean_MU ~1+ (1|participant), data = MU_data, family =gaussian(link ="identity"))
Warning in glmer(mean_MU ~ 1 + (1 | participant), data = MU_data, family =
gaussian(link = "identity")): calling glmer() with family=gaussian (identity
link) as a shortcut to lmer() is deprecated; please call lmer() directly
MUfreeAov <-cbind(car::Anova(MU_GLMM),r.squaredGLMM(MU_GLMM,MUfree_null))# Comparing if the full fits better than the null modelanova(MUfree_null,MU_GLMM)
NOTE: Results may be misleading due to involvement in interactions
$`emmeans of condsFile`
condsFile emmean SE df lower.CL upper.CL
longDelay 1.85 0.199 224 1.46 2.25
noDelay 1.57 0.203 226 1.17 1.97
totalResponse 2.31 0.199 224 1.92 2.70
Degrees-of-freedom method: kenward-roger
Confidence level used: 0.95
$`pairwise differences of condsFile`
1 estimate SE df t.ratio p.value
longDelay - noDelay 0.283 0.259 159 1.089 0.5220
longDelay - totalResponse -0.457 0.257 157 -1.782 0.1789
noDelay - totalResponse -0.740 0.259 159 -2.852 0.0136
Degrees-of-freedom method: kenward-roger
P value adjustment: tukey method for comparing a family of 3 estimates
H3/H4
These hypotheses will be a bit tricky to talk about as they require a distinction between Free and Total conditions, but we can figure it out.
MU Free VS Total
# Make sure dplyr is loadedlibrary(dplyr)# Set cond-type to say whether it was Free-response or Total-responsecondType_data <- no1shot %>%mutate(condType =case_when( condsFile %in%c("noDelayClosing", "longDelayClosing") ~"Total", condsFile %in%c("noDelay", "longDelay") ~"Free",TRUE~NA_character_ ))# Average over participant and conditionfreeVtotal <- condType_data %>%group_by(participant, condType) %>%summarize(mean_MU =mean(meanMU, na.rm =TRUE),mean_StudyTime =mean(meanListTime, na.rm =TRUE),age =first(age),.groups ='drop')# Look at distribution of datahist(freeVtotal$mean_MU)
Warning in glmer(mean_MU ~ condType + (1 | participant), data = freeVtotal, :
calling glmer() with family=gaussian (identity link) as a shortcut to lmer() is
deprecated; please call lmer() directly
# No errors etc. It says this is an lmer, truee# Good 6/6plot(density(freeVtotal$mean_MU), xlim=c(-50, 50), ylim=c(0, 0.6), main='M_1 y_hat')lines(density(predict(freeVtotal_glmm, type='response') ), col='red')
# A bit weird 6/6plot(freeVtotal_glmm)
# The qq plot is looking good actually 6/6residuals <-residuals(freeVtotal_glmm)qqnorm(residuals)qqline(residuals, col ="red")
# This model fits well! 6/6library(performance)check_model(freeVtotal_glmm)
MUfree_null <-glmer(mean_MU ~1+ (1|participant), data = freeVtotal, family =gaussian(link ="identity"))
Warning in glmer(mean_MU ~ 1 + (1 | participant), data = freeVtotal, family =
gaussian(link = "identity")): calling glmer() with family=gaussian (identity
link) as a shortcut to lmer() is deprecated; please call lmer() directly
MUfreeAov <-cbind(car::Anova(freeVtotal_glmm),r.squaredGLMM(freeVtotal_glmm,MUfree_null))# The full fits better than null 6/6anova(MUfree_null,freeVtotal_glmm)
# Total response has more MU and it is significant!summary(freeVtotal_glmm)
Linear mixed model fit by REML ['lmerMod']
Formula: mean_MU ~ condType + (1 | participant)
Data: freeVtotal
REML criterion at convergence: 696
Scaled residuals:
Min 1Q Median 3Q Max
-3.1821 -0.4993 0.0036 0.4690 3.0561
Random effects:
Groups Name Variance Std.Dev.
participant (Intercept) 1.140 1.067
Residual 3.054 1.748
Number of obs: 164, groups: participant, 82
Fixed effects:
Estimate Std. Error t value
(Intercept) 2.0117 0.1803 11.156
condType1 -0.2993 0.1365 -2.193
Correlation of Fixed Effects:
(Intr)
condType1 0.000
Warning in tidy.anova(model): The following column names in ANOVA output were
not recognized or transformed: NumDF, DenDF
age.ct condsFile
0.4737835 0.2220410
KS Test
This test is to see how distributed our ages are.
# Run the KS testks.test(MU_data$age, "punif", min(MU_data$age), max(MU_data$age))
Warning in ks.test.default(MU_data$age, "punif", min(MU_data$age),
max(MU_data$age)): ties should not be present for the Kolmogorov-Smirnov test
Asymptotic one-sample Kolmogorov-Smirnov test
data: MU_data$age
D = 0.089506, p-value = 0.04075
alternative hypothesis: two-sided
# Plot the density of actual dataplot(density(MU_data$age), main ="Age Distribution vs Uniform", xlab ="Age", ylab ="Density", xlim =c(min(MU_data$age), max(MU_data$age)),ylim =c(0,0.6),lwd =2)# Add a horizontal line for the uniform distribution's densityabline(h =1/ (max(MU_data$age) -min(MU_data$age)), col ="red", lty =2, lwd =2)legend("topright", legend =c("Observed Density", "Uniform Density"),col =c("black", "red"), lty =c(1,2), lwd =2)
Order effects
# Average over all trials for each condition, for each child, as per preregistrationsummarized_data <- data %>%group_by(participant, condsFile, order) %>%summarize(mean_MU =mean(meanMU, na.rm =TRUE),mean_StudyTime =mean(meanListTime, na.rm =TRUE),mean_Streak =mean(meanCorBefInc, na.rm =TRUE),age =first(age),.groups ='drop')# make sure condition and order is a factorsummarized_data$condsFile <-as.factor(summarized_data$condsFile)summarized_data$order <-as.factor(summarized_data$order)# Center agesummarized_data$age.ct <- summarized_data$age -mean(summarized_data$age)
Order effects: study time
# Run the modelstudyTimeOrder <-glmer(mean_StudyTime ~ condsFile + order + age.ct + age.ct*condsFile + (1|participant), data = summarized_data, family =inverse.gaussian(link ="identity"))
Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
Model failed to converge with max|grad| = 0.0841533 (tol = 0.002, component 1)
Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, : Model is nearly unidentifiable: very large eigenvalue
- Rescale variables?
# Check summarysummary(studyTimeOrder)
Generalized linear mixed model fit by maximum likelihood (Laplace
Approximation) [glmerMod]
Family: inverse.gaussian ( identity )
Formula: mean_StudyTime ~ condsFile + order + age.ct + age.ct * condsFile +
(1 | participant)
Data: summarized_data
AIC BIC logLik deviance df.resid
1187.3 1218.7 -584.6 1169.3 234
Scaled residuals:
Min 1Q Median 3Q Max
-1.8711 -0.5886 -0.1728 0.5484 2.5713
Random effects:
Groups Name Variance Std.Dev.
participant (Intercept) 4.31705 2.078
Residual 0.02658 0.163
Number of obs: 243, groups: participant, 82
Fixed effects:
Estimate Std. Error t value Pr(>|z|)
(Intercept) 7.8232884 0.0008385 9329.81 <0.0000000000000002 ***
condsFile1 0.4376683 0.0008386 521.92 <0.0000000000000002 ***
condsFile2 -0.3059942 0.0008386 -364.90 <0.0000000000000002 ***
order1 -0.0956869 0.0008386 -114.11 <0.0000000000000002 ***
age.ct -0.0510966 0.0008386 -60.93 <0.0000000000000002 ***
condsFile1:age.ct -0.7201087 0.0008386 -858.73 <0.0000000000000002 ***
condsFile2:age.ct -0.5179262 0.0008386 -617.62 <0.0000000000000002 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Correlation of Fixed Effects:
(Intr) cndsF1 cndsF2 order1 age.ct cnF1:.
condsFile1 0.000
condsFile2 0.000 0.000
order1 0.000 0.000 0.000
age.ct 0.000 0.000 0.000 0.000
cndsFl1:g.c 0.000 0.000 0.000 0.000 0.000
cndsFl2:g.c 0.000 0.000 0.000 0.000 0.000 0.000
optimizer (Nelder_Mead) convergence code: 0 (OK)
Model failed to converge with max|grad| = 0.0841533 (tol = 0.002, component 1)
Model is nearly unidentifiable: very large eigenvalue
- Rescale variables?
# Run the modelMU_order <-glmer(mean_MU ~ condsFile + order + age.ct + age.ct*condsFile + (1|participant),data = summarized_data, family =gaussian(link ="identity"))
Warning in glmer(mean_MU ~ condsFile + order + age.ct + age.ct * condsFile + :
calling glmer() with family=gaussian (identity link) as a shortcut to lmer() is
deprecated; please call lmer() directly
# Check summarysummary(MU_order)
Linear mixed model fit by REML ['lmerMod']
Formula: mean_MU ~ condsFile + order + age.ct + age.ct * condsFile + (1 |
participant)
Data: summarized_data
REML criterion at convergence: 976.8
Scaled residuals:
Min 1Q Median 3Q Max
-3.8745 -0.4511 0.0312 0.4750 3.3225
Random effects:
Groups Name Variance Std.Dev.
participant (Intercept) 0.5703 0.7552
Residual 2.6981 1.6426
Number of obs: 243, groups: participant, 82
Fixed effects:
Estimate Std. Error t value
(Intercept) 1.91174 0.13450 14.213
condsFile1 -0.05839 0.14865 -0.393
condsFile2 -0.34046 0.15025 -2.266
order1 0.01064 0.13464 0.079
age.ct 0.75898 0.18156 4.180
condsFile1:age.ct -0.19107 0.20048 -0.953
condsFile2:age.ct -0.46882 0.20289 -2.311
Correlation of Fixed Effects:
(Intr) cndsF1 cndsF2 order1 age.ct cnF1:.
condsFile1 -0.008
condsFile2 0.016 -0.505
order1 -0.022 -0.002 0.005
age.ct 0.001 0.000 0.000 -0.046
cndsFl1:g.c 0.000 0.000 0.000 0.008 -0.009
cndsFl2:g.c 0.001 0.000 0.000 -0.016 0.018 -0.506
# Compare null with fullMUOrder_null <-glmer(mean_MU ~1+ (1|participant), data = summarized_data, family =gaussian(link ="identity"))
Warning in glmer(mean_MU ~ 1 + (1 | participant), data = summarized_data, :
calling glmer() with family=gaussian (identity link) as a shortcut to lmer() is
deprecated; please call lmer() directly
# Make sure trialis a factordata$trial <-as.factor(data$trial)# Order B, no delay firstorderB <- data[data$order =="B",]orderB <- orderB %>%filter(!(condsFile %in%c("totalResponse")))ggplot(orderB, aes(x =factor(trial), y = meanListTime)) +geom_boxplot() +facet_wrap(~ condsFile) +labs(x ="Trial", y ="Study Time", title ="Study Time by Trial and Condition, order B") +theme_minimal()
ggplot(orderB, aes(x =factor(trial), y = meanMU)) +geom_boxplot() +facet_wrap(~ condsFile) +labs(x ="Trial", y ="MU", title ="MU by Trial and Condition, order B") +theme_minimal()
# Order D, long delay firstorderD <- data[data$order =="D",]orderD <- orderD %>%filter(!(condsFile %in%c("totalResponse")))ggplot(orderD, aes(x =factor(trial), y = meanListTime)) +geom_boxplot() +facet_wrap(~ condsFile) +labs(x ="Trial", y ="Study Time", title ="Study Time by Trial and Condition, order D") +theme_minimal()
ggplot(orderD, aes(x =factor(trial), y = meanMU)) +geom_boxplot() +facet_wrap(~ condsFile) +labs(x ="Trial", y ="MU", title ="MU by Trial and Condition, order D") +theme_minimal()
