Emogo V1 Analysis
Martin Zettersten
2022-08-29
Read in data
data_path <- here("data-analysis","data","v1","processed", "emogo-v1-alldata-anonymized.csv")
d <- read_csv(data_path)## Rows: 20700 Columns: 43
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (30): trial_type, internal_node_id, subject, hitId, assignmentId, struct...
## dbl (11): trial_index, time_elapsed, rt, start_time, end_time, choice_index,...
## lgl (2): success, timeout
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.d <- d %>%
filter(
!(trial_type %in% c("show-reward"))
)Adding some useful columns
Adding columns to characterize participant choices.
d <- d %>%
mutate(
trial_number = case_when(
trial_index<8 ~ trial_index,
trial_index<199 ~ 7+(trial_index-7)/2,
TRUE ~ trial_index-96
)
) %>%
relocate(trial_number,.after=trial_index) %>%
mutate(
test_trial_number = case_when(
trial_number<7 ~ NA_real_,
trial_number<103 ~ trial_number-6,
TRUE ~ NA_real_
)
) %>%
relocate(test_trial_number,.after=trial_number) %>%
mutate(
block_trial_number = case_when(
test_trial_number < 49 ~ test_trial_number,
TRUE ~ test_trial_number - 48),
block_trial_number_c = block_trial_number - 24.5
) %>%
relocate(block_trial_number,.after=test_trial_number) %>%
relocate(block_trial_number_c,.after=block_trial_number) %>%
mutate(
explore_block = case_when(
test_trial_number<9 ~ 1,
test_trial_number<17 ~ 2,
test_trial_number<25 ~ 3,
test_trial_number<33 ~ 4,
test_trial_number < 41 ~ 5,
test_trial_number < 49 ~ 6,
test_trial_number < 57 ~ 7,
test_trial_number<65 ~ 8,
test_trial_number<73 ~ 9,
test_trial_number<81 ~ 10,
test_trial_number <89 ~ 11,
test_trial_number <97 ~ 12,
TRUE ~ NA_real_
)
) %>%
mutate(
max_reward_choice = case_when(
reward_score_unadjusted ==8 ~ 1,
!is.na(test_trial_number) ~ 0,
TRUE ~ NA_real_
)
) %>%
mutate(
cur_structure_condition=case_when(
test_trial_number < 49 ~ structure_condition,
!is.na(test_trial_number) & match_condition == "match" ~ structure_condition,
test_trial_number >= 49 & structure_condition == "emotion" ~ "model",
test_trial_number >= 49 & structure_condition == "model" ~ "emotion"
)
) %>%
mutate(block = case_when(
test_trial_number < 49 ~ 1,
test_trial_number >= 49 ~ 2,
TRUE ~ NA_real_
))Check data
attention_check <- d %>%
filter(trial_index %in% c(4,5)) %>%
mutate(
attention_check_correct_choice = case_when(
trial_index == 4 ~ "stimuli/horse.jpg",
trial_index == 5 ~ "stimuli/hammer.jpg"
),
check_correct = ifelse(attention_check_correct_choice==choiceImage,1,0)
) %>%
group_by(subject) %>%
summarize(
N=n(),
avg_correct = mean(check_correct)
)
passed_attention_check <- attention_check %>%
filter(avg_correct ==1) %>%
pull(subject)
d %>%
filter(subject %in% passed_attention_check) %>%
distinct(subject,structure_condition,match_condition) %>%
group_by(structure_condition,match_condition) %>%
tally()## # A tibble: 4 × 3
## # Groups: structure_condition [2]
## structure_condition match_condition n
## <chr> <chr> <int>
## 1 emotion match 25
## 2 emotion mismatch 25
## 3 model match 25
## 4 model mismatch 25reward_rank <- d %>%
filter(subject %in% passed_attention_check) %>%
filter(test_trial_number==96) %>%
select(subject,structure_condition,match_condition,score_after_trial)
ggplot(reward_rank,aes(x=score_after_trial,color=match_condition))+
geom_density()+
facet_wrap(~structure_condition)
Summarize
subject_by_block <- d %>%
filter(!is.na(explore_block)) %>%
group_by(subject,match_condition,structure_condition,explore_block) %>%
summarize(
max_choice_percent=mean(max_reward_choice)
)## `summarise()` has grouped output by 'subject', 'match_condition',
## 'structure_condition'. You can override using the `.groups` argument.summarize_by_block <- subject_by_block %>%
group_by(explore_block) %>%
summarize(
N=n(),
max_choice = mean(max_choice_percent),
se = sqrt(var(max_choice_percent, na.rm = TRUE)/N),
ci=qt(0.975, N-1)*sd(max_choice_percent,na.rm=TRUE)/sqrt(N),
lower_ci=max_choice-ci,
upper_ci=max_choice+ci,
lower_se=max_choice-se,
upper_se=max_choice+se
)
summarize_by_block_by_condition <- subject_by_block %>%
group_by(match_condition,structure_condition,explore_block) %>%
summarize(
N=n(),
max_choice = mean(max_choice_percent),
se = sqrt(var(max_choice_percent, na.rm = TRUE)/N),
ci=qt(0.975, N-1)*sd(max_choice_percent,na.rm=TRUE)/sqrt(N),
lower_ci=max_choice-ci,
upper_ci=max_choice+ci,
lower_se=max_choice-se,
upper_se=max_choice+se
)## `summarise()` has grouped output by 'match_condition', 'structure_condition'.
## You can override using the `.groups` argument.Plots
ggplot(subject_by_block,aes(explore_block,max_choice_percent, color=subject))+
geom_point(size=1.5,alpha=0.5)+
geom_line(alpha=0.5)+
geom_point(data=summarize_by_block,aes(y=max_choice),size=2,color="black")+
geom_line(data=summarize_by_block,aes(y=max_choice),size=1.2,color="black")+
geom_errorbar(data=summarize_by_block,aes(y=max_choice,ymin=lower_se,ymax=upper_se),width=0,color="black")+
geom_vline(xintercept=6.5,linetype="dotted")+
geom_hline(yintercept=0.25,linetype="dashed")+
theme(legend.position="none")+
scale_x_continuous(breaks=seq(1,12))+
xlab("Block (8 Trials = 1 Block)")+
ylab("Percent reward-maximizing choices")
ggplot(summarize_by_block_by_condition,aes(explore_block,max_choice, color=structure_condition,shape=match_condition,linetype=match_condition))+
geom_point(size=1.5,alpha=0.5)+
geom_line(alpha=0.5)+
geom_point(aes(y=max_choice),size=2)+
geom_line(aes(y=max_choice),size=1.2)+
geom_errorbar(aes(y=max_choice,ymin=lower_se,ymax=upper_se),width=0)+
geom_vline(xintercept=6.5,linetype="dotted")+
geom_hline(yintercept=0.25,linetype="dashed")+
#theme(legend.position="none")+
scale_x_continuous(breaks=seq(1,12))+
xlab("Block (8 Trials = 1 Block)")+
ylab("Percent reward-maximizing choices")
ggplot(subject_by_block,aes(explore_block,max_choice_percent, group=subject))+
#geom_point(size=1.5,alpha=0.5)+
geom_line(alpha=0.5)+
geom_vline(xintercept=6.5,linetype="dotted")+
geom_hline(yintercept=0.25,linetype="dashed")+
theme(legend.position="none")+
facet_wrap(~structure_condition+match_condition)+
scale_x_continuous(breaks=seq(1,12))+
xlab("Block (8 Trials = 1 Block)")+
ylab("Percent reward-maximizing choices")
Model
#recenter vars
d <- d %>%
mutate(
structure_condition_c = case_when(
structure_condition == "model" ~ -0.5,
structure_condition == "emotion" ~ 0.5),
cur_structure_condition_c = case_when(
cur_structure_condition == "model" ~ -0.5,
cur_structure_condition == "emotion" ~ 0.5),
match_condition_c = case_when(
match_condition == "match" ~ 0.5,
match_condition == "mismatch" ~ -0.5
),
block_c = case_when(
test_trial_number < 49 ~ -0.5,
TRUE ~ 0.5
)
)
#fit model
#m <- glmer(max_reward_choice ~ cur_structure_condition_c*match_condition_c*block_c*block_trial_number_c + (1+block_c*block_trial_number_c|subject)+(1|choiceImage),data=d, family=binomial)
#m <- glmer(max_reward_choice ~ cur_structure_condition_c*match_condition_c*block_c*block_trial_number_c + (1+block_trial_number_c||subject)+(1|choiceImage),data=d, family=binomial,glmerControl(optimizer="bobyqa"))
## the above models don't converge - will go through the pruning process more rigorously
m <- glmer(max_reward_choice ~ cur_structure_condition_c*match_condition_c*block_c*block_trial_number_c+ (1|subject)+(1|choiceImage),data=d, family=binomial,glmerControl(optimizer="bobyqa",optCtrl=list(maxfun=20000)))
summary(m)## Generalized linear mixed model fit by maximum likelihood (Laplace
## Approximation) [glmerMod]
## Family: binomial ( logit )
## Formula: max_reward_choice ~ cur_structure_condition_c * match_condition_c *
## block_c * block_trial_number_c + (1 | subject) + (1 | choiceImage)
## Data: d
## Control: glmerControl(optimizer = "bobyqa", optCtrl = list(maxfun = 20000))
##
## AIC BIC logLik deviance df.resid
## 9897.9 10026.9 -4930.9 9861.9 9582
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -24.7884 -0.5927 0.2121 0.5820 7.3011
##
## Random effects:
## Groups Name Variance Std.Dev.
## choiceImage (Intercept) 1.012 1.006
## subject (Intercept) 1.614 1.270
## Number of obs: 9600, groups: choiceImage, 256; subject, 100
##
## Fixed effects:
## Estimate
## (Intercept) 0.366047
## cur_structure_condition_c -0.639332
## match_condition_c 1.250502
## block_c -0.087783
## block_trial_number_c 0.040263
## cur_structure_condition_c:match_condition_c -0.337584
## cur_structure_condition_c:block_c -0.313915
## match_condition_c:block_c 0.807373
## cur_structure_condition_c:block_trial_number_c -0.018359
## match_condition_c:block_trial_number_c 0.011373
## block_c:block_trial_number_c -0.001101
## cur_structure_condition_c:match_condition_c:block_c 0.450306
## cur_structure_condition_c:match_condition_c:block_trial_number_c -0.020151
## cur_structure_condition_c:block_c:block_trial_number_c 0.016785
## match_condition_c:block_c:block_trial_number_c 0.001334
## cur_structure_condition_c:match_condition_c:block_c:block_trial_number_c -0.013667
## Std. Error
## (Intercept) 0.145031
## cur_structure_condition_c 0.189257
## match_condition_c 0.261312
## block_c 0.057312
## block_trial_number_c 0.001997
## cur_structure_condition_c:match_condition_c 0.378206
## cur_structure_condition_c:block_c 0.377759
## match_condition_c:block_c 0.116377
## cur_structure_condition_c:block_trial_number_c 0.003943
## match_condition_c:block_trial_number_c 0.003967
## block_c:block_trial_number_c 0.003885
## cur_structure_condition_c:match_condition_c:block_c 0.755394
## cur_structure_condition_c:match_condition_c:block_trial_number_c 0.007888
## cur_structure_condition_c:block_c:block_trial_number_c 0.007783
## match_condition_c:block_c:block_trial_number_c 0.007756
## cur_structure_condition_c:match_condition_c:block_c:block_trial_number_c 0.015612
## z value
## (Intercept) 2.524
## cur_structure_condition_c -3.378
## match_condition_c 4.785
## block_c -1.532
## block_trial_number_c 20.160
## cur_structure_condition_c:match_condition_c -0.893
## cur_structure_condition_c:block_c -0.831
## match_condition_c:block_c 6.938
## cur_structure_condition_c:block_trial_number_c -4.655
## match_condition_c:block_trial_number_c 2.867
## block_c:block_trial_number_c -0.283
## cur_structure_condition_c:match_condition_c:block_c 0.596
## cur_structure_condition_c:match_condition_c:block_trial_number_c -2.555
## cur_structure_condition_c:block_c:block_trial_number_c 2.157
## match_condition_c:block_c:block_trial_number_c 0.172
## cur_structure_condition_c:match_condition_c:block_c:block_trial_number_c -0.875
## Pr(>|z|)
## (Intercept) 0.01161
## cur_structure_condition_c 0.00073
## match_condition_c 1.71e-06
## block_c 0.12560
## block_trial_number_c < 2e-16
## cur_structure_condition_c:match_condition_c 0.37208
## cur_structure_condition_c:block_c 0.40598
## match_condition_c:block_c 3.99e-12
## cur_structure_condition_c:block_trial_number_c 3.23e-06
## match_condition_c:block_trial_number_c 0.00414
## block_c:block_trial_number_c 0.77689
## cur_structure_condition_c:match_condition_c:block_c 0.55109
## cur_structure_condition_c:match_condition_c:block_trial_number_c 0.01063
## cur_structure_condition_c:block_c:block_trial_number_c 0.03103
## match_condition_c:block_c:block_trial_number_c 0.86345
## cur_structure_condition_c:match_condition_c:block_c:block_trial_number_c 0.38134
##
## (Intercept) *
## cur_structure_condition_c ***
## match_condition_c ***
## block_c
## block_trial_number_c ***
## cur_structure_condition_c:match_condition_c
## cur_structure_condition_c:block_c
## match_condition_c:block_c ***
## cur_structure_condition_c:block_trial_number_c ***
## match_condition_c:block_trial_number_c **
## block_c:block_trial_number_c
## cur_structure_condition_c:match_condition_c:block_c
## cur_structure_condition_c:match_condition_c:block_trial_number_c *
## cur_structure_condition_c:block_c:block_trial_number_c *
## match_condition_c:block_c:block_trial_number_c
## cur_structure_condition_c:match_condition_c:block_c:block_trial_number_c
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1##
## Correlation matrix not shown by default, as p = 16 > 12.
## Use print(x, correlation=TRUE) or
## vcov(x) if you need itFollow-up models
trying to sort out how to look at individual conditions and blocks
m <- glmer(max_reward_choice ~ cur_structure_condition_c*block_trial_number_c+ (1+block_trial_number_c|subject)+(1|choiceImage),data=d, family=binomial)## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
## Model failed to converge with max|grad| = 0.00326546 (tol = 0.002, component 1)summary(m)## Generalized linear mixed model fit by maximum likelihood (Laplace
## Approximation) [glmerMod]
## Family: binomial ( logit )
## Formula:
## max_reward_choice ~ cur_structure_condition_c * block_trial_number_c +
## (1 + block_trial_number_c | subject) + (1 | choiceImage)
## Data: d
##
## AIC BIC logLik deviance df.resid
## 9727.9 9785.3 -4856.0 9711.9 9592
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -61.540 -0.584 0.129 0.578 4.434
##
## Random effects:
## Groups Name Variance Std.Dev. Corr
## choiceImage (Intercept) 1.070949 1.03487
## subject (Intercept) 2.822172 1.67993
## block_trial_number_c 0.002424 0.04923 0.82
## Number of obs: 9600, groups: choiceImage, 256; subject, 100
##
## Fixed effects:
## Estimate Std. Error z value
## (Intercept) 0.540477 0.184289 2.933
## cur_structure_condition_c -0.487870 0.074955 -6.509
## block_trial_number_c 0.051945 0.005535 9.385
## cur_structure_condition_c:block_trial_number_c -0.014268 0.004723 -3.021
## Pr(>|z|)
## (Intercept) 0.00336 **
## cur_structure_condition_c 7.58e-11 ***
## block_trial_number_c < 2e-16 ***
## cur_structure_condition_c:block_trial_number_c 0.00252 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) cr_s__ blc___
## cr_strctr__ -0.001
## blck_trl_n_ 0.714 -0.009
## cr_st__:___ -0.006 0.147 -0.009
## optimizer (Nelder_Mead) convergence code: 0 (OK)
## Model failed to converge with max|grad| = 0.00326546 (tol = 0.002, component 1)m <- glmer(max_reward_choice ~ match_condition_c*block_trial_number_c*block_c+ (1+block_trial_number_c|subject)+(1|choiceImage),data=d, family=binomial)## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
## Model failed to converge with max|grad| = 0.0591377 (tol = 0.002, component 1)summary(m)## Generalized linear mixed model fit by maximum likelihood (Laplace
## Approximation) [glmerMod]
## Family: binomial ( logit )
## Formula: max_reward_choice ~ match_condition_c * block_trial_number_c *
## block_c + (1 + block_trial_number_c | subject) + (1 | choiceImage)
## Data: d
##
## AIC BIC logLik deviance df.resid
## 9704.6 9790.6 -4840.3 9680.6 9588
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -64.509 -0.584 0.130 0.579 4.570
##
## Random effects:
## Groups Name Variance Std.Dev. Corr
## choiceImage (Intercept) 1.075042 1.03684
## subject (Intercept) 2.409021 1.55210
## block_trial_number_c 0.002417 0.04916 0.82
## Number of obs: 9600, groups: choiceImage, 256; subject, 100
##
## Fixed effects:
## Estimate Std. Error z value
## (Intercept) 0.543771 0.172797 3.147
## match_condition_c 1.443057 0.319467 4.517
## block_trial_number_c 0.051998 0.005534 9.395
## block_c -0.092464 0.058178 -1.589
## match_condition_c:block_trial_number_c 0.025082 0.010945 2.292
## match_condition_c:block_c 0.838523 0.118100 7.100
## block_trial_number_c:block_c -0.001361 0.003934 -0.346
## match_condition_c:block_trial_number_c:block_c 0.005426 0.007861 0.690
## Pr(>|z|)
## (Intercept) 0.00165 **
## match_condition_c 6.27e-06 ***
## block_trial_number_c < 2e-16 ***
## block_c 0.11199
## match_condition_c:block_trial_number_c 0.02193 *
## match_condition_c:block_c 1.25e-12 ***
## block_trial_number_c:block_c 0.72940
## match_condition_c:block_trial_number_c:block_c 0.49009
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) mtch__ blc___ blck_c mt__:___ mt__:_ b___:_
## mtch_cndtn_ 0.023
## blck_trl_n_ 0.706 0.040
## block_c 0.001 0.002 0.000
## mtch_c_:___ 0.037 0.763 0.068 0.007
## mtch_cnd_:_ 0.005 0.011 0.013 0.127 0.003
## blck_tr__:_ -0.001 0.003 0.006 0.159 0.009 0.106
## mtc__:___:_ 0.004 0.001 0.008 0.107 0.007 0.166 0.111
## optimizer (Nelder_Mead) convergence code: 0 (OK)
## Model failed to converge with max|grad| = 0.0591377 (tol = 0.002, component 1)m <- glmer(max_reward_choice ~ match_condition_c*block_trial_number_c+ (1+block_trial_number_c|subject)+(1|choiceImage),data=filter(d,block==2), family=binomial)## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
## Model failed to converge with max|grad| = 0.00482086 (tol = 0.002, component 1)summary(m)## Generalized linear mixed model fit by maximum likelihood (Laplace
## Approximation) [glmerMod]
## Family: binomial ( logit )
## Formula: max_reward_choice ~ match_condition_c * block_trial_number_c +
## (1 + block_trial_number_c | subject) + (1 | choiceImage)
## Data: filter(d, block == 2)
##
## AIC BIC logLik deviance df.resid
## 3918.6 3970.4 -1951.3 3902.6 4792
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -47.118 -0.368 0.022 0.348 7.633
##
## Random effects:
## Groups Name Variance Std.Dev. Corr
## choiceImage (Intercept) 4.650239 2.15644
## subject (Intercept) 8.345391 2.88884
## block_trial_number_c 0.009313 0.09651 0.86
## Number of obs: 4800, groups: choiceImage, 255; subject, 100
##
## Fixed effects:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 0.76174 0.33594 2.268 0.0234 *
## match_condition_c 2.36000 0.60452 3.904 9.47e-05 ***
## block_trial_number_c 0.08098 0.01137 7.125 1.04e-12 ***
## match_condition_c:block_trial_number_c 0.04376 0.02172 2.015 0.0439 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) mtch__ blc___
## mtch_cndtn_ 0.042
## blck_trl_n_ 0.743 0.068
## mtch_c_:___ 0.057 0.816 0.093
## optimizer (Nelder_Mead) convergence code: 0 (OK)
## Model failed to converge with max|grad| = 0.00482086 (tol = 0.002, component 1)m <- glmer(max_reward_choice ~ match_condition_c*block_trial_number_c+ (1+block_trial_number_c|subject)+(1|choiceImage),data=filter(d,block==1), family=binomial)
summary(m)#not really sure why there should be a match effect here... Noise?## Generalized linear mixed model fit by maximum likelihood (Laplace
## Approximation) [glmerMod]
## Family: binomial ( logit )
## Formula: max_reward_choice ~ match_condition_c * block_trial_number_c +
## (1 + block_trial_number_c | subject) + (1 | choiceImage)
## Data: filter(d, block == 1)
##
## AIC BIC logLik deviance df.resid
## 4321.7 4373.5 -2152.8 4305.7 4792
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -11.1178 -0.3982 0.1015 0.4471 6.8175
##
## Random effects:
## Groups Name Variance Std.Dev. Corr
## choiceImage (Intercept) 3.607795 1.89942
## subject (Intercept) 4.671596 2.16139
## block_trial_number_c 0.004254 0.06522 0.78
## Number of obs: 4800, groups: choiceImage, 251; subject, 100
##
## Fixed effects:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 0.458122 0.257661 1.778 0.0754 .
## match_condition_c 1.034323 0.449788 2.300 0.0215 *
## block_trial_number_c 0.063418 0.007741 8.192 2.57e-16 ***
## match_condition_c:block_trial_number_c 0.011691 0.015113 0.774 0.4392
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) mtch__ blc___
## mtch_cndtn_ 0.018
## blck_trl_n_ 0.616 0.036
## mtch_c_:___ 0.029 0.707 0.050