Prediction condition
-
# from 7 to 11 years
-for(i in 7:11){
- cat(str_c("Age = ", i, "\n\n"))
- fun.regression(
- formula = "dis_yes ~ 1 + condition_amb + (1 | participant)",
- data = df.exp2.predict %>%
- filter(age_group == i))
-}
+
# from 7 to 11 years
+for(i in 7:11){
+ cat(str_c("Age = ", i, "\n\n"))
+ fun.regression(
+ formula = "dis_yes ~ 1 + condition_amb + (1 | participant)",
+ data = df.exp2.predict %>%
+ filter(age_group == i))
+}
Age = 7
Generalized linear mixed model fit by maximum likelihood (Laplace
@@ -4522,14 +4533,14 @@ Prediction condition
Inference condition
-
# from 7 to 11 years
-for(i in 7:11){
- cat(str_c("Age = ", i, "\n\n"))
- fun.regression(
- formula = "ambiguous_yes ~ 1 + condition_disagree + (1 | participant)",
- data = df.exp2.infer %>%
- filter(age_group == i))
-}
+
# from 7 to 11 years
+for(i in 7:11){
+ cat(str_c("Age = ", i, "\n\n"))
+ fun.regression(
+ formula = "ambiguous_yes ~ 1 + condition_disagree + (1 | participant)",
+ data = df.exp2.infer %>%
+ filter(age_group == i))
+}
Age = 7
Generalized linear mixed model fit by maximum likelihood (Laplace
@@ -4615,14 +4626,14 @@ Inference condition
Inference condition: First story only
Examine story 1 (trials 1 and 2) and story 4 (trials 7 and 8) among 7-year-olds.
-# story 1, 7 year olds
-df.exp2.infer.7.1 = df.exp2.infer %>%
- filter(age_group == 7 &
- (trial == "trial 1" |trial == "trial 2"))
-
-results = fun.regression(
- formula = "ambiguous_yes ~ 1 + condition_disagree + (1 | participant)",
- data = df.exp2.infer.7.1)
# story 1, 7 year olds
+df.exp2.infer.7.1 = df.exp2.infer %>%
+ filter(age_group == 7 &
+ (trial == "trial 1" |trial == "trial 2"))
+
+results = fun.regression(
+ formula = "ambiguous_yes ~ 1 + condition_disagree + (1 | participant)",
+ data = df.exp2.infer.7.1)
boundary (singular) fit: see help('isSingular')
Generalized linear mixed model fit by maximum likelihood (Laplace
Approximation) [glmerMod]
@@ -4639,12 +4650,12 @@ Inference condition: Fi
(Intercept) condition_disagree
-0.6931 -0.4055
optimizer (Nelder_Mead) convergence code: 0 (OK) ; 0 optimizer warnings; 1 lme4 warnings
-prop.table(table(df.exp2.infer.7.1$condition_disagree, df.exp2.infer.7.1$ambiguous_yes), margin=1)
prop.table(table(df.exp2.infer.7.1$condition_disagree, df.exp2.infer.7.1$ambiguous_yes), margin=1)
0 1
0 0.6666667 0.3333333
1 0.7500000 0.2500000
-fun.table(results, type = "confirmatory")
fun.table(results, type = "confirmatory")
@@ -4729,14 +4740,14 @@ Inference condition: Fi
-# story 4, 7 year olds
-df.exp2.infer.7.4 = df.exp2.infer %>%
- filter(age_group == 7 &
- (trial == "trial 7" |trial == "trial 8"))
-
-results = fun.regression(
- formula = "ambiguous_yes ~ 1 + condition_disagree + (1 | participant)",
- data = df.exp2.infer.7.4)
# story 4, 7 year olds
+df.exp2.infer.7.4 = df.exp2.infer %>%
+ filter(age_group == 7 &
+ (trial == "trial 7" |trial == "trial 8"))
+
+results = fun.regression(
+ formula = "ambiguous_yes ~ 1 + condition_disagree + (1 | participant)",
+ data = df.exp2.infer.7.4)
boundary (singular) fit: see help('isSingular')
Generalized linear mixed model fit by maximum likelihood (Laplace
Approximation) [glmerMod]
@@ -4753,12 +4764,12 @@ Inference condition: Fi
(Intercept) condition_disagree
-1.099 1.435
optimizer (Nelder_Mead) convergence code: 0 (OK) ; 0 optimizer warnings; 1 lme4 warnings
-prop.table(table(df.exp2.infer.7.4$condition_disagree, df.exp2.infer.7.4$ambiguous_yes), margin=1)
prop.table(table(df.exp2.infer.7.4$condition_disagree, df.exp2.infer.7.4$ambiguous_yes), margin=1)
0 1
0 0.7500000 0.2500000
1 0.4166667 0.5833333
-fun.table(results, type = "confirmatory")
fun.table(results, type = "confirmatory")
@@ -4846,269 +4857,208 @@ Inference condition: Fi
-
-
Bootstrapping confidence intervals
-
-
Prediction condition
-
set.seed(1)
+
+
Bayesian model
+
+
Prediction data
+
df.exp2.predict.prob = df.exp2.predict %>%
+ count(age_group, condition_amb_c, dis_yes) %>%
+ group_by(age_group, condition_amb_c) %>%
+ mutate(probability = n/sum(n)) %>%
+ ungroup() %>%
+ mutate(utterance = str_remove_all(condition_amb_c, " Trials"),
+ utterance = factor(utterance,
+ levels = c("Unambiguous", "Ambiguous")),
+ agreement = factor(dis_yes,
+ levels = c(0, 1),
+ labels = c("agree", "disagree"))) %>%
+ select(-c(condition_amb_c, dis_yes, n)) %>%
+ relocate(probability, .after = last_col()) %>%
+ arrange(age_group, utterance, agreement)
+
+
+
Without softmax
+
utterance_prior = c(0.5, 0.5)
-# number of bootstrap samples
-n_bootstraps = 1000
-
-df.prediction.boot = df.exp2.predict %>%
- bootstraps(times = n_bootstraps,
- strata = age_group) %>%
- mutate(prob = map(.x = splits,
- .f = ~ .x %>%
- as_tibble() %>%
- count(age_group, condition_amb_c, dis_yes) %>%
- complete(age_group, condition_amb_c, dis_yes,
- fill = list(n = 0)) %>%
- group_by(age_group, condition_amb_c) %>%
- # compute probability
- reframe(p = n/sum(n)) %>%
- arrange(age_group, condition_amb_c) %>%
- # keep only even rows
- filter(row_number() %% 2 == 0))) %>%
- unnest(prob) %>%
- select(-splits) %>%
- group_by(age_group, condition_amb_c) %>%
- summarize(p_low = quantile(p, 0.025),
- p_high = quantile(p, 0.975)) %>%
- ungroup()
+
df.inference = df.exp2.predict.prob %>%
+
group_by(agreement, age_group) %>%
+
mutate(prior = utterance_prior) %>%
+
mutate(posterior = probability * prior /
+
sum(probability * prior)) %>%
+
ungroup()
+
+
df.model.posterior = df.inference %>%
+
rename(condition = agreement) %>%
+
mutate(condition = factor(condition,
+
levels = c("agree", "disagree"),
+
labels = c("Agreement Trials", "Disagreement Trials"))) %>%
+
filter(utterance == "Ambiguous")
-
Inference condition
-
set.seed(1)
+
+
One softmax parameter
+
age = 7:11
-# number of bootstrap samples
-n_bootstraps = 1000
-
-df.inference.boot = df.exp2.infer %>%
- bootstraps(times = n_bootstraps,
- strata = age_group) %>%
- mutate(prob = map(.x = splits,
- .f = ~ .x %>%
- as_tibble() %>%
- count(age_group, condition_disagree_c, ambiguous_yes) %>%
- complete(age_group, condition_disagree_c, ambiguous_yes,
- fill = list(n = 0)) %>%
- group_by(age_group, condition_disagree_c) %>%
- # compute probability
- reframe(p = n/sum(n)) %>%
- arrange(age_group, condition_disagree_c) %>%
- # keep only even rows
- filter(row_number() %% 2 == 0))) %>%
- unnest(prob) %>%
- select(-splits) %>%
- group_by(age_group, condition_disagree_c) %>%
- summarize(p_low = quantile(p, 0.025),
- p_high = quantile(p, 0.975)) %>%
- ungroup()
-
-
-
Bayesian model
-
-
Prediction data
-
df.exp2.predict.prob = df.exp2.predict %>%
- count(age_group, condition_amb_c, dis_yes) %>%
- group_by(age_group, condition_amb_c) %>%
- mutate(probability = n/sum(n)) %>%
- ungroup() %>%
- mutate(utterance = str_remove_all(condition_amb_c, " Trials"),
- utterance = factor(utterance,
- levels = c("Unambiguous", "Ambiguous")),
- agreement = factor(dis_yes,
- levels = c(0, 1),
- labels = c("agree", "disagree"))) %>%
- select(-c(condition_amb_c, dis_yes, n)) %>%
- relocate(probability, .after = last_col()) %>%
- arrange(age_group, utterance, agreement)
-
-
-
Without softmax
-
utterance_prior = c(0.5, 0.5)
-
-df.inference = df.exp2.predict.prob %>%
- group_by(agreement, age_group) %>%
- mutate(prior = utterance_prior) %>%
- mutate(posterior = probability * prior /
- sum(probability * prior)) %>%
- ungroup()
-
-df.model.posterior = df.inference %>%
- rename(condition = agreement) %>%
- mutate(condition = factor(condition,
- levels = c("agree", "disagree"),
- labels = c("Agreement Trials", "Disagreement Trials"))) %>%
- filter(utterance == "Ambiguous")
+
softmax = function(vec, temp = 3) {
+
out = exp(vec*temp) / sum(exp(vec*temp))
+
return(out)
+
}
+
+
df.data = df.exp2.infer %>%
+
count(age_group, condition_disagree_c, ambiguous_yes) %>%
+
group_by(age_group, condition_disagree_c) %>%
+
reframe(p = n/sum(n)) %>%
+
filter(row_number() %% 2 == 0) %>%
+
rename(agreement = condition_disagree_c) %>%
+
mutate(agreement = ifelse(agreement == "Agreement Trials", "agree", "disagree"))
+
+
fit_softmax = function(beta){
+
df.prediction = df.inference %>%
+
filter(age_group %in% age) %>%
+
select(age_group, utterance, agreement, posterior) %>%
+
pivot_wider(names_from = utterance,
+
values_from = posterior) %>%
+
rowwise() %>%
+
mutate(Unambiguous_soft = softmax(c(Unambiguous, Ambiguous),
+
temp = beta)[1],
+
Ambiguous_soft = softmax(c(Unambiguous, Ambiguous),
+
temp = beta)[2]) %>%
+
select(age_group, agreement, prediction = Ambiguous_soft)
+
+
# compute loss as squared error
+
loss = df.data %>%
+
filter(age_group %in% age) %>%
+
left_join(df.prediction) %>%
+
mutate(loss = (p-prediction)^2) %>%
+
pull(loss) %>%
+
sum()
+
+
return(loss)
+
}
+
+
# find best fitting softmax parameter
+
fit = optim(par = 0,
+
fn = fit_softmax)
+
+
# use the best parameter
+
beta = fit[[1]]
+
+
# model with softmax
+
df.model.softmax = df.inference %>%
+
select(age_group, utterance, agreement, posterior) %>%
+
pivot_wider(names_from = utterance,
+
values_from = posterior) %>%
+
rowwise() %>%
+
mutate(Unambiguous_soft = softmax(c(Unambiguous, Ambiguous),
+
temp = beta)[1],
+
Ambiguous_soft = softmax(c(Unambiguous, Ambiguous),
+
temp = beta)[2]) %>%
+
select(age_group, condition = agreement, posterior = Ambiguous_soft) %>%
+
mutate(condition = factor(condition,
+
levels = c("agree", "disagree"),
+
labels = c("Agreement Trials", "Disagreement Trials")))
-
-
One softmax parameter
-
age = 7:11
-
-softmax = function(vec, temp = 3) {
- out = exp(vec*temp) / sum(exp(vec*temp))
- return(out)
-}
-
-df.data = df.exp2.infer %>%
- count(age_group, condition_disagree_c, ambiguous_yes) %>%
- group_by(age_group, condition_disagree_c) %>%
- reframe(p = n/sum(n)) %>%
- filter(row_number() %% 2 == 0) %>%
- rename(agreement = condition_disagree_c) %>%
- mutate(agreement = ifelse(agreement == "Agreement Trials", "agree", "disagree"))
-
-fit_softmax = function(beta){
- df.prediction = df.inference %>%
- filter(age_group %in% age) %>%
- select(age_group, utterance, agreement, posterior) %>%
- pivot_wider(names_from = utterance,
- values_from = posterior) %>%
- rowwise() %>%
- mutate(Unambiguous_soft = softmax(c(Unambiguous, Ambiguous),
- temp = beta)[1],
- Ambiguous_soft = softmax(c(Unambiguous, Ambiguous),
- temp = beta)[2]) %>%
- select(age_group, agreement, prediction = Ambiguous_soft)
-
- # compute loss as squared error
- loss = df.data %>%
- filter(age_group %in% age) %>%
- left_join(df.prediction) %>%
- mutate(loss = (p-prediction)^2) %>%
- pull(loss) %>%
- sum()
-
- return(loss)
-}
-
-# find best fitting softmax parameter
-fit = optim(par = 0,
- fn = fit_softmax)
-
-# use the best parameter
-beta = fit[[1]]
-
-# model with softmax
-df.model.softmax = df.inference %>%
- select(age_group, utterance, agreement, posterior) %>%
- pivot_wider(names_from = utterance,
- values_from = posterior) %>%
- rowwise() %>%
- mutate(Unambiguous_soft = softmax(c(Unambiguous, Ambiguous),
- temp = beta)[1],
- Ambiguous_soft = softmax(c(Unambiguous, Ambiguous),
- temp = beta)[2]) %>%
- select(age_group, condition = agreement, posterior = Ambiguous_soft) %>%
- mutate(condition = factor(condition,
- levels = c("agree", "disagree"),
- labels = c("Agreement Trials", "Disagreement Trials")))
+
+
Separate softmax for each age
+
i = 1
+beta.age = numeric()
+for (age in 7:11){
+ beta.age[i] = optim(par = 0,
+ fn = fit_softmax)[[1]]
+ i = i + 1
+}
+
+df.model.softmax.separate = df.inference %>%
+ select(age_group, utterance, agreement, posterior) %>%
+ pivot_wider(names_from = utterance,
+ values_from = posterior) %>%
+ group_by(age_group) %>%
+ nest() %>%
+ ungroup() %>%
+ mutate(beta = beta.age) %>%
+ mutate(data = map2(.x = data,
+ .y = beta,
+ .f = ~ .x %>%
+ rowwise() %>%
+ mutate(Unambiguous_soft = softmax(c(Unambiguous, Ambiguous),
+ temp = .y)[1],
+ Ambiguous_soft = softmax(c(Unambiguous, Ambiguous),
+ temp = .y)[2]))) %>%
+ select(-beta) %>%
+ unnest(data) %>%
+ select(age_group, condition = agreement, posterior = Ambiguous_soft) %>%
+ mutate(condition = factor(condition,
+ levels = c("agree", "disagree"),
+ labels = c("Agreement Trials", "Disagreement Trials")))
-
-
Separate softmax for each age
-
i = 1
-beta.age = numeric()
-for (age in 7:11){
- beta.age[i] = optim(par = 0,
- fn = fit_softmax)[[1]]
- i = i + 1
-}
-
-df.model.softmax.separate = df.inference %>%
- select(age_group, utterance, agreement, posterior) %>%
- pivot_wider(names_from = utterance,
- values_from = posterior) %>%
- group_by(age_group) %>%
- nest() %>%
- ungroup() %>%
- mutate(beta = beta.age) %>%
- mutate(data = map2(.x = data,
- .y = beta,
- .f = ~ .x %>%
- rowwise() %>%
- mutate(Unambiguous_soft = softmax(c(Unambiguous, Ambiguous),
- temp = .y)[1],
- Ambiguous_soft = softmax(c(Unambiguous, Ambiguous),
- temp = .y)[2]))) %>%
- select(-beta) %>%
- unnest(data) %>%
- select(age_group, condition = agreement, posterior = Ambiguous_soft) %>%
- mutate(condition = factor(condition,
- levels = c("agree", "disagree"),
- labels = c("Agreement Trials", "Disagreement Trials")))
-
-
-
Linear increase in softmax
+
+
Linear increase in softmax
- fit linear model to the best-fitting softmax parameters
-
df.beta.linear = tibble(softmax = beta.age) %>%
- mutate(x = 1:n())
-
-fit = lm(formula = softmax ~ 1 + x,
- data = df.beta.linear)
-
-df.beta.linear = df.beta.linear %>%
- mutate(prediction = predict(fit))
-
-
-df.model.softmax.linear = df.inference %>%
- select(age_group, utterance, agreement, posterior) %>%
- pivot_wider(names_from = utterance,
- values_from = posterior) %>%
- group_by(age_group) %>%
- nest() %>%
- ungroup() %>%
- mutate(beta = df.beta.linear$prediction) %>%
- mutate(data = map2(.x = data,
- .y = beta,
- .f = ~ .x %>%
- rowwise() %>%
- mutate(Unambiguous_soft = softmax(c(Unambiguous, Ambiguous),
- temp = .y)[1],
- Ambiguous_soft = softmax(c(Unambiguous, Ambiguous),
- temp = .y)[2]))) %>%
- select(-beta) %>%
- unnest(data) %>%
- select(age_group, condition = agreement, posterior = Ambiguous_soft) %>%
- mutate(condition = factor(condition,
- levels = c("agree", "disagree"),
- labels = c("Agreement Trials", "Disagreement Trials")))
+
df.beta.linear = tibble(softmax = beta.age) %>%
+ mutate(x = 1:n())
+
+fit = lm(formula = softmax ~ 1 + x,
+ data = df.beta.linear)
+
+df.beta.linear = df.beta.linear %>%
+ mutate(prediction = predict(fit))
+
+
+df.model.softmax.linear = df.inference %>%
+ select(age_group, utterance, agreement, posterior) %>%
+ pivot_wider(names_from = utterance,
+ values_from = posterior) %>%
+ group_by(age_group) %>%
+ nest() %>%
+ ungroup() %>%
+ mutate(beta = df.beta.linear$prediction) %>%
+ mutate(data = map2(.x = data,
+ .y = beta,
+ .f = ~ .x %>%
+ rowwise() %>%
+ mutate(Unambiguous_soft = softmax(c(Unambiguous, Ambiguous),
+ temp = .y)[1],
+ Ambiguous_soft = softmax(c(Unambiguous, Ambiguous),
+ temp = .y)[2]))) %>%
+ select(-beta) %>%
+ unnest(data) %>%
+ select(age_group, condition = agreement, posterior = Ambiguous_soft) %>%
+ mutate(condition = factor(condition,
+ levels = c("agree", "disagree"),
+ labels = c("Agreement Trials", "Disagreement Trials")))
-
-
Model comparison
-
df.model.posterior %>%
- mutate(name = "posterior") %>%
- select(-c(utterance, probability, prior)) %>%
- bind_rows(df.model.softmax %>%
- mutate(name = "softmax")) %>%
- bind_rows(df.model.softmax.linear %>%
- mutate(name = "softmax increase")) %>%
- pivot_wider(names_from = name,
- values_from = posterior) %>%
- left_join(df.data %>%
- mutate(condition = factor(agreement,
- levels = c("agree", "disagree"),
- labels = c("Agreement Trials",
- "Disagreement Trials"))) %>%
- select(-agreement),
- by = c("age_group", "condition")) %>%
- summarize(
- r_posterior = cor(p, posterior),
- r_softmax = cor(p, softmax),
- r_softmaxincrease = cor(p, `softmax increase`),
- rmse_posterior = rmse(p, posterior),
- rmse_softmax = rmse(p, softmax),
- rmse_softmaxincrease = rmse(p, `softmax increase`)) %>%
- pivot_longer(cols = everything(),
- names_to = c("index", "name"),
- names_sep = "_") %>%
- pivot_wider(names_from = index,
- values_from = value) %>%
- print_table()
+
+
Model comparison
+
df.model.posterior %>%
+ mutate(name = "posterior") %>%
+ select(-c(utterance, probability, prior)) %>%
+ bind_rows(df.model.softmax %>%
+ mutate(name = "softmax")) %>%
+ bind_rows(df.model.softmax.linear %>%
+ mutate(name = "softmax increase")) %>%
+ pivot_wider(names_from = name,
+ values_from = posterior) %>%
+ left_join(df.data %>%
+ mutate(condition = factor(agreement,
+ levels = c("agree", "disagree"),
+ labels = c("Agreement Trials",
+ "Disagreement Trials"))) %>%
+ select(-agreement),
+ by = c("age_group", "condition")) %>%
+ summarize(
+ r_posterior = cor(p, posterior),
+ r_softmax = cor(p, softmax),
+ r_softmaxincrease = cor(p, `softmax increase`),
+ rmse_posterior = rmse(p, posterior),
+ rmse_softmax = rmse(p, softmax),
+ rmse_softmaxincrease = rmse(p, `softmax increase`)) %>%
+ pivot_longer(cols = everything(),
+ names_to = c("index", "name"),
+ names_sep = "_") %>%
+ pivot_wider(names_from = index,
+ values_from = value) %>%
+ print_table()
@@ -5164,238 +5114,233 @@ Model comparison
PLOTS
-
-
Prediction: Age continuous plot
-
fit.exp2.prediction_age = glmer(formula = dis_yes ~ 1 + condition_amb * age_continuous + (1 | participant),
- data = df.exp2.predict,
- family = binomial(link = "logit"))
-
-
-ggpredict(fit.exp2.prediction_age, terms = c("age_continuous [all]", "condition_amb")) %>%
- plot() +
- scale_x_continuous(breaks = 7:12,
- labels = 7:12) +
- scale_y_continuous(labels = percent) +
- coord_cartesian(xlim = c(7, 12),
- ylim = c(0, 1)) +
- labs(x = "Age",
- y = "Predict Disagreement",
- fill = "Condition",
- title = "Experiment 2: Prediction") +
- scale_color_manual(name = "Trial Type",
- labels = c("Unambiguous", "Ambiguous"),
- values = c("#A4F76A", "#EEA49A"),
- guide = guide_legend(reverse = T)) +
- scale_fill_manual(name = "Trial Type",
- labels = c("Unambiguous", "Ambiguous"),
- values = c("#A4F76A", "#EEA49A"),
- guide = guide_legend(reverse = T)) +
- theme_classic() +
- theme(plot.title = element_text(hjust = 0.5,
- size = 20,
- face = "bold"),
- strip.text = element_text(size = 18),
- strip.background = element_blank(),
- axis.title = element_text(size = 18),
- axis.text = element_text(size = 16),
- legend.title = element_text(size = 20),
- legend.text = element_text(size = 16),
- legend.position = "right")
-
-ggsave(file = "../figures/plots/exp2_prediction_age.pdf",
- width = 8,
- height = 6)
-
-
-
-
Inference: Age continuous plot
-
fit.exp2.age_inference = glmer(formula = ambiguous_yes ~ age_continuous * condition_disagree + (1 | participant),
- data = df.exp2.infer,
- family = binomial(link = "logit"))
-
-ggpredict(fit.exp2.age_inference,
- terms = c("age_continuous [all]", "condition_disagree")) %>%
- plot() +
- scale_x_continuous(breaks = 7:12,
- labels = 7:12) +
- scale_y_continuous(labels = percent) +
- coord_cartesian(xlim = c(7, 12),
- ylim = c(0, 1)) +
- labs(x = "Age",
- y = "Infer Ambiguous Utterance",
- fill = "Condition",
- title = "Experiment 2: Inference") +
- scale_color_manual(name = "Trial Type",
- labels = c("Agreement", "Disagreement"),
- values = c("#009999", "#CC6600"),
- guide = guide_legend(reverse = T)) +
- scale_fill_manual(name = "Trial Type",
- labels = c("Agreement", "Disagreement"),
- values = c("#009999", "#CC6600"),
- guide = guide_legend(reverse = T)) +
- theme_classic() +
- theme(plot.title = element_text(hjust = 0.5,
- size = 20,
- face = "bold"),
- strip.text = element_text(size = 18),
- strip.background = element_blank(),
- axis.title = element_text(size = 18),
- axis.text = element_text(size = 16),
- legend.title = element_text(size = 20),
- legend.text = element_text(size = 16),
- legend.position = "right")
-
-ggsave(file = "../figures/plots/exp2_inference_age.pdf",
- width = 8,
- height = 6)
-
+
+
Prediction
+
set.seed(1)
+
+df.plot.individual = df.exp2.predict %>%
+ mutate(condition_amb = as.character(condition_amb)) %>%
+ group_by(participant, age_continuous, condition_amb) %>%
+ summarize(pct_dis = sum(dis_yes)/n())
+
+df.age.means = df.plot.individual %>%
+ distinct(participant, age_continuous) %>%
+ mutate(age_continuous = ifelse(age_continuous == 12, 11.99, age_continuous),
+ age_group = floor(age_continuous)) %>%
+ group_by(age_group) %>%
+ summarize(age_mean = mean(age_continuous),
+ n = str_c("n = ", n())) %>%
+ ungroup()
+
+df.plot.means = df.exp2.predict %>%
+ mutate(condition_amb = as.character(condition_amb)) %>%
+ group_by(participant, age_group, condition_amb) %>%
+ summarize(pct_dis = sum(dis_yes)/n()) %>%
+ group_by(age_group, condition_amb) %>%
+ reframe(response = smean.cl.boot(pct_dis),
+ name = c("mean", "low", "high")) %>%
+ left_join(df.age.means,
+ by = "age_group") %>%
+ pivot_wider(names_from = name,
+ values_from = response) %>%
+ mutate(age_mean = ifelse(condition_amb == 0, age_mean - 0.05, age_mean + 0.05))
+
+df.plot.text = df.plot.means %>%
+ distinct(age_group, n)
+
+
+ggplot() +
+ geom_hline(yintercept = 0.5,
+ linetype = 2,
+ alpha = 0.1) +
+ geom_point(data = df.plot.individual,
+ mapping = aes(x = age_continuous,
+ y = pct_dis,
+ color = condition_amb),
+ alpha = 0.5,
+ show.legend = T,
+ shape = 16,
+ size = 1.5) +
+ geom_linerange(data = df.plot.means,
+ mapping = aes(x = age_mean,
+ y = mean,
+ ymin = low,
+ ymax = high),
+ color = "gray40") +
+ geom_point(data = df.plot.means,
+ mapping = aes(x = age_mean,
+ y = mean,
+ fill = condition_amb),
+ shape = 21,
+ size = 3,
+ show.legend = T) +
+ geom_text(data = df.plot.text,
+ mapping = aes(x = age_group + 0.5,
+ y = 1.05,
+ label = n),
+ hjust = 0.5) +
+ scale_y_continuous(labels = percent) +
+ labs(x = "Age (in years)",
+ y = "% Predict Disagreement",
+ title = "Experiment 2: Prediction") +
+ coord_cartesian(xlim = c(7, 12),
+ ylim = c(0, 1),
+ clip = "off") +
+ scale_color_manual(name = "Trial Type",
+ labels = c("Unambiguous", "Ambiguous"),
+ values = c(l.color$unambiguous, l.color$ambiguous),
+ guide = guide_legend(reverse = T)) +
+ scale_fill_manual(name = "Trial Type",
+ labels = c("Unambiguous", "Ambiguous"),
+ values = c(l.color$unambiguous, l.color$ambiguous),
+ guide = guide_legend(reverse = T)) +
+ theme(plot.title = element_text(hjust = 0.5,
+ vjust = 2,
+ size = 18,
+ face = "bold"),
+ axis.title.y = element_markdown(color = l.color$disagreement),
+ legend.position = "right")
+
+ggsave(filename = "../figures/plots/exp2_prediction.pdf",
+ width = 8,
+ height = 4)
+
-
-
Prediction condition
-
# Data
-df.plot = df.exp2.predict %>%
- group_by(condition_amb_c) %>%
- count(age_group, dis_yes) %>%
- complete(age_group, dis_yes,
- fill = list(n = 0)) %>%
- mutate(prediction = factor(dis_yes,
- levels = c(0, 1),
- labels = c("Agree", "Disagree"))) %>%
- mutate(condition_amb_c = factor(condition_amb_c,
- levels = c("Unambiguous Trials", "Ambiguous Trials"))) %>%
- ungroup()
-
-# Bootstrapped confidence intervals
-df.plot.boot = df.prediction.boot %>%
- mutate(condition_amb_c = factor(condition_amb_c,
- levels = c("Unambiguous Trials", "Ambiguous Trials")))
-# Plot
-ggplot(data = df.plot,
- mapping = aes(x = age_group,
- y = n,
- fill = prediction)) +
- geom_bar(position = "fill",
- stat = "identity",
- color = "black") +
- geom_linerange(data = df.plot.boot,
- mapping = aes(y = 1,
- ymin = p_low,
- ymax = p_high,
- fill = NA,
- x = age_group)) +
- facet_grid(cols = vars(condition_amb_c),
- scales = "free") +
- scale_fill_manual(values = c("#A4F76A", "#EEA49A"),
- na.translate = F) +
- scale_y_continuous(labels = percent) +
- labs(x = "Age",
- y = "Predicted Outcome",
- fill = "Possible Outcomes") +
- ggtitle("Experiment 2: Prediction") +
- theme(plot.title = element_text(hjust = 0.5, size = 20, face = "bold"),
- strip.text = element_text(size = 18),
- strip.background = element_blank(),
- axis.title = element_text(size = 18),
- axis.text = element_text(size = 16),
- legend.title = element_text(size = 20),
- legend.text = element_text(size = 16),
- legend.position = "right")
-
-ggsave(file = "../figures/plots/exp2_prediction.pdf",
- width = 12,
- height = 6)
-
-
-
-
Inference condition
-
# Data
-df.plot.infer = df.exp2.infer %>%
- filter(!is.na(ambiguous_yes)) %>%
- rename(condition = condition_disagree_c) %>%
- mutate(condition = factor(condition, levels = c("Agreement Trials",
- "Disagreement Trials"))) %>%
- group_by(condition) %>%
- count(age_group, ambiguous_yes) %>%
- complete(age_group, ambiguous_yes, fill = list(n = 0)) %>%
- mutate(selection = factor(ambiguous_yes,
- levels = c(0, 1),
- labels = c("Unambiguous", "Ambiguous"))) %>%
- ungroup()
-
-# Models
-df.model = df.model.posterior %>%
- mutate(name = "posterior") %>%
- select(-c(utterance, probability, prior)) %>%
- bind_rows(df.model.softmax %>%
- mutate(name = "softmax")) %>%
- bind_rows(df.model.softmax.linear %>%
- mutate(name = "softmax increase"))
-
-# Bootstrapped confidence intervals
-df.inference.boot = df.inference.boot %>%
- rename(condition = condition_disagree_c) %>%
- mutate(condition = factor(condition, levels = c("Agreement Trials",
- "Disagreement Trials"))) %>%
- ungroup()
-
-# Plot
-ggplot(data = df.plot.infer,
- mapping = aes(x = age_group,
- y = n,
- fill = selection)) +
- geom_bar(position = "fill",
- stat = "identity",
- color = "black") +
- geom_linerange(data = df.inference.boot,
- mapping = aes(y = 1,
- ymin = p_low,
- ymax = p_high,
- fill = NA,
- x = age_group)) +
- geom_point(data = df.model,
- mapping = aes(x = age_group,
- y = posterior,
- fill = NA,
- shape = name,
- group = name),
- position = position_dodge(width = 0.9),
- size = 4,
- fill = "white",
- color = "black") +
- facet_grid(cols = vars(condition),
- scales = "free") +
- scale_fill_manual(values = c(Unambiguous = "#009999", Ambiguous = "#CC6600"),
- breaks = c("Unambiguous", "Ambiguous")) +
- scale_shape_manual(values = 21:23) +
- scale_y_continuous(labels = scales::percent) +
- labs(x = "Age",
- y = "Inferred Utterance",
- fill = "Possible Statements",
- shape = "Model",
- title = "Experiment 2: Inference") +
- theme(plot.title = element_text(hjust = 0.5, size = 20, face = "bold"),
- strip.text = element_text(size = 18),
- strip.background = element_blank(),
- axis.title = element_text(size = 18),
- axis.text = element_text(size = 16),
- legend.title = element_text(size = 20),
- legend.text = element_text(size = 16),
- legend.position = "right")
-
-ggsave(str_c("../figures/plots/exp2_inference_models.pdf"),
- width = 12,
- height = 6)
-
+
+
Inference
+
set.seed(1)
+
+df.plot.individual = df.exp2.infer %>%
+ mutate(condition_disagree = as.character(condition_disagree)) %>%
+ group_by(participant, age_continuous, condition_disagree) %>%
+ summarize(pct_amb = sum(ambiguous_yes)/n())
+
+df.age.means = df.plot.individual %>%
+ distinct(participant, age_continuous) %>%
+ mutate(age_continuous = ifelse(age_continuous == 12, 11.99, age_continuous),
+ age_group = floor(age_continuous)) %>%
+ group_by(age_group) %>%
+ summarize(age_mean = mean(age_continuous),
+ n = str_c("n = ", n())) %>%
+ ungroup()
+
+df.plot.means = df.exp2.infer %>%
+ mutate(condition_disagree = as.character(condition_disagree)) %>%
+ group_by(participant, age_group, condition_disagree) %>%
+ summarize(pct_amb = sum(ambiguous_yes)/n()) %>%
+ group_by(age_group, condition_disagree) %>%
+ reframe(response = smean.cl.boot(pct_amb),
+ name = c("mean", "low", "high")) %>%
+ left_join(df.age.means,
+ by = "age_group") %>%
+ pivot_wider(names_from = name,
+ values_from = response) %>%
+ mutate(age_mean = ifelse(condition_disagree == 0, age_mean - 0.05, age_mean + 0.05))
+
+df.plot.text = df.plot.means %>%
+ distinct(age_group, n)
+
+df.model = df.model.posterior %>%
+ mutate(name = "posterior") %>%
+ select(-c(utterance, probability, prior)) %>%
+ bind_rows(df.model.softmax %>%
+ mutate(name = "softmax")) %>%
+ bind_rows(df.model.softmax.linear %>%
+ mutate(name = "softmax increase")) %>%
+ mutate(condition_disagree = factor(condition,
+ levels = c("Agreement Trials",
+ "Disagreement Trials"),
+ labels = c(0,
+ 1))) %>%
+ left_join(df.age.means %>%
+ select(-n),
+ by = "age_group") %>%
+ mutate(age_mean = ifelse(condition_disagree == 0,
+ age_mean - 0.05,
+ age_mean + 0.05))
+
+ggplot() +
+ geom_hline(yintercept = 0.5,
+ linetype = 2,
+ alpha = 0.1) +
+ geom_point(data = df.plot.individual,
+ mapping = aes(x = age_continuous,
+ y = pct_amb,
+ color = condition_disagree),
+ alpha = 0.5,
+ show.legend = T,
+ shape = 16,
+ size = 1.5) +
+ geom_linerange(data = df.plot.means,
+ mapping = aes(x = age_mean,
+ y = mean,
+ ymin = low,
+ ymax = high),
+ color = "gray40",
+ show.legend = F) +
+ geom_point(data = df.plot.means,
+ mapping = aes(x = age_mean,
+ y = mean,
+ fill = condition_disagree),
+ shape = 21,
+ size = 3,
+ show.legend = F) +
+ geom_point(data = df.model,
+ mapping = aes(x = age_mean,
+ y = posterior,
+ shape = name,
+ fill = condition_disagree),
+ size = 1.5,
+ alpha = 0.5,
+ show.legend = T) +
+ geom_text(data = df.plot.text,
+ mapping = aes(x = age_group + 0.5,
+ y = 1.05,
+ label = n),
+ hjust = 0.5) +
+ scale_y_continuous(labels = percent) +
+ labs(x = "Age (in years)",
+ y = "% Infer Ambiguous Utterance",
+ title = "Experiment 2: Inference") +
+ coord_cartesian(xlim = c(7, 12),
+ ylim = c(0, 1),
+ clip = "off") +
+ scale_color_manual(name = "Trial Type",
+ labels = c("Agreement", "Disagreement"),
+ values = c(l.color$agreement, l.color$disagreement)) +
+ scale_fill_manual(name = "Trial Type",
+ labels = c("Agreement", "Disagreement"),
+ values = c(l.color$agreement, l.color$disagreement)) +
+ scale_shape_manual(name = "Model",
+ labels = c("posterior", "softmax", "softmax increase"),
+ values = c(21, 22, 23)) +
+ theme(plot.title = element_text(hjust = 0.5,
+ vjust = 2,
+ size = 18,
+ face = "bold"),
+ axis.title.y = element_markdown(color = l.color$ambiguous),
+ legend.position = "right") +
+ guides(fill = guide_legend(override.aes = list(shape = 21,
+ size = 3),
+ reverse = T,
+ order = 1),
+ shape = guide_legend(override.aes = list(fill = "white", alpha = 1)),
+ color = "none")
+
+ggsave(filename = "../figures/plots/exp2_inference.pdf",
+ width = 8,
+ height = 4)
+
Session info
-
cite_packages(output = "paragraph",
- cite.tidyverse = TRUE,
- out.dir = ".")
-
We used R version 4.3.2 (R Core Team 2023) and the following R packages: bookdown v. 0.37 (Xie 2016, 2023a), broom.mixed v. 0.2.9.4 (Bolker and Robinson 2022), car v. 3.1.2 (Fox and Weisberg 2019), ggeffects v. 1.3.4 (Lüdecke 2018), kableExtra v. 1.3.4 (Zhu 2021), knitr v. 1.45 (Xie 2014, 2015, 2023b), lme4 v. 1.1.35.1 (Bates et al. 2015), Metrics v. 0.1.4 (Hamner and Frasco 2018), rmarkdown v. 2.25 (Xie, Allaire, and Grolemund 2018; Xie, Dervieux, and Riederer 2020; Allaire et al. 2023), rsample v. 1.2.0 (Frick et al. 2023), scales v. 1.3.0 (Wickham, Pedersen, and Seidel 2023), tidyverse v. 2.0.0 (Wickham et al. 2019), xtable v. 1.8.4 (Dahl et al. 2019).
-
+
cite_packages(output = "paragraph",
+ cite.tidyverse = TRUE,
+ out.dir = ".")
+
We used R version 4.3.2 (R Core Team 2023) and the following R packages: bookdown v. 0.37 (Xie 2016, 2023a), broom.mixed v. 0.2.9.4 (Bolker and Robinson 2022), car v. 3.1.2 (Fox and Weisberg 2019), ggeffects v. 1.3.4 (Lüdecke 2018), ggtext v. 0.1.2 (Wilke and Wiernik 2022), Hmisc v. 5.1.1 (Harrell Jr 2023), kableExtra v. 1.3.4 (Zhu 2021), knitr v. 1.45 (Xie 2014, 2015, 2023b), lme4 v. 1.1.35.1 (Bates et al. 2015), Metrics v. 0.1.4 (Hamner and Frasco 2018), rmarkdown v. 2.25 (Xie, Allaire, and Grolemund 2018; Xie, Dervieux, and Riederer 2020; Allaire et al. 2023), rsample v. 1.2.0 (Frick et al. 2023), scales v. 1.3.0 (Wickham, Pedersen, and Seidel 2023), tidyverse v. 2.0.0 (Wickham et al. 2019), xtable v. 1.8.4 (Dahl et al. 2019).
+
R version 4.3.2 (2023-10-31)
Platform: aarch64-apple-darwin20 (64-bit)
Running under: macOS Sonoma 14.1.2
@@ -5417,33 +5362,36 @@ Session info
[1] lubridate_1.9.3 forcats_1.0.0 stringr_1.5.1
[4] dplyr_1.1.4 purrr_1.0.2 readr_2.1.4
[7] tidyr_1.3.0 tibble_3.2.1 ggplot2_3.4.4
-[10] tidyverse_2.0.0 ggeffects_1.3.4 grateful_0.2.4
-[13] broom.mixed_0.2.9.4 scales_1.3.0 Metrics_0.1.4
-[16] car_3.1-2 carData_3.0-5 knitr_1.45
-[19] kableExtra_1.3.4 xtable_1.8-4 rsample_1.2.0
-[22] lme4_1.1-35.1 Matrix_1.6-4
+[10] tidyverse_2.0.0 ggtext_0.1.2 Hmisc_5.1-1
+[13] ggeffects_1.3.4 grateful_0.2.4 broom.mixed_0.2.9.4
+[16] scales_1.3.0 Metrics_0.1.4 car_3.1-2
+[19] carData_3.0-5 knitr_1.45 kableExtra_1.3.4
+[22] xtable_1.8-4 rsample_1.2.0 lme4_1.1-35.1
+[25] Matrix_1.6-4
loaded via a namespace (and not attached):
- [1] sjlabelled_1.2.0 tidyselect_1.2.0 viridisLite_0.4.2 farver_2.1.1
- [5] fastmap_1.1.1 digest_0.6.34 timechange_0.2.0 lifecycle_1.0.4
- [9] magrittr_2.0.3 compiler_4.3.2 rlang_1.1.3 sass_0.4.8
-[13] tools_4.3.2 utf8_1.2.4 yaml_2.3.8 labeling_0.4.3
-[17] bit_4.0.5 xml2_1.3.6 abind_1.4-5 withr_3.0.0
-[21] datawizard_0.9.1 grid_4.3.2 fansi_1.0.6 colorspace_2.1-0
-[25] future_1.33.1 globals_0.16.2 MASS_7.3-60 insight_0.19.7
-[29] cli_3.6.2 rmarkdown_2.25 crayon_1.5.2 ragg_1.2.7
-[33] generics_0.1.3 rstudioapi_0.15.0 httr_1.4.7 tzdb_0.4.0
-[37] minqa_1.2.6 cachem_1.0.8 splines_4.3.2 rvest_1.0.3
-[41] parallel_4.3.2 vctrs_0.6.5 boot_1.3-28.1 webshot_0.5.5
-[45] jsonlite_1.8.8 bookdown_0.37 hms_1.1.3 bit64_4.0.5
-[49] listenv_0.9.1 systemfonts_1.0.5 jquerylib_0.1.4 glue_1.7.0
-[53] parallelly_1.37.0 nloptr_2.0.3 codetools_0.2-19 stringi_1.8.3
-[57] gtable_0.3.4 munsell_0.5.0 furrr_0.3.1 pillar_1.9.0
-[61] htmltools_0.5.7 R6_2.5.1 textshaping_0.3.7 vroom_1.6.5
-[65] evaluate_0.23 lattice_0.22-5 haven_2.5.4 highr_0.10
-[69] backports_1.4.1 snakecase_0.11.1 broom_1.0.5 renv_1.0.3
-[73] bslib_0.6.1 Rcpp_1.0.12 svglite_2.1.3 nlme_3.1-164
-[77] xfun_0.41 pkgconfig_2.0.3
+ [1] gridExtra_2.3 rlang_1.1.3 magrittr_2.0.3 furrr_0.3.1
+ [5] compiler_4.3.2 systemfonts_1.0.5 vctrs_0.6.5 rvest_1.0.3
+ [9] pkgconfig_2.0.3 crayon_1.5.2 fastmap_1.1.1 backports_1.4.1
+[13] labeling_0.4.3 utf8_1.2.4 rmarkdown_2.25 markdown_1.12
+[17] tzdb_0.4.0 nloptr_2.0.3 ragg_1.2.7 bit_4.0.5
+[21] xfun_0.41 cachem_1.0.8 jsonlite_1.8.8 highr_0.10
+[25] broom_1.0.5 parallel_4.3.2 cluster_2.1.6 R6_2.5.1
+[29] bslib_0.6.1 stringi_1.8.3 parallelly_1.37.0 boot_1.3-28.1
+[33] rpart_4.1.23 jquerylib_0.1.4 Rcpp_1.0.12 bookdown_0.37
+[37] base64enc_0.1-3 splines_4.3.2 nnet_7.3-19 timechange_0.2.0
+[41] tidyselect_1.2.0 rstudioapi_0.15.0 abind_1.4-5 yaml_2.3.8
+[45] codetools_0.2-19 listenv_0.9.1 lattice_0.22-5 withr_3.0.0
+[49] evaluate_0.23 foreign_0.8-86 future_1.33.1 xml2_1.3.6
+[53] pillar_1.9.0 renv_1.0.3 checkmate_2.3.1 generics_0.1.3
+[57] vroom_1.6.5 hms_1.1.3 commonmark_1.9.0 munsell_0.5.0
+[61] minqa_1.2.6 globals_0.16.2 glue_1.7.0 tools_4.3.2
+[65] data.table_1.14.10 webshot_0.5.5 grid_4.3.2 colorspace_2.1-0
+[69] nlme_3.1-164 htmlTable_2.4.2 Formula_1.2-5 cli_3.6.2
+[73] textshaping_0.3.7 fansi_1.0.6 viridisLite_0.4.2 svglite_2.1.3
+[77] gtable_0.3.4 sass_0.4.8 digest_0.6.34 htmlwidgets_1.6.4
+[81] farver_2.1.1 htmltools_0.5.7 lifecycle_1.0.4 httr_1.4.7
+[85] gridtext_0.1.5 bit64_4.0.5 MASS_7.3-60
Allaire, JJ, Yihui Xie, Christophe Dervieux, Jonathan McPherson, Javier Luraschi, Kevin Ushey, Aron Atkins, et al. 2023.
rmarkdown: Dynamic Documents for r.
https://github.com/rstudio/rmarkdown.
@@ -5466,6 +5414,9 @@
Session info
Hamner, Ben, and Michael Frasco. 2018.
Metrics: Evaluation Metrics for Machine Learning.
https://CRAN.R-project.org/package=Metrics.
+
+Harrell Jr, Frank E. 2023.
Hmisc: Harrell Miscellaneous.
https://CRAN.R-project.org/package=Hmisc.
+
Lüdecke, Daniel. 2018.
“ggeffects: Tidy Data Frames of Marginal Effects from Regression Models.” Journal of Open Source Software 3 (26): 772.
https://doi.org/10.21105/joss.00772.
@@ -5478,6 +5429,9 @@
Session info
Wickham, Hadley, Thomas Lin Pedersen, and Dana Seidel. 2023.
scales: Scale Functions for Visualization.
https://CRAN.R-project.org/package=scales.
+
+Wilke, Claus O., and Brenton M. Wiernik. 2022.
ggtext: Improved Text Rendering Support for “ggplot2”.
https://CRAN.R-project.org/package=ggtext.
+
Xie, Yihui. 2014. “knitr: A Comprehensive Tool for Reproducible Research in R.” In Implementing Reproducible Computational Research, edited by Victoria Stodden, Friedrich Leisch, and Roger D. Peng. Chapman; Hall/CRC.
diff --git a/analysis/grateful-refs.bib b/analysis/grateful-refs.bib
index 91fb44c..c49acaf 100644
--- a/analysis/grateful-refs.bib
+++ b/analysis/grateful-refs.bib
@@ -49,6 +49,20 @@ @Article{ggeffects
year = {2018},
pages = {772},
}
+@Manual{ggtext,
+title = {{ggtext}: Improved Text Rendering Support for `{ggplot2}'},
+ author = {Claus O. Wilke and Brenton M. Wiernik},
+ year = {2022},
+ note = {R package version 0.1.2},
+ url = {https://CRAN.R-project.org/package=ggtext},
+}
+@Manual{Hmisc,
+title = {{Hmisc}: Harrell Miscellaneous},
+ author = {Frank E {Harrell Jr}},
+ year = {2023},
+ note = {R package version 5.1-1},
+ url = {https://CRAN.R-project.org/package=Hmisc},
+}
@Manual{kableExtra,
title = {{kableExtra}: Construct Complex Table with `{kable}' and Pipe Syntax},
author = {Hao Zhu},
diff --git a/docs/index.html b/docs/index.html
index 75f0e72..ff96a15 100644
--- a/docs/index.html
+++ b/docs/index.html
@@ -11,7 +11,7 @@
-
+
Children use disagreement to infer what happened
@@ -1803,7 +1803,7 @@
Children use disagreement to infer what happened
Jamie Amemiya, Gail D. Heyman & Tobias Gerstenberg
-
March 29, 2024
+
April 01, 2024
@@ -1822,61 +1822,70 @@
Libraries
library("grateful") # for package citations
library("ggeffects") # for marginal predictions
library("scales") # for percentage scales
-
library("tidyverse") # for everything else
+
library("Hmisc") # for bootstrapped means
+
library("ggtext") # for colored text in ggplot
+
library("tidyverse") # for everything else
Helper functions
# set classic theme
-theme_set(theme_classic())
-
-# function for printing out html or latex tables
-print_table = function(data, format = "html", digits = 2){
- if(format == "html"){
- data %>%
- kable(digits = digits) %>%
- kable_styling()
- }else if(format == "latex"){
- data %>%
- xtable(digits = digits,
- caption = "Caption",
- label = "tab:table") %>%
- print(include.rownames = F,
- booktabs = T,
- sanitize.colnames.function = identity,
- caption.placement = "top")
- }
-}
-
-# suppress grouping warning
-options(dplyr.summarise.inform = F)
-
-# show figures at the end of code chunks
-opts_chunk$set(comment = "",
- fig.show = "hold")
-
-# regression function
-fun.regression = function(formula, data){
- results = glmer(formula = formula,
- family = binomial,
- data = data)
- print(results)
- return(results)
-}
-
-# results table
-fun.table = function(results, type = "exploratory"){
- table = results %>%
- tidy(conf.int = T) %>%
- filter(effect == "fixed") %>%
- select(-group)
-
- if (type == "exploratory"){
- table = table %>%
- select(-c(p.value))
- }
- table %>%
- print_table()
-}
+
theme_set(theme_classic() +
+
theme(text = element_text(size = 16)))
+
+
# function for printing out html or latex tables
+
print_table = function(data, format = "html", digits = 2){
+
if(format == "html"){
+
data %>%
+
kable(digits = digits) %>%
+
kable_styling()
+
}else if(format == "latex"){
+
data %>%
+
xtable(digits = digits,
+
caption = "Caption",
+
label = "tab:table") %>%
+
print(include.rownames = F,
+
booktabs = T,
+
sanitize.colnames.function = identity,
+
caption.placement = "top")
+
}
+
}
+
+
# suppress grouping warning
+
options(dplyr.summarise.inform = F)
+
+
# show figures at the end of code chunks
+
opts_chunk$set(comment = "",
+
fig.show = "hold")
+
+
# regression function
+
fun.regression = function(formula, data){
+
results = glmer(formula = formula,
+
family = binomial,
+
data = data)
+
print(results)
+
return(results)
+
}
+
+
# results table
+
fun.table = function(results, type = "exploratory"){
+
table = results %>%
+
tidy(conf.int = T) %>%
+
filter(effect == "fixed") %>%
+
select(-group)
+
+
if (type == "exploratory"){
+
table = table %>%
+
select(-c(p.value))
+
}
+
table %>%
+
print_table()
+
}
+
+
# colors
+
l.color = list(agreement = "#89fa50",
+
disagreement = "#ff968c",
+
ambiguous = "#d38950",
+
unambiguous = "#96d5d6")
EXPERIMENT 1
@@ -2922,94 +2931,96 @@ Moderation by age
PLOTS
-
-
Age continuous plot
-
# Data
-fit.exp1.inference_age = glmer(formula = ambiguous_yes ~ age_continuous * condition_disagree + (1 | participant),
- data = df.exp1,
- family = binomial(link = "logit"))
-
-ggpredict(fit.exp1.inference_age,
- terms = c("age_continuous [all]", "condition_disagree")) %>%
- plot() +
- scale_x_continuous(breaks = c(7, 8, 9, 10, 11, 12),
- labels = c("7", "8","9","10","11", "12")) +
- scale_y_continuous(labels = percent) +
- coord_cartesian(xlim = c(7, 12),
- ylim = c(0, 1)) +
- labs(x = "Age",
- y = "Infer Ambiguous Utterance",
- fill = "Condition",
- title = "Experiment 1: Inference") +
- scale_color_manual(name = "Trial Type",
- labels = c("Agreement", "Disagreement"),
- values = c("#009999", "#CC6600"),
- guide = guide_legend(reverse = T)) +
- scale_fill_manual(name = "Trial Type",
- labels = c("Agreement", "Disagreement"),
- values = c("#009999", "#CC6600"),
- guide = guide_legend(reverse = T)) +
- theme_classic() +
- theme(plot.title = element_text(hjust = 0.5,
- size = 20,
- face = "bold"),
- strip.text = element_text(size = 18),
- strip.background = element_blank(),
- axis.title = element_text(size = 18),
- axis.text = element_text(size = 16),
- legend.title = element_text(size = 20),
- legend.text = element_text(size = 16),
- legend.position = "right")
-
-ggsave(file = "../figures/plots/exp1_inference_age.pdf",
- width = 8,
- height = 6)
-
-
-
-
Bar plot
-
# Data
-df.plot = df.exp1 %>%
- group_by(condition_disagree) %>%
- count(age_group, selection) %>%
- complete(age_group, selection, fill = list(n = 0)) %>%
- mutate(selection = factor(selection,
- levels = c("Unambiguous", "Ambiguous", "Random")),
- condition_disagree = factor(condition_disagree,
- levels = c(0, 1),
- labels = c("Agreement Trials",
- "Disagreement Trials")))
-
-# Plot
-ggplot(data = df.plot,
- mapping = aes(x = age_group,
- y = n,
- fill = selection)) +
- geom_bar(position = "fill",
- stat = "identity",
- color = "black") +
- facet_grid(cols = vars(condition_disagree)) +
- scale_fill_manual(values = c("#009999", "#CC6600", "white")) +
- scale_y_continuous(labels = scales::percent) +
- labs(x = "Age",
- y = "Inferred Utterance",
- fill = "Possible Statements",
- title = "Experiment 1: Inference") +
- theme(plot.title = element_text(hjust = 0.5,
- size = 20,
- face = "bold"),
- strip.text = element_text(size = 18),
- strip.background = element_blank(),
- axis.title = element_text(size = 18),
- axis.text = element_text(size = 16),
- legend.title = element_text(size = 20),
- legend.text = element_text(size = 16),
- legend.position = "right")
-
-ggsave(file = "../figures/plots/exp1_inference.pdf",
- width = 12,
- height = 6)
-
+
+
Inference
+
set.seed(1)
+
+df.plot.individual = df.exp1 %>%
+ mutate(condition_disagree = as.character(condition_disagree)) %>%
+ group_by(participant, age_continuous, condition_disagree) %>%
+ summarize(pct_amb = sum(ambiguous_yes)/n())
+
+df.age.means = df.plot.individual %>%
+ distinct(participant, age_continuous) %>%
+ mutate(age_continuous = ifelse(age_continuous == 12, 11.99, age_continuous),
+ age_group = floor(age_continuous)) %>%
+ group_by(age_group) %>%
+ summarize(age_mean = mean(age_continuous),
+ n = str_c("n = ", n())) %>%
+ ungroup()
+
+df.plot.means = df.exp1 %>%
+ mutate(condition_disagree = as.character(condition_disagree)) %>%
+ group_by(participant, age_group, condition_disagree) %>%
+ summarize(pct_amb = sum(ambiguous_yes)/n()) %>%
+ group_by(age_group, condition_disagree) %>%
+ reframe(response = smean.cl.boot(pct_amb),
+ name = c("mean", "low", "high")) %>%
+ left_join(df.age.means,
+ by = "age_group") %>%
+ pivot_wider(names_from = name,
+ values_from = response) %>%
+ mutate(age_mean = ifelse(condition_disagree == 0, age_mean - 0.05, age_mean + 0.05))
+
+df.plot.text = df.plot.means %>%
+ distinct(age_group, n)
+
+ggplot() +
+ geom_hline(yintercept = 0.5,
+ linetype = 2,
+ alpha = 0.1) +
+ geom_point(data = df.plot.individual,
+ mapping = aes(x = age_continuous,
+ y = pct_amb,
+ color = condition_disagree),
+ alpha = 0.5,
+ show.legend = T,
+ shape = 16,
+ size = 1.5) +
+ geom_linerange(data = df.plot.means,
+ mapping = aes(x = age_mean,
+ y = mean,
+ ymin = low,
+ ymax = high),
+ color = "gray40") +
+ geom_point(data = df.plot.means,
+ mapping = aes(x = age_mean,
+ y = mean,
+ fill = condition_disagree),
+ shape = 21,
+ size = 3,
+ show.legend = T) +
+ geom_text(data = df.plot.text,
+ mapping = aes(x = age_group + 0.5,
+ y = 1.05,
+ label = n),
+ hjust = 0.5) +
+ scale_y_continuous(labels = percent) +
+ labs(x = "Age (in years)",
+ y = "% Infer Ambiguous Utterance",
+ title = "Experiment 1: Inference") +
+ coord_cartesian(xlim = c(7, 12),
+ ylim = c(0, 1),
+ clip = "off") +
+ scale_color_manual(name = "Trial Type",
+ labels = c("Agreement", "Disagreement"),
+ values = c(l.color$agreement, l.color$disagreement),
+ guide = guide_legend(reverse = T)) +
+ scale_fill_manual(name = "Trial Type",
+ labels = c("Agreement", "Disagreement"),
+ values = c(l.color$agreement, l.color$disagreement),
+ guide = guide_legend(reverse = T)) +
+ theme(plot.title = element_text(hjust = 0.5,
+ vjust = 2,
+ size = 18,
+ face = "bold"),
+ axis.title.y = element_markdown(color = l.color$ambiguous),
+ legend.position = "right")
+
+ggsave(filename = "../figures/plots/exp1_inference.pdf",
+ width = 8,
+ height = 4)
+
@@ -3019,9 +3030,9 @@ EXPERIMENT 2
DATA
Read in data
-
df.exp2.predict = read_csv("../data/data2_predict.csv")
-df.exp2.infer = read_csv("../data/data2_infer.csv") %>%
- drop_na()
+
df.exp2.predict = read_csv("../data/data2_predict.csv")
+df.exp2.infer = read_csv("../data/data2_infer.csv") %>%
+ drop_na()
@@ -3032,9 +3043,9 @@
Counterbalancing
Prediction condition
Story order
-
results = fun.regression(
- formula = "dis_yes ~ 1 + condition_amb * story_order_wagon + (1 | participant)",
- data = df.exp2.predict)
+
results = fun.regression(
+ formula = "dis_yes ~ 1 + condition_amb * story_order_wagon + (1 | participant)",
+ data = df.exp2.predict)
Generalized linear mixed model fit by maximum likelihood (Laplace
Approximation) [glmerMod]
Family: binomial ( logit )
@@ -3051,7 +3062,7 @@ Story order
-1.2683 1.5824
story_order_wagon condition_amb:story_order_wagon
-0.1105 0.2620
-
+
@@ -3176,9 +3187,9 @@ Story order
Trial order
-
results = fun.regression(
- formula = "dis_yes ~ 1 + condition_amb*trial_order_auau + (1 | participant)",
- data = df.exp2.predict)
+
results = fun.regression(
+ formula = "dis_yes ~ 1 + condition_amb*trial_order_auau + (1 | participant)",
+ data = df.exp2.predict)
Generalized linear mixed model fit by maximum likelihood (Laplace
Approximation) [glmerMod]
Family: binomial ( logit )
@@ -3195,7 +3206,7 @@ Trial order
-1.25973 1.58341
trial_order_auau condition_amb:trial_order_auau
0.15624 0.01714
-
+
@@ -3320,9 +3331,9 @@ Trial order
Valence
-
results = fun.regression(
- formula = "dis_yes ~ 1 + condition_amb * valence_neg + (1 | participant)",
- data = df.exp2.predict)
+
results = fun.regression(
+ formula = "dis_yes ~ 1 + condition_amb * valence_neg + (1 | participant)",
+ data = df.exp2.predict)
Generalized linear mixed model fit by maximum likelihood (Laplace
Approximation) [glmerMod]
Family: binomial ( logit )
@@ -3339,7 +3350,7 @@ Valence
-1.26341 1.59408
valence_neg condition_amb:valence_neg
-0.05144 0.34376
-
+
@@ -3467,9 +3478,9 @@ Valence
Inference condition
Story order
-
results = fun.regression(
- formula = "ambiguous_yes ~ 1 + condition_disagree * story_order_wagon + (1 | participant)",
- data = df.exp2.infer)
+
results = fun.regression(
+ formula = "ambiguous_yes ~ 1 + condition_disagree * story_order_wagon + (1 | participant)",
+ data = df.exp2.infer)
Generalized linear mixed model fit by maximum likelihood (Laplace
Approximation) [glmerMod]
Family: binomial ( logit )
@@ -3487,7 +3498,7 @@ Story order
-2.687817 3.783142
story_order_wagon condition_disagree:story_order_wagon
0.005322 -0.262981
-
+
@@ -3612,9 +3623,9 @@ Story order
Trial order
-
results = fun.regression(
- formula = "ambiguous_yes ~ 1 + condition_disagree * trial_order_dada + (1 | participant)",
- data = df.exp2.infer)
+
results = fun.regression(
+ formula = "ambiguous_yes ~ 1 + condition_disagree * trial_order_dada + (1 | participant)",
+ data = df.exp2.infer)
Generalized linear mixed model fit by maximum likelihood (Laplace
Approximation) [glmerMod]
Family: binomial ( logit )
@@ -3632,7 +3643,7 @@ Trial order
-2.70545 3.78219
trial_order_dada condition_disagree:trial_order_dada
-0.06539 0.08335
-
+
@@ -3757,9 +3768,9 @@ Trial order
Valence
-
results = fun.regression(
- formula = "ambiguous_yes ~ 1 + condition_disagree * valence_neg + (1 | participant)",
- data = df.exp2.infer)
+
results = fun.regression(
+ formula = "ambiguous_yes ~ 1 + condition_disagree * valence_neg + (1 | participant)",
+ data = df.exp2.infer)
Generalized linear mixed model fit by maximum likelihood (Laplace
Approximation) [glmerMod]
Family: binomial ( logit )
@@ -3777,7 +3788,7 @@ Valence
-2.6816 3.7756
valence_neg condition_disagree:valence_neg
-0.0941 -0.3050
-
+
@@ -3909,9 +3920,9 @@ Trial type effect
Prediction condition
Predict disagreement more in ambiguous than unambiguous trials.
-
results = fun.regression(
- formula = "dis_yes ~ 1 + condition_amb + (1 | participant)",
- data = df.exp2.predict)
+
results = fun.regression(
+ formula = "dis_yes ~ 1 + condition_amb + (1 | participant)",
+ data = df.exp2.predict)
Generalized linear mixed model fit by maximum likelihood (Laplace
Approximation) [glmerMod]
Family: binomial ( logit )
@@ -3926,13 +3937,13 @@ Prediction condition
-
prop.table(table(df.exp2.predict$condition_amb, df.exp2.predict$dis_yes),
- margin = 1)
+
prop.table(table(df.exp2.predict$condition_amb, df.exp2.predict$dis_yes),
+ margin = 1)
0 1
0 0.7685185 0.2314815
1 0.4259259 0.5740741
-
fun.table(results, type = "confirmatory")
+
fun.table(results, type = "confirmatory")
@@ -4021,9 +4032,9 @@ Prediction condition
Inference condition
Choose ambiguous statement more in disagreement than agreement trials.
-results = fun.regression(
- formula = "ambiguous_yes ~ 1 + condition_disagree + (1 | participant)",
- data = df.exp2.infer)
results = fun.regression(
+ formula = "ambiguous_yes ~ 1 + condition_disagree + (1 | participant)",
+ data = df.exp2.infer)
Generalized linear mixed model fit by maximum likelihood (Laplace
Approximation) [glmerMod]
Family: binomial ( logit )
@@ -4038,12 +4049,12 @@ Inference condition
-prop.table(table(df.exp2.infer$condition_disagree, df.exp2.infer$ambiguous_yes), margin=1)
prop.table(table(df.exp2.infer$condition_disagree, df.exp2.infer$ambiguous_yes), margin=1)
0 1
0 0.91071429 0.08928571
1 0.29147982 0.70852018
-fun.table(results, type = "confirmatory")
fun.table(results, type = "confirmatory")
@@ -4137,9 +4148,9 @@ Exploratory analysis
Trial type by age interaction
Prediction
-
results = fun.regression(
- formula = "dis_yes ~ 1 + condition_amb * age_continuous + (1 | participant)",
- data = df.exp2.predict)
+
results = fun.regression(
+ formula = "dis_yes ~ 1 + condition_amb * age_continuous + (1 | participant)",
+ data = df.exp2.predict)
Generalized linear mixed model fit by maximum likelihood (Laplace
Approximation) [glmerMod]
Family: binomial ( logit )
@@ -4156,7 +4167,7 @@ Prediction
0.3225 -0.3813
age_continuous condition_amb:age_continuous
-0.1702 0.2100
-
+
@@ -4279,11 +4290,11 @@ Prediction
-
+
Inference
-
results = fun.regression(
- formula = "ambiguous_yes ~ 1 + condition_disagree * age_continuous + (1 | participant)",
- data = df.exp2.infer)
+
results = fun.regression(
+ formula = "ambiguous_yes ~ 1 + condition_disagree * age_continuous + (1 | participant)",
+ data = df.exp2.infer)
Generalized linear mixed model fit by maximum likelihood (Laplace
Approximation) [glmerMod]
Family: binomial ( logit )
@@ -4301,7 +4312,7 @@ Inference
4.0689 -7.5859
age_continuous condition_disagree:age_continuous
-0.7699 1.2725
-
+
@@ -4429,14 +4440,14 @@ Inference
Moderation by age
Prediction condition
-
# from 7 to 11 years
-for(i in 7:11){
- cat(str_c("Age = ", i, "\n\n"))
- fun.regression(
- formula = "dis_yes ~ 1 + condition_amb + (1 | participant)",
- data = df.exp2.predict %>%
- filter(age_group == i))
-}
+
# from 7 to 11 years
+for(i in 7:11){
+ cat(str_c("Age = ", i, "\n\n"))
+ fun.regression(
+ formula = "dis_yes ~ 1 + condition_amb + (1 | participant)",
+ data = df.exp2.predict %>%
+ filter(age_group == i))
+}
Age = 7
Generalized linear mixed model fit by maximum likelihood (Laplace
@@ -4522,14 +4533,14 @@ Prediction condition
Inference condition
-
# from 7 to 11 years
-for(i in 7:11){
- cat(str_c("Age = ", i, "\n\n"))
- fun.regression(
- formula = "ambiguous_yes ~ 1 + condition_disagree + (1 | participant)",
- data = df.exp2.infer %>%
- filter(age_group == i))
-}
+
# from 7 to 11 years
+for(i in 7:11){
+ cat(str_c("Age = ", i, "\n\n"))
+ fun.regression(
+ formula = "ambiguous_yes ~ 1 + condition_disagree + (1 | participant)",
+ data = df.exp2.infer %>%
+ filter(age_group == i))
+}
Age = 7
Generalized linear mixed model fit by maximum likelihood (Laplace
@@ -4615,14 +4626,14 @@ Inference condition
Inference condition: First story only
Examine story 1 (trials 1 and 2) and story 4 (trials 7 and 8) among 7-year-olds.
-# story 1, 7 year olds
-df.exp2.infer.7.1 = df.exp2.infer %>%
- filter(age_group == 7 &
- (trial == "trial 1" |trial == "trial 2"))
-
-results = fun.regression(
- formula = "ambiguous_yes ~ 1 + condition_disagree + (1 | participant)",
- data = df.exp2.infer.7.1)
# story 1, 7 year olds
+df.exp2.infer.7.1 = df.exp2.infer %>%
+ filter(age_group == 7 &
+ (trial == "trial 1" |trial == "trial 2"))
+
+results = fun.regression(
+ formula = "ambiguous_yes ~ 1 + condition_disagree + (1 | participant)",
+ data = df.exp2.infer.7.1)
boundary (singular) fit: see help('isSingular')
Generalized linear mixed model fit by maximum likelihood (Laplace
Approximation) [glmerMod]
@@ -4639,12 +4650,12 @@ Inference condition: Fi
(Intercept) condition_disagree
-0.6931 -0.4055
optimizer (Nelder_Mead) convergence code: 0 (OK) ; 0 optimizer warnings; 1 lme4 warnings
-prop.table(table(df.exp2.infer.7.1$condition_disagree, df.exp2.infer.7.1$ambiguous_yes), margin=1)
prop.table(table(df.exp2.infer.7.1$condition_disagree, df.exp2.infer.7.1$ambiguous_yes), margin=1)
0 1
0 0.6666667 0.3333333
1 0.7500000 0.2500000
-fun.table(results, type = "confirmatory")
fun.table(results, type = "confirmatory")
@@ -4729,14 +4740,14 @@ Inference condition: Fi
-# story 4, 7 year olds
-df.exp2.infer.7.4 = df.exp2.infer %>%
- filter(age_group == 7 &
- (trial == "trial 7" |trial == "trial 8"))
-
-results = fun.regression(
- formula = "ambiguous_yes ~ 1 + condition_disagree + (1 | participant)",
- data = df.exp2.infer.7.4)
# story 4, 7 year olds
+df.exp2.infer.7.4 = df.exp2.infer %>%
+ filter(age_group == 7 &
+ (trial == "trial 7" |trial == "trial 8"))
+
+results = fun.regression(
+ formula = "ambiguous_yes ~ 1 + condition_disagree + (1 | participant)",
+ data = df.exp2.infer.7.4)
boundary (singular) fit: see help('isSingular')
Generalized linear mixed model fit by maximum likelihood (Laplace
Approximation) [glmerMod]
@@ -4753,12 +4764,12 @@ Inference condition: Fi
(Intercept) condition_disagree
-1.099 1.435
optimizer (Nelder_Mead) convergence code: 0 (OK) ; 0 optimizer warnings; 1 lme4 warnings
-prop.table(table(df.exp2.infer.7.4$condition_disagree, df.exp2.infer.7.4$ambiguous_yes), margin=1)
prop.table(table(df.exp2.infer.7.4$condition_disagree, df.exp2.infer.7.4$ambiguous_yes), margin=1)
0 1
0 0.7500000 0.2500000
1 0.4166667 0.5833333
-fun.table(results, type = "confirmatory")
fun.table(results, type = "confirmatory")
@@ -4846,269 +4857,208 @@ Inference condition: Fi
-
-
Bootstrapping confidence intervals
-
-
Prediction condition
-
set.seed(1)
+
+
Bayesian model
+
+
Prediction data
+
df.exp2.predict.prob = df.exp2.predict %>%
+ count(age_group, condition_amb_c, dis_yes) %>%
+ group_by(age_group, condition_amb_c) %>%
+ mutate(probability = n/sum(n)) %>%
+ ungroup() %>%
+ mutate(utterance = str_remove_all(condition_amb_c, " Trials"),
+ utterance = factor(utterance,
+ levels = c("Unambiguous", "Ambiguous")),
+ agreement = factor(dis_yes,
+ levels = c(0, 1),
+ labels = c("agree", "disagree"))) %>%
+ select(-c(condition_amb_c, dis_yes, n)) %>%
+ relocate(probability, .after = last_col()) %>%
+ arrange(age_group, utterance, agreement)
+
+
+
Without softmax
+
utterance_prior = c(0.5, 0.5)
-# number of bootstrap samples
-n_bootstraps = 1000
-
-df.prediction.boot = df.exp2.predict %>%
- bootstraps(times = n_bootstraps,
- strata = age_group) %>%
- mutate(prob = map(.x = splits,
- .f = ~ .x %>%
- as_tibble() %>%
- count(age_group, condition_amb_c, dis_yes) %>%
- complete(age_group, condition_amb_c, dis_yes,
- fill = list(n = 0)) %>%
- group_by(age_group, condition_amb_c) %>%
- # compute probability
- reframe(p = n/sum(n)) %>%
- arrange(age_group, condition_amb_c) %>%
- # keep only even rows
- filter(row_number() %% 2 == 0))) %>%
- unnest(prob) %>%
- select(-splits) %>%
- group_by(age_group, condition_amb_c) %>%
- summarize(p_low = quantile(p, 0.025),
- p_high = quantile(p, 0.975)) %>%
- ungroup()
+
df.inference = df.exp2.predict.prob %>%
+
group_by(agreement, age_group) %>%
+
mutate(prior = utterance_prior) %>%
+
mutate(posterior = probability * prior /
+
sum(probability * prior)) %>%
+
ungroup()
+
+
df.model.posterior = df.inference %>%
+
rename(condition = agreement) %>%
+
mutate(condition = factor(condition,
+
levels = c("agree", "disagree"),
+
labels = c("Agreement Trials", "Disagreement Trials"))) %>%
+
filter(utterance == "Ambiguous")
-
Inference condition
-
set.seed(1)
+
+
One softmax parameter
+
age = 7:11
-# number of bootstrap samples
-n_bootstraps = 1000
-
-df.inference.boot = df.exp2.infer %>%
- bootstraps(times = n_bootstraps,
- strata = age_group) %>%
- mutate(prob = map(.x = splits,
- .f = ~ .x %>%
- as_tibble() %>%
- count(age_group, condition_disagree_c, ambiguous_yes) %>%
- complete(age_group, condition_disagree_c, ambiguous_yes,
- fill = list(n = 0)) %>%
- group_by(age_group, condition_disagree_c) %>%
- # compute probability
- reframe(p = n/sum(n)) %>%
- arrange(age_group, condition_disagree_c) %>%
- # keep only even rows
- filter(row_number() %% 2 == 0))) %>%
- unnest(prob) %>%
- select(-splits) %>%
- group_by(age_group, condition_disagree_c) %>%
- summarize(p_low = quantile(p, 0.025),
- p_high = quantile(p, 0.975)) %>%
- ungroup()
-
-
-
Bayesian model
-
-
Prediction data
-
df.exp2.predict.prob = df.exp2.predict %>%
- count(age_group, condition_amb_c, dis_yes) %>%
- group_by(age_group, condition_amb_c) %>%
- mutate(probability = n/sum(n)) %>%
- ungroup() %>%
- mutate(utterance = str_remove_all(condition_amb_c, " Trials"),
- utterance = factor(utterance,
- levels = c("Unambiguous", "Ambiguous")),
- agreement = factor(dis_yes,
- levels = c(0, 1),
- labels = c("agree", "disagree"))) %>%
- select(-c(condition_amb_c, dis_yes, n)) %>%
- relocate(probability, .after = last_col()) %>%
- arrange(age_group, utterance, agreement)
-
-
-
Without softmax
-
utterance_prior = c(0.5, 0.5)
-
-df.inference = df.exp2.predict.prob %>%
- group_by(agreement, age_group) %>%
- mutate(prior = utterance_prior) %>%
- mutate(posterior = probability * prior /
- sum(probability * prior)) %>%
- ungroup()
-
-df.model.posterior = df.inference %>%
- rename(condition = agreement) %>%
- mutate(condition = factor(condition,
- levels = c("agree", "disagree"),
- labels = c("Agreement Trials", "Disagreement Trials"))) %>%
- filter(utterance == "Ambiguous")
+
softmax = function(vec, temp = 3) {
+
out = exp(vec*temp) / sum(exp(vec*temp))
+
return(out)
+
}
+
+
df.data = df.exp2.infer %>%
+
count(age_group, condition_disagree_c, ambiguous_yes) %>%
+
group_by(age_group, condition_disagree_c) %>%
+
reframe(p = n/sum(n)) %>%
+
filter(row_number() %% 2 == 0) %>%
+
rename(agreement = condition_disagree_c) %>%
+
mutate(agreement = ifelse(agreement == "Agreement Trials", "agree", "disagree"))
+
+
fit_softmax = function(beta){
+
df.prediction = df.inference %>%
+
filter(age_group %in% age) %>%
+
select(age_group, utterance, agreement, posterior) %>%
+
pivot_wider(names_from = utterance,
+
values_from = posterior) %>%
+
rowwise() %>%
+
mutate(Unambiguous_soft = softmax(c(Unambiguous, Ambiguous),
+
temp = beta)[1],
+
Ambiguous_soft = softmax(c(Unambiguous, Ambiguous),
+
temp = beta)[2]) %>%
+
select(age_group, agreement, prediction = Ambiguous_soft)
+
+
# compute loss as squared error
+
loss = df.data %>%
+
filter(age_group %in% age) %>%
+
left_join(df.prediction) %>%
+
mutate(loss = (p-prediction)^2) %>%
+
pull(loss) %>%
+
sum()
+
+
return(loss)
+
}
+
+
# find best fitting softmax parameter
+
fit = optim(par = 0,
+
fn = fit_softmax)
+
+
# use the best parameter
+
beta = fit[[1]]
+
+
# model with softmax
+
df.model.softmax = df.inference %>%
+
select(age_group, utterance, agreement, posterior) %>%
+
pivot_wider(names_from = utterance,
+
values_from = posterior) %>%
+
rowwise() %>%
+
mutate(Unambiguous_soft = softmax(c(Unambiguous, Ambiguous),
+
temp = beta)[1],
+
Ambiguous_soft = softmax(c(Unambiguous, Ambiguous),
+
temp = beta)[2]) %>%
+
select(age_group, condition = agreement, posterior = Ambiguous_soft) %>%
+
mutate(condition = factor(condition,
+
levels = c("agree", "disagree"),
+
labels = c("Agreement Trials", "Disagreement Trials")))
-
-
One softmax parameter
-
age = 7:11
-
-softmax = function(vec, temp = 3) {
- out = exp(vec*temp) / sum(exp(vec*temp))
- return(out)
-}
-
-df.data = df.exp2.infer %>%
- count(age_group, condition_disagree_c, ambiguous_yes) %>%
- group_by(age_group, condition_disagree_c) %>%
- reframe(p = n/sum(n)) %>%
- filter(row_number() %% 2 == 0) %>%
- rename(agreement = condition_disagree_c) %>%
- mutate(agreement = ifelse(agreement == "Agreement Trials", "agree", "disagree"))
-
-fit_softmax = function(beta){
- df.prediction = df.inference %>%
- filter(age_group %in% age) %>%
- select(age_group, utterance, agreement, posterior) %>%
- pivot_wider(names_from = utterance,
- values_from = posterior) %>%
- rowwise() %>%
- mutate(Unambiguous_soft = softmax(c(Unambiguous, Ambiguous),
- temp = beta)[1],
- Ambiguous_soft = softmax(c(Unambiguous, Ambiguous),
- temp = beta)[2]) %>%
- select(age_group, agreement, prediction = Ambiguous_soft)
-
- # compute loss as squared error
- loss = df.data %>%
- filter(age_group %in% age) %>%
- left_join(df.prediction) %>%
- mutate(loss = (p-prediction)^2) %>%
- pull(loss) %>%
- sum()
-
- return(loss)
-}
-
-# find best fitting softmax parameter
-fit = optim(par = 0,
- fn = fit_softmax)
-
-# use the best parameter
-beta = fit[[1]]
-
-# model with softmax
-df.model.softmax = df.inference %>%
- select(age_group, utterance, agreement, posterior) %>%
- pivot_wider(names_from = utterance,
- values_from = posterior) %>%
- rowwise() %>%
- mutate(Unambiguous_soft = softmax(c(Unambiguous, Ambiguous),
- temp = beta)[1],
- Ambiguous_soft = softmax(c(Unambiguous, Ambiguous),
- temp = beta)[2]) %>%
- select(age_group, condition = agreement, posterior = Ambiguous_soft) %>%
- mutate(condition = factor(condition,
- levels = c("agree", "disagree"),
- labels = c("Agreement Trials", "Disagreement Trials")))
+
+
Separate softmax for each age
+
i = 1
+beta.age = numeric()
+for (age in 7:11){
+ beta.age[i] = optim(par = 0,
+ fn = fit_softmax)[[1]]
+ i = i + 1
+}
+
+df.model.softmax.separate = df.inference %>%
+ select(age_group, utterance, agreement, posterior) %>%
+ pivot_wider(names_from = utterance,
+ values_from = posterior) %>%
+ group_by(age_group) %>%
+ nest() %>%
+ ungroup() %>%
+ mutate(beta = beta.age) %>%
+ mutate(data = map2(.x = data,
+ .y = beta,
+ .f = ~ .x %>%
+ rowwise() %>%
+ mutate(Unambiguous_soft = softmax(c(Unambiguous, Ambiguous),
+ temp = .y)[1],
+ Ambiguous_soft = softmax(c(Unambiguous, Ambiguous),
+ temp = .y)[2]))) %>%
+ select(-beta) %>%
+ unnest(data) %>%
+ select(age_group, condition = agreement, posterior = Ambiguous_soft) %>%
+ mutate(condition = factor(condition,
+ levels = c("agree", "disagree"),
+ labels = c("Agreement Trials", "Disagreement Trials")))
-
-
Separate softmax for each age
-
i = 1
-beta.age = numeric()
-for (age in 7:11){
- beta.age[i] = optim(par = 0,
- fn = fit_softmax)[[1]]
- i = i + 1
-}
-
-df.model.softmax.separate = df.inference %>%
- select(age_group, utterance, agreement, posterior) %>%
- pivot_wider(names_from = utterance,
- values_from = posterior) %>%
- group_by(age_group) %>%
- nest() %>%
- ungroup() %>%
- mutate(beta = beta.age) %>%
- mutate(data = map2(.x = data,
- .y = beta,
- .f = ~ .x %>%
- rowwise() %>%
- mutate(Unambiguous_soft = softmax(c(Unambiguous, Ambiguous),
- temp = .y)[1],
- Ambiguous_soft = softmax(c(Unambiguous, Ambiguous),
- temp = .y)[2]))) %>%
- select(-beta) %>%
- unnest(data) %>%
- select(age_group, condition = agreement, posterior = Ambiguous_soft) %>%
- mutate(condition = factor(condition,
- levels = c("agree", "disagree"),
- labels = c("Agreement Trials", "Disagreement Trials")))
-
-
-
Linear increase in softmax
+
+
Linear increase in softmax
- fit linear model to the best-fitting softmax parameters
-
df.beta.linear = tibble(softmax = beta.age) %>%
- mutate(x = 1:n())
-
-fit = lm(formula = softmax ~ 1 + x,
- data = df.beta.linear)
-
-df.beta.linear = df.beta.linear %>%
- mutate(prediction = predict(fit))
-
-
-df.model.softmax.linear = df.inference %>%
- select(age_group, utterance, agreement, posterior) %>%
- pivot_wider(names_from = utterance,
- values_from = posterior) %>%
- group_by(age_group) %>%
- nest() %>%
- ungroup() %>%
- mutate(beta = df.beta.linear$prediction) %>%
- mutate(data = map2(.x = data,
- .y = beta,
- .f = ~ .x %>%
- rowwise() %>%
- mutate(Unambiguous_soft = softmax(c(Unambiguous, Ambiguous),
- temp = .y)[1],
- Ambiguous_soft = softmax(c(Unambiguous, Ambiguous),
- temp = .y)[2]))) %>%
- select(-beta) %>%
- unnest(data) %>%
- select(age_group, condition = agreement, posterior = Ambiguous_soft) %>%
- mutate(condition = factor(condition,
- levels = c("agree", "disagree"),
- labels = c("Agreement Trials", "Disagreement Trials")))
+
df.beta.linear = tibble(softmax = beta.age) %>%
+ mutate(x = 1:n())
+
+fit = lm(formula = softmax ~ 1 + x,
+ data = df.beta.linear)
+
+df.beta.linear = df.beta.linear %>%
+ mutate(prediction = predict(fit))
+
+
+df.model.softmax.linear = df.inference %>%
+ select(age_group, utterance, agreement, posterior) %>%
+ pivot_wider(names_from = utterance,
+ values_from = posterior) %>%
+ group_by(age_group) %>%
+ nest() %>%
+ ungroup() %>%
+ mutate(beta = df.beta.linear$prediction) %>%
+ mutate(data = map2(.x = data,
+ .y = beta,
+ .f = ~ .x %>%
+ rowwise() %>%
+ mutate(Unambiguous_soft = softmax(c(Unambiguous, Ambiguous),
+ temp = .y)[1],
+ Ambiguous_soft = softmax(c(Unambiguous, Ambiguous),
+ temp = .y)[2]))) %>%
+ select(-beta) %>%
+ unnest(data) %>%
+ select(age_group, condition = agreement, posterior = Ambiguous_soft) %>%
+ mutate(condition = factor(condition,
+ levels = c("agree", "disagree"),
+ labels = c("Agreement Trials", "Disagreement Trials")))
-
-
Model comparison
-
df.model.posterior %>%
- mutate(name = "posterior") %>%
- select(-c(utterance, probability, prior)) %>%
- bind_rows(df.model.softmax %>%
- mutate(name = "softmax")) %>%
- bind_rows(df.model.softmax.linear %>%
- mutate(name = "softmax increase")) %>%
- pivot_wider(names_from = name,
- values_from = posterior) %>%
- left_join(df.data %>%
- mutate(condition = factor(agreement,
- levels = c("agree", "disagree"),
- labels = c("Agreement Trials",
- "Disagreement Trials"))) %>%
- select(-agreement),
- by = c("age_group", "condition")) %>%
- summarize(
- r_posterior = cor(p, posterior),
- r_softmax = cor(p, softmax),
- r_softmaxincrease = cor(p, `softmax increase`),
- rmse_posterior = rmse(p, posterior),
- rmse_softmax = rmse(p, softmax),
- rmse_softmaxincrease = rmse(p, `softmax increase`)) %>%
- pivot_longer(cols = everything(),
- names_to = c("index", "name"),
- names_sep = "_") %>%
- pivot_wider(names_from = index,
- values_from = value) %>%
- print_table()
+
+
Model comparison
+
df.model.posterior %>%
+ mutate(name = "posterior") %>%
+ select(-c(utterance, probability, prior)) %>%
+ bind_rows(df.model.softmax %>%
+ mutate(name = "softmax")) %>%
+ bind_rows(df.model.softmax.linear %>%
+ mutate(name = "softmax increase")) %>%
+ pivot_wider(names_from = name,
+ values_from = posterior) %>%
+ left_join(df.data %>%
+ mutate(condition = factor(agreement,
+ levels = c("agree", "disagree"),
+ labels = c("Agreement Trials",
+ "Disagreement Trials"))) %>%
+ select(-agreement),
+ by = c("age_group", "condition")) %>%
+ summarize(
+ r_posterior = cor(p, posterior),
+ r_softmax = cor(p, softmax),
+ r_softmaxincrease = cor(p, `softmax increase`),
+ rmse_posterior = rmse(p, posterior),
+ rmse_softmax = rmse(p, softmax),
+ rmse_softmaxincrease = rmse(p, `softmax increase`)) %>%
+ pivot_longer(cols = everything(),
+ names_to = c("index", "name"),
+ names_sep = "_") %>%
+ pivot_wider(names_from = index,
+ values_from = value) %>%
+ print_table()
@@ -5164,238 +5114,233 @@ Model comparison
PLOTS
-
-
Prediction: Age continuous plot
-
fit.exp2.prediction_age = glmer(formula = dis_yes ~ 1 + condition_amb * age_continuous + (1 | participant),
- data = df.exp2.predict,
- family = binomial(link = "logit"))
-
-
-ggpredict(fit.exp2.prediction_age, terms = c("age_continuous [all]", "condition_amb")) %>%
- plot() +
- scale_x_continuous(breaks = 7:12,
- labels = 7:12) +
- scale_y_continuous(labels = percent) +
- coord_cartesian(xlim = c(7, 12),
- ylim = c(0, 1)) +
- labs(x = "Age",
- y = "Predict Disagreement",
- fill = "Condition",
- title = "Experiment 2: Prediction") +
- scale_color_manual(name = "Trial Type",
- labels = c("Unambiguous", "Ambiguous"),
- values = c("#A4F76A", "#EEA49A"),
- guide = guide_legend(reverse = T)) +
- scale_fill_manual(name = "Trial Type",
- labels = c("Unambiguous", "Ambiguous"),
- values = c("#A4F76A", "#EEA49A"),
- guide = guide_legend(reverse = T)) +
- theme_classic() +
- theme(plot.title = element_text(hjust = 0.5,
- size = 20,
- face = "bold"),
- strip.text = element_text(size = 18),
- strip.background = element_blank(),
- axis.title = element_text(size = 18),
- axis.text = element_text(size = 16),
- legend.title = element_text(size = 20),
- legend.text = element_text(size = 16),
- legend.position = "right")
-
-ggsave(file = "../figures/plots/exp2_prediction_age.pdf",
- width = 8,
- height = 6)
-
-
-
-
Inference: Age continuous plot
-
fit.exp2.age_inference = glmer(formula = ambiguous_yes ~ age_continuous * condition_disagree + (1 | participant),
- data = df.exp2.infer,
- family = binomial(link = "logit"))
-
-ggpredict(fit.exp2.age_inference,
- terms = c("age_continuous [all]", "condition_disagree")) %>%
- plot() +
- scale_x_continuous(breaks = 7:12,
- labels = 7:12) +
- scale_y_continuous(labels = percent) +
- coord_cartesian(xlim = c(7, 12),
- ylim = c(0, 1)) +
- labs(x = "Age",
- y = "Infer Ambiguous Utterance",
- fill = "Condition",
- title = "Experiment 2: Inference") +
- scale_color_manual(name = "Trial Type",
- labels = c("Agreement", "Disagreement"),
- values = c("#009999", "#CC6600"),
- guide = guide_legend(reverse = T)) +
- scale_fill_manual(name = "Trial Type",
- labels = c("Agreement", "Disagreement"),
- values = c("#009999", "#CC6600"),
- guide = guide_legend(reverse = T)) +
- theme_classic() +
- theme(plot.title = element_text(hjust = 0.5,
- size = 20,
- face = "bold"),
- strip.text = element_text(size = 18),
- strip.background = element_blank(),
- axis.title = element_text(size = 18),
- axis.text = element_text(size = 16),
- legend.title = element_text(size = 20),
- legend.text = element_text(size = 16),
- legend.position = "right")
-
-ggsave(file = "../figures/plots/exp2_inference_age.pdf",
- width = 8,
- height = 6)
-
+
+
Prediction
+
set.seed(1)
+
+df.plot.individual = df.exp2.predict %>%
+ mutate(condition_amb = as.character(condition_amb)) %>%
+ group_by(participant, age_continuous, condition_amb) %>%
+ summarize(pct_dis = sum(dis_yes)/n())
+
+df.age.means = df.plot.individual %>%
+ distinct(participant, age_continuous) %>%
+ mutate(age_continuous = ifelse(age_continuous == 12, 11.99, age_continuous),
+ age_group = floor(age_continuous)) %>%
+ group_by(age_group) %>%
+ summarize(age_mean = mean(age_continuous),
+ n = str_c("n = ", n())) %>%
+ ungroup()
+
+df.plot.means = df.exp2.predict %>%
+ mutate(condition_amb = as.character(condition_amb)) %>%
+ group_by(participant, age_group, condition_amb) %>%
+ summarize(pct_dis = sum(dis_yes)/n()) %>%
+ group_by(age_group, condition_amb) %>%
+ reframe(response = smean.cl.boot(pct_dis),
+ name = c("mean", "low", "high")) %>%
+ left_join(df.age.means,
+ by = "age_group") %>%
+ pivot_wider(names_from = name,
+ values_from = response) %>%
+ mutate(age_mean = ifelse(condition_amb == 0, age_mean - 0.05, age_mean + 0.05))
+
+df.plot.text = df.plot.means %>%
+ distinct(age_group, n)
+
+
+ggplot() +
+ geom_hline(yintercept = 0.5,
+ linetype = 2,
+ alpha = 0.1) +
+ geom_point(data = df.plot.individual,
+ mapping = aes(x = age_continuous,
+ y = pct_dis,
+ color = condition_amb),
+ alpha = 0.5,
+ show.legend = T,
+ shape = 16,
+ size = 1.5) +
+ geom_linerange(data = df.plot.means,
+ mapping = aes(x = age_mean,
+ y = mean,
+ ymin = low,
+ ymax = high),
+ color = "gray40") +
+ geom_point(data = df.plot.means,
+ mapping = aes(x = age_mean,
+ y = mean,
+ fill = condition_amb),
+ shape = 21,
+ size = 3,
+ show.legend = T) +
+ geom_text(data = df.plot.text,
+ mapping = aes(x = age_group + 0.5,
+ y = 1.05,
+ label = n),
+ hjust = 0.5) +
+ scale_y_continuous(labels = percent) +
+ labs(x = "Age (in years)",
+ y = "% Predict Disagreement",
+ title = "Experiment 2: Prediction") +
+ coord_cartesian(xlim = c(7, 12),
+ ylim = c(0, 1),
+ clip = "off") +
+ scale_color_manual(name = "Trial Type",
+ labels = c("Unambiguous", "Ambiguous"),
+ values = c(l.color$unambiguous, l.color$ambiguous),
+ guide = guide_legend(reverse = T)) +
+ scale_fill_manual(name = "Trial Type",
+ labels = c("Unambiguous", "Ambiguous"),
+ values = c(l.color$unambiguous, l.color$ambiguous),
+ guide = guide_legend(reverse = T)) +
+ theme(plot.title = element_text(hjust = 0.5,
+ vjust = 2,
+ size = 18,
+ face = "bold"),
+ axis.title.y = element_markdown(color = l.color$disagreement),
+ legend.position = "right")
+
+ggsave(filename = "../figures/plots/exp2_prediction.pdf",
+ width = 8,
+ height = 4)
+
-
-
Prediction condition
-
# Data
-df.plot = df.exp2.predict %>%
- group_by(condition_amb_c) %>%
- count(age_group, dis_yes) %>%
- complete(age_group, dis_yes,
- fill = list(n = 0)) %>%
- mutate(prediction = factor(dis_yes,
- levels = c(0, 1),
- labels = c("Agree", "Disagree"))) %>%
- mutate(condition_amb_c = factor(condition_amb_c,
- levels = c("Unambiguous Trials", "Ambiguous Trials"))) %>%
- ungroup()
-
-# Bootstrapped confidence intervals
-df.plot.boot = df.prediction.boot %>%
- mutate(condition_amb_c = factor(condition_amb_c,
- levels = c("Unambiguous Trials", "Ambiguous Trials")))
-# Plot
-ggplot(data = df.plot,
- mapping = aes(x = age_group,
- y = n,
- fill = prediction)) +
- geom_bar(position = "fill",
- stat = "identity",
- color = "black") +
- geom_linerange(data = df.plot.boot,
- mapping = aes(y = 1,
- ymin = p_low,
- ymax = p_high,
- fill = NA,
- x = age_group)) +
- facet_grid(cols = vars(condition_amb_c),
- scales = "free") +
- scale_fill_manual(values = c("#A4F76A", "#EEA49A"),
- na.translate = F) +
- scale_y_continuous(labels = percent) +
- labs(x = "Age",
- y = "Predicted Outcome",
- fill = "Possible Outcomes") +
- ggtitle("Experiment 2: Prediction") +
- theme(plot.title = element_text(hjust = 0.5, size = 20, face = "bold"),
- strip.text = element_text(size = 18),
- strip.background = element_blank(),
- axis.title = element_text(size = 18),
- axis.text = element_text(size = 16),
- legend.title = element_text(size = 20),
- legend.text = element_text(size = 16),
- legend.position = "right")
-
-ggsave(file = "../figures/plots/exp2_prediction.pdf",
- width = 12,
- height = 6)
-
-
-
-
Inference condition
-
# Data
-df.plot.infer = df.exp2.infer %>%
- filter(!is.na(ambiguous_yes)) %>%
- rename(condition = condition_disagree_c) %>%
- mutate(condition = factor(condition, levels = c("Agreement Trials",
- "Disagreement Trials"))) %>%
- group_by(condition) %>%
- count(age_group, ambiguous_yes) %>%
- complete(age_group, ambiguous_yes, fill = list(n = 0)) %>%
- mutate(selection = factor(ambiguous_yes,
- levels = c(0, 1),
- labels = c("Unambiguous", "Ambiguous"))) %>%
- ungroup()
-
-# Models
-df.model = df.model.posterior %>%
- mutate(name = "posterior") %>%
- select(-c(utterance, probability, prior)) %>%
- bind_rows(df.model.softmax %>%
- mutate(name = "softmax")) %>%
- bind_rows(df.model.softmax.linear %>%
- mutate(name = "softmax increase"))
-
-# Bootstrapped confidence intervals
-df.inference.boot = df.inference.boot %>%
- rename(condition = condition_disagree_c) %>%
- mutate(condition = factor(condition, levels = c("Agreement Trials",
- "Disagreement Trials"))) %>%
- ungroup()
-
-# Plot
-ggplot(data = df.plot.infer,
- mapping = aes(x = age_group,
- y = n,
- fill = selection)) +
- geom_bar(position = "fill",
- stat = "identity",
- color = "black") +
- geom_linerange(data = df.inference.boot,
- mapping = aes(y = 1,
- ymin = p_low,
- ymax = p_high,
- fill = NA,
- x = age_group)) +
- geom_point(data = df.model,
- mapping = aes(x = age_group,
- y = posterior,
- fill = NA,
- shape = name,
- group = name),
- position = position_dodge(width = 0.9),
- size = 4,
- fill = "white",
- color = "black") +
- facet_grid(cols = vars(condition),
- scales = "free") +
- scale_fill_manual(values = c(Unambiguous = "#009999", Ambiguous = "#CC6600"),
- breaks = c("Unambiguous", "Ambiguous")) +
- scale_shape_manual(values = 21:23) +
- scale_y_continuous(labels = scales::percent) +
- labs(x = "Age",
- y = "Inferred Utterance",
- fill = "Possible Statements",
- shape = "Model",
- title = "Experiment 2: Inference") +
- theme(plot.title = element_text(hjust = 0.5, size = 20, face = "bold"),
- strip.text = element_text(size = 18),
- strip.background = element_blank(),
- axis.title = element_text(size = 18),
- axis.text = element_text(size = 16),
- legend.title = element_text(size = 20),
- legend.text = element_text(size = 16),
- legend.position = "right")
-
-ggsave(str_c("../figures/plots/exp2_inference_models.pdf"),
- width = 12,
- height = 6)
-
+
+
Inference
+
set.seed(1)
+
+df.plot.individual = df.exp2.infer %>%
+ mutate(condition_disagree = as.character(condition_disagree)) %>%
+ group_by(participant, age_continuous, condition_disagree) %>%
+ summarize(pct_amb = sum(ambiguous_yes)/n())
+
+df.age.means = df.plot.individual %>%
+ distinct(participant, age_continuous) %>%
+ mutate(age_continuous = ifelse(age_continuous == 12, 11.99, age_continuous),
+ age_group = floor(age_continuous)) %>%
+ group_by(age_group) %>%
+ summarize(age_mean = mean(age_continuous),
+ n = str_c("n = ", n())) %>%
+ ungroup()
+
+df.plot.means = df.exp2.infer %>%
+ mutate(condition_disagree = as.character(condition_disagree)) %>%
+ group_by(participant, age_group, condition_disagree) %>%
+ summarize(pct_amb = sum(ambiguous_yes)/n()) %>%
+ group_by(age_group, condition_disagree) %>%
+ reframe(response = smean.cl.boot(pct_amb),
+ name = c("mean", "low", "high")) %>%
+ left_join(df.age.means,
+ by = "age_group") %>%
+ pivot_wider(names_from = name,
+ values_from = response) %>%
+ mutate(age_mean = ifelse(condition_disagree == 0, age_mean - 0.05, age_mean + 0.05))
+
+df.plot.text = df.plot.means %>%
+ distinct(age_group, n)
+
+df.model = df.model.posterior %>%
+ mutate(name = "posterior") %>%
+ select(-c(utterance, probability, prior)) %>%
+ bind_rows(df.model.softmax %>%
+ mutate(name = "softmax")) %>%
+ bind_rows(df.model.softmax.linear %>%
+ mutate(name = "softmax increase")) %>%
+ mutate(condition_disagree = factor(condition,
+ levels = c("Agreement Trials",
+ "Disagreement Trials"),
+ labels = c(0,
+ 1))) %>%
+ left_join(df.age.means %>%
+ select(-n),
+ by = "age_group") %>%
+ mutate(age_mean = ifelse(condition_disagree == 0,
+ age_mean - 0.05,
+ age_mean + 0.05))
+
+ggplot() +
+ geom_hline(yintercept = 0.5,
+ linetype = 2,
+ alpha = 0.1) +
+ geom_point(data = df.plot.individual,
+ mapping = aes(x = age_continuous,
+ y = pct_amb,
+ color = condition_disagree),
+ alpha = 0.5,
+ show.legend = T,
+ shape = 16,
+ size = 1.5) +
+ geom_linerange(data = df.plot.means,
+ mapping = aes(x = age_mean,
+ y = mean,
+ ymin = low,
+ ymax = high),
+ color = "gray40",
+ show.legend = F) +
+ geom_point(data = df.plot.means,
+ mapping = aes(x = age_mean,
+ y = mean,
+ fill = condition_disagree),
+ shape = 21,
+ size = 3,
+ show.legend = F) +
+ geom_point(data = df.model,
+ mapping = aes(x = age_mean,
+ y = posterior,
+ shape = name,
+ fill = condition_disagree),
+ size = 1.5,
+ alpha = 0.5,
+ show.legend = T) +
+ geom_text(data = df.plot.text,
+ mapping = aes(x = age_group + 0.5,
+ y = 1.05,
+ label = n),
+ hjust = 0.5) +
+ scale_y_continuous(labels = percent) +
+ labs(x = "Age (in years)",
+ y = "% Infer Ambiguous Utterance",
+ title = "Experiment 2: Inference") +
+ coord_cartesian(xlim = c(7, 12),
+ ylim = c(0, 1),
+ clip = "off") +
+ scale_color_manual(name = "Trial Type",
+ labels = c("Agreement", "Disagreement"),
+ values = c(l.color$agreement, l.color$disagreement)) +
+ scale_fill_manual(name = "Trial Type",
+ labels = c("Agreement", "Disagreement"),
+ values = c(l.color$agreement, l.color$disagreement)) +
+ scale_shape_manual(name = "Model",
+ labels = c("posterior", "softmax", "softmax increase"),
+ values = c(21, 22, 23)) +
+ theme(plot.title = element_text(hjust = 0.5,
+ vjust = 2,
+ size = 18,
+ face = "bold"),
+ axis.title.y = element_markdown(color = l.color$ambiguous),
+ legend.position = "right") +
+ guides(fill = guide_legend(override.aes = list(shape = 21,
+ size = 3),
+ reverse = T,
+ order = 1),
+ shape = guide_legend(override.aes = list(fill = "white", alpha = 1)),
+ color = "none")
+
+ggsave(filename = "../figures/plots/exp2_inference.pdf",
+ width = 8,
+ height = 4)
+
Session info
-
cite_packages(output = "paragraph",
- cite.tidyverse = TRUE,
- out.dir = ".")
-
We used R version 4.3.2 (R Core Team 2023) and the following R packages: bookdown v. 0.37 (Xie 2016, 2023a), broom.mixed v. 0.2.9.4 (Bolker and Robinson 2022), car v. 3.1.2 (Fox and Weisberg 2019), ggeffects v. 1.3.4 (Lüdecke 2018), kableExtra v. 1.3.4 (Zhu 2021), knitr v. 1.45 (Xie 2014, 2015, 2023b), lme4 v. 1.1.35.1 (Bates et al. 2015), Metrics v. 0.1.4 (Hamner and Frasco 2018), rmarkdown v. 2.25 (Xie, Allaire, and Grolemund 2018; Xie, Dervieux, and Riederer 2020; Allaire et al. 2023), rsample v. 1.2.0 (Frick et al. 2023), scales v. 1.3.0 (Wickham, Pedersen, and Seidel 2023), tidyverse v. 2.0.0 (Wickham et al. 2019), xtable v. 1.8.4 (Dahl et al. 2019).
-
+
cite_packages(output = "paragraph",
+ cite.tidyverse = TRUE,
+ out.dir = ".")
+
We used R version 4.3.2 (R Core Team 2023) and the following R packages: bookdown v. 0.37 (Xie 2016, 2023a), broom.mixed v. 0.2.9.4 (Bolker and Robinson 2022), car v. 3.1.2 (Fox and Weisberg 2019), ggeffects v. 1.3.4 (Lüdecke 2018), ggtext v. 0.1.2 (Wilke and Wiernik 2022), Hmisc v. 5.1.1 (Harrell Jr 2023), kableExtra v. 1.3.4 (Zhu 2021), knitr v. 1.45 (Xie 2014, 2015, 2023b), lme4 v. 1.1.35.1 (Bates et al. 2015), Metrics v. 0.1.4 (Hamner and Frasco 2018), rmarkdown v. 2.25 (Xie, Allaire, and Grolemund 2018; Xie, Dervieux, and Riederer 2020; Allaire et al. 2023), rsample v. 1.2.0 (Frick et al. 2023), scales v. 1.3.0 (Wickham, Pedersen, and Seidel 2023), tidyverse v. 2.0.0 (Wickham et al. 2019), xtable v. 1.8.4 (Dahl et al. 2019).
+
R version 4.3.2 (2023-10-31)
Platform: aarch64-apple-darwin20 (64-bit)
Running under: macOS Sonoma 14.1.2
@@ -5417,33 +5362,36 @@ Session info
[1] lubridate_1.9.3 forcats_1.0.0 stringr_1.5.1
[4] dplyr_1.1.4 purrr_1.0.2 readr_2.1.4
[7] tidyr_1.3.0 tibble_3.2.1 ggplot2_3.4.4
-[10] tidyverse_2.0.0 ggeffects_1.3.4 grateful_0.2.4
-[13] broom.mixed_0.2.9.4 scales_1.3.0 Metrics_0.1.4
-[16] car_3.1-2 carData_3.0-5 knitr_1.45
-[19] kableExtra_1.3.4 xtable_1.8-4 rsample_1.2.0
-[22] lme4_1.1-35.1 Matrix_1.6-4
+[10] tidyverse_2.0.0 ggtext_0.1.2 Hmisc_5.1-1
+[13] ggeffects_1.3.4 grateful_0.2.4 broom.mixed_0.2.9.4
+[16] scales_1.3.0 Metrics_0.1.4 car_3.1-2
+[19] carData_3.0-5 knitr_1.45 kableExtra_1.3.4
+[22] xtable_1.8-4 rsample_1.2.0 lme4_1.1-35.1
+[25] Matrix_1.6-4
loaded via a namespace (and not attached):
- [1] sjlabelled_1.2.0 tidyselect_1.2.0 viridisLite_0.4.2 farver_2.1.1
- [5] fastmap_1.1.1 digest_0.6.34 timechange_0.2.0 lifecycle_1.0.4
- [9] magrittr_2.0.3 compiler_4.3.2 rlang_1.1.3 sass_0.4.8
-[13] tools_4.3.2 utf8_1.2.4 yaml_2.3.8 labeling_0.4.3
-[17] bit_4.0.5 xml2_1.3.6 abind_1.4-5 withr_3.0.0
-[21] datawizard_0.9.1 grid_4.3.2 fansi_1.0.6 colorspace_2.1-0
-[25] future_1.33.1 globals_0.16.2 MASS_7.3-60 insight_0.19.7
-[29] cli_3.6.2 rmarkdown_2.25 crayon_1.5.2 ragg_1.2.7
-[33] generics_0.1.3 rstudioapi_0.15.0 httr_1.4.7 tzdb_0.4.0
-[37] minqa_1.2.6 cachem_1.0.8 splines_4.3.2 rvest_1.0.3
-[41] parallel_4.3.2 vctrs_0.6.5 boot_1.3-28.1 webshot_0.5.5
-[45] jsonlite_1.8.8 bookdown_0.37 hms_1.1.3 bit64_4.0.5
-[49] listenv_0.9.1 systemfonts_1.0.5 jquerylib_0.1.4 glue_1.7.0
-[53] parallelly_1.37.0 nloptr_2.0.3 codetools_0.2-19 stringi_1.8.3
-[57] gtable_0.3.4 munsell_0.5.0 furrr_0.3.1 pillar_1.9.0
-[61] htmltools_0.5.7 R6_2.5.1 textshaping_0.3.7 vroom_1.6.5
-[65] evaluate_0.23 lattice_0.22-5 haven_2.5.4 highr_0.10
-[69] backports_1.4.1 snakecase_0.11.1 broom_1.0.5 renv_1.0.3
-[73] bslib_0.6.1 Rcpp_1.0.12 svglite_2.1.3 nlme_3.1-164
-[77] xfun_0.41 pkgconfig_2.0.3
+ [1] gridExtra_2.3 rlang_1.1.3 magrittr_2.0.3 furrr_0.3.1
+ [5] compiler_4.3.2 systemfonts_1.0.5 vctrs_0.6.5 rvest_1.0.3
+ [9] pkgconfig_2.0.3 crayon_1.5.2 fastmap_1.1.1 backports_1.4.1
+[13] labeling_0.4.3 utf8_1.2.4 rmarkdown_2.25 markdown_1.12
+[17] tzdb_0.4.0 nloptr_2.0.3 ragg_1.2.7 bit_4.0.5
+[21] xfun_0.41 cachem_1.0.8 jsonlite_1.8.8 highr_0.10
+[25] broom_1.0.5 parallel_4.3.2 cluster_2.1.6 R6_2.5.1
+[29] bslib_0.6.1 stringi_1.8.3 parallelly_1.37.0 boot_1.3-28.1
+[33] rpart_4.1.23 jquerylib_0.1.4 Rcpp_1.0.12 bookdown_0.37
+[37] base64enc_0.1-3 splines_4.3.2 nnet_7.3-19 timechange_0.2.0
+[41] tidyselect_1.2.0 rstudioapi_0.15.0 abind_1.4-5 yaml_2.3.8
+[45] codetools_0.2-19 listenv_0.9.1 lattice_0.22-5 withr_3.0.0
+[49] evaluate_0.23 foreign_0.8-86 future_1.33.1 xml2_1.3.6
+[53] pillar_1.9.0 renv_1.0.3 checkmate_2.3.1 generics_0.1.3
+[57] vroom_1.6.5 hms_1.1.3 commonmark_1.9.0 munsell_0.5.0
+[61] minqa_1.2.6 globals_0.16.2 glue_1.7.0 tools_4.3.2
+[65] data.table_1.14.10 webshot_0.5.5 grid_4.3.2 colorspace_2.1-0
+[69] nlme_3.1-164 htmlTable_2.4.2 Formula_1.2-5 cli_3.6.2
+[73] textshaping_0.3.7 fansi_1.0.6 viridisLite_0.4.2 svglite_2.1.3
+[77] gtable_0.3.4 sass_0.4.8 digest_0.6.34 htmlwidgets_1.6.4
+[81] farver_2.1.1 htmltools_0.5.7 lifecycle_1.0.4 httr_1.4.7
+[85] gridtext_0.1.5 bit64_4.0.5 MASS_7.3-60
Allaire, JJ, Yihui Xie, Christophe Dervieux, Jonathan McPherson, Javier Luraschi, Kevin Ushey, Aron Atkins, et al. 2023.
rmarkdown: Dynamic Documents for r.
https://github.com/rstudio/rmarkdown.
@@ -5466,6 +5414,9 @@
Session info
Hamner, Ben, and Michael Frasco. 2018.
Metrics: Evaluation Metrics for Machine Learning.
https://CRAN.R-project.org/package=Metrics.
+
+Harrell Jr, Frank E. 2023.
Hmisc: Harrell Miscellaneous.
https://CRAN.R-project.org/package=Hmisc.
+
Lüdecke, Daniel. 2018.
“ggeffects: Tidy Data Frames of Marginal Effects from Regression Models.” Journal of Open Source Software 3 (26): 772.
https://doi.org/10.21105/joss.00772.
@@ -5478,6 +5429,9 @@
Session info
Wickham, Hadley, Thomas Lin Pedersen, and Dana Seidel. 2023.
scales: Scale Functions for Visualization.
https://CRAN.R-project.org/package=scales.
+
+Wilke, Claus O., and Brenton M. Wiernik. 2022.
ggtext: Improved Text Rendering Support for “ggplot2”.
https://CRAN.R-project.org/package=ggtext.
+
Xie, Yihui. 2014. “knitr: A Comprehensive Tool for Reproducible Research in R.” In Implementing Reproducible Computational Research, edited by Victoria Stodden, Friedrich Leisch, and Roger D. Peng. Chapman; Hall/CRC.
diff --git a/figures/plots/exp1_inference.pdf b/figures/plots/exp1_inference.pdf
index 012deef..86c25a6 100644
Binary files a/figures/plots/exp1_inference.pdf and b/figures/plots/exp1_inference.pdf differ
diff --git a/figures/plots/exp1_inference_age.pdf b/figures/plots/exp1_inference_age.pdf
deleted file mode 100644
index bb4f673..0000000
Binary files a/figures/plots/exp1_inference_age.pdf and /dev/null differ
diff --git a/figures/plots/exp2_inference.pdf b/figures/plots/exp2_inference.pdf
new file mode 100644
index 0000000..9ba5e6a
Binary files /dev/null and b/figures/plots/exp2_inference.pdf differ
diff --git a/figures/plots/exp2_inference_age.pdf b/figures/plots/exp2_inference_age.pdf
deleted file mode 100644
index 18910be..0000000
Binary files a/figures/plots/exp2_inference_age.pdf and /dev/null differ
diff --git a/figures/plots/exp2_inference_models.pdf b/figures/plots/exp2_inference_models.pdf
deleted file mode 100644
index 0f50385..0000000
Binary files a/figures/plots/exp2_inference_models.pdf and /dev/null differ
diff --git a/figures/plots/exp2_prediction.pdf b/figures/plots/exp2_prediction.pdf
index 8b78dde..f8a87a1 100644
Binary files a/figures/plots/exp2_prediction.pdf and b/figures/plots/exp2_prediction.pdf differ
diff --git a/figures/plots/exp2_prediction_age.pdf b/figures/plots/exp2_prediction_age.pdf
deleted file mode 100644
index 3e2e398..0000000
Binary files a/figures/plots/exp2_prediction_age.pdf and /dev/null differ