CrossActivePassive V1 Analysis
Martin Zettersten
08 July, 2021
Read in data
## read in data
d <- read_csv(here("..","..","data","exp1","processed_data","crossActivePassive_v1_processed_data.csv"))Sampling
Summarize subject-level data.
## Active selections
subj_sample_active <- d %>%
filter(trialType=="selection"&round_condition=="active") %>%
group_by(subject,round_condition) %>%
summarize(
prop_ambiguous=mean(choiceItemCondition=="ambiguous")
)
sample_active_overall <- subj_sample_active %>%
group_by(round_condition) %>%
summarize(
N=n(),
mean_ambiguous=mean(prop_ambiguous),
sd_ambiguous=sd(prop_ambiguous),
ci_ambiguous=qt(0.975, N-1)*sd_ambiguous/sqrt(N),
mean_ambiguous_lower_ci=mean_ambiguous-ci_ambiguous,
mean_ambiguous_upper_ci=mean_ambiguous+ci_ambiguous
)
##Passive selections
subj_sample_passive <- d %>%
filter(trialType=="selection"&round_condition=="passive") %>%
group_by(subject,round_condition) %>%
summarize(
prop_ambiguous_1=mean(randomItemCondition1=="ambiguous"),
prop_ambiguous_2=mean(randomItemCondition2=="ambiguous"),
) %>%
mutate(
prop_ambiguous=(prop_ambiguous_1+prop_ambiguous_2)/2
)
sample_passive_overall <- subj_sample_passive %>%
group_by(round_condition) %>%
summarize(
N=n(),
mean_ambiguous=mean(prop_ambiguous),
sd_ambiguous=sd(prop_ambiguous),
ci_ambiguous=qt(0.975, N-1)*sd_ambiguous/sqrt(N),
mean_ambiguous_lower_ci=mean_ambiguous-ci_ambiguous,
mean_ambiguous_upper_ci=mean_ambiguous+ci_ambiguous
)Active Condition Plot
ggplot(subj_sample_active,aes(round_condition,prop_ambiguous))+
geom_bar(data=sample_active_overall,aes(y=mean_ambiguous),stat="identity",width=0.3,fill="red",alpha=0.5,color="black")+
geom_errorbar(data=sample_active_overall,aes(y=mean_ambiguous,ymin=mean_ambiguous_lower_ci,ymax=mean_ambiguous_upper_ci),width=0)+
geom_dotplot(stackdir="center",binaxis="y",alpha=0.6,dotsize=0.5)+
geom_hline(yintercept=0.5, linetype="dashed")+
ylab("Proportion of Ambiguous Selections")+
xlab("Condition")
Passive Condition Plot
ggplot(subj_sample_passive,aes(round_condition,prop_ambiguous))+
geom_bar(data=sample_passive_overall,aes(y=mean_ambiguous),stat="identity",width=0.3,fill="red",alpha=0.5,color="black")+
geom_errorbar(data=sample_passive_overall,aes(y=mean_ambiguous,ymin=mean_ambiguous_lower_ci,ymax=mean_ambiguous_upper_ci),width=0)+
geom_dotplot(stackdir="center",binaxis="y",alpha=0.6,dotsize=0.5)+
geom_hline(yintercept=0.5, linetype="dashed")+
ylab("Proportion of (Random) Ambiguous Selections")+
xlab("Condition")
Model (Active condition)
d$ambiguous_selection <- ifelse(d$choiceItemCondition=="ambiguous",1,0)
m <- glmer(ambiguous_selection ~ 1 + (1|subject)+ (1|choiceImage), data=filter(d,trialType=="selection"&round_condition=="active"), family=binomial)
summary(m)## Generalized linear mixed model fit by maximum likelihood (Laplace
## Approximation) [glmerMod]
## Family: binomial ( logit )
## Formula: ambiguous_selection ~ 1 + (1 | subject) + (1 | choiceImage)
## Data: filter(d, trialType == "selection" & round_condition == "active")
##
## AIC BIC logLik deviance df.resid
## 609.0 621.4 -301.5 603.0 457
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -1.5355 -1.1202 0.6291 0.7270 1.0180
##
## Random effects:
## Groups Name Variance Std.Dev.
## subject (Intercept) 0.32096 0.5665
## choiceImage (Intercept) 0.06313 0.2513
## Number of obs: 460, groups: subject, 115; choiceImage, 16
##
## Fixed effects:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 0.5803 0.1340 4.33 1.49e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Robustness checks:
t.test(subj_sample_active$prop_ambiguous,mu=0.5)##
## One Sample t-test
##
## data: subj_sample_active$prop_ambiguous
## t = 5.0988, df = 114, p-value = 1.373e-06
## alternative hypothesis: true mean is not equal to 0.5
## 95 percent confidence interval:
## 0.5784291 0.6780927
## sample estimates:
## mean of x
## 0.6282609wilcox.test(subj_sample_active$prop_ambiguous,mu=0.5)##
## Wilcoxon signed rank test with continuity correction
##
## data: subj_sample_active$prop_ambiguous
## V = 2159, p-value = 4.249e-06
## alternative hypothesis: true location is not equal to 0.5Test Performance
Summarize subject-level performance
subj_test_by_condition <- d %>%
filter(trialType=="test") %>%
group_by(subject,condition,round_condition) %>%
summarize(
round_n=n(),
accuracy=mean(isRight, na.rm=TRUE)
)
test_by_condition <- subj_test_by_condition %>%
group_by(round_condition) %>%
summarize(
N=n(),
mean_accuracy=mean(accuracy),
sd_accuracy=sd(accuracy),
ci_accuracy=qt(0.975, N-1)*sd_accuracy/sqrt(N),
lower_ci=mean_accuracy-ci_accuracy,
upper_ci=mean_accuracy+ci_accuracy
)
test_by_condition_by_order <- subj_test_by_condition %>%
group_by(condition,round_condition) %>%
summarize(
N=n(),
mean_accuracy=mean(accuracy),
sd_accuracy=sd(accuracy),
ci_accuracy=qt(0.975, N-1)*sd_accuracy/sqrt(N),
lower_ci=mean_accuracy-ci_accuracy,
upper_ci=mean_accuracy+ci_accuracy
)Plot test performance
ggplot(subj_test_by_condition,aes(round_condition,accuracy, color=round_condition,fill=round_condition))+
geom_bar(data=test_by_condition,aes(y=mean_accuracy),stat="identity",width=0.3,alpha=0.5,color="black")+
geom_errorbar(data=test_by_condition,aes(y=mean_accuracy,ymin=lower_ci,ymax=upper_ci),width=0,color="black")+
geom_dotplot(stackdir="center",binaxis="y",alpha=0.6,dotsize=0.5,color="black",fill="black")+
geom_hline(yintercept=1/8, linetype="dashed")+
ylab("Test Accuracy")+
xlab("Condition")+
theme(legend.position="none")
Model
d <- d %>%
mutate(
condition_centered = case_when(
round_condition=="active" ~ 0.5,
round_condition=="passive" ~ -0.5,
TRUE ~ NA_real_))
m <- glmer(isRight ~ 1 + condition_centered + (1+condition_centered|subject)+ (1|choiceImage), data=filter(d,trialType=="test"), family=binomial)
summary(m)## Generalized linear mixed model fit by maximum likelihood (Laplace
## Approximation) [glmerMod]
## Family: binomial ( logit )
## Formula: isRight ~ 1 + condition_centered + (1 + condition_centered |
## subject) + (1 | choiceImage)
## Data: filter(d, trialType == "test")
##
## AIC BIC logLik deviance df.resid
## 3924.2 3961.5 -1956.1 3912.2 3674
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -4.1580 -0.6462 0.2417 0.5927 3.0097
##
## Random effects:
## Groups Name Variance Std.Dev. Corr
## subject (Intercept) 2.58757 1.6086
## condition_centered 1.76195 1.3274 0.23
## choiceImage (Intercept) 0.02107 0.1451
## Number of obs: 3680, groups: subject, 115; choiceImage, 16
##
## Fixed effects:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 0.94275 0.16285 5.789 7.07e-09 ***
## condition_centered 0.08031 0.15988 0.502 0.615
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## cndtn_cntrd 0.181Sampling-Test correlations
subj_sampling_test <- subj_sample_active %>%
bind_rows(subj_sample_passive) %>%
left_join(subj_test_by_condition)Plot Correlations
ggplot(subj_sampling_test,aes(prop_ambiguous,accuracy,color=round_condition))+
geom_violin(aes(group=prop_ambiguous),draw_quantiles=c(0.5),trim=T)+
geom_jitter(width=0.02)+
theme(legend.position="none")+
geom_smooth(method="lm")+
facet_wrap(~round_condition)
Test Correlations
Active condition
cor.test(filter(subj_sampling_test,round_condition=="active")$prop_ambiguous,filter(subj_sampling_test,round_condition=="active")$accuracy)##
## Pearson's product-moment correlation
##
## data: filter(subj_sampling_test, round_condition == "active")$prop_ambiguous and filter(subj_sampling_test, round_condition == "active")$accuracy
## t = 4.1335, df = 113, p-value = 6.886e-05
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## 0.1920476 0.5115749
## sample estimates:
## cor
## 0.3624134Passive condition
cor.test(filter(subj_sampling_test,round_condition=="passive")$prop_ambiguous,filter(subj_sampling_test,round_condition=="passive")$accuracy)##
## Pearson's product-moment correlation
##
## data: filter(subj_sampling_test, round_condition == "passive")$prop_ambiguous and filter(subj_sampling_test, round_condition == "passive")$accuracy
## t = 1.4598, df = 113, p-value = 0.1471
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## -0.04825955 0.31140570
## sample estimates:
## cor
## 0.1360532Exploratory: Test Interaction
d <- d %>%
left_join(subj_sampling_test)
m <- glmer(isRight ~ prop_ambiguous * condition_centered+(1+condition_centered|subject)+(1|choiceImage), data=filter(d,trialType=="test"), family=binomial)
summary(m)## Generalized linear mixed model fit by maximum likelihood (Laplace
## Approximation) [glmerMod]
## Family: binomial ( logit )
## Formula:
## isRight ~ prop_ambiguous * condition_centered + (1 + condition_centered |
## subject) + (1 | choiceImage)
## Data: filter(d, trialType == "test")
##
## AIC BIC logLik deviance df.resid
## 3921.8 3971.5 -1952.9 3905.8 3672
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -4.3429 -0.6486 0.2357 0.5918 2.9603
##
## Random effects:
## Groups Name Variance Std.Dev. Corr
## subject (Intercept) 2.33527 1.5282
## condition_centered 1.83941 1.3562 0.13
## choiceImage (Intercept) 0.02259 0.1503
## Number of obs: 3680, groups: subject, 115; choiceImage, 16
##
## Fixed effects:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 0.3098 0.3033 1.021 0.3071
## prop_ambiguous 1.0941 0.4764 2.297 0.0216 *
## condition_centered -0.3374 0.5649 -0.597 0.5504
## prop_ambiguous:condition_centered 0.4866 0.9810 0.496 0.6199
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) prp_mb cndtn_
## prop_ambigs -0.852
## cndtn_cntrd -0.013 0.138
## prp_mbgs:c_ 0.119 -0.246 -0.953Test Active condition by centering model on active condition
#shift condition coding (centered on active condition)
d <- d %>%
mutate(
condition_active = case_when(
round_condition=="active" ~ 0,
round_condition=="passive" ~ -1,
TRUE ~ NA_real_))
m_active <- glmer(isRight ~ prop_ambiguous * condition_active+(1+condition_active|subject)+(1|choiceImage), data=filter(d,trialType=="test"), family=binomial)
summary(m_active)## Generalized linear mixed model fit by maximum likelihood (Laplace
## Approximation) [glmerMod]
## Family: binomial ( logit )
## Formula: isRight ~ prop_ambiguous * condition_active + (1 + condition_active |
## subject) + (1 | choiceImage)
## Data: filter(d, trialType == "test")
##
## AIC BIC logLik deviance df.resid
## 3921.8 3971.5 -1952.9 3905.8 3672
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -4.3428 -0.6486 0.2357 0.5918 2.9603
##
## Random effects:
## Groups Name Variance Std.Dev. Corr
## subject (Intercept) 3.07152 1.7526
## condition_active 1.83943 1.3563 0.50
## choiceImage (Intercept) 0.02259 0.1503
## Number of obs: 3680, groups: subject, 115; choiceImage, 16
##
## Fixed effects:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 0.1412 0.4118 0.343 0.7316
## prop_ambiguous 1.3373 0.5936 2.253 0.0243 *
## condition_active -0.3373 0.5649 -0.597 0.5504
## prop_ambiguous:condition_active 0.4864 0.9809 0.496 0.6200
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) prp_mb cndtn_
## prop_ambigs -0.895
## conditn_ctv 0.676 -0.676
## prp_mbgs:c_ -0.565 0.628 -0.953Test Passive condition by centering model on passive condition
#shift condition coding (centered on passive condition)
d <- d %>%
mutate(
condition_passive = case_when(
round_condition=="active" ~ 1,
round_condition=="passive" ~ 0,
TRUE ~ NA_real_))
m_passive <- glmer(isRight ~ prop_ambiguous * condition_passive+(1+condition_passive|subject)+(1|choiceImage), data=filter(d,trialType=="test"), family=binomial)
summary(m_passive)## Generalized linear mixed model fit by maximum likelihood (Laplace
## Approximation) [glmerMod]
## Family: binomial ( logit )
## Formula:
## isRight ~ prop_ambiguous * condition_passive + (1 + condition_passive |
## subject) + (1 | choiceImage)
## Data: filter(d, trialType == "test")
##
## AIC BIC logLik deviance df.resid
## 3921.8 3971.5 -1952.9 3905.8 3672
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -4.3428 -0.6486 0.2357 0.5918 2.9603
##
## Random effects:
## Groups Name Variance Std.Dev. Corr
## subject (Intercept) 2.51885 1.5871
## condition_passive 1.83944 1.3563 -0.30
## choiceImage (Intercept) 0.02259 0.1503
## Number of obs: 3680, groups: subject, 115; choiceImage, 16
##
## Fixed effects:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 0.4785 0.4171 1.147 0.251
## prop_ambiguous 0.8509 0.7631 1.115 0.265
## condition_passive -0.3373 0.5648 -0.597 0.550
## prop_ambiguous:condition_passive 0.4865 0.9807 0.496 0.620
##
## Correlation of Fixed Effects:
## (Intr) prp_mb cndtn_
## prop_ambigs -0.916
## condtn_pssv -0.686 0.699
## prp_mbgs:c_ 0.732 -0.796 -0.953Does Sampling Preference predict subject-level accuracy differences?
subj_sampling_test_diff <- subj_sampling_test %>%
ungroup() %>%
group_by(subject, condition) %>%
summarize(
accuracy_diff=accuracy[round_condition=="active"]-accuracy[round_condition=="passive"],
prop_ambiguous_active=prop_ambiguous[round_condition=="active"],
prop_ambiguous_passive=prop_ambiguous[round_condition=="passive"],
prop_ambiguous_diff=prop_ambiguous_active-prop_ambiguous_passive
)
## plot relationships
pA <- ggplot(subj_sampling_test_diff,aes(prop_ambiguous_active,accuracy_diff))+
geom_jitter()+
geom_smooth(method="lm")+
xlab("Proportion Ambiguous Selections\nin Active Condition")+
ylab("Accuracy Difference Active - Passive")
pB <- ggplot(subj_sampling_test_diff,aes(prop_ambiguous_diff,accuracy_diff))+
geom_jitter()+
geom_smooth(method="lm")+
xlab("Difference in Ambiguous Selections\nActive-Passive")+
ylab("Accuracy Difference Active - Passive")
plot_grid(pA,pB)