Adults and preschoolers flexibly adapt to noisy linguistic input
Daniel Yurovsky, Sarah Case, & Michael C. Frank
September 17, 2015
Load libraries
library(dplyr)
library(langcog)
library(tidyr)
library(magrittr)
library(lme4)
library(lmerTest)
library(jsonlite)
library(dplyr)
library(tidyr)
library(ggplot2)
library(readr)
library(jsonlite)Load experiment 1 data
exp1_child_data <- read_csv("data/exp1_child.csv")
exp1_adult_data <- read_csv("data/exp1_adult.csv")
exp1_data <- bind_rows(exp1_child_data,exp1_adult_data) %>%
mutate(response = factor(response, levels = c("Implausible", "Plausible")))Munge experiment 1 data
child_demo_data <- exp1_child_data %>%
distinct(subject) %>%
group_by(condition) %>%
summarise(n = n(),
num_girls = sum(sex == "female"),
min_age = min(age),
mean_age = mean(age),
max_age = max(age))
adult_demo_data <- exp1_adult_data %>%
distinct(subject) %>%
group_by(condition) %>%
summarise(n = n())
kable(child_demo_data,
col.names = c("Speaker Condition", "Num Participants",
"Num Girls","Min Age","Mean Age","Max. Age"))| Speaker Condition | Num Participants | Num Girls | Min Age | Mean Age | Max. Age |
|---|---|---|---|---|---|
| Implausible | 20 | 10 | 4.08 | 4.740500 | 5.40 |
| Plausible | 23 | 12 | 4.00 | 4.631304 | 5.26 |
kable(adult_demo_data,
col.names = c("Speaker Condition", "Num Participants"))| Speaker Condition | Num Participants |
|---|---|
| Implausible | 23 |
| Plausible | 27 |
exp1_group_data <- exp1_data %>%
mutate(response = as.numeric(response)-1) %>%
group_by(group,condition,trial_type) %>%
multi_boot_standard("response", na.rm = T)Analyze exposure and test trials
exp1_exposure_chance_lm <- glmer(response ~ 0 + group : condition + (1|word) + (1|subject),
family = "binomial",
data = filter(exp1_data,trial_type == "Exposure"))
summary(exp1_exposure_chance_lm)## Generalized linear mixed model fit by maximum likelihood (Laplace
## Approximation) [glmerMod]
## Family: binomial ( logit )
## Formula: response ~ 0 + group:condition + (1 | word) + (1 | subject)
## Data: filter(exp1_data, trial_type == "Exposure")
##
## AIC BIC logLik deviance df.resid
## 315.2 342.9 -151.6 303.2 738
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -13.0189 -0.1739 0.0526 0.2148 5.4724
##
## Random effects:
## Groups Name Variance Std.Dev.
## subject (Intercept) 0.5497 0.7414
## word (Intercept) 0.1047 0.3236
## Number of obs: 744, groups: subject, 93; word, 16
##
## Fixed effects:
## Estimate Std. Error z value Pr(>|z|)
## groupadult:conditionImplausible -3.8619 0.5417 -7.130 1.01e-12 ***
## groupchild:conditionImplausible -1.8968 0.3382 -5.608 2.04e-08 ***
## groupadult:conditionPlausible 5.6596 1.0415 5.434 5.51e-08 ***
## groupchild:conditionPlausible 2.6180 0.3873 6.759 1.39e-11 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## grpd:I grpc:I grpd:P
## grpchld:cnI 0.162
## grpdlt:cndP -0.077 -0.046
## grpchld:cnP -0.193 -0.109 0.131exp1_exposure_lm <- glmer(response ~ group * condition + (1|word) + (1|subject),
family = "binomial",
data = filter(exp1_data,trial_type == "Exposure"))
summary(exp1_exposure_lm)## Generalized linear mixed model fit by maximum likelihood (Laplace
## Approximation) [glmerMod]
## Family: binomial ( logit )
## Formula: response ~ group * condition + (1 | word) + (1 | subject)
## Data: filter(exp1_data, trial_type == "Exposure")
##
## AIC BIC logLik deviance df.resid
## 315.2 342.9 -151.6 303.2 738
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -13.0189 -0.1739 0.0526 0.2148 5.4724
##
## Random effects:
## Groups Name Variance Std.Dev.
## subject (Intercept) 0.5497 0.7414
## word (Intercept) 0.1047 0.3236
## Number of obs: 744, groups: subject, 93; word, 16
##
## Fixed effects:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -3.8619 0.5417 -7.130 1.01e-12 ***
## groupchild 1.9651 0.5903 3.329 0.000872 ***
## conditionPlausible 9.5215 1.2103 7.867 3.63e-15 ***
## groupchild:conditionPlausible -5.0067 1.2164 -4.116 3.85e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) grpchl cndtnP
## groupchild -0.825
## condtnPlsbl -0.514 0.407
## grpchld:cnP 0.405 -0.487 -0.901exp1_test_lm <- glmer(response ~ group * condition + (1|word) + (1|subject),
family = "binomial",
data = filter(exp1_data,trial_type == "Test"))
summary(exp1_test_lm)## Generalized linear mixed model fit by maximum likelihood (Laplace
## Approximation) [glmerMod]
## Family: binomial ( logit )
## Formula: response ~ group * condition + (1 | word) + (1 | subject)
## Data: filter(exp1_data, trial_type == "Test")
##
## AIC BIC logLik deviance df.resid
## 690.0 716.9 -339.0 678.0 645
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -2.5518 -0.5216 -0.2078 0.5916 4.7418
##
## Random effects:
## Groups Name Variance Std.Dev.
## subject (Intercept) 1.421 1.192
## word (Intercept) 1.078 1.038
## Number of obs: 651, groups: subject, 93; word, 14
##
## Fixed effects:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -3.1485 0.6064 -5.192 2.08e-07 ***
## groupchild 2.6209 0.7915 3.311 0.000929 ***
## conditionPlausible 2.3310 0.5298 4.399 1.09e-05 ***
## groupchild:conditionPlausible -1.0484 0.6929 -1.513 0.130246
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) grpchl cndtnP
## groupchild -0.759
## condtnPlsbl -0.623 0.471
## grpchld:cnP 0.453 -0.547 -0.745exp1_glm <- glmer(response ~ group * condition * trial_type + (1|word) + (1|subject),
family = "binomial", control=glmerControl(optimizer = "bobyqa"),
data = exp1_data)
summary(exp1_glm)## Generalized linear mixed model fit by maximum likelihood (Laplace
## Approximation) [glmerMod]
## Family: binomial ( logit )
## Formula: response ~ group * condition * trial_type + (1 | word) + (1 |
## subject)
## Data: exp1_data
## Control: glmerControl(optimizer = "bobyqa")
##
## AIC BIC logLik deviance df.resid
## 1014.4 1066.8 -497.2 994.4 1385
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -37.990 -0.362 -0.087 0.265 6.823
##
## Random effects:
## Groups Name Variance Std.Dev.
## subject (Intercept) 0.7995 0.8942
## word (Intercept) 0.6309 0.7943
## Number of obs: 1395, groups: subject, 93; word, 30
##
## Fixed effects:
## Estimate Std. Error z value
## (Intercept) -4.27104 0.62189 -6.868
## groupchild 2.28601 0.74160 3.083
## conditionPlausible 10.26129 1.26096 8.138
## trial_typeTest 1.43883 0.70123 2.052
## groupchild:conditionPlausible -5.56600 1.31908 -4.220
## groupchild:trial_typeTest 0.04875 0.86736 0.056
## conditionPlausible:trial_typeTest -8.15777 1.25864 -6.481
## groupchild:conditionPlausible:trial_typeTest 4.63862 1.32452 3.502
## Pr(>|z|)
## (Intercept) 6.52e-12 ***
## groupchild 0.002052 **
## conditionPlausible 4.03e-16 ***
## trial_typeTest 0.040182 *
## groupchild:conditionPlausible 2.45e-05 ***
## groupchild:trial_typeTest 0.955175
## conditionPlausible:trial_typeTest 9.09e-11 ***
## groupchild:conditionPlausible:trial_typeTest 0.000462 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) grpchl cndtnP trl_tT grpc:P grp:_T cnP:_T
## groupchild -0.822
## condtnPlsbl -0.524 0.506
## tril_typTst -0.736 0.614 0.368
## grpchld:cnP 0.480 -0.573 -0.933 -0.348
## grpchld:t_T 0.585 -0.701 -0.358 -0.806 0.393
## cndtnPls:_T 0.449 -0.447 -0.938 -0.459 0.879 0.435
## grpchl:P:_T -0.413 0.477 0.874 0.433 -0.904 -0.496 -0.937#Exposure Trials
ggplot(filter(exp1_group_data,trial_type == "Exposure"),
aes(x=condition, y=mean, fill=group)) +
facet_grid(. ~ group) +
geom_bar(stat="identity",position=position_dodge(1))+
geom_linerange(aes(ymin = ci_lower,
ymax = ci_upper),
size = .8,
show_guide = FALSE,
position=position_dodge(1)) +
scale_fill_brewer(palette="Set1") +
geom_hline(aes(yintercept=.5),lty=2)+
theme_bw(base_size=14) +
theme(legend.position="none", panel.grid=element_blank()) +
scale_x_discrete(name = "\nSpeaker Condition")+
scale_y_continuous(name = "Proportion Choosing Plausible",
limits=c(0,1))
#Test Trials
#quartz(width=6,height=4)
ggplot(filter(exp1_group_data,trial_type == "Test"),
aes(x=condition, y=mean, fill=group)) +
facet_grid(. ~ group) +
geom_bar(stat="identity",position=position_dodge(1))+
geom_linerange(aes(ymin = ci_lower,
ymax = ci_upper),
size = .8,
show_guide = FALSE,
position=position_dodge(1)) +
scale_fill_brewer(palette="Set1") +
geom_hline(aes(yintercept=.5),lty=2)+
theme_bw(base_size=14) +
theme(legend.position="none", panel.grid=element_blank()) +
scale_x_discrete(name = "\nSpeaker Condition")+
scale_y_continuous(name = "Proportion Choosing Plausible",
limits=c(0,1))
Load experiment 2 data
exp2_child_data <- read_csv("data/exp2_child.csv") %>%
mutate(response = factor(response, levels = c("Implausible", "Plausible")),
condition = factor(condition, levels = c("Implausible", "Plausible", "Control")))Munge experiment 2 data
exp2_demo_data <- exp2_child_data %>%
distinct(subject) %>%
group_by(condition, noise) %>%
summarise(n = n(),
num_girls = sum(sex == "female", na.rm = T),
min_age = min(age),
mean_age = mean(age),
max_age = max(age))
kable(exp2_demo_data,
col.names = c("Speaker Condition", "Noise Level", "Num Participants",
"Num Girls","Min Age","Mean Age","Max. Age"))| Speaker Condition | Noise Level | Num Participants | Num Girls | Min Age | Mean Age | Max. Age |
|---|---|---|---|---|---|---|
| Implausible | No Noise | 20 | 12 | 4.00 | 4.977500 | 5.83 |
| Implausible | Noisy | 24 | 11 | 4.01 | 5.007500 | 5.92 |
| Plausible | No Noise | 21 | 8 | 4.10 | 4.886190 | 5.93 |
| Plausible | Noisy | 26 | 12 | 4.02 | 4.979231 | 5.94 |
| Control | Noisy | 20 | 11 | 4.15 | 4.956500 | 5.91 |
exp2_group_data <- exp2_child_data %>%
mutate(response = as.numeric(response)-1) %>%
group_by(group,condition,noise,trial_type) %>%
multi_boot_standard("response", na.rm = T)Analyze exposure and test trials
exp2_exposure_chance_lm <- glmer(response ~ 0 + condition:noise +
(1|word) + (1|subject), family = "binomial",
data = filter(exp2_child_data,trial_type == "Exposure"))
summary(exp2_exposure_chance_lm)## Generalized linear mixed model fit by maximum likelihood (Laplace
## Approximation) [glmerMod]
## Family: binomial ( logit )
## Formula: response ~ 0 + condition:noise + (1 | word) + (1 | subject)
## Data: filter(exp2_child_data, trial_type == "Exposure")
##
## AIC BIC logLik deviance df.resid
## 601.7 635.2 -293.8 587.7 881
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -4.0973 -0.3692 -0.1740 0.1855 3.7028
##
## Random effects:
## Groups Name Variance Std.Dev.
## subject (Intercept) 1.0877 1.0429
## word (Intercept) 0.1682 0.4101
## Number of obs: 888, groups: subject, 111; word, 16
##
## Fixed effects:
## Estimate Std. Error z value Pr(>|z|)
## conditionImplausible:noiseNo Noise -2.7502 0.4367 -6.297 3.03e-10
## conditionPlausible:noiseNo Noise 3.8715 0.5577 6.942 3.86e-12
## conditionImplausible:noiseNoisy -1.8874 0.3491 -5.406 6.45e-08
## conditionPlausible:noiseNoisy 3.0272 0.4236 7.147 8.89e-13
## conditionControl:noiseNoisy -1.5325 0.3548 -4.320 1.56e-05
##
## conditionImplausible:noiseNo Noise ***
## conditionPlausible:noiseNo Noise ***
## conditionImplausible:noiseNoisy ***
## conditionPlausible:noiseNoisy ***
## conditionControl:noiseNoisy ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## cnI:NN cnP:NN cndI:N cndP:N
## cndtnPls:NN -0.112
## cndtnImpl:N 0.222 -0.086
## cndtnPlsb:N -0.129 0.231 -0.099
## cndtnCntr:N 0.191 -0.056 0.212 -0.065
## fit warnings:
## fixed-effect model matrix is rank deficient so dropping 1 column / coefficientexp2_exposure_lm <- glmer(response ~ condition * noise + (1|word) + (1|subject),
family = "binomial",
data = filter(exp2_child_data,trial_type == "Exposure"))
summary(exp2_exposure_lm)## Generalized linear mixed model fit by maximum likelihood (Laplace
## Approximation) [glmerMod]
## Family: binomial ( logit )
## Formula: response ~ condition * noise + (1 | word) + (1 | subject)
## Data: filter(exp2_child_data, trial_type == "Exposure")
##
## AIC BIC logLik deviance df.resid
## 601.7 635.2 -293.8 587.7 881
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -4.0971 -0.3692 -0.1740 0.1855 3.7028
##
## Random effects:
## Groups Name Variance Std.Dev.
## subject (Intercept) 1.0877 1.0429
## word (Intercept) 0.1682 0.4101
## Number of obs: 888, groups: subject, 111; word, 16
##
## Fixed effects:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -2.7502 0.4368 -6.297 3.04e-10 ***
## conditionPlausible 6.6216 0.7459 8.877 < 2e-16 ***
## conditionControl 0.3549 0.4417 0.803 0.4218
## noiseNoisy 0.8628 0.4950 1.743 0.0813 .
## conditionPlausible:noiseNoisy -1.7070 0.7930 -2.153 0.0314 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) cndtnP cndtnC nosNsy
## condtnPlsbl -0.669
## condtnCntrl -0.022 0.030
## noiseNoisy -0.726 0.454 -0.418
## cndtnPlsb:N 0.463 -0.723 0.259 -0.628
## fit warnings:
## fixed-effect model matrix is rank deficient so dropping 1 column / coefficientexp2_control_lm <- glmer(response ~ condition + (1|word) + (1|subject),
family = "binomial",
data = filter(exp2_child_data, trial_type == "Test",
noise == "Noisy"))
summary(exp2_control_lm)## Generalized linear mixed model fit by maximum likelihood (Laplace
## Approximation) [glmerMod]
## Family: binomial ( logit )
## Formula: response ~ condition + (1 | word) + (1 | subject)
## Data: filter(exp2_child_data, trial_type == "Test", noise == "Noisy")
##
## AIC BIC logLik deviance df.resid
## 622.1 643.7 -306.0 612.1 555
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -2.7236 -0.6271 0.3073 0.5523 2.6053
##
## Random effects:
## Groups Name Variance Std.Dev.
## subject (Intercept) 0.9874 0.9937
## word (Intercept) 0.3327 0.5768
## Number of obs: 560, groups: subject, 70; word, 16
##
## Fixed effects:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -0.5150 0.3353 -1.536 0.125
## conditionPlausible 1.5697 0.3790 4.142 3.44e-05 ***
## conditionControl 2.6280 0.5292 4.966 6.83e-07 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) cndtnP
## condtnPlsbl -0.568
## condtnCntrl -0.645 0.391exp2_test_lm <<- glmer(response ~ noise + condition + (1|word) + (1|subject),
family = "binomial",
data = filter(exp2_child_data,trial_type == "Test",
condition != "Control"))
summary(exp2_test_lm)## Generalized linear mixed model fit by maximum likelihood (Laplace
## Approximation) [glmerMod]
## Family: binomial ( logit )
## Formula: response ~ noise + condition + (1 | word) + (1 | subject)
## Data:
## filter(exp2_child_data, trial_type == "Test", condition != "Control")
##
## AIC BIC logLik deviance df.resid
## 882.5 905.4 -436.2 872.5 723
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -2.1335 -0.6985 -0.3360 0.7020 2.7079
##
## Random effects:
## Groups Name Variance Std.Dev.
## subject (Intercept) 0.7362 0.8580
## word (Intercept) 0.3713 0.6093
## Number of obs: 728, groups: subject, 91; word, 8
##
## Fixed effects:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.4124 0.3193 -4.424 9.71e-06 ***
## noiseNoisy 0.9849 0.2537 3.882 0.000104 ***
## conditionPlausible 1.3837 0.2553 5.420 5.97e-08 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) nosNsy
## noiseNoisy -0.463
## condtnPlsbl -0.446 0.057#Exposure Trials
ggplot(filter(exp2_group_data,trial_type == "Exposure"),
aes(x=condition, y=mean, fill=group)) +
facet_grid(. ~ noise) +
geom_bar(stat="identity",position=position_dodge(1))+
geom_linerange(aes(ymin = ci_lower,
ymax = ci_upper),
size = .8,
show_guide = FALSE,
position=position_dodge(1)) +
scale_fill_brewer(palette="Set1") +
geom_hline(aes(yintercept=.5),lty=2)+
theme_bw(base_size=14) +
theme(legend.position="none", panel.grid=element_blank()) +
scale_x_discrete(name = "\nSpeaker Condition")+
scale_y_continuous(name = "Proportion Choosing Plausible",
limits=c(0,1))
#Test Trials
plotting_test_data <- filter(exp2_group_data,trial_type == "Test") %>%
mutate(width = ifelse(condition == "Control", .4, .9))
#quartz(width=7.5,height=4)
ggplot(plotting_test_data,
aes(x=noise, y=mean, fill=group)) +
facet_grid(. ~ condition, scales = "free_x") +
geom_bar(aes(width = width),
stat="identity", position=position_dodge(1))+
geom_linerange(aes(ymin = ci_lower,
ymax = ci_upper),
size = .8,
show_guide = FALSE,
position=position_dodge(1)) +
scale_fill_brewer(palette="Set1") +
geom_hline(aes(yintercept=.5),lty=2)+
theme_bw(base_size=14) +
theme(legend.position="none", panel.grid=element_blank()) +
scale_x_discrete(name = "\nNoise Level")+
scale_y_continuous(name = "Proportion Choosing Plausible",
limits=c(0,1))