Load data
load("C:/Users/aaron/Desktop/Research/Projects/Conveyor belt_AI_handover/CB data/CB_data.RData")
load("C:/Users/aaron/Desktop/Research/Projects/Conveyor belt_AI_handover/CB data/CB_data_2.RData")Load packages
library(rmdformats)
#CB_analysis
library(ggplot2)
library(readxl)
library(dplyr)
#LMM Analysis
library(lme4)
#plot
library(ggeffects)
library(ggplot2)Simple logistic regression
model <- glm(choice ~ group,
data = CB_data,
family = binomial)
summary(model)##
## Call:
## glm(formula = choice ~ group, family = binomial, data = CB_data)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.3575 -0.4996 -0.4389 -0.3944 2.2771
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -2.0178 0.2219 -9.092 <2e-16 ***
## groupHARD -0.2736 0.3001 -0.912 0.362
## groupIMPOSSIBLE 2.4318 0.2519 9.654 <2e-16 ***
## groupMEDIUM -0.4970 0.3137 -1.584 0.113
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 1165.24 on 1077 degrees of freedom
## Residual deviance: 873.75 on 1074 degrees of freedom
## AIC: 881.75
##
## Number of Fisher Scoring iterations: 5Logistic regression GLMM: group
Participants differ in baseline tendency to delegate. Once you account for that: • EASY: very low choice probability • HARD: slightly lower, but not reliably • MEDIUM: significantly lower • IMPOSSIBLE: dramatically higher.
model_mixed <- glmer(
choice ~ group + (1 | ID),
data = CB_data,
family = binomial
)
summary(model_mixed)## Generalized linear mixed model fit by maximum likelihood (Laplace
## Approximation) [glmerMod]
## Family: binomial ( logit )
## Formula: choice ~ group + (1 | ID)
## Data: CB_data
##
## AIC BIC logLik deviance df.resid
## 684.0 708.9 -337.0 674.0 1073
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -15.2602 -0.2593 -0.1617 -0.0399 10.0489
##
## Random effects:
## Groups Name Variance Std.Dev.
## ID (Intercept) 3.537 1.881
## Number of obs: 1078, groups: ID, 49
##
## Fixed effects:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -2.9507 0.4096 -7.203 5.87e-13 ***
## groupHARD -0.4568 0.3887 -1.175 0.2400
## groupIMPOSSIBLE 3.5978 0.3467 10.376 < 2e-16 ***
## groupMEDIUM -0.8406 0.4131 -2.035 0.0419 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) grHARD gIMPOS
## groupHARD -0.492
## gIMPOSSIBLE -0.679 0.575
## groupMEDIUM -0.451 0.517 0.520Effect sizes (odds ratio)
IMPOSSIBLE trials increase the odds of delegating by over 36× relative to EASY.
Relative to EASY, MEDIUM trials reduce the odds of delegating.
exp(fixef(model_mixed))## (Intercept) groupHARD groupIMPOSSIBLE groupMEDIUM
## 0.05230197 0.63332822 36.51670876 0.4314330595% CIs
exp(confint(model_mixed, parm = "beta_"))## Computing profile confidence intervals ...## 2.5 % 97.5 %
## (Intercept) 0.02237961 0.1132994
## groupHARD 0.29406394 1.3624486
## groupIMPOSSIBLE 19.09678877 74.6726261
## groupMEDIUM 0.18861334 0.9635974Predicted probability
preds <- ggpredict(model_mixed, terms = "group")Compare models (AIC)
Lower is better. Compared GLMM to the simple GLM (AIC ≈ 881). This is a massive improvement, the mixed model fits the data far better.
AIC(model, model_mixed)## df AIC
## model 4 881.7502
## model_mixed 5 683.9655Plot (probabilities not log odds)
Predicted Probability of Choosing is the model’s estimate of the probability that the participant delegated (not odds ratio)
preds$x <- factor(preds$x,
levels = c("EASY", "MEDIUM", "HARD", "IMPOSSIBLE"))
ggplot(preds, aes(x = x, y = predicted)) +
geom_point(data = CB_data, aes(x = group, y = choice),
position = position_jitter(width = 0.2),
alpha = 0.15, colour = "grey40") +
geom_ribbon(aes(ymin = conf.low, ymax = conf.high, group = 1),
fill = "#56B4E9", alpha = 0.35, colour = NA) +
geom_line(aes(group = 1), size = 1.2, colour = "#0072B2") +
geom_point(size = 3, colour = "#0072B2") +
labs(x = "Trial Difficulty", y = "Predicted Probability of Choosing") +
theme_bw()
logistic regression GLMM: group and NFC
Used z scored NfC.Included interaction with group. Nothing interesting?
model_mixed_nfc <- glmer(
choice ~ group * NFC_z + (1 | ID),
data = CB_data_2,
family = binomial
)
summary(model_mixed_nfc)## Generalized linear mixed model fit by maximum likelihood (Laplace
## Approximation) [glmerMod]
## Family: binomial ( logit )
## Formula: choice ~ group * NFC_z + (1 | ID)
## Data: CB_data_2
##
## AIC BIC logLik deviance df.resid
## 678.7 723.6 -330.4 660.7 1069
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -13.2112 -0.2518 -0.1365 -0.0351 9.3190
##
## Random effects:
## Groups Name Variance Std.Dev.
## ID (Intercept) 3.043 1.745
## Number of obs: 1078, groups: ID, 49
##
## Fixed effects:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -2.9158 0.3955 -7.372 1.69e-13 ***
## groupHARD -0.7009 0.4326 -1.620 0.1052
## groupIMPOSSIBLE 3.5214 0.3452 10.200 < 2e-16 ***
## groupMEDIUM -1.0722 0.4689 -2.286 0.0222 *
## NFC_z -0.3565 0.4384 -0.813 0.4161
## groupHARD:NFC_z -0.7581 0.5112 -1.483 0.1381
## groupIMPOSSIBLE:NFC_z 0.4907 0.3935 1.247 0.2124
## groupMEDIUM:NFC_z -0.7007 0.5467 -1.282 0.1999
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) grHARD grIMPOSSIBLE grMEDIUM NFC_z gHARD: gIMPOSSIBLE:
## groupHARD -0.447
## grIMPOSSIBLE -0.698 0.508
## groupMEDIUM -0.405 0.411 0.457
## NFC_z 0.091 -0.091 -0.108 -0.086
## grHARD:NFC_ -0.057 0.396 0.060 0.095 -0.529
## gIMPOSSIBLE: -0.110 0.099 0.107 0.095 -0.760 0.590
## gMEDIUM:NFC -0.060 0.095 0.067 0.439 -0.484 0.452 0.535logistic regression GLMM: group and previous trial difference score
Used z scored Tdiff.Included interaction with group. Model runs well. Significant interactions to poke at?
model_mixed_Tdiff <- glmer(
choice ~ group * Tdiff_z + (1 | ID),
data = CB_data_2,
family = binomial
)
summary(model_mixed_Tdiff)## Generalized linear mixed model fit by maximum likelihood (Laplace
## Approximation) [glmerMod]
## Family: binomial ( logit )
## Formula: choice ~ group * Tdiff_z + (1 | ID)
## Data: CB_data_2
##
## AIC BIC logLik deviance df.resid
## 603.5 648.4 -292.8 585.5 1069
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -9.1628 -0.2173 -0.1018 -0.0202 10.5846
##
## Random effects:
## Groups Name Variance Std.Dev.
## ID (Intercept) 2.717 1.648
## Number of obs: 1078, groups: ID, 49
##
## Fixed effects:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -2.8551 0.3858 -7.400 1.37e-13 ***
## groupHARD -0.7945 0.4607 -1.725 0.084607 .
## groupIMPOSSIBLE 2.6391 0.3506 7.528 5.14e-14 ***
## groupMEDIUM -0.8210 0.4352 -1.887 0.059208 .
## Tdiff_z 0.4217 0.2543 1.658 0.097305 .
## groupHARD:Tdiff_z 1.8575 0.4898 3.793 0.000149 ***
## groupIMPOSSIBLE:Tdiff_z 0.8240 0.3505 2.351 0.018745 *
## groupMEDIUM:Tdiff_z 0.9134 0.3561 2.565 0.010324 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) grHARD grIMPOSSIBLE grMEDIUM Tdff_z gHARD: gIMPOSSIBLE:
## groupHARD -0.402
## grIMPOSSIBLE -0.644 0.446
## groupMEDIUM -0.394 0.345 0.430
## Tdiff_z -0.001 0.029 -0.033 0.116
## grpHARD:Td_ -0.024 -0.246 0.031 -0.058 -0.450
## gIMPOSSIBLE: -0.109 -0.019 -0.102 -0.092 -0.755 0.361
## grMEDIUM:T_ 0.068 -0.059 -0.083 -0.202 -0.409 0.225 0.299logistic regression GLMM: group and payment
No interaction with group included. Significant effect of payment to poke at?
model_mixed_pay <- glmer(
choice ~ group + payment + (1 | ID),
data = CB_data_2,
family = binomial
)
summary(model_mixed_pay)## Generalized linear mixed model fit by maximum likelihood (Laplace
## Approximation) [glmerMod]
## Family: binomial ( logit )
## Formula: choice ~ group + payment + (1 | ID)
## Data: CB_data_2
##
## AIC BIC logLik deviance df.resid
## 678.5 708.4 -333.3 666.5 1072
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -15.3485 -0.2460 -0.1565 -0.0390 10.3986
##
## Random effects:
## Groups Name Variance Std.Dev.
## ID (Intercept) 2.921 1.709
## Number of obs: 1078, groups: ID, 49
##
## Fixed effects:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -0.4355 0.9553 -0.456 0.64844
## groupHARD -0.4576 0.3891 -1.176 0.23952
## groupIMPOSSIBLE 3.5939 0.3466 10.370 < 2e-16 ***
## groupMEDIUM -0.8426 0.4136 -2.037 0.04163 *
## payment -1.5552 0.5558 -2.798 0.00514 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) grHARD gIMPOS gMEDIU
## groupHARD -0.225
## gIMPOSSIBLE -0.217 0.575
## groupMEDIUM -0.219 0.516 0.521
## payment -0.912 0.015 -0.079 0.028