3. Main analyses
Association between event regularity & memory vividness
Result: New events are remembered more vividly than periodic events, which are remembered more vividly than routine events
# run model
mdl <- lmer(test_vividness ~ freq + (freq | subject_id), data = survey_data)
summary(mdl)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: test_vividness ~ freq + (freq | subject_id)
## Data: survey_data
##
## REML criterion at convergence: 5335.2
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -2.83992 -0.74290 0.03798 0.75328 2.77888
##
## Random effects:
## Groups Name Variance Std.Dev. Corr
## subject_id (Intercept) 0.3062 0.5533
## freqperiodic 0.1523 0.3902 -0.45
## freqroutine 0.2981 0.5460 -0.74 0.84
## Residual 1.3896 1.1788
## Number of obs: 1648, groups: subject_id, 41
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 3.66444 0.11026 39.23251 33.234 < 2e-16 ***
## freqperiodic -0.80125 0.09906 42.88533 -8.089 3.62e-10 ***
## freqroutine -1.62155 0.13526 34.07322 -11.988 8.96e-14 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) frqprd
## freqperiodc -0.648
## freqroutine -0.676 0.669
# extract estimated marginal means for plotting
em <- emmeans(mdl, pairwise ~ freq, lmer.df = 'satterthwaite')
ci <- confint(em)
em.con <- as.data.frame(em$contrasts)
em.ci <- as.data.frame(ci$contrasts)
em.all <- cbind(em.ci, em.con$p.value)
em_df <- as.data.frame(em$emmeans)
ggplot(data = survey_data, aes(x = freq, y = test_vividness, fill = freq, color = freq)) +
geom_jitter(height = 0.2, width = 0.2, alpha = 0.2, size = 1, color = 'grey') +
geom_point(data = em_df, aes(x = freq, y = emmean), size = 4) +
geom_errorbar(data = em_df, aes(x = freq, y = emmean, ymin = lower.CL, ymax = upper.CL),
width = 0, linewidth = 1.5) +
scale_fill_manual(values = c('#DD5A71', '#E68770', '#F1C68D')) +
scale_color_manual(values = c('#DD5A71', '#E68770', '#F1C68D')) +
labs(x = 'event regularity', y = 'memory vividness')
Association between number of details recalled & memory vividness
Result: New events are remembered in more detail than routine events.
recall_sub <- filter(survey_data, test_type == 'recall')
# run model
mdl <- lmer(n_episodic_details_recall ~ freq + (freq | subject_id), data = recall_sub)
# extract estimated marginal means for plotting
em <- emmeans(mdl, pairwise ~ freq, lmer.df = 'satterthwaite')
ci <- confint(em)
em.con <- as.data.frame(em$contrasts)
em.ci <- as.data.frame(ci$contrasts)
em.all <- cbind(em.ci, em.con$p.value)
em.all %>% mutate_if(is.numeric, round, digits = 3)
## contrast estimate SE df lower.CL upper.CL em.con$p.value
## 1 new - periodic 0.669 0.321 33.296 -0.118 1.456 0.108
## 2 new - routine 1.641 0.376 37.885 0.724 2.558 0.000
## 3 periodic - routine 0.972 0.283 18.998 0.252 1.692 0.008
em_df <- as.data.frame(em$emmeans)
ggplot(data = recall_sub, aes(x = freq, y = n_episodic_details_recall, fill = freq, color = freq)) +
geom_violinhalf(trim = F, alpha = 0.5, position = position_nudge(0.05)) +
geom_point(data = em_df, aes(x = freq, y = emmean), size = 2, position = position_nudge(-0.05)) +
geom_errorbar(data = em_df, aes(x = freq, y = emmean, ymin = lower.CL, ymax = upper.CL),
width = 0, linewidth = 1, position = position_nudge(-0.05)) +
scale_fill_manual(values = c('#DD5A71', '#E68770', '#F1C68D')) +
scale_color_manual(values = c('#DD5A71', '#E68770', '#F1C68D')) +
labs(x = 'event regularity', y = 'number of details recalled')
# run model controlling for details recorded at the time of the diary
mdl <- lmer(n_episodic_details_recall ~ freq + n_episodic_details_survey + (1 | subject_id), data = recall_sub)
summary(mdl)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: n_episodic_details_recall ~ freq + n_episodic_details_survey +
## (1 | subject_id)
## Data: recall_sub
##
## REML criterion at convergence: 2564.3
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -2.3853 -0.6196 -0.0834 0.5139 4.0118
##
## Random effects:
## Groups Name Variance Std.Dev.
## subject_id (Intercept) 2.756 1.660
## Residual 4.636 2.153
## Number of obs: 565, groups: subject_id, 41
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 5.44581 0.43184 161.64544 12.611 < 2e-16 ***
## freqperiodic -0.68902 0.24186 534.61781 -2.849 0.00456 **
## freqroutine -1.62901 0.32430 539.63258 -5.023 6.92e-07 ***
## n_episodic_details_survey 0.15660 0.03686 485.27761 4.248 2.58e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) frqprd frqrtn
## freqperiodc -0.452
## freqroutine -0.369 0.579
## n_psdc_dtl_ -0.640 0.052 0.069
# run Bayesian model (with random slopes) for comparison
overwrite <- F
mdl_fn <- 'recalldetails_by_event_regularity_ctrl.Rdata'
if (!file.exists(mdl_fn) | overwrite) {
bmdl <- brm(n_episodic_details_recall ~ freq + n_episodic_details_survey + (freq + n_episodic_details_survey | subject_id),
data = recall_sub, iter = 30000, seed = 123, control = list(adapt_delta = 0.99))
save(bmdl, file = mdl_fn)
} else { load(mdl_fn) }
print(bmdl, digits = 3)
## Family: gaussian
## Links: mu = identity; sigma = identity
## Formula: n_episodic_details_recall ~ freq + n_episodic_details_survey + (freq + n_episodic_details_survey | subject_id)
## Data: recall_sub (Number of observations: 565)
## Draws: 4 chains, each with iter = 30000; warmup = 15000; thin = 1;
## total post-warmup draws = 60000
##
## Group-Level Effects:
## ~subject_id (Number of levels: 41)
## Estimate Est.Error l-95% CI
## sd(Intercept) 1.987 0.447 1.180
## sd(freqperiodic) 0.763 0.390 0.056
## sd(freqroutine) 0.596 0.404 0.027
## sd(n_episodic_details_survey) 0.128 0.059 0.015
## cor(Intercept,freqperiodic) -0.359 0.324 -0.839
## cor(Intercept,freqroutine) -0.274 0.398 -0.883
## cor(freqperiodic,freqroutine) 0.225 0.438 -0.703
## cor(Intercept,n_episodic_details_survey) -0.216 0.363 -0.749
## cor(freqperiodic,n_episodic_details_survey) -0.038 0.404 -0.772
## cor(freqroutine,n_episodic_details_survey) -0.037 0.436 -0.818
## u-95% CI Rhat Bulk_ESS Tail_ESS
## sd(Intercept) 2.939 1.000 20008 32572
## sd(freqperiodic) 1.528 1.000 11085 18146
## sd(freqroutine) 1.509 1.000 18807 28111
## sd(n_episodic_details_survey) 0.246 1.000 7709 10839
## cor(Intercept,freqperiodic) 0.434 1.000 33396 32016
## cor(Intercept,freqroutine) 0.614 1.000 48421 43532
## cor(freqperiodic,freqroutine) 0.888 1.000 34843 44887
## cor(Intercept,n_episodic_details_survey) 0.634 1.000 19693 24470
## cor(freqperiodic,n_episodic_details_survey) 0.741 1.000 17301 28363
## cor(freqroutine,n_episodic_details_survey) 0.777 1.000 13816 29332
##
## Population-Level Effects:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
## Intercept 5.355 0.481 4.417 6.310 1.000 38387
## freqperiodic -0.636 0.281 -1.185 -0.081 1.000 59506
## freqroutine -1.613 0.354 -2.305 -0.915 1.000 66672
## n_episodic_details_survey 0.165 0.047 0.072 0.259 1.000 55299
## Tail_ESS
## Intercept 42696
## freqperiodic 45061
## freqroutine 47241
## n_episodic_details_survey 41415
##
## Family Specific Parameters:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sigma 2.100 0.071 1.965 2.244 1.000 37331 42542
##
## Draws were sampled using sampling(NUTS). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).
# extract posterior probabilities for each effect
# (i.e., the proportion of the posterior distribution for that term that falls above/below 0)
print(hypothesis(bmdl, 'freqperiodic < 0'), digits = 3)
## Hypothesis Tests for class b:
## Hypothesis Estimate Est.Error CI.Lower CI.Upper Evid.Ratio Post.Prob
## 1 (freqperiodic) < 0 -0.636 0.281 -1.099 -0.173 78.26 0.987
## Star
## 1 *
## ---
## 'CI': 90%-CI for one-sided and 95%-CI for two-sided hypotheses.
## '*': For one-sided hypotheses, the posterior probability exceeds 95%;
## for two-sided hypotheses, the value tested against lies outside the 95%-CI.
## Posterior probabilities of point hypotheses assume equal prior probabilities.
print(hypothesis(bmdl, 'freqroutine < 0'), digits = 3)
## Hypothesis Tests for class b:
## Hypothesis Estimate Est.Error CI.Lower CI.Upper Evid.Ratio Post.Prob
## 1 (freqroutine) < 0 -1.613 0.354 -2.19 -1.029 19999 1
## Star
## 1 *
## ---
## 'CI': 90%-CI for one-sided and 95%-CI for two-sided hypotheses.
## '*': For one-sided hypotheses, the posterior probability exceeds 95%;
## for two-sided hypotheses, the value tested against lies outside the 95%-CI.
## Posterior probabilities of point hypotheses assume equal prior probabilities.
print(hypothesis(bmdl, 'n_episodic_details_survey > 0'), digits = 3)
## Hypothesis Tests for class b:
## Hypothesis Estimate Est.Error CI.Lower CI.Upper Evid.Ratio
## 1 (n_episodic_detai... > 0 0.165 0.047 0.088 0.243 2067.966
## Post.Prob Star
## 1 1 *
## ---
## 'CI': 90%-CI for one-sided and 95%-CI for two-sided hypotheses.
## '*': For one-sided hypotheses, the posterior probability exceeds 95%;
## for two-sided hypotheses, the value tested against lies outside the 95%-CI.
## Posterior probabilities of point hypotheses assume equal prior probabilities.
Evidence for a “novelty penumbra”
A “novelty penumbra” refers to the idea that the effect of novelty on memory extends across time, such that doing something new will boost memory for non-novel experiences that happen shortly before or after. To test this idea, we can ask whether memory for non-novel events differs based on whether or not it occurred on the same day as a new event.
Result: Vividness ratings were higher for non-novel events when they happened on the same day as a novel event.
# figure out days of novel events
novel_events <- survey_data %>%
filter(freq == 'new') %>%
select(subject_id, group, title, survey_day, test_vividness) %>%
group_by(subject_id, group) %>%
summarise(new_events = list(unique(survey_day)))
# figure out when a non-novel event comes from the same day as a novel one
check_day_same <- function(day, day_list) { day %in% day_list }
vividness_near_novel <- left_join(survey_data, novel_events, by = c('subject_id', 'group')) %>%
filter(freq != 'new') %>%
mutate(test_delay = as.numeric(ymd(test_date) - ymd(start_date))) %>%
select(subject_id, group, new_events, survey_day, test_delay, title, freq, test_vividness) %>%
mutate(novel_sameday = map2_int(survey_day, new_events, check_day_same), .after = new_events) %>%
mutate(novel_sameday = ifelse(novel_sameday == 1, 'yes', 'no'))
# run model testing if vividness ratings show a novelty penumbra
mdl <- lmer(test_vividness ~ novel_sameday + (1 | subject_id), data = vividness_near_novel)
summary(mdl)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: test_vividness ~ novel_sameday + (1 | subject_id)
## Data: vividness_near_novel
##
## REML criterion at convergence: 4252.8
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -2.37541 -0.78305 -0.02406 0.76808 2.49296
##
## Random effects:
## Groups Name Variance Std.Dev.
## subject_id (Intercept) 0.2666 0.5163
## Residual 1.4777 1.2156
## Number of obs: 1292, groups: subject_id, 41
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 2.643e+00 9.134e-02 4.651e+01 28.941 < 2e-16 ***
## novel_samedayyes 2.201e-01 7.814e-02 1.290e+03 2.817 0.00492 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## novl_smdyys -0.282
# plot
em <- emmeans(mdl, pairwise ~ novel_sameday)
em_df <- as.data.frame(em$emmeans)
ggplot(data = vividness_near_novel, aes(x = novel_sameday, y = test_vividness, fill = novel_sameday, color = novel_sameday)) +
geom_jitter(height = 0.2, width = 0.2, alpha = 0.2, size = 1, color = 'grey') +
geom_point(data = em_df, aes(x = novel_sameday, y = emmean), size = 3.5) +
geom_errorbar(data = em_df, aes(x = novel_sameday, y = emmean, ymin = lower.CL, ymax = upper.CL),
width = 0, linewidth = 1.5) +
scale_fill_manual(values = c('#F1C68D', '#E68770')) +
scale_color_manual(values = c('#F1C68D', '#E68770')) +
labs(x = 'on same day as novel event?', y = 'memory vividness')
# run model testing if the number of details recalled shows a novelty penumbra
# figure out when a non-novel event comes from the same day as a novel one
recall_near_novel <- left_join(survey_data, novel_events, by = c('subject_id', 'group')) %>%
filter(freq != 'new', test_type == 'recall') %>%
mutate(novel_sameday = map2_int(survey_day, new_events, check_day_same), .after = new_events) %>%
mutate(novel_sameday = ifelse(novel_sameday == 1, 'yes', 'no'))
# recall for events that occur on the same day as a novel event was reported
# model controls for the number of details recorded during the survey/diary
mdl <- lmer(n_episodic_details_recall ~ novel_sameday + n_episodic_details_survey + (1 | subject_id), data = recall_near_novel)
summary(mdl)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula:
## n_episodic_details_recall ~ novel_sameday + n_episodic_details_survey +
## (1 | subject_id)
## Data: recall_near_novel
##
## REML criterion at convergence: 2012.3
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -2.6060 -0.6306 -0.1217 0.5243 3.6853
##
## Random effects:
## Groups Name Variance Std.Dev.
## subject_id (Intercept) 2.730 1.652
## Residual 4.488 2.119
## Number of obs: 444, groups: subject_id, 41
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 4.66807 0.41763 107.54482 11.178 < 2e-16 ***
## novel_samedayyes 0.30074 0.23374 417.95998 1.287 0.19892
## n_episodic_details_survey 0.12718 0.04321 350.83764 2.943 0.00346 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) nvl_sm
## novl_smdyys -0.140
## n_psdc_dtl_ -0.724 -0.059
# plot
em <- emmeans(mdl, pairwise ~ novel_sameday)
em_df <- as.data.frame(em$emmeans)
ggplot(data = recall_near_novel, aes(x = novel_sameday, y = n_episodic_details_recall, fill = novel_sameday, color = novel_sameday)) +
geom_violinhalf(trim = F, alpha = 0.5, position = position_nudge(0.05)) +
geom_point(data = em_df, aes(x = novel_sameday, y = emmean), size = 3.5, position = position_nudge(-0.05)) +
geom_errorbar(data = em_df, aes(x = novel_sameday, y = emmean, ymin = lower.CL, ymax = upper.CL),
width = 0, linewidth = 1.5, position = position_nudge(-0.05)) +
scale_fill_manual(values = c('#F1C68D', '#E68770')) +
scale_color_manual(values = c('#F1C68D', '#E68770')) +
labs(x = 'on same day as novel event?', y = 'number of details recalled')