Cardinal Extension - Exp2
2023-05-31
df.ppt_raw <- read.csv('../../../data/exp2/PROCESSED_DATA/exp2_ppt.csv')
df.trial_raw <- read.csv('../../../data/exp2/PROCESSED_DATA/exp2_trial.csv')Exclusions
Exclude 2 kids who missed more than 1 trial (completed 7 or fewer trials out of 9).
Exclude 18 trials where kid has precounted.
ppt_excluded_completion <- df.trial_raw %>%
filter(is.na(count) & is.na(set_chosen)) %>%
group_by(id) %>%
summarise(n_no_count = n()) %>%
filter(n_no_count > 1) %>%
pull(id)
df.ppt <- df.ppt_raw %>%
filter(!id %in% ppt_excluded_completion)
df.trial_precounted <- df.trial_raw %>%
filter(!is.na(precounted))
df.trial <- df.trial_raw %>%
filter(!id %in% ppt_excluded_completion) %>%
filter(is.na(precounted))Demographics Stats
df.ppt %>%
count(age_years) %>%
knitr::kable()| age_years | n |
|---|---|
| 3 | 15 |
| 4 | 35 |
| 5 | 28 |
df.ppt_gender <- df.ppt %>%
count(gender) %>%
knitr::kable()
df.ppt %>%
summarise(min_age = min(age_years_cont),
max_age = max(age_years_cont),
mean_age = mean(age_years_cont),
sd_age = sd(age_years_cont))## min_age max_age mean_age sd_age
## 1 3.293151 5.980822 4.675834 0.7051871df.trial <- df.trial %>%
mutate(trial_type = factor(trial_type, levels = c("small", "large-DR", "large-NDR"),
labels = c("small", "large-DR", "large-NR")))Results
Cardinal extension operationalization
How do we operationalize cardinal extension success?
- Kids succeed when they either chose the correct set (even if they got the wrong count due to an error), or when they didn’t give a set but gave the correct count (this usually happens when they didn’t need to explicitly count a set in the small trials). (recorded as correct_set_chosen)
Some kids did not explicitly chose a set but still got the correct count even in large trials –> ?? They could have succeeded by mentally tracking each object (highly unlikely since super difficult) or guessed. They are currently coded as having selected the correct set.
df.trial %>%
filter(is.na(set_chosen) & correct_count == 1 & magnitude == "large") %>%
select(id, age_years_cont, stim_set, trial, trial_type, trial_ratio, set_chosen, count, target_set, target_count) %>%
count()## n
## 1 10- Kids succeed when they chose the correct set AND gave the correct count afterwards. (correct_count_when_correct_set_chosen)
Correct Set Chosen
Descriptive Statistics
df.summary_magnitude_correct_set_chosen <- df.trial %>%
group_by(trial_type) %>%
summarise(mean = mean(correct_set_chosen), sd = sd(correct_set_chosen))
df.summary_magnitude_correct_set_chosen## # A tibble: 3 × 3
## trial_type mean sd
## <fct> <dbl> <dbl>
## 1 small 0.812 0.391
## 2 large-DR 0.695 0.462
## 3 large-NR 0.537 0.500By trial
ggplot(data = df.trial,
mapping = aes(x = trial_type, y = correct_set_chosen, color = trial_type)) +
geom_jitter(height = 0,
alpha = 0.5) +
stat_summary(fun.data = "mean_cl_boot",
geom = "pointrange") +
theme(legend.position = "none") +
labs(y = "Cardinal extension success (by trial)",
x = "Trial Type",
title = "Correct set chosen") 
By participant
Each dot is a participant. Accurracy in set chosen against continuous age looks linear.
plot3 <- ggplot(data = df.trial %>%
mutate(trial_type = factor(trial_type, labels = c("small sets\n (e.g., 1:2)", "large sets,\n discriminable \n ratio (e.g., 5:10)", "large sets,\n off-by-one \n(e.g., 9:10)"))) %>%
group_by(id, age_years, trial_type) %>%
summarise(mean_correct_set = mean(correct_set_chosen, na.rm = FALSE)),
mapping = aes(x = trial_type, y = mean_correct_set)) +
geom_violin(aes(fill = trial_type)) +
geom_jitter(height = 0,
alpha = 0.5,
aes(group = id)) +
stat_summary(fun.data = "mean_cl_boot",
geom = "pointrange") +
geom_hline(yintercept = 0.5, linetype = 2) +
theme(legend.position = "none",
text = element_text(size = 13)) +
scale_fill_manual(values=cbPalette) +
scale_color_manual(values=cbPalette) +
labs(y = "Prop. of correct set choice",
x = "Set Size and Ratio"
) ## `summarise()` has grouped output by 'id', 'age_years'. You can override using
## the `.groups` argument.plot5 <- ggplot(data = df.trial %>%
mutate(trial_type = factor(trial_type, labels = c("small sets\n (e.g., 1:2)", "large sets,\n discriminable \n ratio (e.g., 5:10)", "large sets,\n off-by-one \n(e.g., 9:10)"))) %>%
group_by(id, trial_type, age_years_cont) %>%
summarise(mean_correct_set = mean(correct_set_chosen, na.rm = FALSE)),
mapping = aes(x = age_years_cont, y = mean_correct_set, fill = trial_type, color = trial_type)) +
geom_smooth(method = "lm") +
geom_jitter(height = 0,
alpha = 0.5,
aes(group = id),
color = "black") +
geom_hline(yintercept = 0.5, linetype = 2) +
facet_grid(~trial_type) +
xlim(3, 6) +
#scale_x_continuous(breaks = seq(3, 6, by = 0.5)) +
ylim(0, 1) +
labs(y = "Prop. of correct set choice",
x = "Age") +
scale_fill_manual(values=cbPalette) +
scale_color_manual(values=cbPalette) +
theme(legend.position = "none",
text = element_text(size = 11)) ## `summarise()` has grouped output by 'id', 'trial_type'. You can override using
## the `.groups` argument.T-tests
Only large-NDR trials are not significantly better than chance.
df.trial_type_summary <- df.trial %>%
group_by(id, trial_type) %>%
summarise(mean_correct_set_chosen = mean(correct_set_chosen))## `summarise()` has grouped output by 'id'. You can override using the `.groups`
## argument.t.test(df.trial %>%
pull(correct_set_chosen),
mu = 0.5, alternative = "two.sided")##
## One Sample t-test
##
## data: df.trial %>% pull(correct_set_chosen)
## t = 10.167, df = 683, p-value < 2.2e-16
## alternative hypothesis: true mean is not equal to 0.5
## 95 percent confidence interval:
## 0.6462781 0.7162950
## sample estimates:
## mean of x
## 0.6812865t.test(df.trial %>%
filter(trial_type == "small") %>%
pull(correct_set_chosen),
mu = 0.5, alternative = "two.sided")##
## One Sample t-test
##
## data: df.trial %>% filter(trial_type == "small") %>% pull(correct_set_chosen)
## t = 12.072, df = 228, p-value < 2.2e-16
## alternative hypothesis: true mean is not equal to 0.5
## 95 percent confidence interval:
## 0.7612650 0.8631892
## sample estimates:
## mean of x
## 0.8122271t.test(df.trial %>%
filter(trial_type == "large-DR") %>%
pull(correct_set_chosen),
mu = 0.5, alternative = "two.sided")##
## One Sample t-test
##
## data: df.trial %>% filter(trial_type == "large-DR") %>% pull(correct_set_chosen)
## t = 6.3412, df = 225, p-value = 1.234e-09
## alternative hypothesis: true mean is not equal to 0.5
## 95 percent confidence interval:
## 0.6341889 0.7551916
## sample estimates:
## mean of x
## 0.6946903t.test(df.trial %>%
filter(trial_type == "large-NR") %>%
pull(correct_set_chosen),
mu = 0.5, alternative = "two.sided")##
## One Sample t-test
##
## data: df.trial %>% filter(trial_type == "large-NR") %>% pull(correct_set_chosen)
## t = 1.124, df = 228, p-value = 0.2622
## alternative hypothesis: true mean is not equal to 0.5
## 95 percent confidence interval:
## 0.4720507 0.6021851
## sample estimates:
## mean of x
## 0.5371179Regressions
No effect of age. Effect of trial type. Pairwise post-hoc comparisons show a significant difference between all pairs of trial types, which survives a Bonferroni correction.
So kids are using approximate number representation to evaluate difference between sets!
Question: Not sure if I need to do a Bonferroni correction here. I probably don’t need to since it’s just 3 post-hoc tests.
#no effect of age
fit.base <- glmer(correct_set_chosen ~ age_zscored + (1|id) + (1|trial_ratio), data = df.trial, family="binomial")
summary(fit.base)## Generalized linear mixed model fit by maximum likelihood (Laplace
## Approximation) [glmerMod]
## Family: binomial ( logit )
## Formula: correct_set_chosen ~ age_zscored + (1 | id) + (1 | trial_ratio)
## Data: df.trial
##
## AIC BIC logLik deviance df.resid
## 667.4 685.5 -329.7 659.4 680
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -4.0590 -0.3725 0.2311 0.4299 2.9376
##
## Random effects:
## Groups Name Variance Std.Dev.
## id (Intercept) 4.2789 2.0685
## trial_ratio (Intercept) 0.9201 0.9592
## Number of obs: 684, groups: id, 78; trial_ratio, 9
##
## Fixed effects:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 1.3559 0.4176 3.247 0.00117 **
## age_zscored 0.4644 0.2614 1.776 0.07570 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## age_zscored 0.027Anova(fit.base, type = 3)## Analysis of Deviance Table (Type III Wald chisquare tests)
##
## Response: correct_set_chosen
## Chisq Df Pr(>Chisq)
## (Intercept) 10.5432 1 0.001166 **
## age_zscored 3.1548 1 0.075704 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1#there is an effect of trial type
fit.trial_type <- glmer(correct_set_chosen ~ age_zscored + trial_type + (1|id) + (1|trial_ratio),
data = df.trial,
family="binomial")
summary(fit.trial_type)## Generalized linear mixed model fit by maximum likelihood (Laplace
## Approximation) [glmerMod]
## Family: binomial ( logit )
## Formula: correct_set_chosen ~ age_zscored + trial_type + (1 | id) + (1 |
## trial_ratio)
## Data: df.trial
##
## AIC BIC logLik deviance df.resid
## 654.4 681.6 -321.2 642.4 678
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -5.1473 -0.3878 0.1994 0.3889 2.9076
##
## Random effects:
## Groups Name Variance Std.Dev.
## id (Intercept) 4.27597 2.0678
## trial_ratio (Intercept) 0.04872 0.2207
## Number of obs: 684, groups: id, 78; trial_ratio, 9
##
## Fixed effects:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 2.4896 0.3786 6.576 4.82e-11 ***
## age_zscored 0.4694 0.2666 1.761 0.07831 .
## trial_typelarge-DR -1.0776 0.3491 -3.086 0.00203 **
## trial_typelarge-NR -2.2918 0.3615 -6.340 2.30e-10 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) ag_zsc tr_-DR
## age_zscored 0.073
## trl_typl-DR -0.553 -0.021
## trl_typl-NR -0.613 -0.052 0.585Anova(fit.trial_type, type = 3)## Analysis of Deviance Table (Type III Wald chisquare tests)
##
## Response: correct_set_chosen
## Chisq Df Pr(>Chisq)
## (Intercept) 43.2474 1 4.824e-11 ***
## age_zscored 3.0996 1 0.07831 .
## trial_type 40.7838 2 1.393e-09 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1anova(fit.trial_type, fit.base, type = 3)## Data: df.trial
## Models:
## fit.base: correct_set_chosen ~ age_zscored + (1 | id) + (1 | trial_ratio)
## fit.trial_type: correct_set_chosen ~ age_zscored + trial_type + (1 | id) + (1 | trial_ratio)
## npar AIC BIC logLik deviance Chisq Df Pr(>Chisq)
## fit.base 4 667.38 685.49 -329.69 659.38
## fit.trial_type 6 654.40 681.57 -321.20 642.40 16.973 2 0.0002062 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# significant difference between DR and NDR, and between NDR and small. only difference between NDR and small is significant after Bonferroni correction.
fit.trial_type %>%
emmeans(specs = pairwise ~ trial_type,
adjust = "bonferroni") %>%
pluck("contrasts")## contrast estimate SE df z.ratio p.value
## small - (large-DR) 1.08 0.349 Inf 3.086 0.0061
## small - (large-NR) 2.29 0.362 Inf 6.340 <.0001
## (large-DR) - (large-NR) 1.21 0.324 Inf 3.750 0.0005
##
## Results are given on the log odds ratio (not the response) scale.
## P value adjustment: bonferroni method for 3 testsCorrect count when correct set chosen
Descriptive Stats
By trial
ggplot(data = df.trial,
mapping = aes(x = trial_type, y = correct_count_when_correct_set_chosen, color = trial_type)) +
geom_jitter(height = 0,
alpha = 0.5) +
stat_summary(fun.data = "mean_cl_boot",
geom = "pointrange") +
theme(legend.position = "none") +
labs(y = "Cardinal extension success (by trial)",
x = "Trial Type",
title = "Correct set chosen AND correct count") 
ggplot(data = df.trial %>%
select(trial_type, correct_set_chosen, correct_count_when_correct_set_chosen) %>%
pivot_longer(-trial_type, names_to = "variable", values_to = "value"),
mapping = aes(x = trial_type, y = value, color = variable)) +
geom_jitter(height = 0,
alpha = 0.5) +
stat_summary(fun.data = "mean_cl_boot",
geom = "pointrange",
position = position_dodge(0.7)) +
labs(y = "Prop. correct count",
x = "Trial Type")
By participant
plot4 <- ggplot(data = df.trial %>%
mutate(trial_type = factor(trial_type, labels = c("small sets\n (e.g., 1:2)", "large sets,\n discriminable \n ratio (e.g., 5:10)", "large sets,\n off-by-one \n(e.g., 9:10)"))) %>%
group_by(id, trial_type) %>%
summarise(mean_correct_count_with_set = mean(correct_count_when_correct_set_chosen, na.rm = FALSE)),
mapping = aes(x = trial_type, y = mean_correct_count_with_set)) +
geom_violin(aes(fill = trial_type)) +
geom_jitter(height = 0,
alpha = 0.5,
aes(group = id)) +
stat_summary(fun.data = "mean_cl_boot",
geom = "pointrange") +
theme(legend.position = "none",
text = element_text(size = 13)) +
scale_fill_manual(values=cbPalette) +
scale_color_manual(values=cbPalette) +
labs(y = "Prop. of correct numerical response",
x = "Set Size and Ratio") ## `summarise()` has grouped output by 'id'. You can override using the `.groups`
## argument.combined_plot <- plot_grid(plot3, plot4, labels = c('A', 'B'))
plot6 <- ggplot(data = df.trial %>%
mutate(trial_type = factor(trial_type, labels = c("small sets\n (e.g., 1:2)", "large sets,\n discriminable \n ratio (e.g., 5:10)", "large sets,\n off-by-one \n(e.g., 9:10)"))) %>%
group_by(id, age_years_cont, trial_type) %>%
summarise(mean_correct_count_with_set = mean(correct_count_when_correct_set_chosen, na.rm = TRUE)),
mapping = aes(x = age_years_cont, y = mean_correct_count_with_set, fill = trial_type, color = trial_type)) +
geom_jitter(height = 0,
alpha = 0.5,
aes(group = id),
color = "black")+
geom_smooth(method='lm') +
facet_grid(~trial_type) +
xlim(3, 6) +
ylim(0, 1) +
#scale_x_continuous(breaks = seq(3, 6, by = 0.5)) +
theme(legend.position = "none",
text = element_text(size = 11)) +
scale_fill_manual(values=cbPalette) +
scale_color_manual(values=cbPalette) +
labs(y = "Prop. of correct numerical response",
x = "Age") ## `summarise()` has grouped output by 'id', 'age_years_cont'. You can override
## using the `.groups` argument.combined_plot_count <- plot_grid(plot5, plot6)## `geom_smooth()` using formula = 'y ~ x'
## `geom_smooth()` using formula = 'y ~ x'T-tests
Only large-NDR trials are not significantly better than chance.
df.trial_type_summary_correct_count <- df.trial %>%
group_by(id, trial_type) %>%
summarise(mean_correct_count_with_set = mean(correct_count_when_correct_set_chosen))## `summarise()` has grouped output by 'id'. You can override using the `.groups`
## argument.t.test(df.trial_type_summary_correct_count %>%
filter(trial_type == "small") %>%
pull(mean_correct_count_with_set),
mu = 0.5, alternative = "two.sided")##
## One Sample t-test
##
## data: df.trial_type_summary_correct_count %>% filter(trial_type == "small") %>% pull(mean_correct_count_with_set)
## t = 7.9467, df = 77, p-value = 1.288e-11
## alternative hypothesis: true mean is not equal to 0.5
## 95 percent confidence interval:
## 0.7305916 0.8847930
## sample estimates:
## mean of x
## 0.8076923t.test(df.trial_type_summary_correct_count %>%
filter(trial_type == "large-DR") %>%
pull(mean_correct_count_with_set),
mu = 0.5, alternative = "two.sided")##
## One Sample t-test
##
## data: df.trial_type_summary_correct_count %>% filter(trial_type == "large-DR") %>% pull(mean_correct_count_with_set)
## t = 0.47763, df = 77, p-value = 0.6343
## alternative hypothesis: true mean is not equal to 0.5
## 95 percent confidence interval:
## 0.4322865 0.6104486
## sample estimates:
## mean of x
## 0.5213675t.test(df.trial_type_summary_correct_count %>%
filter(trial_type == "large-NR") %>%
pull(mean_correct_count_with_set),
mu = 0.5, alternative = "two.sided")##
## One Sample t-test
##
## data: df.trial_type_summary_correct_count %>% filter(trial_type == "large-NR") %>% pull(mean_correct_count_with_set)
## t = -1.5941, df = 77, p-value = 0.115
## alternative hypothesis: true mean is not equal to 0.5
## 95 percent confidence interval:
## 0.3414081 0.5175663
## sample estimates:
## mean of x
## 0.4294872df.trial_type_summary_correct_count %>%
pivot_wider(
names_from = trial_type,
values_from = mean_correct_count_with_set) %>%
rowwise() %>%
mutate(total_correct = mean(c(`small`, `large-DR`, `large-NR`))) %>%
filter(total_correct <= 0.5)## # A tibble: 31 × 5
## # Rowwise: id
## id small `large-DR` `large-NR` total_correct
## <chr> <dbl> <dbl> <dbl> <dbl>
## 1 01fd0d06-49c1-486d-8546-6725977f05… 1 0.333 0 0.444
## 2 0604e222-8247-4fab-abea-b449545f73… 1 0 0.333 0.444
## 3 08c72ca7-b089-4941-a6ab-4430a64ccf… 1 0.333 0 0.444
## 4 095ceda1-7954-45c6-a48c-66878d5e33… 1 0 0.333 0.444
## 5 0d686058-6b49-446a-8b3a-32de9b3549… 0 0 0 0
## 6 0d96a54f-f9f9-43b2-adb8-263aec411d… 0 0 0 0
## 7 0de52d71-9575-4e03-985f-484f43ceaf… 0.667 0.333 0.333 0.444
## 8 2ae7332a-4203-4a9e-9424-cb91d555ec… 0.333 0 0 0.111
## 9 358650b3-195f-4e25-9cbf-ec70ba5aea… 0.333 0 0 0.111
## 10 5b063601-1577-445e-b4e6-218e8cdc61… 1 0 0 0.333
## # ℹ 21 more rowsdf.trial %>%
filter(correct_count_when_correct_set_chosen == 0) %>%
filter(correct_set_chosen == 1) %>%
group_by(trial_type) %>%
count()## # A tibble: 3 × 2
## # Groups: trial_type [3]
## trial_type n
## <fct> <int>
## 1 small 2
## 2 large-DR 38
## 3 large-NR 25df.trial %>%
filter(correct_count_when_correct_set_chosen == 0) %>%
filter(!is.na(set_chosen) & correct_set_chosen == 0) %>%
group_by(trial_type) %>%
count()## # A tibble: 3 × 2
## # Groups: trial_type [3]
## trial_type n
## <fct> <int>
## 1 small 34
## 2 large-DR 37
## 3 large-NR 75df.trial %>%
filter(correct_count_when_correct_set_chosen == 0) %>%
filter(is.na(set_chosen) & correct_set_chosen == 0) %>%
group_by(trial_type) %>%
count()## # A tibble: 3 × 2
## # Groups: trial_type [3]
## trial_type n
## <fct> <int>
## 1 small 9
## 2 large-DR 32
## 3 large-NR 31df.trial %>%
filter(correct_count_when_correct_set_chosen == 0) %>%
group_by(trial_type) %>%
count()## # A tibble: 3 × 2
## # Groups: trial_type [3]
## trial_type n
## <fct> <int>
## 1 small 45
## 2 large-DR 107
## 3 large-NR 131Regressions
Effect of age and of trial type. Pairwise post-hoc comparisons show a significant difference between all pairs of trial types, which survive a Bonferroni correction. This is probably driven by counting ability difference between large vs small sets.
#effect of age. Not surprising at all since higher age probably mean higher highest count.
fit.base_correct_set_and_count <- glmer(correct_count_when_correct_set_chosen ~ age_zscored + (1|id)
#+ (1|trial_ratio)
,
data = df.trial,
family="binomial")
summary(fit.base_correct_set_and_count)## Generalized linear mixed model fit by maximum likelihood (Laplace
## Approximation) [glmerMod]
## Family: binomial ( logit )
## Formula: correct_count_when_correct_set_chosen ~ age_zscored + (1 | id)
## Data: df.trial
##
## AIC BIC logLik deviance df.resid
## 808.0 821.6 -401.0 802.0 681
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -2.3609 -0.7399 0.3071 0.6065 2.1034
##
## Random effects:
## Groups Name Variance Std.Dev.
## id (Intercept) 2.268 1.506
## Number of obs: 684, groups: id, 78
##
## Fixed effects:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 0.4974 0.1972 2.523 0.0116 *
## age_zscored 0.4316 0.1971 2.189 0.0286 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## age_zscored 0.026Anova(fit.base_correct_set_and_count, type = 3)## Analysis of Deviance Table (Type III Wald chisquare tests)
##
## Response: correct_count_when_correct_set_chosen
## Chisq Df Pr(>Chisq)
## (Intercept) 6.3653 1 0.01164 *
## age_zscored 4.7937 1 0.02856 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1#effect of trial type AND age.
fit.trial_type_correct_set_and_count <- glmer(correct_count_when_correct_set_chosen ~ trial_type + age_zscored + (1|id)
#+ (1|trial_ratio)
,
data = df.trial,
family="binomial")
summary(fit.trial_type_correct_set_and_count)## Generalized linear mixed model fit by maximum likelihood (Laplace
## Approximation) [glmerMod]
## Family: binomial ( logit )
## Formula: correct_count_when_correct_set_chosen ~ trial_type + age_zscored +
## (1 | id)
## Data: df.trial
##
## AIC BIC logLik deviance df.resid
## 693.0 715.7 -341.5 683.0 679
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.6217 -0.5091 0.1627 0.4600 3.4675
##
## Random effects:
## Groups Name Variance Std.Dev.
## id (Intercept) 4.072 2.018
## Number of obs: 684, groups: id, 78
##
## Fixed effects:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 2.3446 0.3404 6.889 5.63e-12 ***
## trial_typelarge-DR -2.1928 0.3067 -7.151 8.65e-13 ***
## trial_typelarge-NR -2.8995 0.3234 -8.966 < 2e-16 ***
## age_zscored 0.5415 0.2588 2.093 0.0364 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) tr_-DR tr_-NR
## trl_typl-DR -0.592
## trl_typl-NR -0.609 0.689
## age_zscored 0.071 -0.062 -0.082Anova(fit.trial_type_correct_set_and_count, type = 3)## Analysis of Deviance Table (Type III Wald chisquare tests)
##
## Response: correct_count_when_correct_set_chosen
## Chisq Df Pr(>Chisq)
## (Intercept) 47.454 1 5.632e-12 ***
## trial_type 82.194 2 < 2.2e-16 ***
## age_zscored 4.379 1 0.03638 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1anova(fit.trial_type_correct_set_and_count, fit.base_correct_set_and_count, type = 3)## Data: df.trial
## Models:
## fit.base_correct_set_and_count: correct_count_when_correct_set_chosen ~ age_zscored + (1 | id)
## fit.trial_type_correct_set_and_count: correct_count_when_correct_set_chosen ~ trial_type + age_zscored + (1 | id)
## npar AIC BIC logLik deviance Chisq
## fit.base_correct_set_and_count 3 807.98 821.56 -400.99 801.98
## fit.trial_type_correct_set_and_count 5 693.01 715.65 -341.51 683.01 118.96
## Df Pr(>Chisq)
## fit.base_correct_set_and_count
## fit.trial_type_correct_set_and_count 2 < 2.2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# fit.trial_type_correct_set_and_count %>%
# emmeans(specs = pairwise ~ trial_type,
# adjust = "none")
fit.trial_type_correct_set_and_count %>%
emmeans(specs = pairwise ~ trial_type,
adjust = "bonferroni")## $emmeans
## trial_type emmean SE df asymp.LCL asymp.UCL
## small 2.341 0.340 Inf 1.674 3.0074
## large-DR 0.148 0.294 Inf -0.428 0.7232
## large-NR -0.559 0.294 Inf -1.135 0.0171
##
## Results are given on the logit (not the response) scale.
## Confidence level used: 0.95
##
## $contrasts
## contrast estimate SE df z.ratio p.value
## small - (large-DR) 2.193 0.307 Inf 7.151 <.0001
## small - (large-NR) 2.899 0.323 Inf 8.966 <.0001
## (large-DR) - (large-NR) 0.707 0.249 Inf 2.839 0.0136
##
## Results are given on the log odds ratio (not the response) scale.
## P value adjustment: bonferroni method for 3 tests#REFIT, REMOVE TRIAL_RATIO
#effect of age. Not surprising at all since higher age probably mean higher highest count.
fit.base_correct_set_and_count_refit <- glmer(correct_count_when_correct_set_chosen ~ age_zscored + (1|id),
data = df.trial,
family="binomial")
summary(fit.base_correct_set_and_count_refit)## Generalized linear mixed model fit by maximum likelihood (Laplace
## Approximation) [glmerMod]
## Family: binomial ( logit )
## Formula: correct_count_when_correct_set_chosen ~ age_zscored + (1 | id)
## Data: df.trial
##
## AIC BIC logLik deviance df.resid
## 808.0 821.6 -401.0 802.0 681
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -2.3609 -0.7399 0.3071 0.6065 2.1034
##
## Random effects:
## Groups Name Variance Std.Dev.
## id (Intercept) 2.268 1.506
## Number of obs: 684, groups: id, 78
##
## Fixed effects:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 0.4974 0.1972 2.523 0.0116 *
## age_zscored 0.4316 0.1971 2.189 0.0286 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## age_zscored 0.026Anova(fit.base_correct_set_and_count_refit, type = 3)## Analysis of Deviance Table (Type III Wald chisquare tests)
##
## Response: correct_count_when_correct_set_chosen
## Chisq Df Pr(>Chisq)
## (Intercept) 6.3653 1 0.01164 *
## age_zscored 4.7937 1 0.02856 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1#effect of trial type AND age.
fit.trial_type_correct_set_and_count_refit <- glmer(correct_count_when_correct_set_chosen ~ trial_type + age_zscored + (1|id),
data = df.trial,
family="binomial")
summary(fit.trial_type_correct_set_and_count_refit)## Generalized linear mixed model fit by maximum likelihood (Laplace
## Approximation) [glmerMod]
## Family: binomial ( logit )
## Formula: correct_count_when_correct_set_chosen ~ trial_type + age_zscored +
## (1 | id)
## Data: df.trial
##
## AIC BIC logLik deviance df.resid
## 693.0 715.7 -341.5 683.0 679
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.6217 -0.5091 0.1627 0.4600 3.4675
##
## Random effects:
## Groups Name Variance Std.Dev.
## id (Intercept) 4.072 2.018
## Number of obs: 684, groups: id, 78
##
## Fixed effects:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 2.3446 0.3404 6.889 5.63e-12 ***
## trial_typelarge-DR -2.1928 0.3067 -7.151 8.65e-13 ***
## trial_typelarge-NR -2.8995 0.3234 -8.966 < 2e-16 ***
## age_zscored 0.5415 0.2588 2.093 0.0364 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) tr_-DR tr_-NR
## trl_typl-DR -0.592
## trl_typl-NR -0.609 0.689
## age_zscored 0.071 -0.062 -0.082Anova(fit.trial_type_correct_set_and_count_refit, type = 3)## Analysis of Deviance Table (Type III Wald chisquare tests)
##
## Response: correct_count_when_correct_set_chosen
## Chisq Df Pr(>Chisq)
## (Intercept) 47.454 1 5.632e-12 ***
## trial_type 82.194 2 < 2.2e-16 ***
## age_zscored 4.379 1 0.03638 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1anova(fit.trial_type_correct_set_and_count_refit, fit.base_correct_set_and_count_refit, type = 3)## Data: df.trial
## Models:
## fit.base_correct_set_and_count_refit: correct_count_when_correct_set_chosen ~ age_zscored + (1 | id)
## fit.trial_type_correct_set_and_count_refit: correct_count_when_correct_set_chosen ~ trial_type + age_zscored + (1 | id)
## npar AIC BIC logLik deviance
## fit.base_correct_set_and_count_refit 3 807.98 821.56 -400.99 801.98
## fit.trial_type_correct_set_and_count_refit 5 693.01 715.65 -341.51 683.01
## Chisq Df Pr(>Chisq)
## fit.base_correct_set_and_count_refit
## fit.trial_type_correct_set_and_count_refit 118.96 2 < 2.2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# fit.trial_type_correct_set_and_count %>%
# emmeans(specs = pairwise ~ trial_type,
# adjust = "none")
fit.trial_type_correct_set_and_count_refit %>%
emmeans(specs = pairwise ~ trial_type,
adjust = "bonferroni")## $emmeans
## trial_type emmean SE df asymp.LCL asymp.UCL
## small 2.341 0.340 Inf 1.674 3.0074
## large-DR 0.148 0.294 Inf -0.428 0.7232
## large-NR -0.559 0.294 Inf -1.135 0.0171
##
## Results are given on the logit (not the response) scale.
## Confidence level used: 0.95
##
## $contrasts
## contrast estimate SE df z.ratio p.value
## small - (large-DR) 2.193 0.307 Inf 7.151 <.0001
## small - (large-NR) 2.899 0.323 Inf 8.966 <.0001
## (large-DR) - (large-NR) 0.707 0.249 Inf 2.839 0.0136
##
## Results are given on the log odds ratio (not the response) scale.
## P value adjustment: bonferroni method for 3 testsApproximate correct count
Only did this for large set, to take into account kids who might have made a mistake during counting. Does not look significantly different from when exact count is required. Regression using this as a predictor does not show a qualitative difference.
ggplot(data = df.trial %>% filter(trial_type != "small"),
mapping = aes(x = trial_type, y = correct_count_approx_when_correct_set_chosen)) +
geom_jitter(aes(color = id),
height = 0,
alpha = 0.5) +
stat_summary(fun.data = "mean_cl_boot",
geom = "pointrange") +
theme(legend.position = "none")
ggplot(data = df.trial %>% filter(trial_type != "small"),
mapping = aes(x = age_years, y = correct_count_approx)) +
geom_jitter(aes(color = id),
height = 0,
alpha = 0.5) +
stat_summary(fun.data = "mean_cl_boot",
geom = "pointrange") +
theme(legend.position = "none")
ggplot(data = df.trial %>%
select(trial_type, correct_set_chosen, correct_count_when_correct_set_chosen, correct_count_approx_when_correct_set_chosen) %>%
pivot_longer(-trial_type, names_to = "variable", values_to = "value"),
mapping = aes(x = trial_type, y = value, color = variable)) +
geom_jitter(height = 0,
alpha = 0.5) +
stat_summary(fun.data = "mean_cl_boot",
geom = "pointrange",
position = position_dodge(0.7)) +
labs(y = "Cardinal extension success (by trial)",
x = "Trial Type")
Error size
For only trials where counts are given.
ggplot(data = df.trial,
mapping = aes(x = trial_type, y = abs(count_error))) +
geom_jitter(aes(color = id),
height = 0,
alpha = 0.5) +
stat_summary(fun.data = "mean_cl_boot",
geom = "pointrange") +
theme(legend.position = "none")
ggplot(data = df.trial,
mapping = aes(x = age_years, y = abs(count_error))) +
geom_jitter(aes(color = id),
height = 0,
alpha = 0.5) +
stat_summary(fun.data = "mean_cl_boot",
geom = "pointrange") +
theme(legend.position = "none")
Highest count
With correct_set_chosen
Highest count does not explain additional variance.
fit.hc <- glmer(correct_set_chosen ~ highest_count + age_zscored + trial_type + (1|id) + (1|trial_ratio),
data = df.trial %>%
filter(!is.na(highest_count)),
family="binomial")
summary(fit.hc)## Generalized linear mixed model fit by maximum likelihood (Laplace
## Approximation) [glmerMod]
## Family: binomial ( logit )
## Formula: correct_set_chosen ~ highest_count + age_zscored + trial_type +
## (1 | id) + (1 | trial_ratio)
## Data: df.trial %>% filter(!is.na(highest_count))
##
## AIC BIC logLik deviance df.resid
## 620.8 652.2 -303.4 606.8 650
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -5.2161 -0.3599 0.1935 0.3904 2.8574
##
## Random effects:
## Groups Name Variance Std.Dev.
## id (Intercept) 4.36540 2.0894
## trial_ratio (Intercept) 0.08707 0.2951
## Number of obs: 657, groups: id, 75; trial_ratio, 9
##
## Fixed effects:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 2.00881 0.55209 3.639 0.000274 ***
## highest_count 0.02082 0.01498 1.389 0.164777
## age_zscored 0.33404 0.29633 1.127 0.259627
## trial_typelarge-DR -1.15319 0.39408 -2.926 0.003430 **
## trial_typelarge-NR -2.41345 0.40822 -5.912 3.38e-09 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) hghst_ ag_zsc tr_-DR
## highest_cnt -0.675
## age_zscored 0.290 -0.377
## trl_typl-DR -0.409 -0.018 -0.013
## trl_typl-NR -0.437 -0.035 -0.035 0.578Anova(fit.hc, type = 3)## Analysis of Deviance Table (Type III Wald chisquare tests)
##
## Response: correct_set_chosen
## Chisq Df Pr(>Chisq)
## (Intercept) 13.2391 1 0.0002742 ***
## highest_count 1.9298 1 0.1647775
## age_zscored 1.2707 1 0.2596268
## trial_type 35.3140 2 2.146e-08 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1fit.hc_comp <- glmer(correct_set_chosen ~ age_zscored + trial_type + (1|id) + (1|trial_ratio),
data = df.trial %>%
filter(!is.na(highest_count)),
family="binomial")
summary(fit.hc_comp)## Generalized linear mixed model fit by maximum likelihood (Laplace
## Approximation) [glmerMod]
## Family: binomial ( logit )
## Formula: correct_set_chosen ~ age_zscored + trial_type + (1 | id) + (1 |
## trial_ratio)
## Data: df.trial %>% filter(!is.na(highest_count))
##
## AIC BIC logLik deviance df.resid
## 620.7 647.6 -304.4 608.7 651
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -5.2932 -0.3613 0.1917 0.3883 2.8564
##
## Random effects:
## Groups Name Variance Std.Dev.
## id (Intercept) 4.56661 2.137
## trial_ratio (Intercept) 0.08702 0.295
## Number of obs: 657, groups: id, 75; trial_ratio, 9
##
## Fixed effects:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 2.5557 0.4114 6.213 5.21e-10 ***
## age_zscored 0.4965 0.2796 1.776 0.07580 .
## trial_typelarge-DR -1.1547 0.3941 -2.930 0.00339 **
## trial_typelarge-NR -2.4170 0.4082 -5.921 3.21e-09 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) ag_zsc tr_-DR
## age_zscored 0.052
## trl_typl-DR -0.566 -0.022
## trl_typl-NR -0.621 -0.053 0.578Anova(fit.hc_comp, type = 3)## Analysis of Deviance Table (Type III Wald chisquare tests)
##
## Response: correct_set_chosen
## Chisq Df Pr(>Chisq)
## (Intercept) 38.5953 1 5.214e-10 ***
## age_zscored 3.1528 1 0.0758 .
## trial_type 35.4156 2 2.040e-08 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1anova(fit.hc, fit.hc_comp)## Data: df.trial %>% filter(!is.na(highest_count))
## Models:
## fit.hc_comp: correct_set_chosen ~ age_zscored + trial_type + (1 | id) + (1 | trial_ratio)
## fit.hc: correct_set_chosen ~ highest_count + age_zscored + trial_type + (1 | id) + (1 | trial_ratio)
## npar AIC BIC logLik deviance Chisq Df Pr(>Chisq)
## fit.hc_comp 6 620.72 647.64 -304.36 608.72
## fit.hc 7 620.80 652.21 -303.40 606.80 1.9218 1 0.1657With correct_count
fit.hc <- glmer(correct_count_when_correct_set_chosen ~ highest_count + age_zscored + trial_type + (1|id) + (1|trial_ratio),
data = df.trial %>%
filter(!is.na(highest_count)),
family="binomial")## boundary (singular) fit: see help('isSingular')summary(fit.hc)## Generalized linear mixed model fit by maximum likelihood (Laplace
## Approximation) [glmerMod]
## Family: binomial ( logit )
## Formula: correct_count_when_correct_set_chosen ~ highest_count + age_zscored +
## trial_type + (1 | id) + (1 | trial_ratio)
## Data: df.trial %>% filter(!is.na(highest_count))
##
## AIC BIC logLik deviance df.resid
## 665.9 697.3 -325.9 651.9 650
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.6309 -0.5086 0.1627 0.4560 3.6530
##
## Random effects:
## Groups Name Variance Std.Dev.
## id (Intercept) 3.981e+00 1.995e+00
## trial_ratio (Intercept) 5.835e-09 7.639e-05
## Number of obs: 657, groups: id, 75; trial_ratio, 9
##
## Fixed effects:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 1.84711 0.48874 3.779 0.000157 ***
## highest_count 0.01938 0.01389 1.395 0.163137
## age_zscored 0.38709 0.28208 1.372 0.169974
## trial_typelarge-DR -2.23762 0.31782 -7.041 1.92e-12 ***
## trial_typelarge-NR -2.94152 0.33486 -8.784 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) hghst_ ag_zsc tr_-DR
## highest_cnt -0.705
## age_zscored 0.299 -0.378
## trl_typl-DR -0.392 -0.049 -0.041
## trl_typl-NR -0.396 -0.058 -0.055 0.698
## optimizer (Nelder_Mead) convergence code: 0 (OK)
## boundary (singular) fit: see help('isSingular')Anova(fit.hc, type = 3)## Analysis of Deviance Table (Type III Wald chisquare tests)
##
## Response: correct_count_when_correct_set_chosen
## Chisq Df Pr(>Chisq)
## (Intercept) 14.2836 1 0.0001572 ***
## highest_count 1.9449 1 0.1631370
## age_zscored 1.8832 1 0.1699740
## trial_type 78.7766 2 < 2.2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1fit.hc_comp <- glmer(correct_count_when_correct_set_chosen ~ age_zscored + trial_type + (1|id) + (1|trial_ratio),
data = df.trial %>%
filter(!is.na(highest_count)),
family="binomial")## boundary (singular) fit: see help('isSingular')summary(fit.hc_comp)## Generalized linear mixed model fit by maximum likelihood (Laplace
## Approximation) [glmerMod]
## Family: binomial ( logit )
## Formula: correct_count_when_correct_set_chosen ~ age_zscored + trial_type +
## (1 | id) + (1 | trial_ratio)
## Data: df.trial %>% filter(!is.na(highest_count))
##
## AIC BIC logLik deviance df.resid
## 665.8 692.7 -326.9 653.8 651
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.6878 -0.5053 0.1596 0.4542 3.5387
##
## Random effects:
## Groups Name Variance Std.Dev.
## id (Intercept) 4.137 2.034
## trial_ratio (Intercept) 0.000 0.000
## Number of obs: 657, groups: id, 75; trial_ratio, 9
##
## Fixed effects:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 2.3505 0.3503 6.711 1.94e-11 ***
## age_zscored 0.5429 0.2655 2.045 0.0409 *
## trial_typelarge-DR -2.2380 0.3177 -7.044 1.87e-12 ***
## trial_typelarge-NR -2.9431 0.3347 -8.793 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) ag_zsc tr_-DR
## age_zscored 0.049
## trl_typl-DR -0.597 -0.064
## trl_typl-NR -0.613 -0.083 0.698
## optimizer (Nelder_Mead) convergence code: 0 (OK)
## boundary (singular) fit: see help('isSingular')Anova(fit.hc_comp, type = 3)## Analysis of Deviance Table (Type III Wald chisquare tests)
##
## Response: correct_count_when_correct_set_chosen
## Chisq Df Pr(>Chisq)
## (Intercept) 45.0315 1 1.939e-11 ***
## age_zscored 4.1813 1 0.04087 *
## trial_type 78.9331 2 < 2.2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1anova(fit.hc, fit.hc_comp)## Data: df.trial %>% filter(!is.na(highest_count))
## Models:
## fit.hc_comp: correct_count_when_correct_set_chosen ~ age_zscored + trial_type + (1 | id) + (1 | trial_ratio)
## fit.hc: correct_count_when_correct_set_chosen ~ highest_count + age_zscored + trial_type + (1 | id) + (1 | trial_ratio)
## npar AIC BIC logLik deviance Chisq Df Pr(>Chisq)
## fit.hc_comp 6 665.80 692.72 -326.90 653.80
## fit.hc 7 665.86 697.27 -325.93 651.86 1.9368 1 0.164#REFIT
fit.hc <- glmer(correct_count_when_correct_set_chosen ~ highest_count + age_zscored + trial_type + (1|id),
data = df.trial %>%
filter(!is.na(highest_count)),
family="binomial")
summary(fit.hc)## Generalized linear mixed model fit by maximum likelihood (Laplace
## Approximation) [glmerMod]
## Family: binomial ( logit )
## Formula: correct_count_when_correct_set_chosen ~ highest_count + age_zscored +
## trial_type + (1 | id)
## Data: df.trial %>% filter(!is.na(highest_count))
##
## AIC BIC logLik deviance df.resid
## 663.9 690.8 -325.9 651.9 651
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.6309 -0.5086 0.1627 0.4560 3.6531
##
## Random effects:
## Groups Name Variance Std.Dev.
## id (Intercept) 3.981 1.995
## Number of obs: 657, groups: id, 75
##
## Fixed effects:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 1.84709 0.48874 3.779 0.000157 ***
## highest_count 0.01938 0.01389 1.395 0.163114
## age_zscored 0.38706 0.28208 1.372 0.170008
## trial_typelarge-DR -2.23764 0.31783 -7.040 1.92e-12 ***
## trial_typelarge-NR -2.94157 0.33486 -8.784 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) hghst_ ag_zsc tr_-DR
## highest_cnt -0.705
## age_zscored 0.299 -0.378
## trl_typl-DR -0.392 -0.050 -0.041
## trl_typl-NR -0.396 -0.058 -0.055 0.698Anova(fit.hc, type = 3)## Analysis of Deviance Table (Type III Wald chisquare tests)
##
## Response: correct_count_when_correct_set_chosen
## Chisq Df Pr(>Chisq)
## (Intercept) 14.2829 1 0.0001573 ***
## highest_count 1.9451 1 0.1631137
## age_zscored 1.8829 1 0.1700075
## trial_type 78.7762 2 < 2.2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1fit.hc_comp <- glmer(correct_count_when_correct_set_chosen ~ age_zscored + trial_type + (1|id),
data = df.trial %>%
filter(!is.na(highest_count)),
family="binomial")
summary(fit.hc_comp)## Generalized linear mixed model fit by maximum likelihood (Laplace
## Approximation) [glmerMod]
## Family: binomial ( logit )
## Formula: correct_count_when_correct_set_chosen ~ age_zscored + trial_type +
## (1 | id)
## Data: df.trial %>% filter(!is.na(highest_count))
##
## AIC BIC logLik deviance df.resid
## 663.8 686.2 -326.9 653.8 652
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.6878 -0.5053 0.1596 0.4542 3.5387
##
## Random effects:
## Groups Name Variance Std.Dev.
## id (Intercept) 4.137 2.034
## Number of obs: 657, groups: id, 75
##
## Fixed effects:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 2.3505 0.3503 6.711 1.94e-11 ***
## age_zscored 0.5429 0.2655 2.045 0.0409 *
## trial_typelarge-DR -2.2380 0.3177 -7.044 1.87e-12 ***
## trial_typelarge-NR -2.9431 0.3347 -8.793 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) ag_zsc tr_-DR
## age_zscored 0.049
## trl_typl-DR -0.597 -0.064
## trl_typl-NR -0.613 -0.083 0.698Anova(fit.hc_comp, type = 3)## Analysis of Deviance Table (Type III Wald chisquare tests)
##
## Response: correct_count_when_correct_set_chosen
## Chisq Df Pr(>Chisq)
## (Intercept) 45.0311 1 1.939e-11 ***
## age_zscored 4.1813 1 0.04087 *
## trial_type 78.9322 2 < 2.2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1anova(fit.hc, fit.hc_comp)## Data: df.trial %>% filter(!is.na(highest_count))
## Models:
## fit.hc_comp: correct_count_when_correct_set_chosen ~ age_zscored + trial_type + (1 | id)
## fit.hc: correct_count_when_correct_set_chosen ~ highest_count + age_zscored + trial_type + (1 | id)
## npar AIC BIC logLik deviance Chisq Df Pr(>Chisq)
## fit.hc_comp 5 663.80 686.24 -326.90 653.80
## fit.hc 6 663.86 690.79 -325.93 651.86 1.9368 1 0.164Error analysis
What kind of errors are kids making?
df.error_obs <- df.trial %>%
filter(trial_type != "small") %>%
mutate(response_type =
case_when(
correct_set_chosen == 1 ~ "correct",
set_chosen == "top" | set_chosen == "bottom" ~ "counted_wrong",
set_chosen == "both" ~ "counted_both",
is.na(set_chosen) ~ "counted_none",
)) %>%
group_by(trial_type, response_type) %>%
count()
df.error_table <- df.error_obs %>%
pivot_wider(names_from = trial_type,
values_from = n) %>%
ungroup() %>%
mutate(`large-DR` = paste(`large-DR`, " (", force_decimals(`large-DR` / sum(`large-DR`) * 100), "%)", sep = ""),
`large-NR` = paste(`large-NR`, " (", force_decimals(`large-NR` / sum(`large-NR`) * 100), "%)", sep = "")) %>%
mutate(response_type = factor(response_type,
levels = c("correct", "counted_wrong",
"counted_both", "counted_none"),
labels = c("Correct",
"Incorrect, chose distractor set",
"Incorrect, chose both sets",
"Incorrect, did not choose a set")))
df.error_chisq <- df.error_obs %>%
pivot_wider(names_from = response_type,
values_from = n) %>%
ungroup() %>%
select(!c(trial_type, correct))
chisq.test(df.error_chisq)##
## Pearson's Chi-squared test
##
## data: df.error_chisq
## X-squared = 14.596, df = 2, p-value = 0.0006769chisq.posthoc.test(df.error_chisq, round = 3)## Dimension Value counted_both counted_none counted_wrong
## 1 1 Residuals 1.612286 2.307349 -3.81550486245952
## 2 1 p values 0.641000 0.126000 0.001*
## 3 2 Residuals -1.612286 -2.307349 3.81550486245952
## 4 2 p values 0.641000 0.126000 0.001*Individual analysis
Are kids consistently failing at a certain type of trial? Code ‘success at small’ as 100% success in all 3 small trials, etc.
Venn diagram shows expected results. 15 kids did not show 100% success at any trial type (they could have succeeded in 1 trial, but not all 3). 13 kids only succeeded at small trials. 3 kid only succeeded at large - DR trials. No kid only succeeded at large - NDR trials.
3 kids succeeded at only small + large NDR trials. 19 kids succeeded at only small + large DR trials. 1 kid succeeded at only large NDR + DR trials, but this could be because of a parallax issue – on the video (and in person) he looks like he was counting the bottom trial, but gave the quantity of the top trial.
df.indiv_analysis <- df.trial %>%
group_by(id, trial_type, age_years) %>%
summarise(mean_correct_set_chosen = mean(correct_set_chosen)) %>%
pivot_wider(names_from = trial_type, values_from = mean_correct_set_chosen) %>%
mutate(succeed_small = ifelse(small == 1, 1, 0),
succeed_large_NR = ifelse(`large-NR` == 1, 1, 0),
succeed_large_DR = ifelse(`large-DR` == 1, 1, 0))## `summarise()` has grouped output by 'id', 'trial_type'. You can override using
## the `.groups` argument.df.indiv_analysis_summary <- df.indiv_analysis %>%
ungroup() %>%
summarise(
n_succeed_in_small = sum(succeed_small == 1),
n_succeed_in_largeDR = sum(succeed_large_DR == 1),
n_succeed_in_largeNR = sum(succeed_large_NR == 1),
n_succeed_in_small_largeNR = sum(succeed_small == 1 & succeed_large_NR == 1),
n_succeed_in_small_largeDR = sum(succeed_small == 1 & succeed_large_DR == 1),
n_succeed_in_largeNR_largeDR = sum(succeed_large_NR == 1 & succeed_large_DR == 1),
n_succeed_in_all = sum(succeed_small == 1 & succeed_large_NR == 1 & succeed_large_DR == 1),
)
grid.newpage()
venn_object <- draw.triple.venn(area1 = df.indiv_analysis_summary %>% pull(n_succeed_in_small),
area2 = df.indiv_analysis_summary %>% pull(n_succeed_in_largeDR),
area3 = df.indiv_analysis_summary %>% pull(n_succeed_in_largeNR),
n12 = df.indiv_analysis_summary %>% pull(n_succeed_in_small_largeDR),
n23 = df.indiv_analysis_summary %>% pull(n_succeed_in_largeNR_largeDR),
n13 = df.indiv_analysis_summary %>% pull(n_succeed_in_small_largeNR),
n123 = df.indiv_analysis_summary %>% pull(n_succeed_in_all),
category = c("Small", "Large - DR", "Large - NR"),
fill = c("pink", "green", "orange"))
grid.draw(venn_object)
ppt_all_correct <- df.indiv_analysis %>%
filter(succeed_small == 1 & succeed_large_DR == 1 & succeed_large_NR & 1) %>%
pull(id)
df.all_correct <- df.trial %>%
filter(id %in% ppt_all_correct)
df.all_correct %>% summarise(mean_hc = mean(highest_count, na.rm = T),
mean_age = mean(age_years_cont, na.rm = T))## mean_hc mean_age
## 1 28.54348 4.884484df.not_all_correct <- df.trial %>%
filter(!id %in% ppt_all_correct)
df.not_all_correct %>% summarise(mean_hc = mean(highest_count, na.rm = T),
mean_age = mean(age_years_cont, na.rm = T))## mean_hc mean_age
## 1 25.37187 4.60375df.trial %>%
filter(!id %in% ppt_all_correct) %>%
group_by(set_chosen, as.factor(count)) %>%
count()## # A tibble: 77 × 3
## # Groups: set_chosen, as.factor(count) [77]
## set_chosen `as.factor(count)` n
## <chr> <fct> <int>
## 1 both 0 4
## 2 both 2 2
## 3 both 3 8
## 4 both 4 8
## 5 both 5 7
## 6 both 6 1
## 7 both 8 2
## 8 both 9 1
## 9 both 10 4
## 10 both 11 3
## # ℹ 67 more rowsWhat if we plot NDR performance against DR performance?
ggplot(data = df.indiv_analysis,
mapping = aes(x = `large-DR`, y = `large-NR`, color = as.factor(age_years))) +
geom_jitter(alpha = 0.6) +
geom_abline(slope=1, intercept= 0) +
geom_vline(xintercept = 0.5) +
geom_hline(yintercept = 0.5) +
labs(color = "Age")
#theme(legend.position = "none") Sanity Check
Stim Set Analysis
ggplot(data = df.trial,
mapping = aes(x = stim_set, y = correct_set_chosen)) +
geom_jitter(height = 0,
alpha = 0.5) +
stat_summary(fun.data = "mean_cl_boot",
geom = "pointrange") +
geom_hline(yintercept = 0.5, linetype = 2) +
theme(legend.position = "none") +
labs(y = "Cardinal extension success (by trial)",
x = "Stim Set",
title = "Correct set chosen") 
summary(glmer(correct_set_chosen ~ stim_set + (1|id) + (1|trial_ratio),
data = df.trial, family="binomial"))## Generalized linear mixed model fit by maximum likelihood (Laplace
## Approximation) [glmerMod]
## Family: binomial ( logit )
## Formula: correct_set_chosen ~ stim_set + (1 | id) + (1 | trial_ratio)
## Data: df.trial
##
## AIC BIC logLik deviance df.resid
## 669.6 687.8 -330.8 661.6 680
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.9235 -0.3656 0.2274 0.4302 2.7585
##
## Random effects:
## Groups Name Variance Std.Dev.
## id (Intercept) 4.5158 2.1250
## trial_ratio (Intercept) 0.9238 0.9611
## Number of obs: 684, groups: id, 78; trial_ratio, 9
##
## Fixed effects:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 1.9109 0.7540 2.534 0.0113 *
## stim_set -0.2174 0.2422 -0.897 0.3695
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## stim_set -0.829Trial order
No effect of trial order.
ggplot(data = df.trial,
mapping = aes(x = trial, y = correct_set_chosen)) +
geom_jitter(height = 0,
alpha = 0.5) +
stat_summary(fun.data = "mean_cl_boot",
geom = "pointrange") +
theme(legend.position = "none") +
facet_grid(~stim_set) +
labs(y = "Cardinal extension success (by trial)",
x = "Trial #",
title = "Correct set chosen") 
summary(glmer(correct_set_chosen ~ trial + (1|id) + (1|trial_ratio),
data = df.trial, family="binomial"))## Generalized linear mixed model fit by maximum likelihood (Laplace
## Approximation) [glmerMod]
## Family: binomial ( logit )
## Formula: correct_set_chosen ~ trial + (1 | id) + (1 | trial_ratio)
## Data: df.trial
##
## AIC BIC logLik deviance df.resid
## 670.0 688.1 -331.0 662.0 680
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.9737 -0.3709 0.2333 0.4309 2.6709
##
## Random effects:
## Groups Name Variance Std.Dev.
## id (Intercept) 4.5215 2.1264
## trial_ratio (Intercept) 0.9347 0.9668
## Number of obs: 684, groups: id, 78; trial_ratio, 9
##
## Fixed effects:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 1.18838 0.48020 2.475 0.0133 *
## trial 0.03246 0.04581 0.709 0.4786
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## trial -0.473Do kids get better at Large-NR trials with more exposure to them? Not really.
df.nr <- df.trial %>%
filter(trial_type == "large-NR") %>%
mutate(trial_nr_order = case_when(
stim_set == 1 & trial == 3 ~ 1,
stim_set == 1 & trial == 5 ~ 2,
stim_set == 1 & trial == 8 ~ 3,
stim_set == 2 & trial == 1 ~ 1,
stim_set == 2 & trial == 5 ~ 2,
stim_set == 2 & trial == 7 ~ 3,
stim_set == 3 & trial == 4 ~ 1,
stim_set == 3 & trial == 5 ~ 2,
stim_set == 3 & trial == 9 ~ 3,
stim_set == 4 & trial == 4 ~ 1,
stim_set == 4 & trial == 7 ~ 2,
stim_set == 4 & trial == 9 ~ 3
))
df.nr %>% group_by(stim_set, trial_nr_order) %>%
count()## # A tibble: 12 × 3
## # Groups: stim_set, trial_nr_order [12]
## stim_set trial_nr_order n
## <int> <dbl> <int>
## 1 1 1 18
## 2 1 2 18
## 3 1 3 18
## 4 2 1 19
## 5 2 2 19
## 6 2 3 19
## 7 3 1 19
## 8 3 2 20
## 9 3 3 19
## 10 4 1 20
## 11 4 2 20
## 12 4 3 20t.test(df.nr %>%
filter(trial_nr_order == 3) %>%
pull(correct_set_chosen), mu = 0.5)##
## One Sample t-test
##
## data: df.nr %>% filter(trial_nr_order == 3) %>% pull(correct_set_chosen)
## t = 2.1112, df = 75, p-value = 0.03809
## alternative hypothesis: true mean is not equal to 0.5
## 95 percent confidence interval:
## 0.5066793 0.7301628
## sample estimates:
## mean of x
## 0.6184211ggplot(data = df.nr,
mapping = aes(x = trial_nr_order, y = correct_set_chosen)) +
geom_jitter(height = 0,
alpha = 0.5) +
stat_summary(fun.data = "mean_cl_boot",
geom = "pointrange") +
theme(legend.position = "none") +
facet_grid(~stim_set) +
geom_hline(yintercept = 0.5, linetype = 2) +
labs(y = "Cardinal extension success (by trial)",
x = "NR Trial #",
title = "Correct set chosen") 